1
## svyCreate Table1 : include 2 strata
2

3

4
#' @title svyCreateTableOne2: Modified svyCreateTableOne function in tableone package
5
#' @description Combine svyCreateTableOne & 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 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
13
#' @param printToggle Whether to print the output. If FALSE, no output is created, and a matrix is invisibly returned., Default: F
14
#' @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
15
#' @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
16
#' @param Labels Use Label, Default: F
17
#' @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
18
#' @param catDigits Number of digits to print for proportions., Default: 1
19
#' @param contDigits Number of digits to print for continuous variables. Default 2.
20
#' @param pDigits Number of digits to print for p-values (also used for standardized mean differences), Default: 3
21
#' @param labeldata labeldata to use, Default: NULL
22
#' @param minMax Whether to use [min,max] instead of [p25,p75] for nonnormal variables. The default is FALSE.
23
#' @param showpm Logical, show normal distributed continuous variables as Mean ± SD. Default: T 
24
#' @return A matrix object containing what you see is also invisibly returned. This can be assinged a name and exported via write.csv.
25
#' @details DETAILS
26
#' @examples 
27
#'  library(survey);data(nhanes)
28
#'  nhanes$SDMVPSU <- as.factor(nhanes$SDMVPSU)
29
#'  nhanesSvy <- svydesign(ids = ~ SDMVPSU, strata = ~ SDMVSTRA, weights = ~ WTMEC2YR, 
30
#'                         nest = TRUE, data = nhanes)
31
#'  svyCreateTableOne2(vars = c("HI_CHOL","race","agecat","RIAGENDR"), 
32
#'                     strata = "RIAGENDR", data = nhanesSvy)
33
#' @rdname svyCreateTableOne2
34
#' @importFrom data.table data.table :=
35
#' @importFrom tableone svyCreateTableOne 
36
#' @importFrom labelled var_label var_label<-
37
#' @export 
38

39
svyCreateTableOne2 <- function(data, strata, vars, factorVars, includeNA = F, test = T,
40
                           showAllLevels = T, printToggle = F, quote = F, smd = F, nonnormal = NULL, 
41
                           catDigits = 1, contDigits = 2, pDigits = 3, Labels = F, labeldata = NULL, minMax = F, showpm = T){
42
  
43 1
  setkey <- variable <- level <- . <- val_label <- NULL
44
  
45 1
  if (length(strata) != 1){
46 0
    stop("Please select only 1 strata")
47
  }
48

49
  
50 1
  res <- tableone::svyCreateTableOne(vars =vars, strata = strata, data = data, factorVars = factorVars, includeNA = includeNA, test = test, 
51 1
                                  smd = smd)
52
  
53 1
  factor_vars <- res[["MetaData"]][["varFactors"]]
54
  
55 1
  if (Labels & !is.null(labeldata)){
56 1
    labelled::var_label(data$variables) = sapply(names(data$variables), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
57
    #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
58 1
    data.table::setkey(labeldata, variable, level)
59 1
    res0 <- tableone::svyCreateTableOne(vars =vars, data = data, factorVars = factorVars, includeNA = includeNA)
60 1
    for (i in seq_along(res0$CatTable)){
61 1
      for(j in factor_vars){
62 1
        lvs <- res0$CatTable[[i]][[j]]$level
63 1
        res0$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label]
64
      }
65
    }
66 1
    ptb1.res0 <- print(res0, showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal,
67 1
                       catDigits = catDigits, contDigits = contDigits, minMax = minMax)
68 1
    ptb1.rn <- rownames(ptb1.res0)
69 1
    ptb1.rn <- gsub("(mean (SD))", "", ptb1.rn, fixed=T)
70

71
  }
72
  
73
  
74 1
  ptb1 <- print(res,
75 1
                showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, smd = smd, varLabels = Labels, nonnormal = nonnormal,
76 1
                catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax)
77
  
78 1
  if (showpm){
79 1
    ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\(", "\u00B1 ", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ])
80 1
    ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\)", "", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] )
81
  }
82
  
83 1
  rownames(ptb1) = gsub("(mean (SD))", "", rownames(ptb1), fixed=T)
84 1
  if (Labels & !is.null(labeldata)){
85 1
    rownames(ptb1) <- ptb1.rn
86 1
    if (showAllLevels == T) ptb1[, 1] <- ptb1.res0[, 1]
87
  }
88
  #cap.tb1 = paste("Table 1: Stratified by ", strata, sep="")
89
  
90 1
  if (Labels & !is.null(labeldata)){
91 1
    colname.group_var = unlist(labeldata[get("variable") == strata, "val_label"])
92 1
    if(showAllLevels == T){
93
      #colname.group_var <- unlist(labeldata[get("variable") == strata, "val_label"])
94 1
      colnames(ptb1)[1:(length(colname.group_var)+1)] <- unlist(c(labeldata[get("variable") == strata, "var_label"][1], colname.group_var))
95
    } else{
96 1
      colnames(ptb1)[1:length(colname.group_var)] <- colname.group_var
97
    }
98
    
99
  }
100
  
101 1
  sig <- ifelse(ptb1[,"p"] == "<0.001", "0", ptb1[,"p"])
102 1
  sig <- as.numeric(as.vector(sig))
103 1
  sig <- ifelse(sig <= 0.05, "**", "")
104 1
  ptb1 <- cbind(ptb1, sig)
105 1
  return(ptb1)
106
}
107

