-
Notifications
You must be signed in to change notification settings - Fork 0
/
createCovariates.R
executable file
·128 lines (105 loc) · 5.33 KB
/
createCovariates.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
createCovariates <- function(
subjects, #@ Subjects for which to create covariates
## arguments for the `createContinuousCovariates` function
conNames=NULL,#@ Continuous covariate names
conMean, #@ Continuous covariate means
conCov, #@ Continuous covariate covariance matrix
conRange=NULL,#@ Continuous covariate acceptable range
conDigits, #@ Continuous covariate rounding digits
conMaxDraws=100,#@ Continuous covariate maximum draws
## arguments for the `createDiscreteCovariates` function
disNames=NULL,#@ Discrete covariate names
disValues, #@ Discrete covariate values
disProbs, #@ Discrete covariate probabilities
disProbArray, #@ Array of probabilities for multivariate sampling
##arguments for the `createExternalCovariates` function
extNames=NULL,#@ Names for the continuous covariates
extFile, #@ File from which to import (including full or relative path)
extSubset, #@ Subset to apply to data
extRefCol, #@ Reference variable
extSameRow=TRUE, #@ Logical flag: should covariates sampled be from the same row
extDataId=idCol, #@ Subject variable name from file
workingPath = getwd(), #@ Working directory
## arguments for the `createTimeVaryingCovariates` function
timeNames=NULL,
timeMean,
timeCov,
timeRange=NULL,
timeCol = getEctdColName("Time"),
timePeriod,
## common args
idCol = getEctdColName("Subject"), #@ Subject variable name for return data
seed=.deriveFromMasterSeed() #@ random seed
){
###############################################################################
# � Mango Solutions, Chippenham SN14 0SQ 2006
# createCovariates.R Fri Jun 01 10:44:40 BST 2007 @447 /Internet Time/
#
# Author: Romain
###############################################################################
# DESCRIPTION: covariate component, wrapper for the functions:
# createContinuousCovariates, createExtenalCovariates,
# createDiscreteCovariates
# KEYWORDS: datagen, component:covariate
###############################################################################
set.seed( seed )
subjects <- .expandSubjects( subjects )
idCol <- parseCharInput( idCol, convertToNumeric = FALSE, expected = 1, valid = TRUE)
timeCol <- parseCharInput( timeCol, convertToNumeric = FALSE, expected = 1, valid = TRUE)
conNames <- parseCharInput( conNames, convertToNumeric = FALSE, checkdup = TRUE )
extNames <- parseCharInput( extNames, convertToNumeric = FALSE, checkdup = TRUE )
disNames <- parseCharInput( disNames, convertToNumeric = FALSE, checkdup = TRUE )
timeNames <- parseCharInput( timeNames, convertToNumeric = FALSE, checkdup = TRUE )
if( any(duplicated(c(conNames, extNames, disNames, timeNames))))
ectdStop("duplicated names in `conNames`, `extNames`, `disNames`, `timeNames`")
## calling the createContinuousCovariates function
dataList <- NULL
dataList[[idCol]] <- .eval( "data.frame( $idCol = subjects)" )
dataList$continuous <- if( !is.null(conNames) ){
conArgs <- list(
subjects = subjects, names = conNames,
idCol = idCol, seed = seed,
range = conRange, maxDraws = conMaxDraws,
includeIDCol = FALSE)
if(!missing(conMean)) conArgs$mean <- conMean
if(!missing(conCov)) conArgs$covariance <- conCov
if(!missing(conDigits)) conArgs$digits <- conDigits
do.call( createContinuousCovariates, conArgs)
}
## calling the createExternalCovariates function
dataList$external <- if( !is.null(extNames) ){
extArgs <- list( subjects = subjects, names = extNames, idCol = idCol,
seed = seed, sameRow = extSameRow, dataId = extDataId,
includeIDCol = FALSE, workingPath = workingPath )
if(!missing(extFile) ) extArgs$file <- extFile
if(!missing(extSubset) ) extArgs$subset <- extSubset
if(!missing(extRefCol) ) extArgs$refCol <- extRefCol
do.call( createExternalCovariates, extArgs)
}
## calling the createDiscreteCovariates function
probCall <- !missing(disProbArray) && length(disProbArray)
dataList$discrete <- if( !is.null(disNames) | probCall){
disArgs <- list( subjects = subjects, idCol = idCol, seed = seed, includeIDCol = FALSE )
if( !missing(disNames )) disArgs$names <- disNames
if( !missing(disValues )) disArgs$values <- disValues
if( !missing(disProbs )) disArgs$probs <- disProbs
if( !missing(disProbArray)) disArgs$probArray <- disProbArray
do.call( createDiscreteCovariates, disArgs)
}
names( dataList ) <- NULL
out <- do.call(data.frame, dataList[!sapply(dataList, is.null)] )
out.time <- if( !is.null(timeNames) ){
timeArgs <- list(
subjects = subjects, names = timeNames,
idCol = idCol, seed = seed,
range = timeRange, maxDraws = conMaxDraws,
timeCol = timeCol)
if(!missing(timeMean)) timeArgs$mean <- timeMean
if(!missing(timeCov)) timeArgs$covariance <- timeCov
if(!missing(conDigits)) timeArgs$digits <- conDigits
if(!missing(timePeriod)) timeArgs$treatPeriod <- timePeriod
do.call( createTimeVaryingCovariates, timeArgs)
}
if (!is.null(out.time)) out <- merge(out.time, out)
out
}