R/simdata.r

In amp.sim: Flexible Simulation Utilities for Pharmacometric Modeling

#------------------------------------------ simdata ------------------------------------------
#' Create a simulation dataset for NONMEM simulation
#'
#' This function creates a simulation dataset including information
#'  for dosing and sampling. The function is setup to return a data frame
#'  to be used within NONMEM or other frameworks
#' @param time a vector with all sampling times to be used
#' @param dosetime a vector with the different dosing times
#' @param doseheight a vector with the different dosing heights (to be added to AMT)
#' @param addl a vector with the additional dose levels (must be same length as doseheight)
#' @param ii a vector with the interdose interval (must be same length as doseheight)
#' @param rate a vector with the dosing rate (must be same length as doseheight)
#' @param numid a vector with the number of IDs to be created
#' @param ... additional variables to be added to the resulting dataset
#'
#' @export
#' @return a dataframe that can be used for NONMEM simulations
#' @author Richard Hooijmaijers
#' @examples
#'
#' # Include additional variables
#' sim1 <- simdata(seq(0,24,1),0.5,100,10,12,NA,2, WEIGHT=70, ETA=0)
#'
#' # unequal dosing scheme
#' sim2 <- simdata(seq(0,24,1), dosetime = c(0.5,1), doseheight = c(100,200),
#'                 addl = c(10,5), ii = c(12,24), numid = 2)
#'
#' # Directly create a sequence of different dose levels
#' sim3 <- lapply(seq(25,60,5),function(x){
#'   simdata(time=1:12,dosetime=0,doseheight=x,addl=139,ii=120,rate=0,numid=10)
#' }) 
#' sim3 <- do.call(rbind,sim3)
#'
simdata <- function(time,dosetime,doseheight,addl,ii,rate=NA,numid=5,...){
  dose     <- data.frame(TIME=dosetime,DV=NA,AMT=doseheight,ADDL=addl,II=ii,RATE=rate)
  obs      <- data.frame(TIME=time,DV=NA,AMT=NA,ADDL=NA,II=NA,RATE=NA)
  out      <- rbind(dose,obs)
  out$DOSE <- doseheight[1]
  out      <- out[rep(1:nrow(out),numid),]
  out$ID   <- rep(1:numid,each=nrow(out)/numid)
  out      <- out[,c("ID", "DOSE", "TIME", "AMT", "ADDL", "II", "RATE", "DV")]
  out      <- out[order(out$ID,out$TIME),]
  if(all(is.na(out$RATE))) out <- out[,names(out)!="RATE"]  
  addarg <- list(...)
  if(length(addarg)>0){
    for(i in seq_along(addarg)) out[,names(addarg)[i]] <- addarg[[i]]
  }
  return(out)
}