108

109

110
#' @title svyCreateTableOneJS: Modified CreateTableOne function in tableone package
111
#' @description Combine svyCreateTableOne & print function in tableone package
112
#' @param data A data frame in which these variables exist. All variables (both vars and strata) must be in this data frame.
113
#' @param strata Stratifying grouping variable name(s) given as a character vector. If omitted, the overall results are returned.
114
#' @param strata2 Stratifying 2nd grouping variable name(s) given as a character vector. If omitted, the 1 group results are returned.
115
#' @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.
116
#' @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.
117
#' @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
118
#' @param test If TRUE, as in the default and there are more than two groups, groupwise comparisons are performed, Default: T
119
#' @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
120
#' @param printToggle Whether to print the output. If FALSE, no output is created, and a matrix is invisibly returned., Default: F
121
#' @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
122
#' @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
123
#' @param Labels Use Label, Default: F
124
#' @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
125
#' @param catDigits Number of digits to print for proportions., Default: 1
126
#' @param contDigits Number of digits to print for continuous variables. Default 2.
127
#' @param pDigits Number of digits to print for p-values (also used for standardized mean differences), Default: 3
128
#' @param labeldata labeldata to use, Default: NULL
129
#' @param psub show sub-group p-values, Default: F
130
#' @param minMax Whether to use [min,max] instead of [p25,p75] for nonnormal variables. The default is FALSE.
131
#' @param showpm Logical, show normal distributed continuous variables as Mean ± SD. Default: T 
132
#' @return A matrix object containing what you see is also invisibly returned. This can be assinged a name and exported via write.csv.
133
#' @details DETAILS
134
#' @examples 
135
#'  library(survey);data(nhanes)
136
#'  nhanes$SDMVPSU <- as.factor(nhanes$SDMVPSU)
137
#'  nhanesSvy <- svydesign(ids = ~ SDMVPSU, strata = ~ SDMVSTRA, weights = ~ WTMEC2YR, 
138
#'                         nest = TRUE, data = nhanes)
139
#'  svyCreateTableOneJS(vars = c("HI_CHOL","race","agecat","RIAGENDR"), 
140
#'                      strata = "RIAGENDR", data = nhanesSvy)
141
#' @rdname svyCreateTableOneJS
142
#' @importFrom data.table data.table := CJ
143
#' @importFrom tableone svyCreateTableOne 
144
#' @importFrom labelled var_label var_label<-
145
#' @export 
146

147

148
svyCreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVars = NULL, includeNA = F, test = T,
149
                            showAllLevels = T, printToggle = F, quote = F, smd = F, Labels = F, nonnormal = NULL, 
