1
## Create Table1 : include 2 strata
2

3

4
#' @title CreateTableOne2: Modified CreateTableOne function in tableone package
5
#' @description Combine CreateTableOne & print function in tableone package
6
#' @param data A data frame in which these variables exist. All variables (both vars and strata) must be in this data frame.
7
#' @param strata Stratifying (grouping) variable name(s) given as a character vector. If omitted, the overall results are returned.
8
#' @param vars Variables to be summarized given as a character vector. Factors are handled as categorical variables, whereas numeric variables are handled as continuous variables. If empty, all variables in the data frame specified in the data argument are used.
9
#' @param factorVars Numerically coded variables that should be handled as categorical variables given as a character vector. Do not include factors, unless you need to relevel them by removing empty levels. If omitted, only factors are considered categorical variables. The variables specified here must also be specified in the vars argument.
10
#' @param includeNA If TRUE, NA is handled as a regular factor level rather than missing. NA is shown as the last factor level in the table. Only effective for categorical variables., Default: F
11
#' @param test If TRUE, as in the default and there are more than two groups, groupwise comparisons are performed, Default: T
12
#' @param testApprox A function used to perform the large sample approximation based tests. The default is chisq.test. This is not recommended when some of the cell have small counts like fewer than 5, Default: chisq.test
13
#' @param argsApprox A named list of arguments passed to the function specified in testApprox. The default is list(correct = TRUE), which turns on the continuity correction for chisq.test, Default: list(correct = TRUE)
14
#' @param testExact A function used to perform the exact tests. The default is fisher.test. If the cells have large numbers, it will fail because of memory limitation. In this situation, the large sample approximation based should suffice., Default: fisher.test
15
#' @param argsExact A named list of arguments passed to the function specified in testExact. The default is list(workspace = 2 * 10^5), which specifies the memory space allocated for fisher.test, Default: list(workspace = 2 * 10^5)
16
#' @param testNormal A function used to perform the normal assumption based tests. The default is oneway.test. This is equivalent of the t-test when there are only two groups, Default: oneway.test
17
#' @param argsNormal A named list of arguments passed to the function specified in testNormal. The default is list(var.equal = TRUE), which makes it the ordinary ANOVA that assumes equal variance across groups., Default: list(var.equal = F)
18
#' @param testNonNormal A function used to perform the nonparametric tests. The default is kruskal.test (Kruskal-Wallis Rank Sum Test). This is equivalent of the wilcox.test (Man-Whitney U test) when there are only two groups, Default: kruskal.test
19
#' @param argsNonNormal A named list of arguments passed to the function specified in testNonNormal. The default is list(NULL), which is just a placeholder., Default: list(NULL)
20
#' @param showAllLevels Whether to show all levels. FALSE by default, i.e., for 2-level categorical variables, only the higher level is shown to avoid redundant information., Default: T
21
#' @param printToggle Whether to print the output. If FALSE, no output is created, and a matrix is invisibly returned., Default: F
22
#' @param quote Whether to show everything in quotes. The default is FALSE. If TRUE, everything including the row and column names are quoted so that you can copy it to Excel easily, Default: F
23
#' @param smd If TRUE, as in the default and there are more than two groups, standardized mean differences for all pairwise comparisons are calculated, Default: F
24
#' @param Labels Use Label, Default: F
25
#' @param exact A character vector to specify the variables for which the p-values should be those of exact tests. By default all p-values are from large sample approximation tests (chisq.test)., Default: NULL
26
#' @param nonnormal A character vector to specify the variables for which the p-values should be those of nonparametric tests. By default all p-values are from normal assumption-based tests (oneway.test)., Default: NULL
27
#' @param catDigits Number of digits to print for proportions., Default: 1
28
#' @param contDigits Number of digits to print for continuous variables. Default 2.
29
#' @param pDigits Number of digits to print for p-values (also used for standardized mean differences), Default: 3
30
#' @param labeldata labeldata to use, Default: NULL
31
#' @param minMax Whether to use [min,max] instead of [p25,p75] for nonnormal variables. The default is FALSE.
32
#' @return A matrix object containing what you see is also invisibly returned. This can be assinged a name and exported via write.csv.
33
#' @details DETAILS
34
#' @examples 
35
#'  library(survival)
36
#'  CreateTableOne2(vars = names(lung), strata = "sex", data = lung)
37
#' @rdname CreateTableOne2
38
#' @importFrom data.table data.table := setkey
39
#' @importFrom tableone CreateTableOne 
40
#' @importFrom labelled var_label var_label<-
41
#' @importFrom stats chisq.test fisher.test kruskal.test oneway.test
42
#' @importFrom methods is
43
#' @export 
44

