From 7c6fc4f03ee56aa565d80ee9923b09d04776e8d5 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" Date: Wed, 27 Mar 2024 02:04:42 +0000 Subject: [PATCH] Apply automatic stylistic changes --- R/CreateTableOneJS.R | 148 ++++++++++++++++++++++--------------------- R/glmshow.R | 8 +-- 2 files changed, 79 insertions(+), 77 deletions(-) diff --git a/R/CreateTableOneJS.R b/R/CreateTableOneJS.R index fd76cb8..b147a1b 100644 --- a/R/CreateTableOneJS.R +++ b/R/CreateTableOneJS.R @@ -52,21 +52,21 @@ CreateTableOne2 <- function(data, strata, vars, factorVars, includeNA = F, test showAllLevels = T, printToggle = F, quote = F, smd = F, Labels = F, exact = NULL, nonnormal = NULL, catDigits = 1, contDigits = 2, pDigits = 3, labeldata = NULL, minMax = F, showpm = T, addOverall = F) { setkey <- variable <- level <- . <- val_label <- NULL - + if (length(strata) != 1) { stop("Please select only 1 strata") } - + vars.ex <- names(which(sapply(vars, function(x) { !(class(data[[x]]) %in% c("integer", "numeric", "factor", "character")) }))) - + if (length(vars.ex) > 0) { warning("Variables other than numeric or factor types are excluded.") vars <- setdiff(vars, vars.ex) } - - + + res <- tableone::CreateTableOne( vars = vars, strata = strata, data = data, factorVars = factorVars, includeNA = includeNA, test = test, testApprox = testApprox, argsApprox = argsApprox, @@ -74,10 +74,10 @@ CreateTableOne2 <- function(data, strata, vars, factorVars, includeNA = F, test testNormal = testNormal, argsNormal = argsNormal, testNonNormal = testNonNormal, argsNonNormal = argsNonNormal, smd = smd, addOverall = addOverall ) - + # factor_vars <- vars[sapply(vars, function(x){class(data[[x]]) %in% c("factor", "character")})] factor_vars <- res[["MetaData"]][["varFactors"]] - + if (Labels & !is.null(labeldata)) { labelled::var_label(data) <- sapply(names(data), function(v) { as.character(labeldata[get("variable") == v, "var_label"][1]) @@ -91,41 +91,41 @@ CreateTableOne2 <- function(data, strata, vars, factorVars, includeNA = F, test res0$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label] } } - + ptb1.res0 <- print(res0, - showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal, - catDigits = catDigits, contDigits = contDigits, minMax = minMax + showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal, + catDigits = catDigits, contDigits = contDigits, minMax = minMax ) ptb1.rn <- rownames(ptb1.res0) ptb1.rn <- gsub("(mean (SD))", "", ptb1.rn, fixed = T) } - + 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") }) vars.fisher <- factor_vars[unlist(vars.fisher)] - + if (is.null(exact) & length(vars.fisher) > 0) { exact <- vars.fisher } - + ptb1 <- print(res, - showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, smd = smd, varLabels = Labels, nonnormal = nonnormal, exact = exact, - catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax + showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, smd = smd, varLabels = Labels, nonnormal = nonnormal, exact = exact, + catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax ) if (showpm) { ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\(", "\u00B1 ", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ]) ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\)", "", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ]) } - + rownames(ptb1) <- gsub("(mean (SD))", "", rownames(ptb1), fixed = T) if (Labels & !is.null(labeldata)) { rownames(ptb1) <- ptb1.rn if (showAllLevels == T) ptb1[, 1] <- ptb1.res0[, 1] } - + # cap.tb1 = paste("Table 1: Stratified by ", strata, sep="") - + if (Labels & !is.null(labeldata)) { colname.group_var <- unlist(labeldata[.(strata, names(res$CatTable)), val_label]) if (is.na(colname.group_var[1])) { @@ -140,7 +140,7 @@ CreateTableOne2 <- function(data, strata, vars, factorVars, includeNA = F, test # ptb1[,1] = vals.tb1 # cap.tb1 = paste("Table 1: Stratified by ", labeldata[variable == strata, "var_label"][1], sep="") } - + sig <- ifelse(ptb1[, "p"] == "<0.001", "0", ptb1[, "p"]) sig <- as.numeric(as.vector(sig)) sig <- ifelse(sig <= 0.05, "**", "") @@ -192,7 +192,7 @@ CreateTableOne2 <- function(data, strata, vars, factorVars, includeNA = F, test #' @importFrom data.table data.table := CJ #' @importFrom tableone CreateTableOne #' @importFrom labelled var_label var_label<- -#' @importFrom stats chisq.test fisher.test kruskal.test oneway.test shapiro.test +#' @importFrom stats chisq.test fisher.test kruskal.test oneway.test shapiro.test #' @importFrom methods is #' @export @@ -211,20 +211,22 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa # vals.tb1 = c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]}))) # } data <- data - + # 모든 변수에 대해 shapiro test 수행 - if (normalityTest == T){ - if (nrow(data) > 5000){ + if (normalityTest == T) { + if (nrow(data) > 5000) { print("Warning: Shapiro test is not possible due to the large sample size.") - } else{ - if (!is.null(nonnormal)){ + } else { + if (!is.null(nonnormal)) { print("Warning: Nonnormal variables previously entered are ignored.") } nonnormal <- setdiff(names(data), factorVars) - nonnormal <- nonnormal[sapply(nonnormal, function(x){ifelse(class(data[[x]]) %in% c("integer", "numeric"), stats::shapiro.test(data[[x]])$p.value < 0.05, F)})] + nonnormal <- nonnormal[sapply(nonnormal, function(x) { + ifelse(class(data[[x]]) %in% c("integer", "numeric"), stats::shapiro.test(data[[x]])$p.value < 0.05, F) + })] } } - + if (is.null(strata)) { if (Labels & !is.null(labeldata)) { labelled::var_label(data) <- sapply(names(data), function(v) { @@ -232,7 +234,7 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa }, simplify = F) data.table::setkey(labeldata, variable, level) } - + res <- tableone::CreateTableOne( vars = vars, data = data, factorVars = factorVars, includeNA = includeNA, test = test, testApprox = testApprox, argsApprox = argsApprox, @@ -240,9 +242,9 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa testNormal = testNormal, argsNormal = argsNormal, testNonNormal = testNonNormal, argsNonNormal = argsNonNormal, smd = smd ) - + factor_vars <- res[["MetaData"]][["varFactors"]] - + if (Labels & !is.null(labeldata)) { for (i in seq_along(res$CatTable)) { for (j in factor_vars) { @@ -252,17 +254,17 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa } # vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]}))) } - + ptb1 <- print(res, - showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, smd = smd, varLabels = Labels, nonnormal = nonnormal, - catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax + showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, smd = smd, varLabels = Labels, nonnormal = nonnormal, + catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax ) - + if (showpm) { ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\(", "\u00B1 ", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ]) ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\)", "", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ]) } - + rownames(ptb1) <- gsub("(mean (SD))", "", rownames(ptb1), fixed = T) cap.tb1 <- "Total" # if (Labels & !is.null(labeldata)){ @@ -279,10 +281,10 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, Labels = Labels, nonnormal = nonnormal, exact = exact, catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, labeldata = labeldata, minMax = minMax, showpm = showpm, addOverall = addOverall ) - - + + cap.tb1 <- paste("Stratified by ", strata, sep = "") - + if (Labels & !is.null(labeldata)) { cap.tb1 <- paste("Stratified by ", labeldata[get("variable") == strata, "var_label"][1], sep = "") # ptb1[,1] = vals.tb1 @@ -292,15 +294,15 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa # data.strata <- lapply(levels(data[[strata]]), function(x){data[data[[strata]] == x, ]}) data.strata <- split(data, data[[strata]]) ptb1.list <- lapply(data.strata, CreateTableOne2, - vars = vars, strata = strata2, factorVars = factorVars, includeNA = includeNA, test = test, - testApprox = testApprox, argsApprox = argsApprox, - testExact = testExact, argsExact = argsExact, - testNormal = testNormal, argsNormal = argsNormal, - testNonNormal = testNonNormal, argsNonNormal = argsNonNormal, smd = smd, - showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, Labels = F, nonnormal = nonnormal, exact = exact, - catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax, showpm = T, addOverall = F + vars = vars, strata = strata2, factorVars = factorVars, includeNA = includeNA, test = test, + testApprox = testApprox, argsApprox = argsApprox, + testExact = testExact, argsExact = argsExact, + testNormal = testNormal, argsNormal = argsNormal, + testNonNormal = testNonNormal, argsNonNormal = argsNonNormal, smd = smd, + showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, Labels = F, nonnormal = nonnormal, exact = exact, + catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax, showpm = T, addOverall = F ) - + if (showAllLevels == T) { ptb1.cbind <- Reduce(cbind, c(list(ptb1.list[[1]]), lapply(2:length(ptb1.list), function(x) { ptb1.list[[x]][, -1] @@ -308,8 +310,8 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa } else { ptb1.cbind <- Reduce(cbind, ptb1.list) } - - + + # colnum.test = which(colnames(ptb1.cbind) == "test") # ptb1.2group = ptb1.cbind[, c(setdiff(1:ncol(ptb1.cbind), colnum.test), colnum.test[1])] cap.tb1 <- paste("Stratified by ", strata, "(", paste(levels(data[[strata]]), collapse = ", "), ") & ", strata2, sep = "") @@ -319,7 +321,7 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa }, simplify = F) # vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]}))) data.table::setkey(labeldata, variable, level) - + res <- tableone::CreateTableOne(vars = vars, data = data.strata[[1]], factorVars = factorVars, includeNA = includeNA) factor_vars <- res[["MetaData"]][["varFactors"]] for (i in seq_along(res$CatTable)) { @@ -328,20 +330,20 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa res$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label] } } - + ptb1.res <- print(res, - showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal, - catDigits = catDigits, contDigits = contDigits, minMax = minMax + showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal, + catDigits = catDigits, contDigits = contDigits, minMax = minMax ) ptb1.rn <- rownames(ptb1.res) rownames(ptb1.cbind) <- gsub("(mean (SD))", "", ptb1.rn, fixed = T) if (showAllLevels == T) { ptb1.cbind[, 1] <- ptb1.res[, 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], sep = "") } - + return(list(table = ptb1.cbind, caption = cap.tb1)) } else { res <- tableone::CreateTableOne( @@ -351,20 +353,20 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa testNormal = oneway.test, argsNormal = list(var.equal = F), testNonNormal = kruskal.test, argsNonNormal = list(NULL), addOverall = addOverall ) - + factor_vars <- res[["MetaData"]][["varFactors"]] # factor_vars <- vars[sapply(vars, function(x){class(data[[x]]) %in% c("factor", "character")})] var.strata <- paste(data[[strata2]], data[[strata]], sep = "_") - + 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") }) vars.fisher <- factor_vars[unlist(vars.fisher)] - + if (is.null(exact) & length(vars.fisher) > 0) { exact <- vars.fisher } - + if (Labels & !is.null(labeldata)) { labelled::var_label(data) <- sapply(names(data), function(v) { as.character(labeldata[get("variable") == v, "var_label"][1]) @@ -377,28 +379,28 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa res0$CatTable[[i]][[j]]$level <- labeldata[.(j, lvs), val_label] } } - + ptb1.res0 <- print(res0, - showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal, - catDigits = catDigits, contDigits = contDigits, minMax = minMax + showAllLevels = showAllLevels, printToggle = printToggle, quote = quote, varLabels = Labels, nonnormal = nonnormal, + catDigits = catDigits, contDigits = contDigits, minMax = minMax ) ptb1.rn <- rownames(ptb1.res0) ptb1.rn <- gsub("(mean (SD))", "", ptb1.rn, fixed = T) - + # vals.tb1 <- c(NA, unlist(sapply(vars, function(v){labeldata[get("variable") == v, "val_label"]}))) } - + ptb1 <- print(res, - showAllLevels = showAllLevels, - printToggle = F, quote = F, smd = smd, varLabels = Labels, exact = exact, nonnormal = nonnormal, - catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax + showAllLevels = showAllLevels, + printToggle = F, quote = F, smd = smd, varLabels = Labels, exact = exact, nonnormal = nonnormal, + catDigits = catDigits, contDigits = contDigits, pDigits = pDigits, minMax = minMax ) - + if (showpm) { ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\(", "\u00B1 ", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ]) ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ] <- gsub("\\)", "", ptb1[grepl("\\(mean \\(SD\\)\\)", rownames(ptb1)), ]) } - + rownames(ptb1) <- gsub("(mean (SD))", "", rownames(ptb1), fixed = T) if (Labels & !is.null(labeldata)) { rownames(ptb1) <- ptb1.rn @@ -406,14 +408,14 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa ptb1[, 1] <- ptb1.res0[, 1] } } - + sig <- ifelse(ptb1[, "p"] == "<0.001", "0", ptb1[, "p"]) sig <- as.numeric(as.vector(sig)) sig <- ifelse(sig <= 0.05, "**", "") ptb1 <- cbind(ptb1, sig) cap.tb1 <- paste("Table 1: Stratified by ", strata, " and ", strata2, sep = "") - - + + # Column name if (Labels & !is.null(labeldata)) { val_combination <- data.table::CJ(labeldata[variable == strata, val_label], labeldata[variable == strata2, val_label], sorted = F) @@ -432,7 +434,7 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa colnames(ptb1)[1:length(colname.group_var)] <- colname.group_var } } - + # caption cap.tb1 <- paste("Stratified by ", labeldata[variable == strata, var_label][1], " and ", labeldata[variable == strata2, var_label][1], sep = "") # val_label @@ -441,4 +443,4 @@ CreateTableOneJS <- function(vars, strata = NULL, strata2 = NULL, data, factorVa } return(list(table = ptb1, caption = cap.tb1)) } -} \ No newline at end of file +} diff --git a/R/glmshow.R b/R/glmshow.R index d0f4fd3..50b2916 100644 --- a/R/glmshow.R +++ b/R/glmshow.R @@ -122,16 +122,16 @@ glmshow.display <- function(glm.object, decimal = 2) { rn.list[[x]] <<- paste(xs[x], ": ", model$xlevels[[xs[x]]][2], " vs ", model$xlevels[[xs[x]]][1], sep = "") }) lapply(varnum.mfac, function(x) { - if (grepl(":", xs[x])){ + if (grepl(":", xs[x])) { a <- unlist(strsplit(xs[x], ":"))[1] b <- unlist(strsplit(xs[x], ":"))[2] - if (a %in% xs && b %in% xs ){ + if (a %in% xs && b %in% xs) { ref <- paste0(a, model$xlevels[[a]][1], ":", b, model$xlevels[[b]][1]) rn.list[[x]] <<- c(paste(xs[x], ": ref.=", ref, sep = ""), gsub(xs[x], " ", rn.list[[x]])) - } else{ + } else { rn.list[[x]] <<- c(paste(xs[x], ": ref.=NA", model$xlevels[[xs[x]]][1], sep = ""), gsub(xs[x], " ", rn.list[[x]])) } - } else{ + } else { rn.list[[x]] <<- c(paste(xs[x], ": ref.=", model$xlevels[[xs[x]]][1], sep = ""), gsub(xs[x], " ", rn.list[[x]])) } })