150
                            catDigits = 1, contDigits = 2, pDigits = 3, labeldata = NULL, psub = T, minMax = F, showpm = T){
151
  
152 1
  . <- level <- variable <- val_label <- V1 <- V2 <- NULL
153
  
154
  #if (Labels & !is.null(labeldata)){
155
  #  var_label(data) = sapply(names(data), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
156
  #  vals.tb1 = c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
157
  #}
158 1
  data <- data
159
  
160 1
  if (is.null(strata)){
161
    
162 1
    if (Labels & !is.null(labeldata)){
163 1
      labelled::var_label(data$variables) = sapply(names(data$variables), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
164
      #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
165 1
      data.table::setkey(labeldata, variable, level)
166
    }
167
    
168 1
    res <- tableone::svyCreateTableOne(vars =vars, data = data, factorVars = factorVars, includeNA = includeNA)
169 1
    factor_vars <- res[["MetaData"]][["varFactors"]]
170
    
171 1
    if (Labels & !is.null(labeldata)){
172 1
      for (i in seq_along(res$CatTable)){
173 1
        for(j in factor_vars){
174 1
          lvs <- res$CatTable[[i]][[j]]$level
175 1
          res$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label]
176
        }
177
      }
178
    }
179
    
180 1
    ptb1 <- print(res,
181 1
                  showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal,
182 1
                  catDigits = catDigits, contDigits = contDigits, minMax = minMax)
183
    
184 1
    if (showpm){
185 1
      ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\(", "\u00B1 ", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ])
186 1
      ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\)", "", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] )
187
    }
188
    
189 1
    rownames(ptb1) <- gsub("(mean (SD))", "", rownames(ptb1), fixed=T)
190
    
191 1
    cap.tb1 <- "Total - weighted data"
192
    #if (Labels & !is.null(labeldata)){
193
    #  ptb1[,1] <- vals.tb1
194
    #}
195 1
    return(list(table = ptb1, caption = cap.tb1))
196 1
  } else if (is.null(strata2)){
197 1
    ptb1 <- svyCreateTableOne2(strata = strata, vars =vars, data = data, factorVars = factorVars, includeNA = includeNA, test = test, smd = smd,
198 1
                            showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, Labels = Labels, nonnormal = nonnormal,
199 1
                            catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, labeldata = labeldata, minMax = minMax, showpm = showpm)
200
    
201 1
    cap.tb1 <- paste("Stratified by ", strata, "- weighted data", sep="")
202
    
203 1
    if (Labels & !is.null(labeldata)){
204 1
      cap.tb1 <- paste("Stratified by ", labeldata[get("variable") == strata, "var_label"][1], "- weighted data", sep="")
205
      #ptb1[,1] = vals.tb1
206
      
207
    }
208 1
    return(list(table = ptb1, caption = cap.tb1))
209 1
  } else if (psub ==T){
210 1
    data.strata <-  lapply(setdiff(unique(data$variable[[strata]]), NA), function(x){subset(data, get(strata) == x)})
211 1
    ptb1.list <- lapply(data.strata, svyCreateTableOne2,
212 1
                        vars =vars, strata = strata2, factorVars = factorVars, includeNA = includeNA, test = test, smd = smd,
213 1
                        showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, Labels = F, nonnormal = nonnormal, 
214 1
                        catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax, showpm = showpm)
215
    
216
    
217 1
    if (showAllLevels == T){
218 1
      ptb1.cbind <- Reduce(cbind, c(list(ptb1.list[[1]]), lapply(2:length(ptb1.list), function(x){ptb1.list[[x]][,-1]})))
219
    } else{
220 1
      ptb1.cbind <- Reduce(cbind, ptb1.list)
221
    }
222
    
223
    #colnum.test = which(colnames(ptb1.cbind) == "test")
224
    #ptb1.2group = ptb1.cbind[, c(setdiff(1:ncol(ptb1.cbind), colnum.test), colnum.test[1])]
225 1
    cap.tb1 <- paste("Stratified by ", strata, "(", paste(levels(data[[strata]]), collapse=", "), ") & ", strata2, "- weighted data", sep="")
226 1
    if (Labels & !is.null(labeldata)){
227 1
      labelled::var_label(data.strata[[1]]$variables) = sapply(names(data.strata[[1]]$variables), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
228
      #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
229 1
      data.table::setkey(labeldata, variable, level)
230
      
231 1
      res <- tableone::svyCreateTableOne(vars =vars, data = data.strata[[1]], factorVars = factorVars, includeNA = includeNA)
232 1
      factor_vars <- res[["MetaData"]][["varFactors"]]
233 1
      for (i in seq_along(res$CatTable)){
234 0
        for(j in factor_vars){
235 0
          lvs <- res$CatTable[[i]][[j]]$level
236 0
          res$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label]
237
        }
238
      }
239
      
240 1
      ptb1.res <- print(res, showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal,
241 1
                        catDigits = catDigits, contDigits = contDigits, minMax = minMax)
242 1
      ptb1.rn <- rownames(ptb1.res)
243 1
      rownames(ptb1.cbind) <- gsub("(mean (SD))", "", ptb1.rn, fixed=T)
244 1
      if (showAllLevels == T) {ptb1.cbind[, 1] <- ptb1.res[, 1]}
245
      
246 1
      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], "- weighted data", sep="")
247
    }