45
CreateTableOne2 <- function(data, strata, vars, factorVars, includeNA = F, test = T,
46
                           testApprox = chisq.test, argsApprox = list(correct = TRUE),
47
                           testExact = fisher.test, argsExact = list(workspace = 2 * 10^5),
48
                           testNormal = oneway.test, argsNormal = list(var.equal = F),
49
                           testNonNormal = kruskal.test, argsNonNormal = list(NULL), 
50
                           showAllLevels = T, printToggle = F, quote = F, smd = F, Labels = F, exact = NULL, nonnormal = NULL, 
51
                           catDigits = 1, contDigits = 2, pDigits = 3, labeldata = NULL, minMax = F){
52
  
53 2
  setkey <- variable <- level <- . <- val_label <- NULL
54
  
55 2
  if (length(strata) != 1){
56 0
    stop("Please select only 1 strata")
57
  }
58
  
59
  
60 2
  res <- tableone::CreateTableOne(vars =vars, strata = strata, data = data, factorVars = factorVars, includeNA = includeNA, test = test, 
61 2
                       testApprox = testApprox, argsApprox = argsApprox,
62 2
                       testExact = testExact, argsExact = argsExact,
63 2
                       testNormal = testNormal, argsNormal = argsNormal,
64 2
                       testNonNormal = testNonNormal, argsNonNormal = argsNonNormal, smd = smd)
65
  
66
  #factor_vars <- vars[sapply(vars, function(x){class(data[[x]]) %in% c("factor", "character")})]
67 2
  factor_vars <- res[["MetaData"]][["varFactors"]]
68
  
69 2
  if (Labels & !is.null(labeldata)){
70 2
    labelled::var_label(data) = sapply(names(data), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
71
    #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
72 2
    data.table::setkey(labeldata, variable, level)
73 2
    res0 <- tableone::CreateTableOne(vars =vars, data = data, factorVars = factorVars, includeNA = includeNA)
74 2
    for (i in seq_along(res0$CatTable)){
75 2
      for(j in factor_vars){
76 2
        lvs <- res0$CatTable[[i]][[j]]$level
77 2
        res0$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label]
78
      }
79
    }
80
    
81 2
    ptb1.res0 <- print(res0, showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal,
82 2
                       catDigits = catDigits, contDigits = contDigits, minMax = minMax)
83 2
    ptb1.rn <- rownames(ptb1.res0)
84 2
    ptb1.rn <- gsub("(mean (SD))", "", ptb1.rn, fixed=T)
85
  }
86
  
87 2
  vars.fisher <- sapply(factor_vars, function(x){is(tryCatch(chisq.test(table(data[[strata]], data[[x]])),error=function(e) e, warning=function(w) w), "warning")})
88 2
  vars.fisher <- factor_vars[unlist(vars.fisher)]
89
  
90 2
  if (is.null(exact) & length(vars.fisher) > 0){
91 2
    exact <- vars.fisher
92
  }
93
  
94 2
  ptb1 <- print(res,
95 2
               showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, smd = smd, varLabels = Labels, nonnormal = nonnormal, exact = exact,
96 2
               catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax)
97
  
98 2
  rownames(ptb1) <- gsub("(mean (SD))", "", rownames(ptb1), fixed=T)
99 2
  if (Labels & !is.null(labeldata)){
100 2
    rownames(ptb1) <- ptb1.rn
101 2
    if (showAllLevels == T) ptb1[, 1] <- ptb1.res0[, 1]
102
  }
103
  
104
  #cap.tb1 = paste("Table 1: Stratified by ", strata, sep="")
105
  
106 2
  if (Labels & !is.null(labeldata)){
107 2
    colname.group_var <- unlist(labeldata[.(strata, names(res$CatTable)), val_label])
108 2
    if(showAllLevels == T){
109
      #colname.group_var <- unlist(labeldata[get("variable") == strata, "val_label"])
110 2
      colnames(ptb1)[1:(length(colname.group_var)+1)] <- unlist(c(labeldata[get("variable") == strata, "var_label"][1], colname.group_var))
111
    } else{
112 2
      colnames(ptb1)[1:length(colname.group_var)] <- colname.group_var
113
    }
114
    #ptb1[,1] = vals.tb1
115
    #cap.tb1 = paste("Table 1: Stratified by ", labeldata[variable == strata, "var_label"][1], sep="")
116
    
117
  }
118
  
119 2
  sig <- ifelse(ptb1[,"p"] == "<0.001", "0", ptb1[,"p"])
120 2
  sig <- as.numeric(as.vector(sig))
121 2
  sig <- ifelse(sig <= 0.05, "**", "")
122 2
  ptb1 <- cbind(ptb1, sig)
123 2
  return(ptb1)
124
}
125

