R/createParameters.R

In MSToolkit: The MSToolkit library for clinical trial design

createParameters <- function( 
  subjects,              #@ subjects for which to create parameters
  
  ## arguments for the `createNormalParameters` function
  genNames,              #@ Names of fixed effects to generate
  genFixedMean,          #@ Means for generating fixed parameters
  genFixedCov = 0,       #@ Covariance Matrix for generating fixed parameter
  genRange,              #@ Range of Acceptable values for derived parameters
  genBetweenNames,       #@ Between subjects effects to generate
  genBetweenMean,        #@ Means for generated bw effects
  genBetweenCov,         #@ bw covariance
  genErrStruc = "None",  #@ how to map effects
  genMaxDraws = 10,      #@ maximum number of draws
  genParRangeTolerance = .5,  ## Proportion of subjects with "in range" parameters with which we'd be happy proceeding
  
  ## arguments for the `createExternalParameters` function
  extFile,               #@ file name for data to import
  extNames,              #@ Names of parameters to import
  extBetween,            #@ bw subject effect variables in the data
  extBetweenNums,        #@ integer mapping  between random and fixed effects
  extSubset,             #@ subset to be applied to data before sampling
  extRange,              #@ Range of Acceptable values for derived parameters
  extErrStruc = "None",  #@ function to map effects
  extRefCol,             #@ Column of reference data
  extRefColName,         #@ Reference column name
  extRefColSuffix,       #@ Reference column name
  extIndEffects,         #@ individual effects flag
  extDataId = idCol,     #@ External subject variable name
  workingPath = getwd(), #@ Working directory
  
  ## arguments for both
  suffix = ".Between",   #@ suffix for retained between subject effects
  idCol  = getEctdColName("Subject"),         #@ Subject variable name
  seed = .deriveFromMasterSeed( ) , #@ Random seed 
  flagName = getEctdColName("ParOmit")   #@ name for omit flag
) 
{
  ##############################################################################
  # Mango Solutions, Chippenham SN15 1BN 2009
  # createParameters.R Thu Jun 21 16:54:02 BST 2007 @704 /Internet Time/
  #
  # Author: Romain/Rich P
  ###############################################################################
  # DESCRIPTION: create parameters wrapper
  # KEYWORDS: datagen, component:data:parameter
  ##############################################################################

	subjects <- .expandSubjects( subjects )  
  
	idCol    <- parseCharInput( idCol, expected = 1, convertToNumeric = FALSE, valid = TRUE)
	flagName <- parseCharInput( flagName, expected = 1, convertToNumeric = FALSE, valid = TRUE)
  
	test1 <- !missing(genNames) && !missing(genFixedMean)
	test2 <- !missing(extFile)  && !missing(extNames)
  
	if (test1) genNames <- parseCharInput( genNames , convertToNumeric = FALSE, checkdup = TRUE)
	if (test2) extNames <- parseCharInput( extNames , convertToNumeric = FALSE, checkdup = TRUE)
	if(test1 & test2 && any(genNames %in% extNames) ) ectdStop( "Duplicated names between `genNames` and `extNames`")
    
  if( !test1 && !test2){
    out <- .eval( "data.frame( $idCol = subjects, $flagName = rep(0, length(subjects)) )" )
    return( out ) 
  }
	if( test1 ){  
		## generate parameters from a MVN distribution using createNormalParameters
    
		## build the argument list
	    argsNP <- list( subjects = subjects, idCol = idCol, 
   			seed = seed, flagName = flagName, suffix = suffix, 
   			errStruc = genErrStruc, covariance = genFixedCov, parRangeTolerance = genParRangeTolerance  )
   		## handle missing arguments 
		if(!missing(genNames       )) argsNP$names      <- genNames       
    	if(!missing(genFixedMean   )) argsNP$mean       <- genFixedMean   
    	if(!missing(genRange  ))      argsNP$range      <- genRange
    	if(!missing(genBetweenNames)) argsNP$betNames   <- genBetweenNames
    	if(!missing(genBetweenMean )) argsNP$betMean    <- genBetweenMean 
    	if(!missing(genBetweenCov  )) argsNP$betCov     <- genBetweenCov  
    	if(!missing(genMaxDraws    )) argsNP$maxDraws   <- genMaxDraws    
    
    	## call the createNormalParameters function and check its output   
    	genData <- try( do.call(createNormalParameters, argsNP), silent = TRUE ) 
    	if( class(genData) == "try-error") ectdStop( "Errors when building data from normal distribution\n\t$genData"  )
    	if( !is.data.frame(genData)) ectdStop( "The dataset generated by `createNormalParameters` is not a data frame")
		if( nrow(genData) != length(subjects) ) ectdStop( "The number of lines in the dataset does not match the number of subjects requested")    
	}
	
	if( test2 ){ 
    ## generate parameters by sampling from a file using `createExternalParameters` 
	
    ## build the argument list
    argsEX <- list( subjects = subjects, idCol = idCol, seed = seed, flagName = flagName, 
      errStruc = extErrStruc, file = extFile, names = extNames, workingPath = workingPath, dataId = extDataId )
    ## handle missing arguments                    
    if( !missing(extBetween    )) argsEX$betNames    <- extBetween              
    if( !missing(extBetweenNums)) argsEX$betNums     <- extBetweenNums      
    if( !missing(extSubset     )) argsEX$subset      <- extSubset            
	if( !missing(extRange      )) argsNP$range       <- extRange
	if( !missing(extRefCol     )) argsEX$refCol      <- extRefCol                
    if( !missing(extRefColName )) argsEX$refColName  <- extRefColName        
	if( !missing(extRefColSuffix)) argsEX$refColSuffix  <- extRefColSuffix
	if( !missing(extIndEffects )) argsEX$indEffects  <- extIndEffects        
    	
	## call the function and check consistency of the output
    extData <- try( do.call( createExternalParameters, argsEX), silent =  TRUE)
	if( class(extData) == "try-error") ectdStop( "Errors when importing data from file \n\t $extFile" )  
    if( !is.data.frame(extData)) ectdStop( "The dataset generated by `createExternalParameters` is not a data frame") 
    if( nrow(extData) != length(subjects) ) ectdStop( "The number of lines in the dataset does not match the number of subjects requested")    
  }
  
  ## build the output data
  out <- switch( test1 + 2*test2, 
    genData,                  # (1) only test1 is TRUE ->  normal data
    extData,                  # (2) only test2 is TRUE ->  external data
    {                         # (3) merge genData and extData
      namesGD <- names(genData)
      namesEX <- names(extData)
      data.frame( 
        genData[,namesGD != flagName, drop = FALSE],  # all data from genData but the paromit 
        extData[,namesEX %!in% c(idCol, flagName) , drop = FALSE],   # all data from extData but the id and flag
        1 * ( extData[,flagName,drop=FALSE] | genData[,flagName,drop=FALSE] ) ) # omit from gen or ext
    })
  out
}