248
    
249 1
    return(list(table = ptb1.cbind, caption = cap.tb1))
250
  } else{
251 0
    res <- tableone::svyCreateTableOne(vars = vars, strata = c(strata2, strata), data = data, factorVars = factorVars, includeNA = F, test = T) 
252 0
    factor_vars <- res[["MetaData"]][["varFactors"]]
253
    
254 0
    if (Labels & !is.null(labeldata)){
255 0
      labelled::var_label(data$variable) <- sapply(names(data$variable), function(v){as.character(labeldata[get("variable") == v, "var_label"][1])}, simplify = F)
256 0
      data.table::setkey(labeldata, variable, level)
257 0
      res0 <- tableone::svyCreateTableOne(vars =vars, data = data, factorVars = factorVars, includeNA = includeNA)
258 0
      for (i in seq_along(res0$CatTable)){
259 0
        for(j in factor_vars){
260 0
          lvs <- res0$CatTable[[i]][[j]]$level
261 0
          res0$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label]
262
        }
263
      }
264
      
265 0
      ptb1.res0 <- print(res0, showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal,
266 0
                         catDigits = catDigits, contDigits = contDigits, minMax = minMax)
267 0
      ptb1.rn <- rownames(ptb1.res0)
268 0
      ptb1.rn <- gsub("(mean (SD))", "", ptb1.rn, fixed=T)
269
      
270
      #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]})))
271
    }
272
    
273 0
    ptb1 <- print(res, 
274 0
                  showAllLevels=showAllLevels,
275 0
                  printToggle=F, quote=F, smd = smd, varLabels = T,  nonnormal = nonnormal,
276 0
                  catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax)
277
    
278 0
    if (showpm){
279 0
      ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\(", "\u00B1 ", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ])
280 0
      ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\)", "", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] )
281
    }
282
    
283 0
    rownames(ptb1) <- gsub("(mean (SD))", "", rownames(ptb1), fixed=T)
284 0
    if (Labels & !is.null(labeldata)){
285 0
      rownames(ptb1) <- ptb1.rn
286 0
      if (showAllLevels == T) {ptb1[, 1] <- ptb1.res0[, 1]}
287
      }
288
    
289 0
    sig <- ifelse(ptb1[,"p"] == "<0.001", "0", ptb1[,"p"])
290 0
    sig <- as.numeric(as.vector(sig))
291 0
    sig <- ifelse(sig <= 0.05, "**", "")
292 0
    ptb1 <- cbind(ptb1, sig)
293 0
    cap.tb1 <- paste("Stratified by ", strata, " and ",strata2, "- weighted data",  sep="")
294
    
295 0
    if (showpm){
296 0
      ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] <- gsub("\\(", "\u00B1 ", ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] )
297 0
      ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] <- gsub("\\)", "", ptb1[!grepl("(%)", rownames(ptb1)) & ptb1[, "p"] != "", ] )
298
    }
299
    
300
    # Column name
301 0
    if (Labels & !is.null(labeldata)){
302 0
      val_combination <- data.table::CJ(labeldata[variable == strata, val_label], labeldata[variable == strata2, val_label], sorted = F)
303 0
      colname.group_var <- val_combination[, paste(V1, ":", V2, sep="")] 
304 0
      colname.group_index <- paste(labeldata[variable == strata, var_label][1], ":", labeldata[variable == strata2, var_label][1], sep = "")
305 0
      if (showAllLevels == T){
306 0
        colnames(ptb1)[1:(length(colname.group_var)+1)] <- c(colname.group_index, colname.group_var)
307
      } else{
308 0
        colnames(ptb1)[1:length(colname.group_var)] <- colname.group_var
309
      }
310
      # caption
311 0
      cap.tb1 <- paste("Stratified by ", labeldata[variable == strata, var_label][1], " and ", labeldata[variable == strata2, var_label][1], "- weighted data",  sep="")
312
      # val_label
313
      #vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[variable == v, val_label]})))
314
      #ptb1[,1] <- vals.tb1
315
    }
316 0
    return(list(table = ptb1, caption = cap.tb1))
317
    
318
  }
319
  
320
} 

Read our documentation on viewing source code .

Loading