126

127

128
#' @title CreateTableOneJS: Modified CreateTableOne function in tableone package
129
#' @description Combine CreateTableOne & print function in tableone package
130
#' @param data A data frame in which these variables exist. All variables (both vars and strata) must be in this data frame.
131
#' @param strata Stratifying grouping variable name(s) given as a character vector. If omitted, the overall results are returned.
132
#' @param strata2 Stratifying 2nd grouping variable name(s) given as a character vector. If omitted, the 1 group results are returned.
133
#' @param vars Variables to be summarized given as a character vector. Factors are handled as categorical variables, whereas numeric variables are handled as continuous variables. If empty, all variables in the data frame specified in the data argument are used.
134
#' @param factorVars Numerically coded variables that should be handled as categorical variables given as a character vector. Do not include factors, unless you need to relevel them by removing empty levels. If omitted, only factors are considered categorical variables. The variables specified here must also be specified in the vars argument.
135
#' @param includeNA If TRUE, NA is handled as a regular factor level rather than missing. NA is shown as the last factor level in the table. Only effective for categorical variables., Default: F
136
#' @param test If TRUE, as in the default and there are more than two groups, groupwise comparisons are performed, Default: T
137
#' @param testApprox A function used to perform the large sample approximation based tests. The default is chisq.test. This is not recommended when some of the cell have small counts like fewer than 5, Default: chisq.test
138
#' @param argsApprox A named list of arguments passed to the function specified in testApprox. The default is list(correct = TRUE), which turns on the continuity correction for chisq.test, Default: list(correct = TRUE)
139
#' @param testExact A function used to perform the exact tests. The default is fisher.test. If the cells have large numbers, it will fail because of memory limitation. In this situation, the large sample approximation based should suffice., Default: fisher.test
140
#' @param argsExact A named list of arguments passed to the function specified in testExact. The default is list(workspace = 2 * 10^5), which specifies the memory space allocated for fisher.test, Default: list(workspace = 2 * 10^5)
141
#' @param testNormal A function used to perform the normal assumption based tests. The default is oneway.test. This is equivalent of the t-test when there are only two groups, Default: oneway.test
142
#' @param argsNormal A named list of arguments passed to the function specified in testNormal. The default is list(var.equal = TRUE), which makes it the ordinary ANOVA that assumes equal variance across groups., Default: list(var.equal = F)
143
#' @param testNonNormal A function used to perform the nonparametric tests. The default is kruskal.test (Kruskal-Wallis Rank Sum Test). This is equivalent of the wilcox.test (Man-Whitney U test) when there are only two groups, Default: kruskal.test
144
#' @param argsNonNormal A named list of arguments passed to the function specified in testNonNormal. The default is list(NULL), which is just a placeholder., Default: list(NULL)
145
#' @param showAllLevels Whether to show all levels. FALSE by default, i.e., for 2-level categorical variables, only the higher level is shown to avoid redundant information., Default: T
146
#' @param printToggle Whether to print the output. If FALSE, no output is created, and a matrix is invisibly returned., Default: F
147
#' @param quote Whether to show everything in quotes. The default is FALSE. If TRUE, everything including the row and column names are quoted so that you can copy it to Excel easily, Default: F
148
#' @param smd If TRUE, as in the default and there are more than two groups, standardized mean differences for all pairwise comparisons are calculated, Default: F
149
#' @param Labels Use Label, Default: F
150
#' @param exact A character vector to specify the variables for which the p-values should be those of exact tests. By default all p-values are from large sample approximation tests (chisq.test)., Default: NULL
151
#' @param nonnormal A character vector to specify the variables for which the p-values should be those of nonparametric tests. By default all p-values are from normal assumption-based tests (oneway.test)., Default: NULL
152
#' @param catDigits Number of digits to print for proportions. Default: 1
153
#' @param contDigits Number of digits to print for continuous variables. Default 2.
154
#' @param pDigits Number of digits to print for p-values (also used for standardized mean differences), Default: 3
155
#' @param labeldata labeldata to use, Default: NULL
156
#' @param psub show sub-group p-values, Default: F
157
#' @param minMax Whether to use [min,max] instead of [p25,p75] for nonnormal variables. The default is FALSE.
158
#' @param showpm Logical, show normal distributed continuous variables as Mean ± SD. Default: T 
159
#' @return A matrix object containing what you see is also invisibly returned. This can be assinged a name and exported via write.csv.
160
#' @details DETAILS
161
#' @examples 
162
#'  library(survival)
163
#'  CreateTableOneJS(vars = names(lung), strata = "sex", data = lung)
164
#' @rdname CreateTableOneJS
165
#' @importFrom data.table data.table := CJ
166
#' @importFrom tableone CreateTableOne 
167
#' @importFrom labelled var_label var_label<-
168
#' @importFrom stats chisq.test fisher.test kruskal.test oneway.test
169
#' @importFrom methods is
170
#' @export 
171

172

173
CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVars = NULL, includeNA = F, test = T,
174
                            testApprox = chisq.test, argsApprox = list(correct = TRUE),
175
                            testExact = fisher.test, argsExact = list(workspace = 2 * 10^5),
176
                            testNormal = oneway.test, argsNormal = list(var.equal = F),
177
                            testNonNormal = kruskal.test, argsNonNormal = list(NULL), 
178
                            showAllLevels = T, printToggle = F, quote = F, smd = F, Labels = F, exact = NULL, nonnormal = NULL, 
179
                            catDigits = 1, contDigits = 2, pDigits = 3, labeldata = NULL, psub = T, minMax = F, showpm = T){
180
  
181 2
  . <- level <- variable <- val_label <- V1 <- V2 <- NULL
182
  #if (Labels & !is.null(labeldata)){
183
  #  var_label(data) = sapply(names(data), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
184
  #  vals.tb1 = c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
185
  #}
186 2
  data <- data
187
  
188 2
  if (is.null(strata)){
189
    
190 2
    if (Labels & !is.null(labeldata)){
191 2
      labelled::var_label(data) <- sapply(names(data), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
192 2
      data.table::setkey(labeldata, variable, level)
193
    }
194
    
195 2
    res <- tableone::CreateTableOne(vars =vars, data = data, factorVars = factorVars, includeNA = includeNA, test = test, 
196 2
                         testApprox = testApprox, argsApprox = argsApprox,
197 2
                         testExact = testExact, argsExact = argsExact,
198 2
                         testNormal = testNormal, argsNormal = argsNormal,
199 2
                         testNonNormal = testNonNormal, argsNonNormal = argsNonNormal, smd = smd)
200
    
201 2
    factor_vars <- res[["MetaData"]][["varFactors"]]
202
    
203 2
    if (Labels & !is.null(labeldata)){
204 2
      for (i in seq_along(res$CatTable)){
205 2
        for(j in factor_vars){
206 2
          lvs <- res$CatTable[[i]][[j]]$level
207 2
          res$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label]
208
        }
209
      }
210
      #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
211
    }
212
    
213 2
    ptb1 <- print(res,
214 2
                 showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, smd = smd, varLabels = Labels, nonnormal = nonnormal,
215 2
                 catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax)
216 2
    rownames(ptb1) <- gsub("(mean (SD))", "", rownames(ptb1), fixed=T)
217 2
    if (showpm){
218 2
      ptb1[!grepl("(%)", rownames(ptb1)) & rownames(ptb1) != "", ] <- gsub("\\(", "\u00B1 ", ptb1[!grepl("(%)", rownames(ptb1)) & rownames(ptb1) != "", ] )
219 2
      ptb1[!grepl("(%)", rownames(ptb1)) & rownames(ptb1) != "", ] <- gsub("\\)", "", ptb1[!grepl("(%)", rownames(ptb1)) & rownames(ptb1) != "", ] )
220
    }
221 2
    cap.tb1 <- "Total"
222
    #if (Labels & !is.null(labeldata)){
223
    #  ptb1[,1] <- vals.tb1
224
    #}
225 2
    return(list(table = ptb1, caption = cap.tb1))
226 2
  } else if (is.null(strata2)){
227 2
    ptb1 <- CreateTableOne2(strata = strata, vars =vars, data = data, factorVars = factorVars, includeNA = includeNA, test = test, 
228 2
                           testApprox = testApprox, argsApprox = argsApprox,
229 2
                           testExact = testExact, argsExact = argsExact,
230 2
                           testNormal = testNormal, argsNormal = argsNormal,
231 2
                           testNonNormal = testNonNormal, argsNonNormal = argsNonNormal, smd = smd,
232 2
                           showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, Labels = Labels, nonnormal = nonnormal, exact = exact,
233 2
                           catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, labeldata = labeldata, minMax = minMax)
234
    
235 2
    if (showpm){
236 2
      ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] <- gsub("\\(", "\u00B1 ", ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] )
237 2
      ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] <- gsub("\\)", "", ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] )
238
    }
239
    
240 2
    cap.tb1 <- paste("Stratified by ", strata, sep="")
241
    
242 2
    if (Labels & !is.null(labeldata)){
243 2
      cap.tb1 <- paste("Stratified by ", labeldata[get("variable") == strata, "var_label"][1], sep="")
244
      #ptb1[,1] = vals.tb1
245
      
246
    }
247 2
    return(list(table = ptb1, caption = cap.tb1))
248 2
  } else if (psub ==T){
249
    #data.strata <-  lapply(levels(data[[strata]]), function(x){data[data[[strata]] == x, ]})
250 2
    data.strata <- split(data, data[[strata]])
251 2
    ptb1.list <- lapply(data.strata, CreateTableOne2,
252 2
                       vars =vars, strata = strata2, factorVars = factorVars, includeNA = includeNA, test = test, 
253 2
                       testApprox = testApprox, argsApprox = argsApprox,
254 2
                       testExact = testExact, argsExact = argsExact,
255 2
                       testNormal = testNormal, argsNormal = argsNormal,
256 2
                       testNonNormal = testNonNormal, argsNonNormal = argsNonNormal, smd = smd,
257 2
                       showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, Labels = F, nonnormal = nonnormal, exact = exact,
258 2
                       catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax)
259
    
260 2
    if (showAllLevels == T){
261 2
      ptb1.cbind <- Reduce(cbind, c(list(ptb1.list[[1]]), lapply(2:length(ptb1.list), function(x){ptb1.list[[x]][,-1]})))
262
    } else{
263 2
      ptb1.cbind <- Reduce(cbind, ptb1.list)
264
    }
265 2
    if (showpm){
266 2
      ptb1.cbind[!grepl("(%)", rownames(ptb1.cbind)) & ptb1.cbind[, "p"] != "", ] <- gsub("\\(", "\u00B1 ", ptb1.cbind[!grepl("(%)", rownames(ptb1.cbind)) & ptb1.cbind[, "p"] != "", ] )
267 2
      ptb1.cbind[!grepl("(%)", rownames(ptb1.cbind)) & ptb1.cbind[, "p"] != "", ] <- gsub("\\)", "", ptb1.cbind[!grepl("(%)", rownames(ptb1.cbind)) & ptb1.cbind[, "p"] != "", ] )
268
    }
269
    
270
    #colnum.test = which(colnames(ptb1.cbind) == "test")
271
    #ptb1.2group = ptb1.cbind[, c(setdiff(1:ncol(ptb1.cbind), colnum.test), colnum.test[1])]
272 2
    cap.tb1 <- paste("Stratified by ", strata, "(", paste(levels(data[[strata]]), collapse=", "), ") & ", strata2, sep="")
273 2
    if (Labels & !is.null(labeldata)){
274 2
      labelled::var_label(data.strata[[1]]) = sapply(names(data.strata[[1]]), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
275
      #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
276 2
      data.table::setkey(labeldata, variable, level)
277
      
278 2
      res <- tableone::CreateTableOne(vars =vars, data = data.strata[[1]], factorVars = factorVars, includeNA = includeNA)
279 2
      factor_vars <- res[["MetaData"]][["varFactors"]]
280 2
      for (i in seq_along(res$CatTable)){
281 2
        for(j in factor_vars){
282 2
          lvs <- res$CatTable[[i]][[j]]$level
283 2
          res$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label]
284
        }
285
      }
286
      
287 2
      ptb1.res <- print(res, showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal,
288 2
                        catDigits = catDigits, contDigits = contDigits, minMax = minMax)
289 2
      ptb1.rn <- rownames(ptb1.res)
290 2
      rownames(ptb1.cbind) <- gsub("(mean (SD))", "", ptb1.rn, fixed=T)
291 2
      if (showAllLevels == T) {ptb1.cbind[, 1] <- ptb1.res[, 1]}
292
      
293 2
      cap.tb1 <- paste("Stratified by ", labeldata[get("variable") == strata, "var_label"][1], "(", paste(unlist(labeldata[get("variable") == strata, "val_label"]), collapse=", "), ") & ", labeldata[get("variable") == strata2, "var_label"][1], sep="")
294
    }
295
    
296 2
    return(list(table = ptb1.cbind, caption = cap.tb1))
297
  } else{
298 2
    res <- tableone::CreateTableOne(vars = vars, strata = c(strata2, strata), data = data, factorVars = factorVars, includeNA = F, test = T,
299 2
                        testApprox = chisq.test, argsApprox = list(correct = TRUE),
300 2
                        testExact = fisher.test, argsExact = list(workspace = 2 * 10^5),
301 2
                        testNormal = oneway.test, argsNormal = list(var.equal = F),
302 2
                        testNonNormal = kruskal.test, argsNonNormal = list(NULL)) 
303
    
304 2
    factor_vars <- res[["MetaData"]][["varFactors"]]
305
    #factor_vars <- vars[sapply(vars, function(x){class(data[[x]]) %in% c("factor", "character")})]
306 2
    var.strata <- paste(data[[strata2]], data[[strata]], sep = "_")
307
  
308 2
    vars.fisher <- sapply(factor_vars, function(x){is(tryCatch(chisq.test(table(var.strata, data[[x]])),error=function(e) e, warning=function(w) w), "warning")})
309 2
    vars.fisher <- factor_vars[unlist(vars.fisher)]
310
    
311 2
    if (is.null(exact) & length(vars.fisher) > 0){
312 2
      exact <- vars.fisher
313
    }
314
    
315 2
    if (Labels & !is.null(labeldata)){
316 2
      labelled::var_label(data) <- sapply(names(data), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
317 2
      data.table::setkey(labeldata, variable, level)
318 2
      res0 <- tableone::CreateTableOne(vars =vars, data = data, factorVars = factorVars, includeNA = includeNA)
319 2
      for (i in seq_along(res0$CatTable)){
320 2
        for(j in factor_vars){
321 2
          lvs <- res0$CatTable[[i]][[j]]$level
322 2
          res0$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label]
323
        }
324
      }
325
      
326 2
      ptb1.res0 <- print(res0, showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal,
327 2
                         catDigits = catDigits, contDigits = contDigits, minMax = minMax)
328 2
      ptb1.rn <- rownames(ptb1.res0)
329 2
      ptb1.rn <- gsub("(mean (SD))", "", ptb1.rn, fixed=T)
330
      
331
      #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
332
    }
333
    
334 2
    ptb1 <- print(res, 
335 2
                showAllLevels=showAllLevels,
336 2
                printToggle=F, quote=F, smd = smd, varLabels = Labels, exact = exact, nonnormal = nonnormal,
337 2
                catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax)
338
    
339 2
    rownames(ptb1) <- gsub("(mean (SD))", "", rownames(ptb1), fixed=T)
340 2
    if (Labels & !is.null(labeldata)){
341 2
      rownames(ptb1) <- ptb1.rn
342 2
      if (showAllLevels == T) {ptb1[, 1] <- ptb1.res0[, 1]}
343
    
344
      }
345
    
346 2
    sig <- ifelse(ptb1[,"p"] == "<0.001", "0", ptb1[,"p"])
347 2
    sig <- as.numeric(as.vector(sig))
348 2
    sig <- ifelse(sig <= 0.05, "**", "")
349 2
    ptb1 <- cbind(ptb1, sig)
350 2
    cap.tb1 <- paste("Table 1: Stratified by ", strata, " and ",strata2,  sep="")
351
    
352 2
    if (showpm){
353 2
      ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] <- gsub("\\(", "\u00B1 ", ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] )
354 2
      ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] <- gsub("\\)", "", ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] )
355
    }
356
    
357
    # Column name
358 2
    if (Labels & !is.null(labeldata)){
359 2
      val_combination <- data.table::CJ(labeldata[variable == strata, val_label], labeldata[variable == strata2, val_label], sorted = F)
360 2
      colname.group_var <- val_combination[, paste(V1, ":", V2, sep="")] 
361 2
      colname.group_index <- paste(labeldata[variable == strata, var_label][1], ":", labeldata[variable == strata2, var_label][1], sep = "")
362 2
      if (showAllLevels == T){
363 2
        colnames(ptb1)[1:(length(colname.group_var)+1)] <- c(colname.group_index, colname.group_var)
364
      } else{
365 2
        colnames(ptb1)[1:length(colname.group_var)] <- colname.group_var
366
      }
367
      
368
      # caption
369 2
      cap.tb1 = paste("Stratified by ", labeldata[variable == strata, var_label][1], " and ", labeldata[variable == strata2, var_label][1],  sep="")
370
      # val_label
371
      #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[variable == v, val_label]})))
372
      #ptb1[,1] <- vals.tb1
373
    }
374 2
    return(list(table = ptb1, caption = cap.tb1))
375
    
376
  }
377
  
378
} 

Read our documentation on viewing source code .

Loading