diff --git a/.RDataTmp b/.RDataTmp new file mode 100644 index 0000000..3990a2e Binary files /dev/null and b/.RDataTmp differ diff --git a/.gitignore b/.gitignore index 5b6a065..381c7d7 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ .Rhistory .RData .Ruserdata +R/.depricated.R diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..426d019 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,3 @@ +{ + "vim.useSystemClipboard": true +} diff --git a/DESCRIPTION b/DESCRIPTION index c7cf2ef..1697d16 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,23 +1,55 @@ Package: C306 Type: Package Title: Collection of useful R codes for data analysis from the Biostatistics group at OUCRU -Version: 0.1.2 +Version: 0.1.5-240715 Author: Lam Phung Khanh -Maintainer: Lam Phung Khanh +Maintainer@R: + c( + person( + given = "Khanh Lam", + family = "Phung", + role = c("author", "maintainer"), + email = "phungkhanhlam@gmail.com"), + person( + given = "Huu Khanh Trinh", + family = "Dong" + role = "maintainer", + email = "trindhk@oucru.org"), + person( + given = "Biostatistic Group", + role = "maintainer", + email = "biostatistics@oucru.org" + ) + ) Description: Collection of useful R codes for data analysis from the Biostatistics group at OUCRU Use four spaces when indenting paragraphs within the Description. License: The MIT License (MIT) Encoding: UTF-8 LazyData: true -Imports: lubridate, +Depends: + data.table, + dplyr, + R (>= 4.1) +Imports: + Hmisc, + stringi, + lubridate, car, readxl, - dplyr, flextable, officer, + tidyr, + rlang, + purrr, + formula.tools, + eventglm, + ggplot2, + survminer, + ggsurvfit, survival, - tidyr -RoxygenNote: 6.1.1 + aod +RoxygenNote: 7.3.2 Suggests: knitr, - rmarkdown + rmarkdown, + huxtable VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index b9b4a6e..d8ab219 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,20 +1,86 @@ # Generated by roxygen2: do not edit by hand +S3method("[",subgroup_logist_summary) +S3method("ref_lv<-",factor) +S3method(as_sstable,default) +S3method(as_sstable,list) +S3method(as_sstable,logist_summary) +S3method(as_sstable,overlap_summary) +S3method(as_sstable,subgroup_logist_summary) +S3method(explicit,lm) +S3method(gg_boxcox,default) +S3method(gg_boxcox,formula) +S3method(gg_boxcox,lm) +S3method(mutate_f,data.frame) +S3method(mutate_f,data.table) +S3method(mutate_f,grouped_df) +S3method(mutate_f,tbl) +S3method(print,logist_summary) +S3method(print,ss_tbl) +S3method(print,subgroup_logist_summary) +S3method(rbind,ss_ae) +S3method(rbind,ss_baseline) +S3method(rbind,ss_obj) +S3method(rbind,ss_survcomp) +S3method(ref_lv,factor) S3method(simple_recode,data.frame) S3method(simple_recode,default) +S3method(simple_relevel,data.frame) +S3method(simple_relevel,default) +S3method(ss_flextable,default) +S3method(ss_flextable,list) +S3method(ss_flextable,ss_obj) +S3method(ss_huxtable,default) +S3method(ss_huxtable,list) +S3method(summarise_f,data.frame) +S3method(summarise_f,data.table) +S3method(summarise_f,grouped_df) +S3method(summarise_f,tbl) +S3method(t,subgroup_logist_summary) +export("ref_lv<-") +export(as_sstable) export(contSummary) export(convert.info) export(createProject) +export(createProject2) +export(explicit) +export(ft_sstheme) export(getlabel) +export(gg_ajsurvplot) +export(gg_ajsurvplot2) +export(gg_boxcox) +export(ggsurvfit2) +export(ht_theme_kable) +export(ht_theme_markdown) export(import.info) export(inspect.data) export(labAE) +export(logist_summary) +export(mutate_f) export(myformat.data) +export(pct) +export(ref_lv) export(simple_recode) +export(simple_relevel) +export(simple_sort) +export(ss_body) +export(ss_flextable) +export(ss_format) +export(ss_header) +export(ss_huxtable) +export(ss_section) +export(ss_template) export(sstable.ae) export(sstable.baseline) +export(sstable.baseline.edit) export(sstable.survcomp) export(sstable.survcomp.subgroup) +export(subgroup_effect) +export(summarise_f) +export(tidy_competingevent) +export(tidy_survfit2) import(dplyr) +import(ggplot2) import(survival) import(tidyr) +importFrom(data.table,":=") diff --git a/R/.gitignore b/R/.gitignore new file mode 100644 index 0000000..718db98 --- /dev/null +++ b/R/.gitignore @@ -0,0 +1 @@ +.depricated.R diff --git a/R/checking.R b/R/checking.R index 61c2f8b..7d46aed 100644 --- a/R/checking.R +++ b/R/checking.R @@ -65,14 +65,17 @@ inspect.data <- function (data, info, id, check_missing = c(TRUE, FALSE), plot = lapply(X = 1:ncol(data), FUN = function(x) { tmpdata <- data[, x] + tmprow <- seq_len(nrow(data)) if ("condition" %in% names(info)) { if (!is.na(info$condition[x])) { ## match variable name is condition tmpcondition <- find_match_correct_var_final(cond = info$condition[x], realvar = names(data)) tmpdata <- eval(parse(text = paste0("subset(data,", tmpcondition, ")[, x]"))) + tmprow <- with(data, which(eval(parse(text=tmpcondition)))) } } inspect.each(x = tmpdata, + id = tmprow, varname = info$varname[x], value = info$value[x], type = info$type[x], @@ -94,8 +97,11 @@ inspect.data <- function (data, info, id, check_missing = c(TRUE, FALSE), plot = N <- nrow(data) for (i in (1:length(info$varname))) { tmpdata <- data[, names(data)[tolower(names(data)) == tolower(info$varname[i])]] - tmplabel <- substr(gsub(pattern = "[\x01-\x1f\x7f-\xff:]", replacement = "", - x = info$label[i]), start = 1, stop = 30) + # tmplabel <- substr(gsub(pattern = "[\x01-\x1f\x7f-\xff:]", replacement = "", + # x = info$label[i]), start = 1, stop = 30) + tmplabel <- substr(stringi::stri_trans_general( + info$label[i], + id="Latin-ASCII"), start=1, stop=30) |> gsub("?", "", x=_, fixed=TRUE) if (length(na.omit(tmpdata)) == 0) { plot(x = 1:10, y = 1:10, main = paste(info$varname[i], "\n (", tmplabel, ")", " \n (", info$type[i], ")", sep = ""), @@ -109,8 +115,12 @@ inspect.data <- function (data, info, id, check_missing = c(TRUE, FALSE), plot = x <- barplot(table(tmpdata), main = paste(info$varname[i], "\n (", tmplabel, ")", " \n (", info$type[i], ", N=", N, ", missing=", nNA, ")", sep = ""), xaxt = "n") - labs <- substr(gsub(pattern = "[\x01-\x1f\x7f-\xff:]", replacement = "", - x = names(table(tmpdata))), start = 1, stop = 10) + # labs <- substr(gsub(pattern = "[\x01-\x1f\x7f-\xff:]", replacement = "", + # x = names(table(tmpdata))), start = 1, stop = 10) + labs <- substr(gsub(pattern = "?", replacement = "", fixed=TRUE, + x = stringi::stri_trans_general( + names(table(tmpdata)), + id="Latin-ASCII")), start = 1, stop = 10) text(cex = 1, x = x, y = 0, labs, xpd = TRUE, srt = 45, adj = 1) } else { @@ -137,25 +147,25 @@ inspect.data <- function (data, info, id, check_missing = c(TRUE, FALSE), plot = } } -inspect.each <- function (x, varname, type, value = NA, check_missing = TRUE) { +inspect.each <- function (x, id, varname, type, value = NA, check_missing = TRUE) { tmp <- NULL if (check_missing) { if (anyNA(x) | any(as.character(x) == "")) { - tmp <- rbind(tmp, data.frame(index = which(is.na(x) | - as.character(x) == ""), error = paste("Missing value for", + tmp <- rbind(tmp, data.frame(index = id[is.na(x) | + as.character(x) == ""], error = paste("Missing value for", varname))) } } if (type == "numeric" & (!is.na(value) & value != "")) { range <- as.numeric(unlist(strsplit(value, split = ";"))) if (any(x < range[1] & !is.na(x))) { - tmp <- rbind(tmp, data.frame(index = which(!is.na(x) & - x < range[1]), error = paste("Out of range:", + tmp <- rbind(tmp, data.frame(index = id[!is.na(x) & + x < range[1]], error = paste("Out of range:", varname, "<", range[1]))) } if (any(x > range[2] & !is.na(x))) { - tmp <- rbind(tmp, data.frame(index = which(!is.na(x) & - x > range[2]), error = paste("Out of range:", + tmp <- rbind(tmp, data.frame(index = id[!is.na(x) & + x > range[2]], error = paste("Out of range:", varname, ">", range[2]))) } } @@ -165,8 +175,8 @@ inspect.each <- function (x, varname, type, value = NA, check_missing = TRUE) { USE.NAMES = FALSE) if (any(!x %in% range & !is.na(x))) { xx <- x[!is.na(x) & !x %in% range] - tmp <- rbind(tmp, data.frame(index = which(!is.na(x) & - !x %in% range), error = paste("Out of range:", + tmp <- rbind(tmp, data.frame(index = id[!is.na(x) & + !x %in% range], error = paste("Out of range:", varname, "=", xx))) } } diff --git a/R/createProject.R b/R/createProject.R index d23b6d5..7801765 100644 --- a/R/createProject.R +++ b/R/createProject.R @@ -24,4 +24,27 @@ createProject <- function(dir, structure = c("OUCRU_RCT_wInterim")){ # inform cat(paste("Project", basename(dir), "was created in", dirname(dir), "\n", sep = " ")) } +#' @export +createProject2 <- function(dir, structure = c("Project")){ + ## to create project directory + ## initial version: 23 July 2015 + + if (length(structure) > 1) {structure <- "Project"} + ## create destination folder + dir.create(dir) + + ## copy folder structure into destination folder + file.copy(from = file.path(system.file(package = "C306"), "structure", structure, "."), + to = dir, recursive = TRUE) + file.rename(from = file.path(dir, "Analysis"), to = file.path(dir, paste0(basename(dir), "_Analysis"))) + file.rename(from = file.path(dir, "Published"), to = file.path(dir, paste0(basename(dir), "_Published"))) + + ## populate workflowr + if ("workflowr" %in% rownames(installed.packages())) { + workflowr::wflow_start(file.path(dir, paste0(basename(dir), "_Published")), existing = TRUE, overwrite = TRUE) + } + + # inform + cat(paste("Project", basename(dir), "was created in", dirname(dir), "\n", sep = " ")) +} diff --git a/R/explicit.R b/R/explicit.R new file mode 100644 index 0000000..53b95cb --- /dev/null +++ b/R/explicit.R @@ -0,0 +1,54 @@ +#' Transform an object to its explicit form +#' @description A function to transform an object to its explicit form if possible +#' @param x An object +#' @seealso \link{explicit.lm} +#' @export +explicit <- function(x, ...){ + UseMethod('explicit') +} + +#' Transform a model to its explicit form +#' @description +#' A function to transform an lm model formula to its explicit form. +#' This is useful when you want to use stats::drop1 to drop additional terms in interaction models. +#' @param fit An object of class "lm" +#' @examples +#' iris.model <- lm(Sepal.Width ~ Sepal.Length*Petal.Width, data=iris) +#' explicit(iris.model) +#' @return A model with explicit formula +#' @seealso \link[stats]{add1} +#' @export +explicit.lm <- function(fit){ + ._explicit_lm(fit, data = data, .meta = FALSE) + # if (length(data)) new_fit$call$data <- rlang::sym(deparse(substitute(data))) + # new_fit +} + +._explicit_lm <- function(lm, .meta = FALSE, ...) +{ + formula <- formula(lm) + mf <- match.call(expand.dots = FALSE) + m <- match(c("lm", "data", "weights", "na.action", + "offset"), names(mf), 0L) + mf <- mf[c(1, m)] + mf$drop.unused.levels <- TRUE + # browser() + mf[[1L]] <- as.name("model.frame") + names(mf)[2L] <- "formula" + mf <- eval(mf, parent.frame()) + y <- model.response(mf) + x <- model.matrix(lm) + new_data <- cbind(mf, model.matrix(lm)[,!colnames(x) %in% c('(Intercept)', colnames(mf)), drop=FALSE]) + x_names <- paste0('`', gsub('(^`)|(`$)', '', colnames(x)[-1]), '`') + names(x_names) <- colnames(x)[-1] + # browser() + new_fml <- formula(call('~', + parse(text = paste(x_names, + collapse = '+'), + keep.source = FALSE)[[1L]] + )) + new_lm <- update(lm, new_fml, data = new_data) + new_lm$call$data <- lm$call$data + if (.meta) attr(new_lm, 'name.map') <- structure(names(x_names), names = unname(x_names)) + return(new_lm) +} diff --git a/R/func_mult.R b/R/func_mult.R new file mode 100644 index 0000000..a39417a --- /dev/null +++ b/R/func_mult.R @@ -0,0 +1,117 @@ +#' Create or transform variables, with support for multiple assignment +#' +#' @description A function to create new variable(s) based on existing ones. +#' @param .data A data.frame, data.table, or tbl +#' @param ... Name-value pairs of expressions, following data.table syntax: "new_col" := expression. +#' Multiple assignments can be done via c("new_col1", "new_col2") := expression_returning_a_list. +#' +#' If unnamed, names of each list elements will be used +#' @return a data.frame, data.table, or a tbl +#' @examples +#' df <- data.frame(baz = 1:10, foo = c(rep(1, 5), rep(2, 5))) +#' df %>% +#' dplyr::group_by(foo) %>% +#' mutate_f(c('foo', 'bar') := list(a = cumsum(baz), b = baz*2)) +#' @importFrom data.table := +#' @export +mutate_f <- function(.data, ...){ + UseMethod('mutate_f') +} + +#' @rdname mutate_f +#' @export +mutate_f.data.table <- function(.data, ...){ + dt_out <- mutate_f.data.frame(.data, ...) + setDT(dt_out) + dt_out +} + +#' @rdname mutate_f +#' @export +mutate_f.tbl <- function(.data, ...){ + dt_out <- mutate_f.data.frame(.data, ...) + dt_out <- dplyr::as_tibble(dt_out) + dt_out +} + +#' @rdname mutate_f +#' @export +mutate_f.grouped_df <- function(.data, ...){ + dt_out <- mutate_f.data.frame(.data, ...) + group_names <- dplyr::group_vars(.data) + dplyr::group_by_at(dt_out, dplyr::vars(!!!{{group_names}})) +} + +#' @rdname mutate_f +#' @export +mutate_f.data.frame <- function(.data, ...){ + group_names <- dplyr::group_vars(.data) + data_tbl <- if (!data.table::is.data.table(.data))data.table::as.data.table(.data) else .data + # browser() + .dots <- rlang::enexprs(..., .unquote_names = FALSE) + for (.dot in .dots){ + .expr <- rlang::expr(data_tbl[, !!.dot, by = group_names]) + data_tbl <- rlang::eval_tidy(.expr) + } + new_cols <- names(data_tbl)[!names(data_tbl) %in% union(group_names, names(.data))] + data_tbl <- cbind(as.data.frame(.data), as.data.frame(data_tbl)[,new_cols]) + data_tbl +} + +######################################################### + +#' Reduce multiple values by summarisation functions. +#' +#' @description Create variables summarising exisiting variables, by using summarisation function. +#' @param .data A data.frame, data.table, or tbl +#' @param ... Summarisation functions. +#' Each of which must return a named list, whose names stand for new variables' names. +#' Anonymous functions must be wrapped in parentheses. +#' +#' @return a data.frame, data.table, or a tbl +#' @examples +#' df <- data.frame(baz = 1:10, foo = c(rep(1, 5), rep(2, 5)), bar =4:13) +#' df %>% +#' dplyr::group_by(foo) %>% +#' summarise_f((function(baz) list(a = cumsum(baz), b = baz*2))(baz), rangemisc::overlap_collapse(bar, baz)) +#' @importFrom data.table := +#' @export +summarise_f <- summarize_f <- function(.data, ...){ + UseMethod('summarise_f') +} + +#' @rdname summarise_f +#' @export +summarise_f.data.frame <- function(.data, ...){ + # browser() + # .fun <- lapply(rlang::enquos(...), rlang::quo_get_expr) + .fun <- rlang::enexprs(...) + group_names <- dplyr::group_vars(.data) + if (!data.table::is.data.table(.data)) data_tbl <- data.table::as.data.table(.data) else data_tbl <- .data + expr <- rlang::quo_get_expr(rlang::quo(data_tbl[, c(!!!.fun), by = group_names])) + rlang::eval_tidy(expr) +} + +#' @rdname summarise_f +#' @export +summarise_f.data.table <- function(.data, ...){ + dt_out <- summarise_f.data.frame(.data, ...) + setDT(dt_out) + dt_out +} + +#' @rdname summarise_f +#' @export +summarise_f.tbl <- function(.data, ...){ + dt_out <- summarise_f.data.frame(.data, ...) + dt_out <- dplyr::as_tibble(dt_out) + dt_out +} + +#' @rdname summarise_f +#' @export +summarise_f.grouped_df <- function(.data, ...){ + dt_out <- summarise_f.data.frame(.data, ...) + group_names <- dplyr::group_vars(.data) + dplyr::group_by_at(dt_out, dplyr::vars(!!!{{group_names}})) +} diff --git a/R/getlabel.R b/R/getlabel.R index 8f0808c..73f2565 100644 --- a/R/getlabel.R +++ b/R/getlabel.R @@ -4,7 +4,7 @@ #' #' @param x a vector or data frame to get label. #' @param meta a data frame contains metadata of the dataset. This data frame should have the following variables: varname (character variable specifies name of each variable), label (character variable specifies label of each variables), type (character variable specifies type of each variable [numeric, factor, character, datetime], unit (character variable specifies units of each continuous variable), scale (numeric variable specifies how each variable will be scaled). -#' @param unit a logical value specifies whether unit will be appendded in the label of continous variables. +#' @param unit a logical value specifies whether unit will be appended in the label of continuous variables. #' @param fit a logical value specifies whether the label will use presentation as in model fitting. #' #' @return vector of character of label diff --git a/R/gg_ajsurvplot.R b/R/gg_ajsurvplot.R new file mode 100644 index 0000000..ba91dca --- /dev/null +++ b/R/gg_ajsurvplot.R @@ -0,0 +1,186 @@ +#' Plot the Aalen-Johansen curve with ggplot for competing risks +#' @description +#' Extend \link[survminer:ggsurvplot]{ggsurvplot} functionality to plot competing risk curve +#' +#' @param formula A standard model formula, with survival on the left and covariates on the right +#' @param data an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model +#' @param weights,subset,na.action,etype,count,id,timefix parameter passed to finegray model. See \code{\link[survival:finegray]{finegray}}, +#' @param ... optional parameters passed to \code{ggsurvplot}. +#' @export +gg_ajsurvplot <- function(formula, data, weights, subset, na.action, etype, count, id, timefix, ...){ + dot <- list(...) + fgargs <- match.call()[-1] + fgargs <- as.list(fgargs[setdiff(names(fgargs), names(dot))]) + fg <- do.call(survival::finegray, fgargs) + # browser() + fml <- force(update(formula, Surv(fgstart,fgstop,fgstatus)~.)) + sf <- eval(substitute(survival::survfit(fml, data = fg, weights=fgwt), list(fml=fml))) + survminer::ggsurvplot( + sf, + data=fg, + ... + ) +} + +#' ggsurvfit with strata saved +#' @description +#' Same as \link[ggsurvfit:ggsurvfit]{ggsurvfit} but with strata saved, so you can facet by covariables. +#' +#' @param x,type,linetype_aes,theme,... parameters passed directly \link[ggsurvfit:ggsurvfit]{ggsurvfit}. +#' @export +ggsurvfit2 <- rlang::new_function( + args = rlang::fn_fmls(ggsurvfit::ggsurvfit), + body = { + # require(cli) + require(ggsurvfit) + tt <- ggsurvfit::ggsurvfit |> + rlang::fn_body() |> + as.character() |> + gsub('tidy_survfit', 'C306::tidy_survfit2', x=_)|> + c('}') |> paste(collapse = '\n') |> + # parse(text=_) |> + rlang::parse_expr() + environment(tt) <- asNamespace('ggsurvfit') + tt + } +) + +environment(ggsurvfit2) <- asNamespace('ggsurvfit') + +#' Untidy the tidy_survfit +untidy_strata <- function(x, strata.col='strata') { + if (!'strata' %in% names(x)) return(x) + x2 <- x |> + mutate(strata.split = strsplit(as.character(strata), ', ')) |> + tidyr::unnest(cols=strata.split) |> + mutate( + strata.split = unlist(strata.split), + strata.names = strsplit(strata.split, '=') %>% purrr::transpose() %>% `[[`(1) |> unlist(), + strata.values = strsplit(strata.split, '=') %>% purrr::transpose() %>% `[[`(2) |> unlist(), + strata.split=NULL + ) |> + tidyr::pivot_wider(names_from = strata.names, values_from = strata.values) + + x2 +} + +#' Tidy survfit with strata save +#' @description +#' Same as \link[ggsurvfit:tidy_survfit]{tidy_survfit} but with strata saved. +#' @param x,times,type same as \link[ggsurvfit:tidy_survfit]{tidy_survfit} +#' @export +tidy_survfit2 <- function(x, times=NULL, type='survival'){ + ggsurvfit::tidy_survfit(x, times=times, type) |> + untidy_strata() +} + +#' Tidy competing risk mstate survival fit. +#' @description +#' This complements gg_ajurvplot2, provides the intermediate data for advanced ggplot manipulation +#' @param formula A standard model formula, with survival on the left and covariates on the right +#' @param data an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model +#' @param weights,subset,na.action,,count,id,timefix parameter passed to finegray model. See \code{\link[survival:finegray]{finegray}}, +#' @param main.event,competing.event main and competing event to plot +#' @param tidy_types [c(main='risk', competing='survival')] summarisiation for main and competing events +#' @param ... other parameters passed to finegray (excluding etype) +#' @return a tibble +#' @export +tidy_competingevent <- function(formula, data, weights, subset, na.action, main.event, competing.event, count, id, timefix, tidy_types, ...){ + dot <- list(...) + fgargs <- match.call()[-1] + fgargs <- as.list(fgargs[setdiff(names(fgargs), names(dot))]) + fgargs$tidy_types <- NULL + etypes <- with(fgargs, list(main.event, competing.event)) + fgargs.each <- lapply(etypes, function(etype) { + new.arg <- fgargs + new.arg$etype <- etype + new.arg$main.event <- new.arg$competing.event <- NULL + new.arg + }) + if(is.null(names(tidy_types))) names(tidy_types) <- c('main', 'competing') + fg1 <- do.call(survival::finegray, fgargs.each[[1]]) + fg2 <- do.call(survival::finegray, fgargs.each[[2]]) + # browser() + fml <- force(update(formula, survival::Surv(fgstart,fgstop,fgstatus)~.)) + + sf1 <- eval(substitute(survival::survfit(fml, data = fg1, weights=fgwt), list(fml=fml))) + sf2 <- eval(substitute(survival::survfit(fml, data = fg2, weights=fgwt), list(fml=fml))) + + tidy1 <- tidy_survfit2(sf1, type=tidy_types[['main']]) |> mutate(Event = main.event) + tidy2 <- tidy_survfit2(sf2, type=tidy_types[['competing']]) |> mutate(Event = competing.event) + + rbind(tidy1, tidy2) |> tibble::as_tibble() +} + +#' Plot 2 Aalen-Johansen curves with ggplot for competing risks +#' @description +#' Extend \link[ggsurvfit:ggsurvfit]{ggsurvfit} functionality to plot competing risk curve, with main risk and competing risk in one plot +#' +#' @param formula A standard model formula, with survival on the left and covariates on the right +#' @param data an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model +#' @param weights,subset,na.action,,count,id,timefix parameter passed to finegray model. See \code{\link[survival:finegray]{finegray}}, +#' @param main.event,competing.event main and competing event to plot +#' @param facet.by formula. default to all strata +#' @param ci [TRUE] Plot confidence band? +#' @param monochrome [FALSE] plot in monochrome? either FALSE (default) or a string of color, TRUE is equivalent to "black" +#' @param type ['alternate'] plot in alternative or overlaid style? +#' @param ... other parameters passed to finegray (excluding etype) +#' @import ggplot2 +#' @export +gg_ajsurvplot2 <- function(formula, data, weights, subset, na.action, main.event, competing.event, facet.by = ~strata, count, id, timefix, ci=TRUE, monochrome = FALSE, type=c('alternate', 'overlaid'), ...){ + + dot <- list(...) + gargs <- match.call()[-1] + gargs <- as.list(gargs[setdiff(names(gargs), names(dot))]) + gargs$facet.by <- gargs$ci <- gargs$monochrome <- NULL + type = match.arg(type) + gargs$tidy_type <- c(main='risk', competing='survival') + if (type == 'overlaid') gargs$tidy_type[['competing']] <- 'risk' + + dt <- do.call(tidy_competingevent, gargs) + + # facet <- if (formula.tools::is.formula(facet.by)) if (length(formula.tools::lhs.vars(facet.by))) + # facet_grid(facet.by) else facet_wrap(facet.by) + + # if (is.null(facet.by)) + # { + # plt <- ggplot(dt,aes(x=time, y=estimate, ymin=conf.low, ymax=conf.high, linetype=Event, color=strata, fill=strata)) + + # geom_step(linewidth=1) + # + # if (ci) plt <- plt + ggsurvfit::stat_stepribbon(alpha=.3, color='transparent') + # plt <- plt + ggsurvfit::theme_ggsurvfit_default() + # return(plt) + # } + + # browser() + facet <- facet.vars <- NULL + if (!is.null(facet.by)){ + facet <- + if (length(formula.tools::lhs.vars(facet.by))) facet_grid(facet.by) else facet_wrap(facet.by) + facet.vars <- formula.tools::get.vars(facet.by) + } + + for (v in facet.vars) dt$strata <- + sapply(strsplit(as.character(dt$strata), ', '), + function(x) x[!grepl(paste0(v,'='), x, fixed=TRUE)]|>paste(collapse=', ')) + + if (all(dt$strata == '')) plt <- ggplot(dt,aes(x=time, y=estimate, ymin=conf.low, ymax=conf.high, group=Event)) + else if (!isFALSE(monochrome)) { + plt <- ggplot(dt,aes(x=time, y=estimate, ymin=conf.low, ymax=conf.high, linetype=strata, color=Event)) + if (ci) plt <- plt + + ggsurvfit::stat_stepribbon(alpha=.5, linewidth=.2, fill='transparent') + plt <- plt + + geom_step(linewidth=1) + + scale_color_manual(values=rep(if (isTRUE(monochrome)) 'black' else as.character(monochrome),2), guide=NULL) + } + + else { + plt <- ggplot(dt,aes(x=time, y=estimate, ymin=conf.low, ymax=conf.high, linetype=Event, color=strata, fill=strata)) + if (ci) plt <- plt + ggsurvfit::stat_stepribbon(alpha=.3, color='transparent') + plt <- plt + geom_step(linewidth=1) + + scale_linetype_manual(values=rep('solid',2), guide=NULL) + } + + plt + ggsurvfit::theme_ggsurvfit_default() + facet + +} diff --git a/R/gg_boxcox.R b/R/gg_boxcox.R new file mode 100644 index 0000000..7e36845 --- /dev/null +++ b/R/gg_boxcox.R @@ -0,0 +1,111 @@ +#' Compute and draw Box-Cox transformation plot for linear models using ggplot2 +#' @description A forked version of MASS::boxcox using ggplot2 +#' @param object a formula or fitted model object. Currently only lm and aov objects are handled. +#' @param lambda vector of values of lambda – default (-2, 2) in steps of 0.1 +#' @param interp +#' logical which controls whether spline interpolation is used. Default to TRUE if plotting with lambda of length less than 100. +#' @param eps Tolerance for lambda = 0; defaults to 0.02 +#' @param xlab defaults to "lambda" +#' @param ylab defaults to "log-Likelihood" +#' @param ... additional parameters to be used in the model fitting. +#' @return a ggplot object +#' @seealso \link[MASS]{boxcox} +#' @examples +#' gg_boxcox(Volume ~ log(Height) + log(Girth), data = trees, +#' lambda = seq(-0.25, 0.25, length = 10)) +#' @export +gg_boxcox <- function(object,...){ + UseMethod('gg_boxcox') +} + +#' @export +gg_boxcox.formula <- function (object, lambda = seq(-2, 2, 1/10), + interp = (m < 100), eps = 1/50, xlab = expression(lambda), + ylab = "log-Likelihood", ...) +{ + m <- length(lambda) + object <- lm(object, y = TRUE, qr = TRUE, ...) + NextMethod() +} + +#' @export +gg_boxcox.lm <- function(object, lambda = seq(-2, 2, 1/10), + interp = (m < 100), eps = 1/50, xlab = expression(lambda), + ylab = "log-Likelihood", ...) +{ + m <- length(lambda) + if (is.null(object$y) || is.null(object$qr)) + object <- update(object, y = TRUE, qr = TRUE, ...) + NextMethod() +} + +#' @export +gg_boxcox.default <- function (object, lambda = seq(-2, 2, 1/10), + interp = (m < 100), eps = 1/50, xlab = expression(lambda), + ylab = "log-Likelihood", ...) +{ + object <- lm(object, y = TRUE, qr = TRUE, ...) + # if (is.null(object$y) || is.null(object$qr)) + # object <- update(object, y = TRUE, qr = TRUE, ...) + y <- object$y + xqr <- object$qr + if (any(y <= 0)) + stop("response variable must be positive") + n <- length(y) + y <- y/exp(mean(log(y))) + logy <- log(y) + xl <- loglik <- as.vector(lambda) + m <- length(xl) + for (i in 1L:m) { + if (abs(la <- xl[i]) > eps) + yt <- (y^la - 1)/la + else yt <- logy * (1 + (la * logy)/2 * (1 + (la * logy)/3 * + (1 + (la * logy)/4))) + loglik[i] <- -n/2 * log(sum(qr.resid(xqr, yt)^2)) + } + if (interp) { + sp <- spline(xl, loglik, n = 100) + xl <- sp$x + loglik <- sp$y + m <- length(xl) + } + mx <- (1L:m)[loglik == max(loglik)][1L] + Lmax <- loglik[mx] + lim <- Lmax - qchisq(19/20, 1)/2 + plt <- + ggplot2::ggplot()+ + ggplot2::geom_line(mapping = ggplot2::aes(x = xl, y = loglik), size=.5, color = grey(0.1))+ + ggplot2::labs(x = xlab, y = ylab)+ + ggplot2::geom_hline(ggplot2::aes(yintercept = lim), linetype = 'dashed')+ + ggplot2::geom_text(ggplot2::aes(x=min(lambda),y=lim, label='95%'), hjust='left', vjust='bottom')+ + ggplot2::ylim(min(loglik, lim), max(loglik, lim)) + la <- xl[mx] + # browser() + if (mx > 1 && mx < m){ + plt <- plt+ + ggplot2::geom_segment(ggplot2::aes(x=la, y=min(loglik), xend=la, yend=Lmax), + linetype='dashed', color='red', size=.5)+ + ggplot2::geom_text(ggplot2::aes(x=la,y=min(loglik),label=round(la,digits = 2)),color='red',vjust='top', + hjust='center') + } + # browser() + ind <- range((1L:m)[loglik > lim]) + if (loglik[1L] < lim) { + i <- ind[1L] + x <- xl[i - 1] + ((lim - loglik[i - 1]) * (xl[i] - + xl[i - 1]))/(loglik[i] - loglik[i - 1]) + plt <- plt + + ggplot2::geom_segment(ggplot2::aes(x=x, y=min(loglik), xend=x, yend=lim), + linetype='dashed', color=grey(.5), size=.5, inherit.aes = FALSE) + } + if (loglik[m] < lim) { + i2 <- ind[2L] + 1 + x2 <- xl[i2 - 1] + ((lim - loglik[i2 - 1]) * (xl[i2] - + xl[i2 - 1]))/(loglik[i2] - loglik[i2 - 1]) + plt <- plt + + ggplot2::geom_segment(ggplot2::aes(x=x2, y=min(loglik), xend=x2, yend=lim), + linetype='dashed', color=grey(.5), size=.5, inherit.aes = FALSE) + } + plt +} + diff --git a/R/group_effect.R b/R/group_effect.R new file mode 100644 index 0000000..f6baec4 --- /dev/null +++ b/R/group_effect.R @@ -0,0 +1,251 @@ +#' Calculation of covariable effects within each value of another covariable that has interaction +#' @description This function calculate the OR, CI, an p.value within each value of specified covariable. +#' @param formula +#' A formula in the the form of A + B ~ X, where +#' +#' - X is the covariable to be concerned. X must be of type factor. +#' - A, B are the covarables having interaction with X whose effects will be calculated. +#' If . or blank. All covariables having interaction with X would be included. +#' +#' @param model A fitted glm model or a formula +#' @param method +#' a string whose value is either +#' "lik.ratio" for CI and tests based on likelihood ratio statistics (preferred) +#' or "wald" for CI and tests based on Wald statistics +#' @param transpose logical value, default is FALSE, whether to return a transposed summary. See also \link{t.subgroup_logist_summary} +#' @param stat_digits Number of decimal digits for statistics +#' @param p_digits Number of decimal digits for the p-values +#' @param simplify by default, if there is only one variable on each side of the formula and +#' no LHS is a binary, then the function will combine tables in each state of X to one. +#' Set to FALSE to avoid this behaviour. +#' @param sstable logical value specifying whether to return in sstable format. Default is FALSE. Set to TRUE forces verbose to FALSE +#' @param flextable logical value specifying whether to build flextable object. Default it FALSE. Set to TRUE forces sstable to TRUE. +#' @param ... additional parameters passed to glm to fit "model" (if model is a formula) +#' @return Under certain circumstances defined in param simplify, a flextable, an sstable, +#' a data.frame of class 'subgroup_logist_summary', +#' or a 'subgroup_logist_summary'/list of logist_summary, each represents one state of X. +#' @author Trinh Dong Huu Khanh +#' @seealso \link{logist_summary}, \link{print.subgroup_logist_summary}, \link{t.subgroup_logist_summary} +#' @examples +#' y = sample(0:1, 1000, replace = T) +#' x1 = sample(1:100, 1000, replace = T) +#' x2 = sample(c("A", "B"), 1000, replace = T) +#' x3 = sample(c("C", "D", "E"), 1000, replace = T) +#' x4 = sample(c("F", "G"), 1000, replace = T) +#' fakefit = glm(y ~ x1*x3 + x2*x3 + x2*x4, family = binomial()) +#' C306::subgroup_effect(~x3, fakefit) +#' @export +subgroup_effect <- function(formula, model, method = c('lik.ratio', 'wald'), transpose = FALSE, + stat_digits = 2, p_digits = 4, sstable = FALSE, flextable = FALSE, simplify = TRUE, ...) +{ + # browser() + method <- match.arg(method) + if (inherits(model, 'formula')){ + fml <- model + model <- glm(model, ..., family = binomial) + model$call$formula <- fml + } + compatible <- FALSE + if (length(model$family)) { + if ((model$family$family=='binomial')|(model$family$link=='logit')) compatible <- TRUE + } + # browser() + if (!compatible) stop("This function only works for logistic regression.") + mf <- model.frame(model) + all_ia <- ._get_interaction_terms(model) + base_var <- formula.tools::rhs.vars(formula) + base_lv <- levels(as.factor(mf[[base_var]])) + summary_vars <- formula.tools::lhs.vars(formula) + assertthat::assert_that(length(base_var) == 1, + msg = 'rhs must be of length 1') + ._assert_ia(base_var, all_ia$ia.vars) + has_base <- sapply(all_ia$ia.vars, function(ia_var) base_var %in% ia_var) + base_ia <- sapply(all_ia, `[`, has_base, simplify = FALSE) + summary_vars.auto <- + unname(unlist(lapply(base_ia$ia.vars,function(ia.var) ia.var[ia.var != base_var]))) + if (length(summary_vars) & + !(length(summary_vars) == 1 & !length(setdiff(summary_vars, '.')))) + { + ._assert_ia(summary_vars, summary_vars.auto) + } else summary_vars <- summary_vars.auto + y <- model.response(mf) + # browser() + ci.p <- sapply(base_lv, function(lv){ + new_mf <- mf + new_mf[[base_var]] <- relevel(as.factor(new_mf[[base_var]]), ref = lv) + new_model <- update(model, data = new_mf) + new_mm <- model.matrix(new_model) + est <- lapply(summary_vars, function(sv){ + k <- which(names(new_mf) == sv) - 1 + iS <- which(attr(new_mm, 'assign') == k) + est.sv <- coef(new_model)[iS] + names(est.sv) <- colnames(new_mm)[iS] + est.sv + }) + if (method == 'lik.ratio'){ + logLik.full <- logLik(new_model) + ci.p <- sapply(summary_vars, function(sv){ + ci.p.sv <- ._ci_p_calc(sv, new_mf, new_mm, new_model, wald = FALSE, logLik.full = logLik.full) + }, simplify = FALSE) + } else { + ci.p <- sapply(summary_vars, function(sv){ + ci.p.sv <- ._ci_p_calc(sv, new_mf, new_mm, new_model, wald = TRUE) + }, simplify = FALSE) + } + ci.p.t <- purrr::transpose(ci.p) + ci.lower <- ci.p.t$ci.lower.sv + ci.upper <- ci.p.t$ci.upper.sv + p <- ci.p.t$p.sv + # browser() + list( + log.OR = do.call(c, as.list(unlist(est))), + OR = do.call(c, as.list(exp(unlist(est)))), + CI.lower = do.call(c, as.list(unlist(ci.lower))), + CI.upper = do.call(c, as.list(unlist(ci.upper))), + p.value = do.call(c, as.list(unlist(p)))) + }, simplify = FALSE) + # browser() + out <- lapply(ci.p, function(.x) do.call(cbind, .x)) + out <- sapply(out, + function(.out){ + for (i in 1:4) + .out[,i] <- formatC(as.numeric(.out[,i]), + digits = stat_digits, format = 'f') + .out[,'p.value'] <- formatC(as.numeric(.out[,'p.value']), + p_digits, format = 'f') + .out + }, simplify = FALSE) + # message('- CI and p-value are based on ', + # switch(method, wald = 'Wald', lik.ratio = 'Likelihood ratio'), + # ' test with 95% level of confidence.') + if (all(sapply(out, nrow) == 1) & simplify){ + msg <- paste('- Effect table for', crayon::green(rownames(out[[1]]))) + grp <- names(out) + out <- do.call(rbind, out) + rownames(out) <- grp + lgs <- ._as_logist_summary(out, method = method, stringsAsFactor = FALSE) + class(lgs) <- c('subgroup_logist_summary', class(lgs)) + attr(lgs, 'base_var') <- base_var + attr(lgs, 'summary_vars') <- summary_vars + attr(lgs, 'msg') <- msg + return(lgs) + } + tbl <- structure(sapply(out, ._as_logist_summary, + method = method, stringsAsFactors = FALSE, + simplify = FALSE), + class = 'subgroup_logist_summary', + base_var = base_var, + summary_vars = summary_vars) + if (flextable) sstable <- TRUE + if (sstable) return(as_sstable.subgroup_logist_summary(tbl, flextable = flextable)) + if (transpose) return(t(tbl)) + tbl +} + +._get_interaction_terms <- function(fit){ + fml <- formula(fit) + ia.terms <- attr(terms(fml),"term.labels")[attr(terms(fml),"order")>1] + ia.factors <- attr(terms(fml),"factors")[,ia.terms, drop = FALSE] + ia.vars <- sapply(ia.terms, + function(ia.term) rownames(ia.factors)[ia.factors[,ia.term] == 1], + simplify = FALSE) + return(list(ia.terms = ia.terms, ia.vars = ia.vars)) +} + +._assert_ia <- function(vars, ia_vars){ + for (v in vars){ + assertthat::assert_that( + v %in% unique(unlist(ia_vars)), + msg = paste(deparse(substitute(v)), 'not exists in interaction terms.') + ) + } +} + +._as_logist_summary <- function(x, method, ...){ + x <- as.data.frame(x, ...) + class(x) <- c('logist_summary', class(x)) + attr(x, 'method') <- method + attr(x, 'footer') <- paste('Note: 95% confidence intervals and p-values are based on', method, 'statistics.') + x +} + +._ci_p_calc <- function(sv, mf, mm, model, wald, logLik.full = NULL){ + # browser() + y <- model.response(mf) + k <- which(names(mf) == sv) - 1 + iS <- which(attr(mm, 'assign') == k) + if (wald){ + ci <- suppressMessages(confint.default(model))[iS,,drop = FALSE] + ps <- coef(summary(model))[, 'Pr(>|z|)'] + p.sv <- ps[iS] + } else { + ci <- suppressMessages(confint(model))[iS,,drop = FALSE] + p.sv <- sapply(iS, function(i){ + fit.i <- glm.fit(x = mm[, -i], y = y, family = binomial()) + logLik.i <- logLik(structure(fit.i, class = 'glm')) + 1 - pchisq(2 * (logLik.full - logLik.i), 1) + }) + } + ci.lower.sv <- ci[,1] + ci.upper.sv <- ci[,2] + names(ci.lower.sv) <- colnames(mm)[iS] + names(ci.upper.sv) <- colnames(mm)[iS] + names(p.sv) <- colnames(mm)[iS] + list(ci.lower.sv = ci.lower.sv, ci.upper.sv = ci.upper.sv, p.sv = p.sv) +} + +#' Print method for subgroup_logist_summary +#' @description Print method for subgroup_logist_summary +#' @param x an object of class subgroup_logist_summary +#' @param ... additional params passed to print.data.frame +#' @return invisibly return itself +#' @seealso \link{print.data.frame} +#' @export +print.subgroup_logist_summary <- function(x, ...){ + if (length(attr(x, 'msg'))) message(attr(x, 'msg')) + if (is.data.frame(x)) NextMethod('print') + else { + method <- attr(x[[1]], 'method') + base_var <- attr(x, 'base_var') + cat(crayon::silver('- Method:', switch(method, lik.ratio = 'Likelihood ratio', wald = 'Wald')), '\n') + cat(crayon::silver('- CIs are calculated at 95% level of confidence.\n\n')) + for (i in seq_along(x)){ + name <- if (length(base_var)) paste0(base_var, ' = ', names(x)[i]) else names(x)[i] + this <- cbind(rn = rownames(x[[i]]), x[[i]]) + colnames(this)[[1]] <- name + print.data.frame(this, row.names = FALSE) + cat('\n') + } + } + invisible(x) +} + +#' Transpose a subgroup logist summary table +#' @description A method to transpose logist summary table, rather than stratify by subgroup, it stratifies by covariables. +#' @param x an object of class subgroup_logist_summary +#' @return +#' If x is a simplified subgroup_logist_summary (aka a data.frame), return itself. Otherwise, a transposed list of class subgroup_logist_summary +#' @seealso \link{t} +#' @method t subgroup_logist_summary +#' @author Trinh Dong Huu Khanh +#' @export +#' @examples +#' y = sample(0:1, 1000, replace = T) +#' x1 = sample(1:100, 1000, replace = T) +#' x2 = sample(c("A", "B"), 1000, replace = T) +#' x3 = sample(c("C", "D", "E"), 1000, replace = T) +#' x4 = sample(c("F", "G"), 1000, replace = T) +#' fakefit = glm(y ~ x1*x3 + x2*x3 + x2*x4, family = binomial()) +#' se = C306::subgroup_effect(~x3, fakefit) +#' t(se) +t.subgroup_logist_summary <- function(x){ + if (is.data.frame(x)) return(x) + v <- rownames(x[[1]]) + structure(sapply(v, function(.v) do.call(rbind, lapply(x,`[`,.v,)), simplify = FALSE), class = 'subgroup_logist_summary') +} + +#' @export +`[.subgroup_logist_summary` <- function(x,...){ + class(x) <- 'data.frame' + NextMethod('[') +} diff --git a/R/logist_summary.R b/R/logist_summary.R new file mode 100644 index 0000000..ec45da7 --- /dev/null +++ b/R/logist_summary.R @@ -0,0 +1,112 @@ +#' An alternative summary for a logistic model with OR, CI, and p-values +#' @description a function to create summary table for glm logistic model +#' @param fit a logistic regression model of class "glm" +#' @param method +#' a string whose value is either +#' "lik.ratio" for CI and tests based on likelihood ratio statistics (preferred) +#' or "wald" for CI and tests based on Wald statistics +#' @param stat_digits Number of decimal digits for statistics +#' @param p_digits Number of decimal digits for the p-values +#' @param verbose logical value specifying whether to print out result and notation. Default is FALSE +#' @param sstable logical value specifying whether to return in sstable format. Default is FALSE. Set to TRUE forces verbose to FALSE +#' @param flextable logical value specifying whether to build flextable object. Default it FALSE. Set to TRUE forces sstable to TRUE and verbose to FALSE. +#' Like other sstable objects, you can still create flextable or huxtable afterwards by using \link{ss_flextable} or \link{ss_huxtable} +#' @param ... additional parameters passed to \link{ss_flextable} +#' @author Marcel Wolbers, Lam Phung Khanh, and Trinh Dong Huu Khanh +#' @seealso \link{ss_format}, \link{ss_huxtable}, \link{ss_flextable} +#' @return A data frame of additional class "logist_summary" (if sstable == FALSE), a matrix of class c("summary_tbl", "ss_tbl") otherwise +#' @export +logist_summary <- function(fit, method = c('lik.ratio', 'wald'), stat_digits=2, p_digits=4, verbose = FALSE, + sstable = FALSE, flextable = FALSE, ...){ + compatible <- FALSE + if (length(fit$family)) { + if ((fit$family$family=='binomial')|(fit$family$link=='logit')) compatible <- TRUE + } + # browser() + if (!compatible) stop("This function only works for logistic regression.") + method <- match.arg(method) + if (flextable) sstable <- TRUE + if (sstable) verbose <- FALSE + + summary_method <- switch(method, lik.ratio = ._lik.ratio_summary, wald = ._wald_summary) + result_obj <- summary_method(fit, stat_digits = stat_digits, p_digits = p_digits, verbose = verbose) + + out <- structure(result_obj$table, footer = result_obj$footer, method = method, class = c('logist_summary','data.frame')) + if (sstable) return(as_sstable.logist_summary(out, flextable = flextable)) + if (verbose) return(invisible(print(out))) + return(out) +} + +._wald_summary <- function(fit, stat_digits=2, p_digits=4, verbose = FALSE){ + est <- coef(fit) + ci <- suppressMessages(confint.default(fit)) + result <- data.frame(log.OR = est, OR = exp(est), + lower.CI = exp(ci[,1]), upper.CI = exp(ci[,2]), p.value = summary(fit)$coef[,"Pr(>|z|)"]) + for (i in 1:4) result[,i] <- formatC(result[,i], digits = stat_digits, format = 'f') + if (length(result$p.value)) result$p.value <- formatC(result$p.value, p_digits, format = 'f') + if (naprint(fit$na.action)!="") message("\nNote:",naprint(fit$na.action)) + if (verbose){ + cat("\nNote: 95% confidence intervals and p-values are based on Wald statistics.\n\n", + "\n(Inference based on likelihood ratio statistics can be obtained with logist.summary(",deparse(substitute(obj)),") and is usually more accurate.\n)",sep="") + } + return(list(table = result, + footer = "Note: 95% confidence intervals and p-values are based on Wald statistics.")) +} + +._lik.ratio_summary <- function(fit, stat_digits=2, p_digits=4, verbose = FALSE, sstable = FALSE){ + est <- coef(fit) + ci <- suppressMessages(confint(fit)) + result <- data.frame(log.OR = est, OR = exp(est), + lower.CI = exp(ci[,1]), upper.CI = exp(ci[,2])) + + has.intercept <- (names(coef(fit))[1]=="(Intercept)") + any.ia <- any(attr(terms(formula(fit)),"order")>1) + # browser() + logLik.full <- logLik(structure(fit, class = 'glm')) + x <- names(coef(fit)) + y <- model.response(model.frame(fit, drop.unused.levels = TRUE)) + p <- sapply(seq_along(x), function(i){ + fit.i <- glm.fit(x = model.matrix(fit)[,-i], y = y, family = binomial()) + logLik.i <-logLik(structure(fit.i, class = 'glm')) + 1 - pchisq(2 * (logLik.full - logLik.i), 1) + }) + names(p) <- x + result <- merge(result, data.frame(p.value = p), all.x = TRUE, by='row.names') + rownames(result) <- result[,'Row.names'] + result <- result[, -1] + + for (i in 1:4) result[,i] <- formatC(result[,i], digits = stat_digits, format = 'f') + if (length(result$p.value)) result$p.value <- formatC(result$p.value, p_digits, format = 'f') + result$p.value <- ifelse(grepl('NA', result$p.value), '', result$p.value) + if (naprint(fit$na.action)!="") message("\nNote:",naprint(fit$na.action)) + if (verbose) { + cat("\nNote: 95% confidence intervals and p-values are based on likelihood ratio statistics.\n\n") + if (!has.intercept) cat("\nNote: p-values of LR-tests not calculated because model has no intercept.\n\n") + } + + return(list(table = result, + footer = c( + "Note: 95% confidence intervals and p-values are based on likelihood ratio statistics.", + if (!has.intercept) + "p-values of LR-tests not calculated because model has no intercept."))) + # return(result) +} + +# provide a method for family to get the family of glm.fit +family.list <- function(object,...) object$family + + +#' Print method for logist_summary +#' @description Print method for logist_summary table +#' @param x an object of class logist_summary +#' @param ... additional params passed to print.data.frame +#' @return invisibly return itself +#' @seealso \link{print.data.frame} +#' @export +print.logist_summary <- function(x, ...) +{ + method <- attr(x, 'method') + cat(crayon::silver('- Method:', switch(method, lik.ratio = 'Likelihood ratio', wald = 'Wald')), '\n') + cat(crayon::silver('- CIs are calculated at 95% level of confidence.\n\n')) + print.data.frame(x, ...) +} diff --git a/R/simple_relevel.R b/R/simple_relevel.R new file mode 100644 index 0000000..d7c0a66 --- /dev/null +++ b/R/simple_relevel.R @@ -0,0 +1,95 @@ +#' Relevel in correspondence to another factor +#' +#' @description Function to relevel a variable in accordance to a another variable of class "factor". +#' @return An object of the same class as the input +#' @export +simple_relevel <- function(x, ...){ + UseMethod('simple_relevel') +} + +#' @rdname simple_relevel +#' +#' @param data A data.frame +#' @param by A vector or unquoted variable name the relevelling process will base on +#' @param ... Unquoted variable names that will be relevelled +#' @export +simple_relevel.data.frame <- function(data, ..., by){ + #... variables to relevel + # by: variable that is based on + require(dplyr) + requireNamespace('rlang') + dep.vars <- rlang::enquos(...) + dep.vars.2 <- sapply(dep.vars, function(dep.var) rlang::quo_name(dep.var)) + by <- rlang::enquo(by) + by.2 <- rlang::quo_name(by) + # browser() + if (!is.factor(data[[by.2]])) data[[by.2]] <- as.factor(data[[by.2]]) + for(i in seq_along(dep.vars.2)){ + # browser() + dep.var.2 <- dep.vars.2[[i]] + dep.var <- dep.vars[[i]] + isolated.data <- + data[c(by.2, dep.var.2)] %>% + unique() %>% #remove all dup + arrange({{dep.var}}) %>% arrange({{by}})# first, sort the data by dep.var to retain prev levels, second by "by" + dep.var.lv <- isolated.data[[dep.var.2]] + # browser() + data[[dep.var.2]] <- factor(data[[dep.var.2]], levels = dep.var.lv) + } + data +} + +#' @rdname simple_relevel +#' +#' @param x a vector that will be relevelled +#' @param by a vector that the relevelling process will base on +#' @param map a list that links by to x in the form of list(by.1 = c(x1.1, x1.2...), by.2 = c(x2.1, x2.2...)) +#' or a data.frame with two columns "from" and "to" serving the same purpose. +#' @param value a string: whether to return +#' +#' - "levels": new levels only +#' +#' - "unsorted" (default): an unsorted, relevelled factor +#' +#' - "sorted": a sorted, relevelled factor +#' @return A factor or a numeric vector of order +#' @export +simple_relevel.default <- function(x, by, map, value = c('unsorted', 'sorted', 'levels')){ + requireNamespace('dplyr') + value <- match.arg(value) + if (!is.data.frame(map)){ + map <- do.call(rbind, + lapply(seq_along(map), + function(i){ + .map <- map[i] + name <- names(.map) + data.frame(from = rep(name, length(map[[i]])), to = map[[i]]) + })) + } + # browser() + stopifnot(setequal(unique(x), map$to)) + stopifnot(setequal(unique(by), map$from)) + map$from <- factor(map$from, levels = levels(by)) + X <- data.frame(to = x) + data <- merge(X, map, by = 'to', all.x = TRUE) + to <- simple_relevel.data.frame(data, to, by = from)$to + if (value == 'sorted') return(to) + lv <- levels(to) + if (value == 'levels') return(lv) + factor(x, levels = lv) +} + +#' Sort a vector in a user-defined order +#' @description A function to sort a vector in an user-defined order +#' @param x A vector to be sorted +#' @param order A manually defined order vector +#' @return A vector +#' @export +simple_sort <- function(x, order = levels(as.factor(x))){ + stopifnot(length(order) == length(unique(x))) + x_factor <- factor(x, levels = order) + x_sort <- sort(x_factor) + x_retrieve <- as(levels(x_sort), typeof(x))[x_sort] + attributes(x_retrieve) <- attributes(x) + x_retrieve +} diff --git a/R/ssformat.R b/R/ssformat.R new file mode 100644 index 0000000..a7b91cd --- /dev/null +++ b/R/ssformat.R @@ -0,0 +1,727 @@ +## Quick sstable drawing helpers +## Author: trinhdhk +## Day first written: Sep 20 2019 +## Latest build: Sep 27 2019 +## Ver 0.1.0.092019 + +## Check legitibility +ss_legit <- function(sstable){ + # requireNamespace('tibble') + if (!is.matrix(sstable) & !is.data.frame(sstable)) stop('sstable must be of type matrix or data frame.') + return(as.matrix(sstable)) +} +#' Set template for sstable +#' +#' @description This function set the template for sstable +#' @param sstable a data frame following sstable's grammar +#' @param template +#' An accepted template for sstable: must be either 'baseline', 'survcomp', or 'ae'. +#' +#' If NA, the existing template in the sstable is kept as-is. It no template built-in, will return a no-template sstable instead. +#' @return a matrix of class ss_tbl +#' @export +ss_template <- function(sstable, template = c('baseline', 'survcomp', 'ae')){ + sstable <- ss_legit(sstable) + ss.class <- class(sstable) + if (missing(template)) template <- NA + if (!is.na(template)) template <- match.arg(template) + if (is.na(template)){ + template <- c('baseline', 'survcomp', 'ae') + template.match <- match(template, ss.class) + template.match <- template.match[!is.na(template.match)] + if (length(template.match) > 1) template.match <- template.match[[1]] + template <- template[template.match] + } + + template <- paste0(template, '_tbl') + class(sstable) <- unique(c(template, 'ss_tbl', 'matrix', class(sstable))) + return(sstable) +} + +#' Designation of header rows for custom sstable +#' +#' @description This function set the designated rows as header rows of a sstable +#' @param sstable a data frame following sstable's grammar +#' @param rows a numeric vector +#' @return a matrix of class ss_tbl +#' @export +ss_header <- function(sstable, rows) { + sstable <- ss_legit(sstable) + if (!length(rownames(sstable))) rownames(sstable) <- seq_len(nrow(sstable)) + rownames(sstable)[rows] <- paste("header", seq_along(rows), sep=".") + ss_table <- ss_template(sstable, template = NA) + sstable +} + +#' Designation of body part for custom sstable +#' +#' @description This function set the designated rows as body part of a sstable +#' @param sstable a data frame following sstable's grammar +#' @param rows a numeric vector +#' @return a matrix of class ss_tbl +#' @export +ss_body <- function(sstable, rows){ + sstable <- ss_legit(sstable) + if (!length(rownames(sstable))) rownames(sstable) <- seq_len(nrow(sstable)) + rownames(sstable)[rows] <- paste("body", seq_along(rows), sep=".") + ss_table <- ss_template(sstable, template = NA) + sstable +} + +#' Designation of section title rows for custom sstable +#' +#' @description This function set the designated rows as section title rows of an sstable +#' @param sstable a data frame following sstable's grammar +#' @param rows a numeric vector +#' @return a matrix of class ss_tbl +#' @export +ss_section <- function(sstable, rows){ + sstable <- ss_legit(sstable) + if (!length(rownames(sstable))) rownames(sstable) <- seq_len(nrow(sstable)) + rownames(sstable)[rows] <- paste("section", seq_along(rows), sep=".") + ss_table <- ss_template(sstable, template = NA) + sstable +} + +#' Quick format a sstable in preparation for create flextable/huxtable +#' +#' @description This function is the combination of ss_header, ss_body, and ss_section. +#' @param sstable a data frame following sstable's grammar +#' @param header a numeric vector that will be passed to ss_header +#' @param section a numeric vector that will be passed to ss_section +#' @param body a numeric vector that will be passed to ss_body +#' @param template +#' An accepted template for sstable: must be either 'baseline', 'survcomp', or 'ae'. +#' +#' If NA, the existing template in the sstable is kept as-is. It no template built-in, will return a no-template sstable instead. +#' @param .guess a logical value. If TRUE, the function will try to guess to which part each row belongs. +#' @return a matrix of class ss_tbl +#' @export +ss_format <- function(sstable, header = c(), section = c(), body = c(), template = c('baseline', 'survcomp', 'ae'), .guess= TRUE){ + if (missing(template)) template <- NA + if (!is.na(template)) template <- match.arg(template) + sstable <- ss_template(sstable, template = template) + if (.guess) { + no.guess.in.table <- which(grepl( + '(header)|(section)|(body)', + rownames(sstable), + perl = TRUE + )) + no.guess <- union(no.guess.in.table, na.omit(as.numeric(c(header, section, body)))) + # filter out from guess what have been defined + guess <- ss_guess_format(sstable) + h <- which(guess == 'header') + s <- which(guess == 'section') + b <- which(guess == 'body') + # filling the undecided row with auto guess + header <- unique(c(h[!h %in% no.guess], header)) + # if (length(colnames(sstable))) header <- c('colnames', header) + section <- unique(c(s[!s %in% no.guess], section)) + body <- unique(c(b[!b %in% no.guess], body)) + } + if (length(header)) sstable <- ss_header(sstable, rows = header) + if (length(body)) sstable <- ss_body(sstable, rows = body) + if (length(section)) sstable <- ss_section(sstable, rows = section) + if (sum(sapply(c('header', 'section', 'body'), grepl, x=rownames(sstable), fixed=TRUE)) != nrow(sstable)) + stop('Some row are not classified as header, section, or body. Perhaps you want to set .guess to TRUE?') + class(sstable) <- c('formatted_sstable', class(sstable)) + sstable +} + +# An incomplete algorithm to guess the format of each sstable row. +ss_guess_format <- function(sstable){ + UseMethod('ss_guess_format') +} + +ss_guess_format.default <- function(sstable){ + guess <- sapply(seq_len(nrow(sstable)), + function(i){ + r <- sstable[i,] + if (isTRUE(grepl("header", rownames(sstable)[i]))) return("header") + if (all(is.na(suppressWarnings(as.numeric(r)))) && i <= 2) return("header") + if (sum(r == '', na.rm=TRUE) == ncol(sstable)-1) return("section") + return("body") + }) + return(guess) +} + +ss_guess_format.ae_tbl <- function(sstable){ + guess <- sapply(seq_len(nrow(sstable)), + function(i){ + if (i <= 2) return('header') + r <- sstable[i, ] + if (sum(r == '', na.rm=TRUE) >= 2) return('section') + return('body') + }) + return(guess) +} + +ss_guess_format.baseline_tbl <- function(sstable){ + guess <- c(rep('header',2), rep('body', nrow(sstable)-2)) + return(guess) +} + +ss_guess_format.survcomp_tbl <- function(sstable){ + guess <- c(rep('header',2), rep('body', nrow(sstable)-2)) + return(guess) +} + +ss_guess_format.summary_tbl <- function(sstable){ + guess <- c('header', rep('body', nrow(sstable)-1)) + return(guess) +} + +#' Create summary table using flextable package. +#' +#' @description This function generate a flextable from a sstable. +#' @param sstable a data frame following sstable's grammar +#' @param footer a character vector each of which is the footnote of the flextable +#' @param bg a character string that defines stripped background color of the flextable +#' @param ... additional parameters that will be passed to ss_format if the sstable has yet to be formatted. +#' @seealso \link[flextable]{flextable} +#' @return an object of class flextable +#' @export +ss_flextable <- function(sstable, ...){ + UseMethod('ss_flextable') +} + +#' @rdname ss_flextable +#' @method ss_flextable list +#' @param add_footer additional footer lines to be appended to object footers +#' @export +ss_flextable.list <- function(sstable, add_footer = NULL,...){ + ss_flextable(sstable$table, footer = c(sstable$footer, add_footer), ...) +} + +#' @rdname ss_flextable +#' @method ss_flextable ss_obj +#' @export +ss_flextable.ss_obj <- ss_flextable.list + +#' @rdname ss_flextable +#' @export +ss_flextable.default <- function(sstable, footer = NULL, bg = "#F2EFEE", ...){ + requireNamespace("flextable") + requireNamespace("officer") + if (!inherits(sstable, 'formatted_sstable')) sstable <- ss_format(sstable, ..., .guess = TRUE) + header <- which(grepl("header", rownames(sstable))) + body <- which(grepl("body", rownames(sstable))) + section <- which(grepl("section", rownames(sstable))) + + colnames(sstable) <- NULL + sstable <- as.data.frame(sstable, stringsAsFactors = FALSE) + col.even <- ncol(sstable) %% 2 == 0 + + ## headers + ss.header <- sstable[header,] + names(ss.header) <- colnames(sstable) + # browser() + + ss.header2 <- + lapply(seq_along(header), + function(i){ + h <- ss.header[i, ] + if (col.even) col <- seq_len((ncol(sstable)-1))[-1] + else col <- seq_len(ncol(sstable))[-1] + right_fill <- h[[max(col)]] != "" & h[[1]] == "" + + h <- sapply(seq_along(h), + function(j){ + if (h[[j]] == "") { + if (j == ncol(sstable) && i>1) return(ss.header[i-1,j]) + if (j == 1){ + if (i > 1) return(ss.header[i-1,j]) #lag 1 row + return(h[[j]]) #return "" + } + if (right_fill) return(h[[j+1]]) + return(h[[j-1]]) + } + return(h[[j]]) + }) + names(h) <- paste0('V',seq_len(ncol(sstable))) + return(h) + } + ) + # browser() + + ## Create the flextable + ft <- flextable::flextable(sstable[-header,, drop = FALSE]) + # browser() + + ## header format + ft <- flextable::set_header_labels(ft, values = ss.header2[[1]]) + if (length(ss.header2) > 1) + for (i in seq_along(ss.header2)[-1]) + ft <- flextable::add_header_row(ft, values = ss.header2[[i]], top = F) + + ft <- flextable::merge_h(ft, i = seq_len(length(ss.header2)-1), part = "header") + ft <- flextable::merge_v(ft, part = "header") + + ## footer format + for (k in (seq_along(footer))) { + ft <- flextable::add_footer(ft, V1 = footer[k], top = FALSE) + ft <- flextable::merge_at(ft, i = k, j = seq_len(ncol(sstable)), part = "footer") + } + + ## section format + for (k in section){ + + ### merging cells that from the left if the whole row is empty + if (all(sstable[k, -1] == '') %in% TRUE) + ft <- flextable::merge_at(ft, i = k, j = seq_len(ncol(sstable)), part = 'body') + else ft <- flextable::merge_h(ft, i = k , part = 'body') + + ft <- flextable::bold(ft, i = k-length(header), j = 1, part = 'body') + } + + ## format flextable + ## width + ft <- flextable::autofit(ft) + ### alignment + ft <- flextable::align(ft, j = 1, align = "left", part = "all") + + ft_sstheme(ft, bg = "#F2EFEE" ) +} + + +#' Flextable theming for sstable +#' +#' @description Theming flextable for sstable +#' @param ft flextable +#' @export +ft_sstheme <- function(ft, bg = "#F2EFEE"){ + ### faces of header + ft <- flextable::bold(ft, part = "header") + ### background + ft <- flextable::bg(ft, i = seq(from = 1, to = nrow(ft$body$dataset), by = 2), j = seq_len(ncol(ft$body$dataset)), + bg = bg, part = "body") + ### border + tabbd <- officer::fp_border(color="black", width = 1.5) + ft <- flextable::border_remove(ft) + ft <- flextable::hline(ft, border = tabbd, part = "header") + ft <- flextable::hline_top(ft, border = tabbd, part = "all") + ft <- flextable::hline_bottom(ft, border = tabbd, part = "body") + return(ft) +} + +#' Create summary table using huxtable package. +#' +#' @description This function generate a huxtable from a sstable. +#' @param sstable a data frame following sstable's grammar +#' @param footer a character vector each of which is the footnote of the flextable +#' @param caption a string containing table caption. Default is NULL +#' @param caption_pos +#' A length-one character vector, +#' one of "top", "bottom", "topleft", "topcenter", "topright", "bottomleft", "bottomcenter", "bottomright". +#' Default is "bottomcenter". +#' +#' See also \link[huxtable]{caption_pos} +#' @param bg a character vector that defines background color of the flextable. If length(bg) >= 2, the table will have stripe background, otherwise plain. +#' @param border_width a number that defines huxtable border width +#' @param border_color a character string that defines huxtable border color +#' @param wrap a logical value. Default is FALSE. If TRUE, long texts would be wrapped, long lines would be broken. +#' This applies to the whole table. Please use huxtable::set_wrap instead if you want a cell-wise approach. +#' See also \link[huxtable]{wrap} +#' @param ... additional parameters that will be passed to ss_format if the sstable has yet to be formatted. +#' @return an object of class huxtable +#' @seealso \link[huxtable]{huxtable} +#' @export +ss_huxtable <- function(sstable,...){ + UseMethod('ss_huxtable') +} + +#' @rdname ss_huxtable +#' @param add_footer additional footer lines to be appended to object footers +#' @export +ss_huxtable.list <- function(sstable, add_footer = NULL,...){ + ss_huxtable(sstable$table, footer = c(sstable$footer, add_footer), ...) +} + +#' @rdname ss_huxtable +#' @export +ss_huxtable.default <- function(sstable, footer = NULL, + caption = NULL, caption_pos = c("top", "bottom", "topleft", "topcenter", "topright", + "bottomleft", "bottomcenter", "bottomright"), + bg = c(grey(.95), 'white'), border_width=0.8, border_color = grey(.75), wrap = FALSE,...){ + requireNamespace('huxtable') + if (missing(caption_pos)) caption_pos <- 'bottomcenter' else caption_pos <- match.arg(caption_pos) + if (!inherits(sstable, 'formatted_sstable')) sstable <- ss_format(sstable, ..., .guess = TRUE) + header <- which(grepl("header", rownames(sstable))) + body <- which(grepl("body", rownames(sstable))) + section <- which(grepl("section", rownames(sstable))) + + colnames(sstable) <- NULL + sstable <- as.data.frame(sstable, stringsAsFactors = FALSE) + col.even <- ncol(sstable) %% 2 == 0 + + ## headers pre-processing + ss.header <- sstable[header,] + names(ss.header) <- colnames(sstable) + # browser() + + ss.header2 <- + lapply(seq_along(header), + function(i){ + h <- ss.header[i, ] + if (col.even) col <- 2:(ncol(sstable)-1) + else col <- 2:ncol(sstable) + right_fill <- h[[max(col)]] != "" & h[[2]] == "" + + h <- sapply(seq_along(h), + function(j){ + if (h[[j]] == "") { + if (j == ncol(sstable) && i>1) return(ss.header[i-1,j]) + if (j == 1){ + if (i > 1) return(ss.header[i-1,j]) #lag 1 row + return(h[[j]]) #return "" + } + if (right_fill) return(h[[j+1]]) + return(h[[j-1]]) + } + return(h[[j]]) + }) + return(h) + } + ) + + sstable.headless <- sstable[-header,] + colnames(sstable.headless) <- ss.header2[[length(ss.header2)]] + + ## create table + ht <- huxtable::as_hux(sstable.headless, add_colnames = TRUE, add_rownames = FALSE) + + ## insert header + if (nrow(ss.header)>1){ + for (i in seq_along(ss.header2)[-length(ss.header2)]){ + ht <- huxtable::insert_row(ht, ss.header2[[i]]) + } + } + + ## format header + # browser() + + # merge cols that have same values + for (i in seq_along(ss.header2)){ + which.start <- 1 + for (j in seq_along(ss.header2[[i]])){ + if (j > 1){ + if (ss.header2[[i]][[j]] != ss.header2[[i]][[j-1]]) which.start <- c(which.start, j) + } + ht <- huxtable::set_align(ht, i, j, value = 'center') + } + + which.start <- sort(unique(c(which.start, ncol(sstable)+1))) + + for (k in seq_along(which.start)){ + if (k < length(which.start) & which.start[k+1] - which.start[k] > 1){ + ht <- huxtable::merge_cells(ht, i, which.start[k]:(which.start[k+1]-1)) + } + } + } + # merge rows that have same values + for (i in seq_len(ncol(sstable))){ + which.start <- 1 + for (j in seq_along(ss.header2)){ + if (j > 1){ + if (ss.header2[[j]][[i]] != ss.header2[[j-1]][[i]]) which.start <- c(which.start, j) + } + } + + which.start <- sort(unique(c(which.start, length(ss.header2)+1))) + + for (k in seq_along(which.start)){ + if (k < length(which.start) & which.start[k+1] - which.start[k] > 1){ + ht <- huxtable::merge_cells(ht, which.start[k]:(which.start[k+1]-1), i) + } + } + } + + ## format sections + for (i in section){ + ht <- huxtable::set_bold(ht, i, huxtable::everywhere, value = TRUE) + ### merging cells that from the left if the whole row is empty + if (all(sstable[i, -1] == '')) + ht <- huxtable::merge_cells(ht, i, huxtable::everywhere) + } + + ## footer + for (i in seq_along(footer)){ + ht <- huxtable::add_footnote(ht, footer[i], border = if (i>1) 0 else border_width) + } + + ## caption + if (length(caption)){ + huxtable::caption(ht) <- caption + huxtable::caption_pos(ht) <- caption_pos + } + + ## format huxtable + ht <- huxtable::set_width(ht, 1) + + ht <- ht_theme_markdown(ht, header_rows = header, header_cols = NULL, + border_width = border_width, + border_color = border_color, + bg = bg) + + ## format wrapping + huxtable::wrap(ht) <- wrap + + return(ht) +} + + +#' A stripe theme for huxtable object +#' +#' @description This function provides a markdown stripe theme for huxtable object +#' @param ht an object of class huxtable +#' @param header_rows a numeric vector that delimits the header zone. +#' @param bg a character vector that defines background color of the flextable. If length(bg) >= 2, the table will have stripe background, otherwise plain. +#' @param border_width a number that defines huxtable border width +#' @param border_color a character string that defines huxtable border color +#' @return an object of class huxtable +#' @export +ht_theme_markdown <- function(ht, header_rows = 1:2, header_cols = NULL, + border_width=0.8, border_color = grey(0.75), bg = c(grey(.95),'white')){ + huxtable::top_border(ht)[1, ] <- border_width + huxtable::bottom_border(ht)[nrow(ht),] <- border_width + + for (header_row in header_rows){ + huxtable::bold(ht)[header_row, ] <- TRUE + } + + huxtable::bottom_border(ht)[max(header_rows), ] <- border_width + huxtable::top_border(ht)[max(header_rows)+1, ] <- border_width + + for (header_col in header_cols){ + huxtable::bold(ht)[, header_col] <- TRUE + } + ht <- huxtable::set_all_border_colors(ht, border_color) + if (length(bg > 1)) ht <- huxtable::map_background_color(ht, do.call(huxtable::by_rows, as.list(bg))) + else huxtable::background_color(ht) <- bg + ht +} + +#' A kable-esque theme for huxtable object +#' +#' @description This function provides a kable-esque theme for huxtable object +#' @param ht an object of class huxtable +#' @param header_rows a numeric vector that delimits the header zone. +#' @param bg a character vector that defines background color of the flextable. If length(bg) >= 2, the table will have stripe background, otherwise plain. +#' @param border_width a number that defines huxtable border width +#' @param border_color a character string that defines huxtable border color +#' @return an object of class huxtable +#' @export +ht_theme_kable <- function(ht, header_rows = 1:2, header_cols = NULL, + border_width = 1, border_color = '#dddddd', bg = c('white', '#f9f9f9')){ + huxtable::top_border(ht)[1, ] <- 0 + huxtable::bottom_border(ht)[nrow(ht),] <- border_width + + for (header_row in header_rows){ + huxtable::bold(ht)[header_row, ] <- TRUE + for (col in seq_len(ncol(ht))){ + if (!is.na(ht[header_row, col]) & stringr::str_trim(ht[header_row, col]) != ''){ + huxtable::bottom_border(ht)[header_row, col] <- border_width + } + } + } + # browser() + + huxtable::bottom_border(ht)[max(header_rows):nrow(ht), ] <- border_width + huxtable::top_border(ht)[max(header_rows)+1, ] <- border_width*2 + + for (header_col in header_cols){ + huxtable::bold(ht)[, header_col] <- TRUE + } + + ht <- huxtable::set_all_border_colors(ht, border_color) + if (length(bg > 1)){ + ht <- huxtable::map_background_color(ht, do.call(huxtable::by_rows, append(as.list(bg), c(from = max(header_rows)+1)))) + huxtable::background_color(ht)[header_rows,] <- bg[[1]] + } else huxtable::background_color(ht) <- bg + ht +} + +#' Coerce an object to sstable +#' @description A function to coerce objects to a sstable +#' @param x An object, usually a named list of length 2 whose names are 'table' and 'footer', or a data.frame/matrix (optionally with attribute "footer") +#' @param flextable logical value specifying whether to return a flextable. Default is FALSE +#' @param include_footnote logical value specifying whether to include footnote in the output. Default is FALSE +#' @param ... additional parameters passed to \link{ss_flextable} +#' @return A matrix of class ss_tbl if flextable == FALSE, otherwise a flextable +#' @export +#' +as_sstable <- function(x,...){ + UseMethod('as_sstable') +} + +#' @rdname as_sstable +#' @export +as_sstable.default <- function(x, flextable = FALSE, ...){ + out <- list() + out$table <- as.matrix(x$table) + out$table <- rbind(colnames(out$table), out$table) + out$table <- cbind(rownames(out$table), out$table) + colnames(out$table) <- rownames(out$table) <- NULL + if (length(attr(x, 'footer'))) out$footer <- attr(x, 'footer') + + class(out$table) <- c('ss_tbl', 'matrix') + if (flextable) return(ss_flextable(out, ...)) + return(out) +} + +#' @rdname as_sstable +#' @export +as_sstable.list <- function(x, flextable = FALSE, ...){ + out <- list() + + if (is.null(x$header)) + return(as_sstable.default(x, flextable = flextable, ...)) + header <- if (inherits(x$header, 'matrix')) x$header else do.call(rbind, x$header) + rownames(header) = paste0('header', seq_len(nrow(header))) + + if (inherits(x$body, 'list')){ + body <- lapply(seq_along(x$body), function(i){ + cont <- x$body[[i]] + title <- names(x$body)[[i]] + if (is.null(title)) title <- '' + title <- rep(title, ncol(cont)) + sec <- rbind(title, cont) + rownames(sec) = c(paste0('section', i), paste0('body',i, seq_len(nrow(cont)))) + if (title == '' & i == 1) sec <- sec[-1,] + sec + }) + body <- do.call(rbind, body) + } else { + body <- as.matrix(x$body) + rownames(body) <- paste0('body', seq_len(nrow(body))) + } + + out$table <- rbind(header, body) + out$footer <- x$footer + class(out$table) <- c('ss_tbl', 'matrix') + + if (flextable) return(ss_flextable(out, ...)) + return(out) +} + +#' @rdname as_sstable +#' @export +as_sstable.logist_summary <- function(x, include_footnote = TRUE, flextable = FALSE, ...){ + out <- list() + out$table <- as.matrix(x) + out$table <- rbind(colnames(out$table), out$table) + out$table <- cbind(rownames(out$table), out$table) + colnames(out$table) <- rownames(out$table) <- NULL + out$footer <- attr(x, 'footer') + class(out$table) <- c('summary_tbl', 'ss_tbl', 'matrix') + + if (flextable){ + logist_summary.sstable <- ss_flextable(out$table, footer = out$footer, ...) + return(logist_summary.sstable) + } + + if (include_footnote) return(out) + out$table +} + +#' @rdname as_sstable +#' @param include_footsnote logical value specifying whether to include footnote in the output. Default is FALSE +#' @export +as_sstable.overlap_summary <- function(x, include_footnote = TRUE, flextable = FALSE, ...){ + out <- list() + out$table <- as.matrix(x) + out$table <- rbind(colnames(out$table), out$table) + out$table <- cbind(rownames(out$table), out$table) + colnames(out$table) <- rownames(out$table) <- NULL + out$footer <- attr(x, 'footer') + class(out$table) <- c('summary_tbl', 'ss_tbl', 'matrix') + + if (flextable){ + overlap_summary.sstable <- ss_flextable(out$table, footer = out$footer, ...) + return(overlap_summary.sstable) + } + + if (include_footnote) return(out) + out$table +} + +#' @rdname as_sstable +#' @export +as_sstable.subgroup_logist_summary <- function(x, include_footnote = TRUE, flextable = FALSE, ...) +{ + tables <- sapply(x, as_sstable, include_footnote = FALSE, ..., simplify = FALSE) + footer <- attr(x[[1]], 'footer') + first_header <- c('', tables[[1]][1,-1]) + tables <- lapply(tables, `[`, -1,) + headers <- matrix(rep('', length(tables) * ncol(tables[[1]])), ncol = ncol(tables[[1]])) + headers[,1] <- paste(attr(x, 'base_var'), '=', names(tables)) + # browser() + table <- do.call(rbind, + lapply(seq_along(tables), + function(i) rbind(headers[i,], tables[[i]]))) + table <- rbind(first_header, table) + sstable <- ss_format(table, header = 1, section = (seq_len(length(tables)) - 1)*(nrow(tables[[1]])+1)+2) + if (flextable) return(ss_flextable(sstable, footer = footer)) + if (include_footnote) return(list(table = sstable, footer = footer)) + sstable +} + + +#' Row-binding two sstables +#' @description +#' Row-binding two sstables +#' @param tbl1,tbl2, two object of class sstables of the same template. Only export for technical use. +#' @param footer [NULL] default is the joint footer of two ss_tbl +#' @param ... args passed to the downstream method +#' @export +rbind.ss_obj <- function(tbl1, tbl2, footer=NULL, ...){ + if (!identical(class(tbl1$table), class(tbl2$table))) + stop('tbl1 and tbl2 must be of the same class.') + if (ncol(tbl1$table) != ncol(tbl2$table)) + stop('Unmatched number of columns between tbl1 and tbl2.') + NextMethod('rbind') +} + +._do_rbind <- function(tbl1, tbl2, header=1){ + new_tbl <- list() + new_tbl$table <- rbind(tbl1$table, tbl2$table[-header,]) + new_tbl$footer <- tbl1$footer + class(new_tbl$table) <- class(tbl1$table) + new_tbl +} + +#' @rdname rbind.ss_obj +#' @method rbind ss_ae +#' @export +rbind.ss_ae <- function(tbl1, tbl2, footer=NULL){ + if (!all.equal(tbl1$footer, tbl2$footer) & is.null(footer)) + stop('Two footers mismatched. Perhaps two tbl are using different config? \n + To ignore this, set a specific footer.') + out <- ._do_rbind(tbl1, tbl2, header=1:3) + if (!is.null(footer)) out$footer <- footer + out +} + +#' @rdname rbind.ss_obj +#' @method rbind ss_survcomp +#' @export +rbind.ss_survcomp <- function(tbl1, tbl2, footer=NULL){ + if (!all.equal(tbl1$footer, tbl2$footer) & is.null(footer)) + stop('Two footers mismatched. Perhaps two tbl are using different config? \n + To ignore this, set a specific footer.') + out <- ._do_rbind(tbl1, tbl2, header=1:3) + if (!is.null(footer)) out$footer <- footer + out +} + +#' @rdname rbind.ss_obj +#' @method rbind ss_baseline +#' @export +rbind.ss_baseline <- function(tbl1, tbl2, footer=NULL){ + if (!all.equal(tbl1$footer, tbl2$footer) & is.null(footer)) + stop('Two footers mismatched. Perhaps two tbl are using different config? \n + To ignore this, set a specific footer.') + out <- ._do_rbind(tbl1, tbl2, header=1) + if (!is.null(footer)) out$footer <- footer + out +} diff --git a/R/sstable.R b/R/sstable.R index 570096f..4223a65 100644 --- a/R/sstable.R +++ b/R/sstable.R @@ -13,6 +13,20 @@ getvar <- function(formula) { } } +# extract the sign from quo/formula for sstable - trinhdhk ---------------- + +getsign <- function(fml){ + fml <- unclass(fml)[[2]] + .getsign = function(x){ + c(x[[1]], + unlist(lapply(x[-1], + function(.x) if(is.call(.x)) .getsign(.x)))) + } + + out <- .getsign(fml) + out[length(out):1] +} + # extract information from formula for sstable ---------------------------- sstable.formula <- function(formula) { @@ -74,30 +88,38 @@ sstable.formula <- function(formula) { #' #' @return a string displays formatted summary statistics. #' @export -contSummary <- function(x, statistics = c("med.IQR", "med.90", "med.range", "mean.sd"), digits = 1, n = TRUE){ - if (length(statistics) > 1) statistics <- "med.IQR" - loc <- formatC(ifelse(statistics == "mean.sd", - mean(x, na.rm = TRUE), - median(x, na.rm = TRUE)), digits = digits, format = "f") - dis <- switch(statistics, - mean.sd = formatC(sd(x, na.rm = TRUE), digits = digits, format = "f"), - med.IQR = paste( - formatC(quantile(x, probs = c(0.25, 0.75), na.rm = TRUE), digits = digits, format = "f"), - collapse = ", "), - med.90 = paste( - formatC(quantile(x, probs = c(0.05, 0.95), na.rm = TRUE), digits = digits, format = "f"), - collapse = ", "), - med.range = paste( - formatC(quantile(x, probs = c(0.00, 1.00), na.rm = TRUE), digits = digits, format = "f"), - collapse = ", ")) - if (n == TRUE){ - output <- paste(loc, " (", dis, ") - ", length(na.omit(x)), sep = "") - names(output) <- paste(statistics, "- n") - } else { - output <- paste(loc, " (", dis, ")", sep = "") - names(output) <- statistics + +contSummary <- function(x, statistics = NULL, digits = 1, n = TRUE) { + if (is.null(statistics)) { + stop("Please provide a string for 'statistics'") } - return(output) + + # Convert the 'statistics' string to lowercase + statistics <- tolower(statistics) + + # Define a list of supported statistics and their corresponding functions + stat_list <- list( + mean = function(x) round(mean(x, na.rm = TRUE), digits), + median = function(x) round(median(x, na.rm = TRUE), digits), + sd = function(x) round(sd(x, na.rm = TRUE), digits), + q1 = function(x) round(quantile(x, 0.25, na.rm = TRUE), digits), + q3 = function(x) round(quantile(x, 0.75, na.rm = TRUE), digits), + min = function(x) round(min(x, na.rm = TRUE), digits), + max = function(x) round(max(x, na.rm = TRUE), digits) + ) + + # Replace statistical names with their calculated values + for (stat_name in names(stat_list)) { + stat_value <- stat_list[[stat_name]](x) + statistics <- gsub(stat_name, stat_value, statistics) + } + + # Include the count if requested + if (n) { + statistics <- paste0(statistics) + } + + return(statistics) } # create baseline table --------------------------------------------------- @@ -107,11 +129,17 @@ contSummary <- function(x, statistics = c("med.IQR", "med.90", "med.range", "mea #' @description A function to create a simple summary baseline table. #' #' @param formula a formula specifies variables for rows, variable for column and third-dimension variable. +#' +#' If formula is in the form of x+y ~ a, the function will summary x and y with respects to each value of a +#' +#' If formula is in the form of x+y ~ a|z, the function will summary z with respects to each value of {a,x} and {a, y} #' @param data a data frame to derive baseline table from. #' @param bycol a logical value specifies whether the summary will be by column or by row. #' @param pooledGroup a logical value specifies whether to pool all subgroups of column variable. +#' @param keepEmptyGroup a logical value specifying whether should keep empty groups #' @param statistics a character specifies summary statistics for continuous row variables. -#' @param continuous a logical vector specifies whether each row variables is continuous or categorical. +#' @param cont a vector specifies whether each row variables is continuous. +#' @param cate a vector specifies whether each row variables is categorical. #' @param digits a number specifies number of significant digits for numeric statistics. #' @param test a logical value specifies whether a statistical test will be performed to compare between treatment arms. #' @param pdigits a number specifies number of significant digits for p value. @@ -125,19 +153,22 @@ contSummary <- function(x, statistics = c("med.IQR", "med.90", "med.range", "mea #' @param footer a vector of strings to be used as footnote of table. #' @param flextable a logical value specifies whether output will be a flextable-type table. #' @param bg a character specifies color of the odd rows in the body of flextable-type table. +#' @param df a logical values specifies whether output will be a draw dataframe. #' #' @return a flextable-type table or a list with values/headers/footers #' @export -sstable.baseline <- function(formula, data, bycol = TRUE, pooledGroup = FALSE, - statistics = "med.IQR", continuous = NA, fullfreq = TRUE, digits = 1, - test = FALSE, pdigits = 3, pcutoff = 0.0001, - chisq.test = FALSE, correct = FALSE, simulate.p.value = FALSE, B = 2000, - workspace = 1000000, hybrid = FALSE, - footer = NULL, flextable = FALSE, bg = "#F2EFEE") { - +# function to format data frame to baseline table -hungtt +sstable.baseline.edit <- function(value, formula, data, bycol = TRUE, pooledGroup = FALSE, keepEmptyGroup = FALSE, + statistics = "mean, median (Q1-Q3)", cont = NULL, cate = NULL, fullfreq = TRUE, digits = 1, + test = FALSE, pdigits = 3, pcutoff = 0.0001, + chisq.test = FALSE, correct = FALSE, simulate.p.value = FALSE, B = 2000, + workspace = 1000000, hybrid = FALSE, footer = NULL, flextable = FALSE, bg = "#F2EFEE") { ## get information from formula info <- sstable.formula(formula) + ## strip the tibble class which causes issue - trinhdhk + data <- as.data.frame(data) + ## get data dat <- model.frame(info$formula0, data = data, na.action = NULL) x <- xlabel <- dat[, info$index$x, drop = FALSE] @@ -148,21 +179,32 @@ sstable.baseline <- function(formula, data, bycol = TRUE, pooledGroup = FALSE, if (!is.null(y)) { if (all(!c("character", "factor", "logical") %in% class(y)) | (any(c("numeric", "integer") %in% class(y)) & length(unique(na.omit(y))) > 5)) { - stop("Colum-wise variable must be categorical !!!") + stop("Column-wise variable must be categorical !!!") + } + if (is.factor(y)){ + ### [trinhdhk] 2024-04: reverse level of y for better summary + y <- ._lv_rev_(y) + if (!keepEmptyGroup) y <- droplevels(y) + y <- addNA(y, ifany = TRUE) + } else { + y <- factor(as.character(y), levels = sort(unique(as.character(y), decreasing = TRUE), na.last = TRUE), exclude = NULL) } - y <- factor(as.character(y), levels = sort(unique(as.character(y)), na.last = TRUE), exclude = NULL) } else { y <- factor(rep("Total", nrow(dat))) } #browser() - ## determine type of x (argument: continuous) - if (length(continuous) == 1) { - continuous <- rep(continuous, ncol(x)) - } else { - if (length(continuous) != ncol(x)) stop("continuous argument must have length 1 or similar length as number of row-wise variables !!!") - } + ## determine type of x (argument: cont and cate) + varlist <- getvar(formula) #hungtt + varlist <- varlist[-length(varlist)] #remove the y name + + # Convert varlist, cont, and cate to lowercase for case-insensitive comparison + varlist_lower <- tolower(varlist) + cont_lower <- tolower(cont) + cate_lower <- tolower(cate) + + continuous <- ifelse(varlist_lower %in% cont_lower, TRUE, ifelse(varlist_lower %in% cate_lower, FALSE, NA)) #assign var type continuous <- sapply(1:ncol(x), function(i) { out <- ifelse(is.na(continuous[i]), @@ -186,11 +228,13 @@ sstable.baseline <- function(formula, data, bycol = TRUE, pooledGroup = FALSE, ## determine type of z if (!is.null(z)) { - zcontinuous <- ifelse(any(c("factor", "character", "logical") %in% class(z)) | - (any(c("numeric", "integer") %in% class(z)) & length(unique(na.omit(z))) <= 5), FALSE, TRUE) - if (zcontinuous == FALSE & !is.factor(z)) z <- factor(z, levels = unique(na.omit(z))) + zdiscrete <- any(c("factor", "character", "logical") %in% class(unclass(z))) | + (any(c("numeric", "integer") %in% class(unclass(z))) & length(unique(na.omit(z))) <= 5) + # if (zcontinuous == FALSE & !is.factor(z)) z <- factor(z, levels = unique(na.omit(z))) + if (zdiscrete) z <- factor(z, levels = unique(na.omit(z))) } + # browser() ## digits if (length(digits) == 1) { digits <- rep(digits, ncol(x)) @@ -205,29 +249,32 @@ sstable.baseline <- function(formula, data, bycol = TRUE, pooledGroup = FALSE, y <- factor(c(as.character(y), rep(ypool, nrow(dat))), levels = c(levels(y), ypool), exclude = NULL) z <- if (!is.null(z)) factor(c(z, z), levels = unique(na.omit(z))) else NULL } - + # else{ + # z <- if (!is.null(z)) factor(z, levels = unique(na.omit(z))) else NULL + # } ## get variable name varname <- if (ncol(xlabel) == 1) getlabel(xlabel[, 1]) else getlabel(xlabel) - ## get summary - value <- do.call(rbind, - lapply(1:ncol(x), function(i) { - sstable.baseline.each(varname = varname[i][[1]], - x = x[, i], y = y, z = z, bycol = bycol, - pooledGroup = pooledGroup, statistics = statistics, - continuous = continuous[i], fullfreq = fullfreq, test = test, - digits = digits[i], pdigits = pdigits, pcutoff = pcutoff, - chisq.test = chisq.test, correct = correct, - workspace = workspace, hybrid = hybrid, - simulate.p.value = simulate.p.value, B = B) - })) - ## indication of unestimatable values - value_dim <- dim(value) - value <- apply(value, 2, function(x) ifelse(is.na(x) | x %in% c("NA (NA, NA)", "0/0 (NaN%)"), "-", x)) - dim(value) <- value_dim + # Initialize an empty vector to store labels or variable names + label_list <- character(length(varlist)) + + # Loop through the variables in varlist + for (i in seq_along(varlist)) { + var_name <- varlist[i] + + # Retrieve the variable label if available + var_label <- attr(data[[var_name]], "label") + + # Check if the variable has a label or use the variable name + if (!is.null(var_label) && var_label != "") { + label_list[i] <- var_label + } else { + label_list[i] <- var_name + } + } ## output ### header gr.lev <- levels(y) @@ -240,18 +287,19 @@ sstable.baseline <- function(formula, data, bycol = TRUE, pooledGroup = FALSE, ### footer footer2 <- footer1 <- footer1.after <- footer.con <- footer.cat <- NULL + #### summary statistics if ((is.null(z) & any(continuous)) | (!is.null(z) & !is.factor(z))) { - footer.con <- paste0(switch(statistics, - med.IQR = "median (IQR)", - med.90 = "median (90% range)", - med.range = "median (range)", - mean.sd = "mean (sd)"), - " for continuous variable(s).") + footer.con <- paste0( + paste(statistics, collapse = ", "), + " for continuous variable(s)." + ) } + if ((is.null(z) & any(continuous == FALSE)) | (!is.null(z) & is.factor(z))) { - footer.cat <- paste0("absolute count (%) for categorical variable(s)") + footer.cat <- "absolute count (%) for categorical variable(s)" } + footer1.after <- if (is.null(footer.con)) { paste0(footer.cat, ".") } else { @@ -265,7 +313,10 @@ sstable.baseline <- function(formula, data, bycol = TRUE, pooledGroup = FALSE, #### test if (test) { - footer2.cat <- paste(ifelse(chisq.test == FALSE, "Fisher's exact test", "Chi-squared test"), "for categorical variable(s)") + footer2.cat <- paste( + ifelse(chisq.test == FALSE, "Fisher's exact test", "Chi-squared test"), + "for categorical variable(s)" + ) footer2.con <- "Kruskal-Wallis/Mann-Whitney U-test for continuous variable(s)." footer2.after <- if (is.null(footer.con)) { paste0(footer2.cat, ".") @@ -279,11 +330,13 @@ sstable.baseline <- function(formula, data, bycol = TRUE, pooledGroup = FALSE, footer2 <- paste("p-values were based on", footer2.after) } - footer <- c("N is number of all patients, n is number of patients with non-missing value.", - footer1, - if (any(value == "-")) {"- : value cannot be estimated."} else NULL, - footer2, - footer) + footer <- c( + "N is number of all patients, n is number of patients with non-missing value.", + footer1, + if (any(value == "-")) {"- : value cannot be estimated."} else NULL, + footer2, + footer + ) ### flextable if (flextable) { @@ -326,45 +379,411 @@ sstable.baseline <- function(formula, data, bycol = TRUE, pooledGroup = FALSE, tab <- flextable::bg(tab, i = seq(from = 1, to = nrow(value), by = 2), j = 1:length(header1), bg = bg, part = "body") ### border tabbd <- officer::fp_border(color="black", width = 1.5) - tab <- border_remove(tab) - tab <- hline(tab, border = tabbd, part = "header") - tab <- hline_top(tab, border = tabbd, part = "all") - tab <- hline_bottom(tab, border = tabbd, part = "body") + tab <- flextable::border_remove(tab) + tab <- flextable::hline(tab, border = tabbd, part = "header") + tab <- flextable::hline_top(tab, border = tabbd, part = "all") + tab <- flextable::hline_bottom(tab, border = tabbd, part = "body") } else { tab <- list(table = rbind(header1, header2, value), footer = footer) + class(tab$table) <- c('baseline_tbl', 'ss_tbl', class(tab$table)) } ## output + if (!flextable) class(tab) <- c('ss_baseline','ss_obj') return(tab) } -sstable.baseline.each <- function(varname, x, y, z, bycol = TRUE, pooledGroup = FALSE, - statistics = "med.IQR", continuous = NA, fullfreq = TRUE, test = FALSE, + +# create baseline table --------------------------------------------------- + +#' Create baseline table +#' +#' @description A function to create a simple summary baseline table. +#' +#' @param formula a formula specifies variables for rows, variable for column and third-dimension variable. +#' +#' If formula is in the form of x+y ~ a, the function will summary x and y with respects to each value of a +#' +#' If formula is in the form of x+y ~ a|z, the function will summary z with respects to each value of {a,x} and {a, y} +#' @param data a data frame to derive baseline table from. +#' @param bycol a logical value specifies whether the summary will be by column or by row. +#' @param pooledGroup a logical value specifies whether to pool all subgroups of column variable. +#' @param keepEmptyGroup a logical value specifying whether should keep empty groups +#' @param statistics a character specifies summary statistics for continuous row variables. +#' @param cont a vector specifies whether each row variables is continuous. +#' @param cate a vector specifies whether each row variables is categorical. +#' @param digits a number specifies number of significant digits for numeric statistics. +#' @param test a logical value specifies whether a statistical test will be performed to compare between treatment arms. +#' @param pdigits a number specifies number of significant digits for p value. +#' @param pcutoff a number specifies threshold value of p value to be displayed as "< pcutoff". +#' @param chisq.test a logical value specifies whether Chi-squared test or Fisher's exact test will be used to compare between treatment arms. +#' @param correct a parameter for chisq.test(). +#' @param simulate.p.value a parameter for chisq.test() and fisher.test(). +#' @param B a parameter for chisq.test() and fisher.test(). +#' @param workspace a parameter for fisher.test(). +#' @param hybrid a parameter for fisher.test(). +#' @param footer a vector of strings to be used as footnote of table. +#' @param flextable a logical value specifies whether output will be a flextable-type table. +#' @param bg a character specifies color of the odd rows in the body of flextable-type table. +#' @param df a logical values specifies whether output will be a draw dataframe. +#' +#' @return a flextable-type table or a list with values/headers/footers +#' @export +sstable.baseline <- function(formula, data, bycol = TRUE, pooledGroup = FALSE, keepEmptyGroup = FALSE, + statistics = "mean, median (Q1-Q3)", cont = NULL, cate = NULL, fullfreq = TRUE, digits = 1, + test = FALSE, pdigits = 3, pcutoff = 0.0001, + chisq.test = FALSE, correct = FALSE, simulate.p.value = FALSE, B = 2000, + workspace = 1000000, hybrid = FALSE, + footer = NULL, flextable = FALSE, bg = "#F2EFEE", df = FALSE) { + + ## get information from formula + info <- sstable.formula(formula) + + ## strip the tibble class which causes issue - trinhdhk + data <- as.data.frame(data) + + ## get data + dat <- model.frame(info$formula0, data = data, na.action = NULL) + x <- xlabel <- dat[, info$index$x, drop = FALSE] + y <- if (info$index$y > 0) dat[, info$index$y] else NULL + z <- if (info$index$z > 0) dat[, info$index$z] else NULL + + ## y must be categorical variable + if (!is.null(y)) { + if (all(!c("character", "factor", "logical") %in% class(y)) | + (any(c("numeric", "integer") %in% class(y)) & length(unique(na.omit(y))) > 5)) { + stop("Column-wise variable must be categorical !!!") + } + if (is.factor(y)){ + ### [trinhdhk] 2024-04: reverse level of y for better summary + y <- ._lv_rev_(y) + if (!keepEmptyGroup) y <- droplevels(y) + y <- addNA(y, ifany = TRUE) + } else { + y <- factor(as.character(y), levels = sort(unique(as.character(y), decreasing = TRUE), na.last = TRUE), exclude = NULL) + } + } else { + y <- factor(rep("Total", nrow(dat))) + } + + #browser() + + ## determine type of x (argument: cont and cate) + varlist <- getvar(formula) #hungtt + varlist <- varlist[-length(varlist)] #remove the y name + + # Convert varlist, cont, and cate to lowercase for case-insensitive comparison + varlist_lower <- tolower(varlist) + cont_lower <- tolower(cont) + cate_lower <- tolower(cate) + + continuous <- ifelse(varlist_lower %in% cont_lower, TRUE, ifelse(varlist_lower %in% cate_lower, FALSE, NA)) #assign var type + + continuous <- sapply(1:ncol(x), function(i) { + out <- ifelse(is.na(continuous[i]), + ifelse(any(c("factor", "character", "logical") %in% class(x[, i])) | + (any(c("numeric", "integer") %in% class(x[, i])) & length(unique(na.omit(x[, i]))) <= 5), FALSE, TRUE), + continuous[i]) + return(out) + }) + + + for (i in (1:ncol(x))) { + if (continuous[i] == FALSE & !is.factor(x[, i])) x[, i] <- factor(x[, i], levels = sort(unique(na.omit(x[, i])))) + } + + ## if z exists, x must be categorical + if (!is.null(z) & any(continuous == TRUE)) stop("Row-wise variable must be categorical when third dimension variable exists !!!") + + ## if use by-row layout, x must be categorical + #browser() + if (bycol == FALSE & any(sapply(1:ncol(x), function(i) is.factor(x[,i])) == FALSE)) stop("Row-wise variable must be categorical in by-row layout !!!") + + ## determine type of z + if (!is.null(z)) { + zdiscrete <- any(c("factor", "character", "logical") %in% class(unclass(z))) | + (any(c("numeric", "integer") %in% class(unclass(z))) & length(unique(na.omit(z))) <= 5) + # if (zcontinuous == FALSE & !is.factor(z)) z <- factor(z, levels = unique(na.omit(z))) + if (zdiscrete) z <- factor(z, levels = unique(na.omit(z))) + } + + # browser() + ## digits + if (length(digits) == 1) { + digits <- rep(digits, ncol(x)) + } else { + if (length(digits) != ncol(x)) stop("digits argument must have length 1 or similar length as number of row-wise variables !!!") + } + + ## if pooledGroup + if (pooledGroup) { + x <- rbind(x, x) + ypool <- ifelse("total" %in% tolower(levels(y)), "pooledGroup", "Total") + y <- factor(c(as.character(y), rep(ypool, nrow(dat))), levels = c(levels(y), ypool), exclude = NULL) + z <- if (!is.null(z)) factor(c(z, z), levels = unique(na.omit(z))) else NULL + } + # else{ + # z <- if (!is.null(z)) factor(z, levels = unique(na.omit(z))) else NULL + # } + + ## get variable name + varname <- if (ncol(xlabel) == 1) getlabel(xlabel[, 1]) else getlabel(xlabel) + + + # Initialize an empty vector to store labels or variable names + label_list <- character(length(varlist)) + + # Loop through the variables in varlist + for (i in seq_along(varlist)) { + var_name <- varlist[i] + + # Retrieve the variable label if available + var_label <- attr(data[[var_name]], "label") + + # Check if the variable has a label or use the variable name + + if (!is.null(var_label) && var_label != "") { + label_list[i] <- var_label + } else { + label_list[i] <- var_name + } + } + + ## get summary + value <- do.call(rbind, + lapply(1:ncol(x), function(i) { + sstable.baseline.each(varname = varname[i][[1]], label_list = label_list[i][[1]], + x = x[, i], y = y, z = z, bycol = bycol, + pooledGroup = pooledGroup, statistics = statistics, + continuous = continuous[i], fullfreq = fullfreq, test = test, + digits = digits[i], pdigits = pdigits, pcutoff = pcutoff, + chisq.test = chisq.test, correct = correct, + workspace = workspace, hybrid = hybrid, + simulate.p.value = simulate.p.value, B = B) + })) + + ## indication of unestimatable values + value_dim <- dim(value) + value <- apply(value, 2, function(x) ifelse(is.na(x) | x %in% c("NA (NA, NA)", "0/0 (NaN%)"), "-", x)) + dim(value) <- value_dim + value <- as.data.frame(value) + # ## output - old code, if want to reverse to old code, uncomment this code, remove df argument in main function + #and delete the corresponding code below + # ### header + # + # gr.lev <- levels(y) + # header1 <- c("", c(rbind(rep("", length(gr.lev)), paste(gr.lev, " (N=", table(y), ")", sep = "")))) + # header2 <- c("Characteristic", rep(c("n", "Summary statistic"), length(gr.lev))) + # if (test) { + # header1 <- c(header1, "p value") + # header2 <- c(header2, "") + # } + # + # ### footer + # footer2 <- footer1 <- footer1.after <- footer.con <- footer.cat <- NULL + # + # #### summary statistics + # if ((is.null(z) & any(continuous)) | (!is.null(z) & !is.factor(z))) { + # footer.con <- paste0( + # paste(statistics, collapse = ", "), + # " for continuous variable(s)." + # ) + # } + # + # if ((is.null(z) & any(continuous == FALSE)) | (!is.null(z) & is.factor(z))) { + # footer.cat <- "absolute count (%) for categorical variable(s)" + # } + # + # footer1.after <- if (is.null(footer.con)) { + # paste0(footer.cat, ".") + # } else { + # if (is.null(footer.cat)) { + # footer.con + # } else { + # paste0(footer.cat, " and ", footer.con) + # } + # } + # footer1 <- paste("Summary statistic is", footer1.after) + # + # #### test + # if (test) { + # footer2.cat <- paste( + # ifelse(chisq.test == FALSE, "Fisher's exact test", "Chi-squared test"), + # "for categorical variable(s)" + # ) + # footer2.con <- "Kruskal-Wallis/Mann-Whitney U-test for continuous variable(s)." + # footer2.after <- if (is.null(footer.con)) { + # paste0(footer2.cat, ".") + # } else { + # if (is.null(footer.cat)) { + # footer2.con + # } else { + # paste0(footer2.cat, " and ", footer2.con) + # } + # } + # footer2 <- paste("p-values were based on", footer2.after) + # } + # + # footer <- c( + # "N is number of all patients, n is number of patients with non-missing value.", + # footer1, + # if (any(value == "-")) {"- : value cannot be estimated."} else NULL, + # footer2, + # footer + # ) + # + # + # ### flextable + # if (flextable) { + # requireNamespace("flextable") + # requireNamespace("officer") + # + # ## main table + # tab <- flextable::flextable(as.data.frame(value)) + # + # ## header + # header1[1] <- header2[1] + # header1[seq(from = 2, to = 2 * length(gr.lev), by = 2)] <- header1[seq(from = 2, to = 2 * length(gr.lev), by = 2) + 1] + # if (test) header2[length(header1)] <- header1[length(header1)] + # assign("tab", + # eval(parse(text = paste0("flextable::set_header_labels(tab,", + # paste(paste0("V", 1:length(header1)), paste0("'", header1, "'"), sep = "=", collapse = ","), + # ")")))) + # assign("tab", + # eval(parse(text = paste0("flextable::add_header(tab,", + # paste(paste0("V", 1:length(header1)), paste0("'", header2, "'"), sep = "=", collapse = ","), + # ", top = FALSE)")))) + # + # tab <- flextable::merge_h(tab, part = "header") + # tab <- flextable::merge_v(tab, part = "header") + # + # ## footer + # for (k in (1:length(footer))) { + # tab <- flextable::add_footer(tab, V1 = footer[k], top = FALSE) + # tab <- flextable::merge_at(tab, i = k, j = 1:length(header1), part = "footer") + # } + # + # ## format + # ### width + # tab <- flextable::autofit(tab) + # ### alignment + # tab <- flextable::align(tab, j = 1, align = "left", part = "all") + # ### faces of header + # tab <- flextable::bold(tab, part = "header") + # ### background + # tab <- flextable::bg(tab, i = seq(from = 1, to = nrow(value), by = 2), j = 1:length(header1), bg = bg, part = "body") + # ### border + # tabbd <- officer::fp_border(color="black", width = 1.5) + # tab <- flextable::border_remove(tab) + # tab <- flextable::hline(tab, border = tabbd, part = "header") + # tab <- flextable::hline_top(tab, border = tabbd, part = "all") + # tab <- flextable::hline_bottom(tab, border = tabbd, part = "body") + # + # } else { + # tab <- list(table = rbind(header1, header2, value), + # footer = footer) + # class(tab$table) <- c('baseline_tbl', 'ss_tbl', class(tab$table)) + # } + # ## output + # if (!flextable) class(tab) <- c('ss_baseline','ss_obj') + + + # add option to call dataframe before adding header, footer -hungtt +if (df) { tab <- value} +else { tab <- sstable.baseline.edit(value = value, formula = formula, data =data, bycol = bycol, pooledGroup = pooledGroup , keepEmptyGroup = keepEmptyGroup, + statistics = statistics, cont = cont, cate = cate, fullfreq = fullfreq, digits = digits, + test = test, pdigits = pdigits, pcutoff = pcutoff, + chisq.test = chisq.test, correct = correct, simulate.p.value = simulate.p.value, B = B, + workspace = workspace, hybrid = hybrid, footer = footer, flextable = flextable, bg = bg) +} + +return (tab) +} + + +sstable.baseline.each <- function(varname, label_list, x, y, z, bycol = TRUE, pooledGroup = FALSE, + statistics = "mean, median (Q1-Q3)", continuous = NA, fullfreq = TRUE, test = FALSE, digits = 1, pdigits = pdigits, pcutoff = 0.0001, chisq.test = FALSE, correct = FALSE, workspace = 1000000, hybrid = FALSE, simulate.p.value = FALSE, B = 2000) { - ## functions + # ## functions to make the summary value of different statistics in different rows -hungtt + # mycont.summary <- function(x, y, z) { + # ngroup <- length(levels(y)) + # + # if (is.null(z)) { + # summarystat.nice <- by(unclass(x), y, contSummary, statistics = statistics, digits = digits, n = FALSE) + # n <- table(y[!is.na(x)]) + # + # # Determine the number of values in each element of summarystat.nice + # n_values <- length(summarystat.nice[[1]]) + # + # # Create result matrix with appropriate dimensions + # result <- matrix("", nrow = n_values, ncol = 1 + 2 * ngroup) + # + # + # # Fill in the n values and summarystat.nice values + # for (i in 1:ngroup) { + # result[, 2 * i] <- n[i] + # for (j in 1:n_values) { + # result[j, 2 * i + 1] <- summarystat.nice[[i]][j] + # } + # } + # + # } else { + # summarystat.nice <- by(unclass(z), list(x, y), contSummary, statistics = statistics, digits = digits, n = FALSE) + # n <- table(x, y) + # + # # Determine the number of values in each element of summarystat.nice + # n_values <- length(summarystat.nice[[1]]) + # + # # Create result matrix with appropriate dimensions + # result <- matrix("", nrow = n_values, ncol = 1 + 2 * ngroup) + # + # # Fill in the first column with labels + # result[, 1] <- paste0("- ", levels(x)) + # + # # Fill in the n values and summarystat.nice values + # for (i in 1:ngroup) { + # result[, 2 * i] <- apply(n, 1, sum)[i] + # for (j in 1:n_values) { + # result[j, 2 * i + 1] <- summarystat.nice[[i]][j] + # } + # } + # } + mycont.summary <- function(x, y, z) { ngroup <- length(levels(y)) if (is.null(z)) { summarystat.nice <- by(unclass(x), y, contSummary, statistics = statistics, digits = digits, n = FALSE) - #n <- c(by(x, y, function(x) length(na.omit(x)))) n <- table(y[!is.na(x)]) result <- matrix("", ncol = ngroup * 2 + 1, nrow = 1) result[1, seq(2, ncol(result), by = 2)] <- n - result[1, seq(3, ncol(result), by = 2)] <- unlist(summarystat.nice) + + # Check if summarystat.nice has more than one value per row and flatten it if necessary + if (length(summarystat.nice) > 1) { + result[1, seq(3, ncol(result), by = 2)] <- unlist(lapply(summarystat.nice, function(x) paste(x, collapse = ", "))) + } else { + result[1, seq(3, ncol(result), by = 2)] <- unlist(summarystat.nice) + } } else { summarystat.nice <- by(unclass(z), list(x, y), contSummary, statistics = statistics, digits = digits, n = FALSE) n <- table(x, y) + result <- matrix("", ncol = ngroup * 2 + 1, nrow = length(levels(x)) + 1) result[1, seq(2, ncol(result), by = 2)] <- apply(n, 2, sum) result[2:nrow(result), seq(2, ncol(result), by = 2)] <- n result[2:nrow(result), 1] <- paste0("- ", levels(x), " (n = ", apply(n, 1, sum), ")") - result[2:nrow(result), seq(3, ncol(result), by = 2)] <- unlist(summarystat.nice) + + # Check if summarystat.nice has more than one value per row and flatten it if necessary + if (length(summarystat.nice) > 1) { + result[2:nrow(result), seq(3, ncol(result), by = 2)] <- unlist(lapply(summarystat.nice, function(x) paste(x, collapse = ", "))) + } else { + result[2:nrow(result), seq(3, ncol(result), by = 2)] <- unlist(summarystat.nice) + } } if (test == TRUE & ngroup > 1) { @@ -392,6 +811,33 @@ sstable.baseline.each <- function(varname, x, y, z, bycol = TRUE, pooledGroup = } } + + + # if (test == TRUE & ngroup > 1) { + # # overall Kruskal-Wallis test for group differences + # if (is.null(z)) { + # m <- 1:(length(x) * (1 - 0.5 * as.numeric(pooledGroup))) + # pval <- tryCatch(format.pval(kruskal.test(x = x[m], g = y[m])$p.value, + # eps = pcutoff, digits = pdigits, scientific = FALSE), + # error = function(c) NA) + # result <- cbind(result, pval) + # } else { + # pval <- sapply(1:length(levels(x)), function(i) { + # q <- which(x == levels(x)[i]) + # if (length(q) == 0) { + # out <- NA + # } else { + # m <- q[q %in% 1:(length(z) * (1 - 0.5 * as.numeric(pooledGroup)))] + # out <- tryCatch(format.pval(kruskal.test(x = z[m], g = y[m])$p.value, + # eps = pcutoff, digits = pdigits, scientific = FALSE), + # error = function(c) NA) + # } + # return(out) + # }) + # result <- cbind(result, c("", pval)) + # } + # + # } return(result) } @@ -509,7 +955,9 @@ sstable.baseline.each <- function(varname, x, y, z, bycol = TRUE, pooledGroup = } } - out[1, 1] <- varname + + + out[1, 1] <- label_list return(out) } @@ -521,15 +969,25 @@ sstable.baseline.each <- function(varname, x, y, z, bycol = TRUE, pooledGroup = #' #' @param ae_data a data frame contains adverse event data. #' @param fullid_data a data frame contains treatment arm data of all participants (not just those had adverse event). +#' @param group_data a reference data frame contains the group name of each ae. #' @param id.var a character specifies name of study id variable (exists in both adverse event data and treatment arm data). #' @param aetype.var a character specifies name of adverse event type variable (exists in adverse event data). -#' @param grade.var a character specifies name of adverse event grade variable (exists in adverse event data). +#' @param grade.var NULL or character specifies name of adverse event grade variable (exists in adverse event data). +#' @param group.var a character specifies group (exists in adverse event data if group_data = NULL or group_data otherwise). #' @param arm.var a character specifies name of treatment arm variable (exists in treatment arm data). +#' @param sort.by +#' An unquoted formula of sorting options. +#' +#' Available options are `ep`, `pt`, `p`, or a combination of them (eg ep+pt-p); +#' A minus sign indicates a descending order. #' @param digits a number specifies number of significant digits for numeric statistics. #' @param test a logical value specifies whether a statistical test will be performed to compare between treatment arms. #' @param pdigits a number specifies number of significant digits for p value. #' @param pcutoff a number specifies threshold value of p value to be displayed as "< pcutoff". -#' @param chisq.test a logical value specifies whether Chi-squared test or Fisher's exact test will be used to compare between treatment arms. +#' @param chisq.test +#' a logical value specifies whether Chi-squared test or Fisher's exact test will be used to compare between treatment arms. +#' +#' Be aware that even when chisq.test==TRUE, if expected values are < 1, the later test will take over. #' @param correct a parameter for chisq.test(). #' @param simulate.p.value a parameter for chisq.test() and fisher.test(). #' @param B a parameter for chisq.test() and fisher.test(). @@ -538,39 +996,166 @@ sstable.baseline.each <- function(varname, x, y, z, bycol = TRUE, pooledGroup = #' @param footer a vector of strings to be used as footnote of table. #' @param flextable a logical value specifies whether output will be a flextable-type table. #' @param bg a character specifies color of the odd rows in the body of flextable-type table. +#' @param group.var.priority a vector that specifies which groups will be appear first in the table. +#' @param print.aetype.header a logical value, whether to print the label of aetype.header. +#' @param na.text [`(Missing)`] in-placed text for missing AE #' #' @return a flextable-type table or a list with values/headers/footers #' @import dplyr #' @import tidyr #' @export -sstable.ae <- function(ae_data, fullid_data, id.var, aetype.var, grade.var = NULL, arm.var, digits = 0, +sstable.ae <- function(ae_data, fullid_data, group_data = NULL, id.var, + aetype.var, grade.var = NULL, + group.var = NULL, group.var.priority = NULL, arm.var, sort.by, digits = 0, test = TRUE, pdigits = 3, pcutoff = 0.001, chisq.test = FALSE, correct = FALSE, simulate.p.value = FALSE, B = 2000, workspace = 1000000, hybrid = FALSE, + print.aetype.header = + length(aetype.var) > 1 | any(length(names(aetype.var)) > 0) | any(isTRUE(nchar(names(aetype.var)) > 0)), + na.text = '(Missing)', footer = NULL, flextable = TRUE, bg = "#F2EFEE"){ requireNamespace("dplyr") requireNamespace("tidyr") - ## check variable's name tmp <- match.call() - if (!id.var %in% names(ae_data)){stop(paste(tmp[[4]], "does not exist in", deparse(tmp[[2]]), "!!!"))} - if (!id.var %in% names(fullid_data)){stop(paste(tmp[[4]], "does not exist in", deparse(tmp[[3]]), "!!!"))} - if (!aetype.var %in% names(ae_data)){stop(paste(tmp[[5]], "does not exist in", deparse(tmp[[2]]), "!!!"))} + print.aetype.header <- force(print.aetype.header) + + # if more than one aetype.var + # perform sstable.ae for each for aetype.var + # then do rbind + if (length(aetype.var) > 1){ + + # function to prepare + make_tblcall <- function(orig_call, .aetype_var) { + new_call <- orig_call + new_call$aetype.var <- .aetype_var + new_call$flextable <- FALSE + new_call$print.aetype.header <- print.aetype.header + new_call + } + env <- rlang::caller_env() + n.grade <- if (length(grade.var)) length(unique(ae_data[[grade.var]])) else 0 + tbl1_call <- make_tblcall(tmp, aetype.var[1]) + tbl1 <- eval(tbl1_call, envir = env) + tbl2p <- + lapply(seq_along(aetype.var[-1]), + function(i){ + .aetype.var <- aetype.var[i+1] + tbl_call <- make_tblcall(tmp, .aetype.var) + sstbl = eval(tbl_call, envir=env) + sstbl + }) + tbl2 <- tbl2p[[1]] + + # tbl2$table <- tbl2$table[-c(1:(3+n.grade)),] + for (tbl3 in tbl2p[-1]) tbl2 <- ._do_rbind(tbl2, tbl3, header=c(1:(3+n.grade))) + # browser() + out <- ._do_rbind(tbl1, tbl2, header=c(1:(3+n.grade))) + # rownames(out)[c(3,4,5,8)] <- 'section' + if (flextable) return(ss_flextable(out)) + return(out) + } + + ## check variable's name + + if (!id.var %in% names(ae_data)){stop(paste(tmp$id.var, "does not exist in", deparse(tmp$ae_data), "!!!"))} + if (!id.var %in% names(fullid_data)){stop(paste(tmp$id.var, "does not exist in", deparse(tmp$fullid_data), "!!!"))} + if (!aetype.var %in% names(ae_data)){stop(paste(tmp$aetype.var, "does not exist in", deparse(tmp$ae_data), "!!!"))} if (!is.null(grade.var)) { - if (!grade.var %in% names(ae_data)){stop(paste(tmp[[6]], "does not exist in", deparse(tmp[[2]]), "!!!"))} + if (!grade.var %in% names(ae_data)){stop(paste(tmp$grade.var, "does not exist in", deparse(tmp$ae_data), "!!!"))} + } + if (!is.null(group.var)){ + if (!is.null(group_data)){ + if (!group.var %in% names(group_data)) stop(paste(tmp$group.var, 'does not exist in', deparse(tmp$group_data), '!!!')) + if (!aetype.var %in% names(group_data)){stop(paste(tmp$aetype.var, "does not exist in", deparse(tmp$group_data), "!!!"))} + } else + if (!group.var %in% names(ae_data)) stop(paste(tmp$group.var, 'does not exist in', deparse(tmp$ae_data), '!!!')) + } + if (!arm.var %in% names(fullid_data)){stop(paste(tmp$arm.var, "does not exist in", deparse(tmp$fullid_data), "!!!"))} + if (!missing(sort.by)){ + sort.by <- rlang::enquo(sort.by) + sort.vars <- all.vars(sort.by) + sort.signs <- getsign(sort.by) + if (length(sort.signs) < length(sort.vars)) sort.signs <- purrr::prepend(sort.signs, quote(`+`)) + if (length(setdiff(sort.vars, c('pt','ep','p')))) + stop('Sorting can only apply to `pt`, `ep`, and `p`') + } + + #strip tibble class as it might cause problem + ae_data <- as.data.frame(ae_data) + fullid_data <- as.data.frame(fullid_data) + group_data <- as.data.frame(group_data) + is.grouped <- !missing(group.var) + + # Check if grade.var is not NULL and has any NA values - hungtt + if (!is.null(grade.var) && any(is.na(ae_data[[grade.var]]))) { + # Replace NA values with "Grade NA" + ae_data[[grade.var]][is.na(ae_data[[grade.var]])] <- "Grade N/A" + } + + # If there is a designated name to aetype.var, populate that into the data + if (!is.null(names(aetype.var)) & isTRUE(nchar(names(aetype.var))>0)){ + attr(ae_data[, aetype.var[[1]]], 'label') <- names(aetype.var)[[1]] + } + aetype.var <- aetype.var[[1]] + + # Check if any aetype.var is NA and replace with "NA" + lbl = attr(ae_data[[aetype.var]], 'label') + ae_data[[aetype.var]] = as.character(ae_data[[aetype.var]]) + ae_data[[aetype.var]] = structure(ae_data[[aetype.var]], label=lbl) + if (any(is.na(ae_data[[aetype.var]]))) { + #if (is.factor(ae_data[[var]])) + #levels(ae_data[[var]]) <- c(levels(ae_data[[var]]), na.text ) + + ae_data[[aetype.var]][is.na(ae_data[[aetype.var]])] <- na.text } - if (!arm.var %in% names(fullid_data)){stop(paste(tmp[[7]], "does not exist in", deparse(tmp[[3]]), "!!!"))} ## format study arms idarm <- fullid_data[, c(id.var, arm.var)]; colnames(idarm) <- c("id", "arm") - arm_lev <- sort(unique(as.character(idarm$arm)), na.last = TRUE) - idarm$arm <- with(idarm, factor(as.character(arm), levels = arm_lev, exclude = NULL)) + if (is.factor(idarm$arm)){ + ### [trinhdhk] 2024-04: reverse level of y for better summary + idarm$arm <- addNA(idarm$arm, ifany = TRUE) + idarm$arm <- ._lv_rev_(idarm$arm) + arm_lev <- levels(idarm$arm) + } else { + ### [trinhdhk] 2024-04: reverse level of y for better summary + arm_lev <- sort(unique(as.character(idarm$arm)), decreasing = TRUE, na.last = TRUE) + idarm$arm <- with(idarm, factor(as.character(arm), levels = arm_lev, exclude = NULL)) + } - ## add aetype of "Any selected AE" & format aetype - ae_any <- ae_data; ae_any[, aetype.var] <- "Any selected adverse event" - ae <- rbind(ae_data, ae_any) - aetype_lev <- c("Any selected adverse event", unique(as.character(ae_data[, aetype.var]))) - #browser() + # Original data frame ae_data assumed to exist + # Ensure ae_data, ae_any, ae_grade, etc., are defined appropriately in your script + + replace_with_var_names <- function(df, var, aetype_var) { + # Identify rows where aetype_var is not "NA" + not_na_rows <- df[[aetype_var]] != na.text + + # Replace values with variable names or labels only where not "NA" + if (!is.null(attr(df[[var]], "label"))) { + df[[aetype_var]][not_na_rows] <- attr(df[[var]], "label") # Use label if available + } else { + df[[aetype_var]][not_na_rows] <- var # Fallback to default label + } + + # Delete rows where aetype_var is "NA" + df <- df[not_na_rows, , drop = FALSE] + + return(df) + } + + # browser() + + # Example usage with ae_any data frame mutation + ae_any <- ae_data # Assuming ae_data is your original data frame + + mutated_data <- if(print.aetype.header) + replace_with_var_names(ae_any, aetype.var, aetype.var) else NULL + ae_any[, aetype.var] <- "Any selected adverse event" + # Combine original and mutated data (assuming ae_data and ae_any exist) + ae <- if(print.aetype.header) + rbind(ae_data, ae_any, mutated_data) else + rbind(ae_data, ae_any) + # Extract grades of ae (assuming grade.var exists) if (!is.null(grade.var)) { grade <- sort(unique(na.omit(ae_data[, grade.var]))) grade2 <- ifelse(grepl(pattern = "grade", ignore.case = TRUE, x = grade), grade, paste("Grade", grade)) @@ -581,15 +1166,35 @@ sstable.ae <- function(ae_data, fullid_data, id.var, aetype.var, grade.var = NUL return(tmpdat) })) ae <- rbind(ae, ae_grade) - aetype_lev <- c("Any selected adverse event", paste("-", grade2), unique(as.character(ae_data[, aetype.var]))) } - ae <- ae[, c(id.var, aetype.var)]; colnames(ae) <- c("id", "aetype") - #browser() + + # Select necessary columns and rename them + ae <- ae[, c(id.var, aetype.var)] + colnames(ae) <- c("id", "aetype") + + + # Get unique levels of aetype + aetype_lev.raw <- unique(as.character(ae_data[[aetype.var]])) + + # Check if aetype.var has a label attribute + if (!is.null(attr(ae_data[[aetype.var]], "label"))) { + aetype.var.label <- attr(ae_data[[aetype.var]], "label") + } else { + aetype.var.label <- aetype.var + # Use default label + } + + # Construct aetype_lev with labels where available + aetype_lev <- c("Any selected adverse event", + if (!is.null(grade.var)) paste("-", grade2), + if (print.aetype.header) aetype.var.label, + aetype_lev.raw) ## add randomized arm to AE ae_arm <- merge(idarm, ae, by = "id", all.y = TRUE) %>% mutate(arm = addNA(factor(as.character(arm), levels = arm_lev, exclude = NULL), ifany = TRUE), aetype = addNA(factor(as.character(aetype), levels = aetype_lev, exclude = NULL), ifany = TRUE)) + idarm2 <- ae_arm |> select(id, arm) ## calculate episodes and patients ae_count <- ae_arm %>% @@ -606,38 +1211,214 @@ sstable.ae <- function(ae_data, fullid_data, id.var, aetype.var, grade.var = NUL patient_n <- unlist(spread(select(ae_count, -n_episode), key = arm, value = n_patient)[, -1]) patient_n[is.na(patient_n)] <- 0 patient_N <- rep(table(idarm$arm), each = nlevels(ae_arm$aetype)) + # tryCatch(patient_n/patient_N, warning=function(w) browser()) patient_p <- patient_n/patient_N ## table #browser() - value <- matrix(ncol = nlevels(ae_arm$arm) * 2, nrow = nlevels(ae_arm$aetype)) - value[, seq(from = 1, to = ncol(value), by = 2)] <- episode_n - value[, seq(from = 2, to = ncol(value), by = 2)] <- paste0(patient_n, "/", patient_N, - " (", formatC(100 * patient_p, digits, format = "f"), "%)") - ae_value <- cbind(levels(ae_arm$aetype), value) + value <- matrix(ncol = nlevels(ae_arm$arm)*3, nrow = nlevels(ae_arm$aetype)) + value[, seq(from = 1, to = nlevels(ae_arm$arm)*2, by = 2)] <- episode_n + value[, seq(from = 2, to = nlevels(ae_arm$arm)*2, by = 2)] <- paste0(patient_n, "/", patient_N, + " (", formatC(100 * patient_p, digits, format = "f"), "%)") + ## add raw values to 2 dummy columns for sorting purpose + value[, (nlevels(ae_arm$arm)*2 + 1):(nlevels(ae_arm$arm)*3)] <- patient_n + ae_value <- cbind(aename = levels(ae_arm$aetype), value) + + ## get the aehead -trinhdhk + ae_value.head <- as.data.frame(ae_value, stringsAsFactors = FALSE) %>% filter(!aename %in% aetype_lev.raw) + + ## categorizing ae into groups + ## author: trinhdhk + if (!is.null(group.var)) { + if (is.null(group_data)) { + group_data <- unique(ae_data[,c(aetype.var, group.var)]) + } + group_data[[group.var]] <- replace_na(as.character(group_data[[group.var]]), 'Uncategorised') + if (!is.factor(group_data[, group.var])) group_data[, group.var] <- as.factor(group_data[, group.var]) + group_data <- group_data[, c(aetype.var, group.var)] + group_data[,aetype.var] <- as.character(group_data[,aetype.var]) + names(group_data) <- c(aetype.var, '.tmp.group') + + if (!is.null(group.var.priority)) { + # Reorder group.var based on group.var.priority + group_data <- group_data %>% + mutate(.tmp.group = factor(.tmp.group, levels = c(group.var.priority, setdiff(unique(.tmp.group), group.var.priority)), ordered = TRUE)) + } + # } else { + # ## - create a fake grouping + # group_data <- data.frame(ae = aetype_lev.raw, group=1, stringsAsFactors = FALSE) + # names(group_data) <- c(aetype.var, '.tmp.group') + # } + + # browser() + + ### bind group back to summary table -trinhdhk + ae_value.headless <- + as.data.frame(ae_value, stringsAsFactors = FALSE) %>% + filter(aename %in% aetype_lev.raw) %>% + rename({{aetype.var}} := aename) %>% + right_join(group_data, by = aetype.var) %>% + group_by(.tmp.group) %>% + group_modify(~ rbind(c(as.character(.y$.tmp.group), + unlist(lapply(seq_along(arm_lev), + function(i){ + return(c( + sum(as.numeric(unlist(.x[, 2*i]))), + '')) + # paste(sum(as.numeric(unlist(.x[, length(arm_lev)*2+i+1]))))) + })), + rep('',ncol(ae_value)-1-2*length(arm_lev)) + ),.x)) + # browser() + + grouptitle_index <- ae_value.headless %>% group_rows() %>% sapply(., function(x) head(x, 1)) + + ae_value.headless <- + ae_value.headless %>% + ungroup %>% + select(-.tmp.group) + + #adjust the row number of group title by combining with the head + grouptitle_index <- grouptitle_index + nrow(ae_value.head) + ae_value <- + ae_value.head %>% + `names<-`(names(ae_value.headless)) %>% + rbind(ae_value.headless) + } else ae_value <- as.data.frame(ae_value, stringsAsFactors = FALSE) %>% rename({{aetype.var}} := aename) + # browser() ## test if (test) { + ## + + do_fisher <- function(mat, workspace = workspace, hybrid = hybrid, + simulate.p.value = simulate.p.value, B = B){ + tryCatch(format.pval(fisher.test(x = mat, workspace = workspace, hybrid = hybrid, + simulate.p.value = simulate.p.value, B = B)$p.value, + eps = pcutoff, digits = pdigits, scientific = FALSE), + error = function(e) NA) + } + + do_chisq <- function(mat, correct = correct, + simulate.p.value = simulate.p.value, B = B, + workspace = workspace, hybrid = hybrid){ + chi.out <- tryCatch(suppressWarnings(chisq.test(x = mat, correct = correct, + simulate.p.value = simulate.p.value, B = B)), + error = function(e) NA) + if (length(chi.out) == 1) # that implicits the NA value, so no more NA check here + return(chi.out) + + if (any(chi.out$expected<1)) + return(do_fisher(mat=mat, workspace = workspace, hybrid = hybrid, + simulate.p.value = simulate.p.value, B = B)) + #else + return(format.pval(chi.out$p.value,eps = pcutoff, digits = pdigits, scientific = FALSE)) + } + pval <- sapply(1:nrow(value), function(i) { idx <- seq(from = i, to = length(patient_n), by = nrow(value)) mat <- matrix(c(patient_n[idx], patient_N[idx] - patient_n[idx]), nrow = 2, byrow = TRUE) out <- if (chisq.test) { - tryCatch(format.pval(chisq.test(x = mat, correct = correct, - simulate.p.value = simulate.p.value, B = B)$p.value, - eps = pcutoff, digits = pdigits, scientific = FALSE), - error = function(c) NA) + # tryCatch(format.pval(chisq.test(x = mat, correct = correct, + # simulate.p.value = simulate.p.value, B = B)$p.value, + # eps = pcutoff, digits = pdigits, scientific = FALSE), + # error = function(c) NA) + do_chisq(mat, correct = correct, + simulate.p.value = simulate.p.value, B = B, + workspace = workspace, hybrid = hybrid) } else { - tryCatch(format.pval(fisher.test(x = mat, workspace = workspace, hybrid = hybrid, - simulate.p.value = simulate.p.value, B = B)$p.value, - eps = pcutoff, digits = pdigits, scientific = FALSE), - error = function(c) NA) + # tryCatch(format.pval(fisher.test(x = mat, workspace = workspace, hybrid = hybrid, + # simulate.p.value = simulate.p.value, B = B)$p.value, + # eps = pcutoff, digits = pdigits, scientific = FALSE), + # error = function(c) NA) + do_fisher(mat, workspace = workspace, hybrid = hybrid, + simulate.p.value = simulate.p.value, B = B) } return(out) }) pval[is.na(pval)] <- "-" - ae_value <- cbind(ae_value, pval) + + ## add grouping row - trinhdhk + # browser() + ae_value <- + left_join( + ae_value, + cbind(aetype=aetype_lev, pval) %>% + as.data.frame(stringsAsFactors = FALSE) %>% + rename({{aetype.var}} := aetype), + by = aetype.var + ) %>% + mutate(pval = replace_na(as.character(pval), '')) } + # browser() + ## sorting - trinhdhk + if (!missing(sort.by)){ + ## - the head will not be sorted. + split.parts <- c(1, if(is.null(group.var)) (nrow(ae_value.head)+1) else grouptitle_index) + col.name <- arrange(mutate(expand.grid(c('ep', 'n.pt'), 1:nlevels(ae_arm$arm)), out = paste(Var1, Var2, sep='.')), Var2)$out + dummy.col.name <- paste('pt', 1:nlevels(ae_arm$arm), sep='.') + colnames(ae_value) <- c('aetype', col.name, dummy.col.name, if (test) 'p') + ae_value <- + mutate_at(as.data.frame(ae_value, stringsAsFactors = FALSE), + vars(matches('(^pt.\\d)|(^ep.\\d)'), dummy.col.name), as.numeric) %>% + mutate( + pt.all = by(select(., starts_with('pt.')), 1:nrow(.), sum), + ep.all = by(select(., starts_with('ep.')), 1:nrow(.), sum) + ) + + ae_value.group <- lapply(seq_along(split.parts), + function(i){ + return(ae_value[split.parts[i]:(c(split.parts, nrow(ae_value) + 1)[i+1]-1),]) + }) + ## - remove the head + ae_value.head <- ae_value.group[[1]] + ae_value.group.headless <- ae_value.group[-1] + + ## - convert the sign and var into arrange-friendly quosures. + + arrange.params <- rlang::as_quosures( + unlist(lapply(seq_along(sort.vars), + function(i){ + sort.var <- sort.vars[[i]] + sort.sign <- sort.signs[[i]] + if (identical(sort.sign, quote(`+`))) + lapply(paste0('~', sort.var, if (sort.var != 'p') paste0('.', c('all',seq_along(arm_lev)))), env = parent.frame(), as.formula) + else + lapply(paste0('~desc(', sort.var,if (sort.var != 'p') paste0('.', c('all',seq_along(arm_lev))), ')'), env = parent.frame(), as.formula) + }) + ), env=NULL) + + + ae_value.sorted <- do.call(rbind, + lapply(ae_value.group.headless, + function(grouped_ae){ + if (is.grouped){ + rbind( + grouped_ae[1, ], + do.call(arrange, rlang::flatten(list( + .data=as.data.frame(grouped_ae, stringsAsFactors = FALSE)[-1, ], + unlist(arrange.params)))) + ) + } else { + do.call(arrange, rlang::flatten(list( + .data=as.data.frame(grouped_ae, stringsAsFactors = FALSE), + unlist(arrange.params)))) + } + })) + ## - bind the head again + ae_value <- rbind(ae_value.head, ae_value.sorted) %>% mutate_all(as.character) %>% mutate_all(replace_na, '') %>% select(-pt.all, -ep.all) + + # browser() + } + + ## remove the dummy col -trinhdhk + ae_value <- ae_value[,-(nlevels(ae_arm$arm)*2 + 2):-(nlevels(ae_arm$arm)*3+1)] + ae_value <- as.matrix(ae_value) #convert back to matrix to avoid conflicts + colnames(ae_value) <- NULL ## output ### header gr.lev <- levels(ae_arm$arm) @@ -649,11 +1430,11 @@ sstable.ae <- function(ae_data, fullid_data, id.var, aetype.var, grade.var = NUL } ### footer - footer <- c("n episode refer to the number of adverse events in each study arm.", - "n patient refer to the number of patients with at least one event in each study arm.", + footer <- c("n episode refers to the number of adverse events in each study arm.", + "n patient refers to the number of patients with at least one event in each study arm.", if (any(value == "-")) "- : value cannot be estimated." else NULL, if (test) {paste("p-values were based on", - ifelse(chisq.test == FALSE, "Fisher's exact test", "Chi-squared test"), + ifelse(chisq.test == FALSE, "Fisher's exact test", "Chi-squared test if applicable and Fisher's exact test otherwise "), "comparing n patient between study arms for each type of adverse event.")} else NULL, footer) @@ -661,6 +1442,13 @@ sstable.ae <- function(ae_data, fullid_data, id.var, aetype.var, grade.var = NUL if (flextable) { requireNamespace("flextable") requireNamespace("officer") + # return(ss_flextable({ + # tab <- list(table = rbind(header1, header2, ae_value), + # footer = footer) + # class(tab$table) <- c('ae_tbl', 'ss_tbl', class(tab$table)) + # class(tab) <- c('ss_ae','ss_obj') + # tab + # })) ## main table colnames(ae_value) <- rep("", ncol(ae_value)) @@ -701,109 +1489,368 @@ sstable.ae <- function(ae_data, fullid_data, id.var, aetype.var, grade.var = NUL tab <- flextable::bg(tab, i = seq(from = 1, to = nrow(value), by = 2), j = 1:length(header1), bg = bg, part = "body") ### border tabbd <- officer::fp_border(color="black", width = 1.5) - tab <- border_remove(tab) - tab <- hline(tab, border = tabbd, part = "header") - tab <- hline_top(tab, border = tabbd, part = "all") - tab <- hline_bottom(tab, border = tabbd, part = "body") + tab <- flextable::border_remove(tab) + tab <- flextable::hline(tab, border = tabbd, part = "header") + tab <- flextable::hline_top(tab, border = tabbd, part = "all") + tab <- flextable::hline_bottom(tab, border = tabbd, part = "body") + if (print.aetype.header){ + tab <- flextable::bold( + tab, + i = 2 + if (length(grade.var)) length(unique(ae_data[[grade.var]])) else 0, + j=1, part = "body") + } + + ### group-name rows-trinhdhk + if (is.grouped) { + tab <- flextable::merge_h_range(tab, grouptitle_index, 1, ncol(ae_value)) + tab <- flextable::bold(tab, i = grouptitle_index, part = "body") # Bold the group.var rows - hungtt + } } else { tab <- list(table = rbind(header1, header2, ae_value), footer = footer) + if (print.aetype.header){ + rownames(tab$table)[[4 + if (length(grade.var)) length(unique(ae_data[[grade.var]])) else 0]] <- 'section' + } + class(tab$table) <- c('ae_tbl', 'ss_tbl', class(tab$table)) } + if (!flextable) class(tab) <- c('ss_ae','ss_obj') return(tab) } # create survival comparison table ---------------------------------------- -#' Summarize results for a Cox survival model with the treatment arm as the main covariate +#' Summarize results for a Cox survival model or restricted mean survival time with the treatment arm as the main covariate #' -#' @description A function to summarize results for a Cox survival model with the treatment arm (variable "arm") as the main covariate +#' @description A function to summarize results for a survival model with the treatment arm (variable "arm") as the main covariate #' -#' @param model a formula which can be used to fit the Cox survival model. This formula can include other covariates than arm BUT arm must be the first covariate in the model. -#' @param data a data frame to fir the Cox survival model. -#' @param add.risk a logical value specifies whether the event probability ("absolute risk") at time "infinity" should be displayed. -#' @param add.prop.haz.test a logical value specifies whether a test for proportional hazards should be added. -#' @param medsum a logical value specifies whether median (IQR) of time to event should be described. -#' @param digits a number specifies number of significant digits for numeric statistics. -#' @param pdigits a number specifies number of significant digits for p value. -#' @param pcutoff a number specifies threshold value of p value to be displayed as "< pcutoff". -#' @param footer a vector of strings to be used as footnote of table. -#' @param flextable a logical value specifies whether output will be a flextable-type table. -#' @param bg a character specifies color of the odd rows in the body of flextable-type table. +#' @param model a formula which can be used to fit the survival model. This formula can include other covariates than arm BUT arm must be the first covariate in the model. +#' @param data a data frame to fit the survival model. +#' @param add.risk [\code{TRUE}] a logical value specifies whether the event probability ("absolute risk") +#' @param time [\code{Inf}] the truncation time, affecting the descriptive and the RMST model, set to \code{Inf} to perform analyses at maximum time available +#' (minimax of the observed time across two arms in RMST model) +#' @param reference.arm [\code{B}] reference arm, default to the second arm ("B"), change to "A" for base on the first arm +#' @param compare.method [\code{cox}] a string, either "cox" for CoxPH model, "cuminc" for cumulative incidence, or "rmst" for restricted mean survival time. +#' Note that if "cox" is specified and model is a mstate model, a Fine-Gray model is used. +#' If CoxPH is preferred, used Surv(t, ev == 'event-of-interest') on the LHS. +#' +#' @param compare.args: a list of additional args for compare.methods, +#' +#' For compare.method = 'cox', it is +#' `add.prop.haz.test` [\code{TRUE}]: a logical value specifies whether a test for proportional hazards should be added,, additional args are fed directly to `survival::coxph`. +#' only when model is a mstate model, `cause`, default to whatever the first cause. #' +#' For compare.method = 'cuminc', args are fed to \code{\link[eventglm:cumincglm]{cumincglm}} +#' `type`: [\code{diff}] a string, "diff" for difference in cumulative incidence, "ratio' for ratio of cumulative incidence, +#' other optional args include: model.censoring, formula.censoring, ipcw.method. See \code{\link[eventglm:cumincglm]{cumincglm}} for more details. +#' +#' For compare.method = 'rmst', args are fed to \code{\link[eventglm:rmeanglm]{rmeanglm}} , +#' `type`: [\code{diff}] a string, "diff" for difference in RMST, "ratio' for ratio of RMST, "lost.diff" for difference in restricted mean time lost (RMTL, = -diff), and "lost.ratio" for ratio of RMTL +#' other optional args include: model.censoring, formula.censoring, ipcw.method. See \code{\link[eventglm:rmeanglm]{rmeanglm}} for more details. +#' @param add.prop.haz.test [\code{TRUE}] (legacy, depricated), please move this to compare.args +#' @param medsum [\code{TRUE}] a logical value, specifying whether median (IQR) of time to event should be described. +#' @param p.compare [\code{TRUE}] a logical value, specifying whether we should report p-value for the main comparison +#' @param digits [\code{2}] a number specifies number of significant digits for numeric statistics. +#' @param pdigits [\code{3}] a number specifies number of significant digits for p value. +#' @param pcutoff [\code{0.001}] a number specifies threshold value of p value to be displayed as "< pcutoff". +#' @param footer a [\code{NULL}] vector of strings to be used as footnote of table. +#' @param flextable [\code{TRUE}] a logical value specifies whether output will be a flextable-type table. +#' @param bg [\code{#F2EFEE}] a character specifies color of the odd rows in the body of flextable-type table. #' @return a flextable-type table or a list with values/headers/footers #' #' @author This function was originally written by Marcel Wolbers. Lam Phung Khanh did some modification. #' @import survival #' @export -sstable.survcomp <- function(model, data, add.risk = TRUE, add.prop.haz.test = TRUE, medsum = TRUE, - digits = 2, pdigits = 3, pcutoff = 0.001, footer = NULL, flextable = TRUE, bg = "#F2EFEE"){ +sstable.survcomp <- function( + model, data, add.risk = TRUE, + time = Inf, + reference.arm = c('B', 'A'), + compare.method = c('cox', 'rmst', 'cuminc'), + compare.args = list(), + add.prop.haz.test = TRUE, medsum = TRUE, + p.compare = TRUE, + digits = 2, pdigits = 3, pcutoff = 0.001, footer = NULL, flextable = TRUE, bg = "#F2EFEE"){ requireNamespace("survival") - arm.var <- if (length(model[[3]]) > 1) {deparse(model[[3]][[2]])} else {deparse(model[[3]])} + # Initialise the table -------------------------- + ## strip the tibble class which causes issue - trinhdhk + data <- as.data.frame(data) + + mf <- model.frame(update(model, .~1), data=data) + NAs <- attr(mf, 'na.action') |> unname() + + if (length(NAs)){ + warning(sprintf('Missing values on observation(s) %s', + paste(NAs,collapse=', '))) + # data <- data[seq_len(nrow(data))[-NAs],] + data <- dplyr::slice(data, seq_len(nrow(data))[-NAs]) + } + + compare.method <- match.arg(compare.method) + reference.arm <- match.arg(reference.arm) + + # arm.var <- if (length(model[[3]]) > 1) {deparse(model[[3]][[2]])} else {deparse(model[[3]])} + arm.var <- formula.tools::rhs.vars(model)[[1]] + if (!inherits(data[, arm.var], "factor")) data[, arm.var] <- factor(data[, arm.var]) + ### [trinhdhk] 2024-04: reverse level of y for better summary + data[, arm.var] <- ._lv_rev_(data[, arm.var]) arm.names <- levels(data[, arm.var]) + if (length(arm.names) > 2) stop('At the moment, only two-arm studies are supported. A lot of code has covered more than 2 arms but please think about what should be compared in those cases (chunk test or pairwise test for instance) before implementing / trinhdhk.') + + + # Prepare survfit + time2 <- if (time == Inf) .Machine$integer.max else time + fit.surv0 <- survival::survfit(update(model, new = as.formula(paste0(". ~ ", arm.var))), data = data) + # [Trinhdhk] Use integer.max instead of Inf b/c summary.survfit does not want Inf anymore. 05/24 + + # Check for competing risk aka mstate -trinhdhk + ms <- inherits(fit.surv0, 'survfitms') + if (ms) { + all_causes <- attr(mf[[1]], 'states') + if(length(unique(mf[[1]][,2]))<2) + stop('You wanted to use a mstate model. But only one event happened.') + + if (is.null(compare.args$cause)) compare.args$cause <- all_causes[[1]] + if (!compare.args$cause %in% all_causes) + stop('Specified cause is not available in the list of causes. +If you are running this in survcomp.subgroup, perhaps in one subgroup an event did not happen. I don\'t know how to fix this.') + this_cause <- which(all_causes == compare.args$cause)+1 + } + # Table header header1 <- c(paste(arm.names, " (n=", table(data[, arm.var]), ")", sep = ""), "Comparison") - header2 <- c(rep(ifelse(add.risk, "events/n (risk [%])", "events/n"), length(arm.names)), "HR (95%CI); p-value") + compare.stat <- switch(compare.method, + cox = 'HR', + cuminc = if (is.null(compare.args$type)) 'Cumul.inc difference' + else switch(compare.args$type, + diff = 'Cumul.inc difference', + ratio = 'Cumul.inc ratio', + stop('Illegal type for cumulative incidence comparison model')), + rmst = if (is.null(compare.args$type)) 'RMST difference' + else switch(compare.args$type, + diff = 'RMST difference', + lost.diff = 'RMTL difference', + ratio = 'RMST ratio', + lost.ratio = 'RMTL ratio', + stop('Illegal type for RMST comparison model'))) + + header2 <- c(rep(ifelse(add.risk, "events/n (risk [%])", "events/n"), length(arm.names)), paste(compare.stat, if (p.compare) "(95%CI); p-value" else "(95%CI)")) header <- rbind(header1, header2) result <- rbind(header, "") ## footer - footer <- c("HR = hazard ratio; IQR = interquartile range.", "HR and p value were based on Cox proportional hazards models.", footer) - + compare.note <- switch( + compare.stat, + 'HR' = 'HR = hazard ratio', + 'Cumul.inc difference' = 'Cumul.inc : Cumulative incidence', + 'Cumul.inc ratio' = 'Cumul.inc : Cumulative incidence', + 'RMST difference' = 'RMST: Restricted mean survival time', + 'RMTL difference' = 'RMTL: Restricted mean time loss', + 'RMST ratio' = 'RMST: Restricted mean survival time', + 'RMTL ratio' = 'RMTL: Restricted mean time lost' + ) + compare.name <- switch(compare.method, + cuminc='Generalized linear models for cumulative incidence', + cox=if (ms) 'Fine-Gray model' else 'Cox proportional hazards model', + rmst='Restricted mean survival time model') + footer <- c( + paste0(compare.note, "; IQR = interquartile range."), + paste(compare.stat, if (p.compare) "and p value", "were based on", + paste0(compare.name, '.')), + footer) + + + # Descriptive analysis --------------------------- # add number of events and risks - fit.surv0 <- survival::survfit(update(model, new = as.formula(paste0(". ~ ", arm.var))), data = data) - fit.surv <- summary(fit.surv0, time = Inf, extend = TRUE) - if (length(unique(data[, arm.var])) < length(arm.names)) { - tmp <- fit.surv$table - dim(tmp) <- c(length(unique(data[, arm.var])), length(tmp)) - colnames(tmp) <- names(fit.surv$table) - } else { - tmp <- fit.surv$table + fit.surv <- summary(fit.surv0, time = time2, extend = TRUE) + + # [Trinhdhk] This is crap as always returns at inf + # if (length(unique(data[, arm.var])) < length(arm.names)) { + # tmp <- fit.surv$table + # dim(tmp) <- c(length(unique(data[, arm.var])), length(tmp)) + # colnames(tmp) <- names(fit.surv$table) + # } else { + # tmp <- fit.surv$table + # } + # browser() + n.event <- if (ms) fit.surv$n.event[,this_cause] else fit.surv$n.event + events.n <- paste(n.event, fit.surv$n, sep = "/") + if (add.risk) { + # cumhaz <- if (ms) fit.surv$cumhaz[, this_cause-1] else fit.surv$cumhaz + # risk <- if (ms) + # n.event / with(fit.surv, n.event[,this_cause]+n.risk[,this_cause]+n.censor[,this_cause]) else + # n.event / with(fit.surv, n.event+n.risk+n.censor) + risk <- n.event / fit.surv$n + events.n <- paste(events.n, + " (", formatC(100*(risk), digits, format = "f"), ")", sep="") } - events.n <- paste(tmp[, "events"], tmp[, "n.max"], sep = "/") - if (add.risk) events.n <- paste(events.n, " (", formatC(100*(1 - fit.surv$surv), digits, format = "f"), ")", sep="") idx <- which(arm.names %in% unique(data[, arm.var])) result[3, 1:length(arm.names)] <- rep("-", length(arm.names)) result[3, idx] <- events.n - #browser() - if (length(events.n) < length(arm.names)) { - result[3, length(arm.names) + 1] <- "-" - if (add.prop.haz.test){result <- cbind(result, c("Test for proportional hazards", "p-value", "-"))} - } else { - # add HR, CI, p-value - fit.coxph <- survival::coxph(model, data) - est <- coef(fit.coxph) - hr <- formatC(exp(est), digits, format = "f") - result[3, length(arm.names) + 1] <- if (is.na(coef(fit.coxph))) { - "-" + + + + # Comparison -------------------------------------- + # Re-base the arm factor + if (reference.arm == 'B') data[, arm.var] <- ._lv_rev_(data[, arm.var]) + if (compare.method == "cox"){ + if (!is.null(compare.args$add.prop.haz.test)) + add.prop.haz.test <- compare.args$add.prop.haz.test + if (length(events.n) < length(arm.names)) { + result[3, length(arm.names) + 1] <- "-" + if (add.prop.haz.test){result <- cbind(result, c("Test for proportional hazards", "p-value", "-"))} } else { - se <- sqrt(fit.coxph$var) - z <- abs(est/se) - pval <- format.pval((1 - pnorm(z)) * 2, eps = pcutoff, digits = pdigits) - ci <- paste(formatC(exp(c(est - qnorm(0.975) * se, est + qnorm(0.975) * se)), digits, format = "f"), collapse = ", ") - hr.ci.p <- paste(hr, " (", ci, "); p=", pval, sep = "") - result[3, length(arm.names) + 1] <- hr.ci.p - } - - # add test for proportional hazards - if (add.prop.haz.test){ - if (is.na(est)) { - result <- cbind(result, c("Test for proportional hazards", "p-value", "-")) - } else { - attr(model, ".Environment") <- environment() # needed for cox.zph to work - p.prop.haz <- survival::cox.zph(survival::coxph(model, data))$table[1, "p"] - if (is.na(p.prop.haz)) { - p.prop.haz <- "-" + compare.args$add.prop.haz.test <- NULL + compare.args$formula <- model + compare.args$data <- data + + # add HR, CI, p-value + fit.coxph <- if (!ms) + do.call(survival::coxph, compare.args) #survival::coxph(model, data) + else{ + compare.args$etype <- compare.args$cause + compare.args$cause <- NULL + fml <- force(update(model, Surv(fgstart,fgstop,fgstatus)~.)) + fg <- do.call(survival::finegray, compare.args) + eval(substitute(survival::coxph(fml, data = fg, weights=fgwt), list(fml=fml))) + } + est <- coef(fit.coxph)[1:(length(arm.names)-1)] #trinhdhk: if there were more covariables than just arm, subsetting this to only get the arm + hr <- formatC(exp(est), digits, format = "f") + + result[3, length(arm.names) + 1] <- + ifelse(is.na(est),"-", + + { + # browser() + se <- sqrt(fit.coxph$var[[1]]) # trinhdhk: if there were more covariables than just arm, $var returns a var-cov mat, this first element is the var of arm (given arm is the first covariable) + z <- abs(est/se) + pval <- format.pval((1 - pnorm(z)) * 2, eps = pcutoff, digits = pdigits) + ci <- sapply(est, \(.est) { + paste(formatC(exp(c(.est - qnorm(0.975) * se, .est + qnorm(0.975) * se)), digits, format = "f"), collapse = ", ") + }) + if (p.compare){ + hr.ci.p <- paste(hr, " (", ci, "); p=", pval, sep = "") + } else { + hr.ci.p <- paste(hr, " (", ci, ")", sep = "") + } + + hr.ci.p + }) + + + # add test for proportional hazards + if (add.prop.haz.test){ + if (is.na(est)) { + result <- cbind(result, c("Test for proportional hazards", "p-value", "-")) } else { - p.prop.haz <- format.pval(p.prop.haz, eps = pcutoff, digits = pdigits) + attr(model, ".Environment") <- environment() # needed for cox.zph to work + p.prop.haz <- + if(!ms){ + cox <- do.call(survival::coxph, compare.args) + survival::cox.zph(cox)$table[1, "p"] + } else{ + fml <- force(update(model, Surv(fgstart,fgstop,fgstatus)~.)) + fg <- do.call(survival::finegray, compare.args) + cox <- eval(substitute(survival::coxph(fml, data = fg, weights=fgwt), list(fml=fml))) + survival::cox.zph(cox)$table[1, "p"] + } + if (is.na(p.prop.haz)) { + p.prop.haz <- "-" + } else { + p.prop.haz <- format.pval(p.prop.haz, eps = pcutoff, digits = pdigits) + } + result <- cbind(result, c("Test for proportional hazards", "p-value", p.prop.haz)) + } + } + } + } else { + # requireNamespace('eventglm') + if (length(events.n) < length(arm.names)) { + result[3, length(arm.names) + 1] <- "-" + } else { + compare.args$time <- time + compare.args$add.prop.haz.test <- NULL + compare.args$formula <- model + compare.args$data <- data + type <- if (is.null(compare.args$type)) 'diff' else compare.args$type + compare.args$type <- NULL + compare.args$link <- switch(type, + "lost.diff" = 'identity', + "diff" = 'identity', + "ratio" = 'log', + 'lost.ratio' = 'log') + if (is.null(compare.args$model.censoring)) compare.args$model.censoring <- 'stratified' + if (is.null(compare.args$formula.censoring)) compare.args$formula.censoring <- as.formula(paste0("~`", arm.var, '`')) + # Extract the time from Surv object with the arm included + mf <- model.frame(update(model, new = as.formula(paste0(". ~`", arm.var, '`'))), data = data) + mf <- cbind(unclass(mf[,1]), mf[,2]) + # Get max of stop time, is the minimum of last observed time between two arms. + # The stop time for right cens data is the first column ($time), for interval-cens data it is the second column ($stop) + # With laziness it is coded as mf[, ncol(mf)-2] (the last two columns are the event status from Surv object, and the arm) + # browser() + minimax.time <- min(by(mf[, ncol(mf)-2], mf[, ncol(mf)], max)) + max.time <- max(mf[, ncol(mf)-2]) + # tau for rmst is capped as minamax.time + if (is.null(compare.args$time)) compare.args$time <- minimax.time + else if (compare.args$time > minimax.time) { + if (time != Inf) warning( + sprintf('Specified time (tau) is later than maximum observed time between two arms (%.2f). Set too %.2f', minimax.time, minimax.time) + ) + compare.args$time <- minimax.time + } + # If type == lost.ratio then reverse the time + # i.e. Surv(tau - ev_time, ev) ~ . + if (type == 'lost.ratio' && !ms) { + if (compare.method == 'cuminc') stop('type lost.ratio is meaningless in cuminc comparison.') + model.lhs <- formula.tools::lhs(model) + for (i in 2:(length(model.lhs)-1)) { + old <- model.lhs[[i]]; + model.lhs[[i]] <- substitute(max.time - old, list(old=old, max.time=max.time)) } - result <- cbind(result, c("Test for proportional hazards", "p-value", p.prop.haz)) + formula.tools::lhs(model) <- model.lhs + # browser() + compare.args$formula <- model + } + + if (type=='ratio' && ms) { + stop('Don\'t know how to quantify RMST ratio for competing risks. See ?rmeanglm for more details.') } + + # Perform rmeanglm + # rmeanglm <- eventglm::rmeanglm + fitter <- if (compare.method == 'rmst') eventglm::rmeanglm else eventglm::cumincglm + fit.rmst <- do.call(fitter, compare.args) + est <- coef(fit.rmst)[2:(length(arm.names))] # get the coef for arm + invlink <- fit.rmst$family$linkinv + # i don't know why but rmeanglm decides to quantify RMST for non-ms and + # RMTL for ms models. + if ((type=='diff' && ms)|(type=='lost.diff'&&!ms)) invlink <- function(x) -x # loss.diff=-diff + diff <- formatC(invlink(est), digits, format = "f") + + result[3, length(arm.names) + 1] <- + ifelse(is.na(est),"-", + { + summary.rmst <- summary(fit.rmst)$coefficients + p <- summary.rmst[2:length(arm.names), 'Pr(>|z|)'] + pval <- format.pval(p, eps = pcutoff, digits = pdigits) + cf <- confint(fit.rmst)[2:length(arm.names),, drop=FALSE] + ci <- apply(cf, 1, + \(.cf) paste(formatC(sort(invlink(.cf)), digits, format = "f"), collapse = ", ") + ) + if (is.na(p)) diff.ci.p <- paste(diff, '(-)') + else if (p.compare){ + diff.ci.p <- paste(diff, " (", ci, "); p=", pval, sep = "") + } else { + diff.ci.p <- paste(diff, " (", ci, ")", sep = "") + } + diff.ci.p + }) } + } + rownames(result) <- NULL # add label @@ -813,7 +1860,7 @@ sstable.survcomp <- function(model, data, add.risk = TRUE, add.prop.haz.test = T ifelse(is.null(attr(data[, x], "label")), x, attr(data[, x], "label")) }) # output - output <- if (medsum) { + output <- if (medsum & !ms) { result <- rbind(result, "", "", "", "") # add median (IQR) of time-to-event qfit <- as.matrix(do.call(cbind, quantile(fit.surv0, probs = c(0.5, 0.25, 0.75)))) @@ -867,79 +1914,263 @@ sstable.survcomp <- function(model, data, add.risk = TRUE, add.prop.haz.test = T tab <- flextable::bg(tab, i = seq(from = 1, to = nrow(value), by = 2), j = 1:length(header1), bg = bg, part = "body") ### border tabbd <- officer::fp_border(color="black", width = 1.5) - tab <- border_remove(tab) - tab <- hline(tab, border = tabbd, part = "header") - tab <- hline_top(tab, border = tabbd, part = "all") - tab <- hline_bottom(tab, border = tabbd, part = "body") + tab <- flextable::border_remove(tab) + tab <- flextable::hline(tab, border = tabbd, part = "header") + tab <- flextable::hline_top(tab, border = tabbd, part = "all") + tab <- flextable::hline_bottom(tab, border = tabbd, part = "body") } else { tab <- list(table = output, footer = footer) + class(tab$table) <- c('survcomp_tbl', 'ss_tbl', class(tab$table)) } + if (!flextable) class(tab) <- c('ss_survcomp','ss_obj') return(tab) } -#' Summarize results for a Cox survival model by treatment arm and subgroup +#' Summarize results for a survival model by treatment arm and subgroup #' -#' @description A function to summarize results for a Cox survival model by treatment arm (variable "arm") and subgroup. +#' @description A function to summarize results for a survival model by treatment arm (variable "arm") and subgroup. #' #' @param base.model a formula from which sub-group specific estimates are extracted (!! arm must be the first covariate in the model). +#' @param overall.model an optional one-sided formula for additional terms for overall population only #' @param subgroup.model a formula of the form "~subgrouping.variable1+subgrouping.variable2" (!! subgrouping.variable must be factors and there should be nothing on the left-hand side of the formula). -#' @param data a data frame to fir the Cox survival model. -#' @param ... arguments that are passed to sstable.survcomp. -#' @param digits a number specifies number of significant digits for numeric statistics. -#' @param pdigits a number specifies number of significant digits for p value. -#' @param pcutoff a number specifies threshold value of p value to be displayed as "< pcutoff". -#' @param footer a vector of strings to be used as footnote of table. -#' @param flextable a logical value specifies whether output will be a flextable-type table. -#' @param bg a character specifies color of the odd rows in the body of flextable-type table. +#' @param data a data frame to fit the survival model. +#' @param add.risk [\code{TRUE}] a logical value specifies whether the event probability ("absolute risk") at time "infinity" should be displayed. +#' @param time [\code{Inf}] the truncation time, affecting the descriptive and the RMST model, set to \code{Inf} to perform analyses at maximum time available +#' (minimax of the observed time across two arms in RMST model) +#' @param reference.arm [\code{B}] reference arm, default to the second arm ("B"), change to "A" for base on the first arm +#' @param compare.method [\code{cox}] a string, either "cox" for CoxPH model, "cuminc" for cumulative incidence, or "rmst" for restricted mean survival time. +#' Note that if "cox" is specified and model is a mstate model, a Fine-Gray model is used. +#' If CoxPH is preferred, used Surv(t, ev == 'event-of-interest') on the LHS. +#' +#' @param compare.args: a list of additional args for compare.methods, +#' +#' For compare.method = 'cox', it is +#' `add.prop.haz.test` [\code{TRUE}]: a logical value specifies whether a test for proportional hazards should be added,, additional args are fed directly to `survival::coxph`. +#' only when model is a mstate model, `cause`, default to whatever the first cause. +#' +#' For compare.method = 'cuminc', args are fed to \code{\link[eventglm:cumincglm]{cumincglm}} +#' `type`: [\code{diff}] a string, "diff" for difference in cumulative incidence, "ratio' for ratio of cumulative incidence, +#' other optional args include: model.censoring, formula.censoring, ipcw.method. See \code{\link[eventglm:cumincglm]{cumincglm}} for more details. +#' +#' For compare.method = 'rmst', args are fed to \code{\link[eventglm:rmeanglm]{rmeanglm}} , +#' `type`: [\code{diff}] a string, "diff" for difference in RMST, "ratio' for ratio of RMST, "lost.diff" for difference in restricted mean time lost (RMTL, = -diff), and "lost.ratio" for ratio of RMTL +#' other optional args include: model.censoring, formula.censoring, ipcw.method. See \code{\link[eventglm:rmeanglm]{rmeanglm}} for more details. +#' @param p.compare [\code{TRUE}] a logical value, specifying whether we should report p-value for the main comparison +#' @param digits [\code{2}] a number specifies number of significant digits for numeric statistics. +#' @param pdigits [\code{3}] a number specifies number of significant digits for p value. +#' @param pcutoff [\code{0.001}] a number specifies threshold value of p value to be displayed as "< pcutoff". +#' @param footer a [\code{NULL}] vector of strings to be used as footnote of table. +#' @param flextable [\code{TRUE}] a logical value specifies whether output will be a flextable-type table. +#' @param bg [\code{#F2EFEE}] a character specifies color of the odd rows in the body of flextable-type table. +#' @param overall [\code{TRUE}] where to print overall model +#' @param ... arguments that are passed to sstable.survcomp #' #' @return a flextable-type table or a list with values/headers/footers #' -#' @author This function was originally written by Marcel Wolbers. Lam Phung Khanh did some modification. +#' @author This function was originally written by Marcel Wolbers. Trinh Dong and Lam Phung Khanh did some modification. #' @import survival #' @export -sstable.survcomp.subgroup <- function(base.model, subgroup.model, data, digits = 2, pdigits = 3, pcutoff = 0.001, footer = NULL, flextable = TRUE, bg = "#F2EFEE", ...){ +sstable.survcomp.subgroup <- function(base.model, subgroup.model, overall.model, data, + time = Inf, + reference.arm = c('B', 'A'), + compare.method = c('cox', 'rmst', 'cuminc'), + compare.args = list(), + p.compare = TRUE, + digits = 2, pdigits = 3, pcutoff = 0.001, footer = NULL, flextable = TRUE, bg = "#F2EFEE", overall = TRUE,...){ + + requireNamespace("survival") + ## strip the tibble class which causes issue - trinhdhk + data <- as.data.frame(data) + NAs <- model.frame(update(base.model, .~1), data=data) |> attr('na.action') |> unname() + if (length(NAs)){ + warning(sprintf('Missing values on observation(s) %s', + paste(NAs,collapse=', '))) + # data <- data[seq_len(nrow(data))[-NAs],] + data <- dplyr::slice(data, seq_len(nrow(data))[-NAs]) + } + compare.method <- match.arg(compare.method) + fit.surv0 <- survfit(update(base.model, .~1), data=data) + ms <- inherits(fit.surv0, 'survfitms') + + # arm.var <- if (length(base.model[[3]]) > 1) { + # deparse(base.model[[3]][[2]]) + # } else { + # deparse(base.model[[3]]) + # } + arm.var <- formula.tools::rhs.vars(base.model)[[1]] + if (!inherits(data[, arm.var], "factor")) data[, arm.var] <- factor(data[, arm.var]) + # result in entire population - result <- sstable.survcomp(model = base.model, data = data, medsum = FALSE, digits = digits, + if (!missing(overall.model)){ + added.terms <- terms(overall.model) |> attr('term.labels') + overall.model <- update(base.model, + as.formula(paste('. ~ . +', + paste(added.terms, + collapse='+')))) + } else overall.model <- base.model + result <- sstable.survcomp(model = overall.model, data = data, time=time, reference.arm=reference.arm, + medsum = FALSE, digits = digits, + compare.method = compare.method, compare.args = compare.args, + p.compare = p.compare, pdigits = 3, pcutoff = pcutoff, flextable = FALSE, ...)$table[,-1] result <- cbind(c("Subgroup", "", "All patients"), result, c("Test for heterogeneity", "p-value", "")) # Preparation of models and data subgroup.char <- all.vars(subgroup.model) + #browser() for (k in 1:length(subgroup.char)){ main.model <- update(base.model, as.formula(paste(". ~ . +", subgroup.char[k], sep = ""))) - ia.model <- update(base.model, as.formula(paste(". ~ . + arm *", subgroup.char[k], sep = ""))) + ia.model <- update(base.model, as.formula(paste(". ~ . +`", arm.var, "`*", subgroup.char[k], sep = ""))) data$.subgroup.var <- data[, subgroup.char[k]] + if (!inherits(data[, subgroup.char[k]], 'factor')) data[, subgroup.char[k]] <- factor(data[, subgroup.char[k]]) factor.levels <- levels(data[, subgroup.char[k]]) - + compare.args.subgroup <- compare.args # Add interaction test for heterogeneity result <- rbind(result, "") result[nrow(result), 1] <- ifelse(is.null(attr(data[, subgroup.char[k]], "label")), subgroup.char[k], attr(data[, subgroup.char[k]], "label")) - ia.pval <- anova(survival::coxph(ia.model, data = data), survival::coxph(main.model, data = data), test = "Chisq")[2, "P(>|Chi|)"] - result[nrow(result), ncol(result)] <- format.pval(ia.pval, digits = pdigits, eps = pcutoff) + ia.pval <- + if (compare.method == 'cox'){ + if (ms){ + etype <- compare.args$cause + fg.ia <- survival::finegray(ia.model, data=data, etype=etype) + fg.main <- survival::finegray(main.model, data=data, etype=etype) + + anova( + survival::coxph(update(ia.model, Surv(fgstart,fgstop,fgstatus)~.), + data=fg.ia, weights=fgwt), + survival::coxph(update(main.model, Surv(fgstart,fgstop,fgstatus)~.), + data=fg.main, weights=fgwt), + test = "Chisq")[2, "Pr(>|Chi|)"] + } else { + anova(survival::coxph(ia.model, data = data), + survival::coxph(main.model, data = data), + test = "Chisq")[2, "Pr(>|Chi|)"] + } + } else { + ia.args <- compare.args + ia.args$add.prop.haz.test <- NULL + # ia.args$formula <- ia.model + ia.args$data <- data + + type <- if (is.null(ia.args$type)) 'diff' else ia.args$type + ia.args$type <- NULL + ia.args$link <- switch(type, "diff" = 'identity', "ratio" = 'log', 'lost.ratio' = 'log') + ia.args$model.censoring <- if (is.null(ia.args$model.censoring)) 'stratified' + ia.args$formula.censoring <- + if (is.null(ia.args$formula.censoring)) update(main.model, NULL ~.) else + update(ia.args$formula.censoring, as.formula(paste("NULL ~ . +", subgroup.char[k], sep = ""))) + mf <- model.frame(update(base.model, new = as.formula(paste0(". ~`", arm.var, '`'))), data = data) + mf <- cbind(unclass(mf[,1]), mf[,2]) + # Get max of stop time, is the minimum of last observed time between two arms. + # The stop time for right cens data is the first column ($time), for interval-cens data it is the second column ($stop) + # With laziness it is coded as mf[, ncol(mf)-2] (the last two columns are the event status from Surv object, and the arm) + # browser() + minimax.time <- min(by(mf[, ncol(mf)-2], mf[, ncol(mf)], max)) + + # tau for rmst is capped as minamax.time + if (is.null(ia.args$time)) ia.args$time <- minimax.time + else if (ia.args$time > minimax.time) { + ia.args$time <- minimax.time + } + + # Remove missing value from predictor bc this causes problem in censoring model + NAs <- model.frame(main.model, data=data) |> attr('na.action') |> unname() + if (length(NAs)){ + warning(sprintf('Missing %s on observation(s) %s', + subgroup.char[k], + paste(NAs,collapse=', '))) + # data <- data[seq_len(nrow(data))[-NAs],] + ia.args$data <- dplyr::slice(data, seq_len(nrow(data))[-NAs]) + } + + # browsere) + # Perform multivariate wald test for interaction term + tryCatch({ + fitter <- switch(compare.method, + 'rmst' = eventglm::rmeanglm, + 'cuminc' = eventglm::cumincglm) + ia.fit <- + do.call(fitter, append(ia.args, c(formula=ia.model))) + main.terms <- colnames(model.matrix(main.model, data=ia.args$data)) + ia.terms <- coef(ia.fit) + test.terms <- which(!names(ia.terms) %in% main.terms) + test <- aod::wald.test(vcov(ia.fit), b=ia.terms, Terms=test.terms) + test$result$chi2['P'] + }, + error=\(e) NA + ) + + } + # browser() + + result[nrow(result), ncol(result)] <- + if (is.na(ia.pval)) '-' else + format.pval(ia.pval, digits = pdigits, eps = pcutoff) # Add results for each subgroup level for (j in 1:length(factor.levels)){ result <- rbind(result, "") result[nrow(result), 1] <- paste("-", factor.levels[j]) d.subgroup <- subset(data, .subgroup.var == factor.levels[j]) - result[nrow(result), 2:(ncol(result) - 1)] <- sstable.survcomp(model = base.model, data = d.subgroup, + # if (compare.method=='rmst'){ + # compare.args$model.censoring <- if (is.null(compare.args$model.censoring)) 'stratified' + # compare.args$formula.censoring <- + # if (is.null(compare.args$formula.censoring)) update(main.model, NULL ~.) else + # update(compare.args$formula.censoring, as.formula(paste("NULL ~ . +", subgroup.char[k], sep = ""))) + # } + # browser() + result[nrow(result), 2:(ncol(result) - 1)] <- sstable.survcomp(model = base.model, data = d.subgroup, time=time, + compare.method = compare.method, compare.args = compare.args, + p.compare = p.compare, medsum = FALSE, digits = digits, pdigits = pdigits, pcutoff = pcutoff, flextable = FALSE, ...)$table[3,-1] } } ## footer - footer <- c("HR = hazard ratio.", - "HR and p value were based on Cox proportional hazards models.", - "Test for heterogeneity is an interaction test between treatment effect and each subgroup in a Cox proportional hazard model (not include other variables).", - footer) + compare.stat <- switch(compare.method, + cox = 'HR', + cuminc = if (is.null(compare.args$type)) 'Cumul.inc difference' + else switch(compare.args$type, + diff = 'Cumul.inc difference', ratio = 'Cumul.inc ratio', + stop('Illegal type for cumulative incidence comparison model')), + rmst = if (is.null(compare.args$type)) 'RMST difference' + else switch(compare.args$type, + diff = 'RMST difference', + lost.diff = 'RMTL difference', + ratio = 'RMST ratio', + lost.ratio = 'RMTL ratio', + stop('Illegal type for RMST comparison model'))) + compare.note <- switch( + compare.stat, + 'HR' = 'HR = hazard ratio', + 'Cumul.inc difference' = 'Cumul.inc : Cumulative incidence', + 'Cumul.inc ratio' = 'Cumul.inc : Cumulative incidence', + 'RMST difference' = 'RMST: Restricted mean survival time', + 'RMTL difference' = 'RMTL: Restricted mean time loss', + 'RMST ratio' = 'RMST: Restricted mean survival time', + 'RMTL ratio' = 'RMTL: Restricted mean time lost' + ) + compare.name <- switch(compare.method, + cuminc='Generalized linear models for cumulative incidence', + cox=if (ms) 'Fine-Gray model' else 'Cox proportional hazards model', + rmst='Restricted mean survival time model') + footer <- c( + compare.note, + paste(compare.stat, "and p value were based on", paste0(compare.name, '.')), + sprintf( + "Test for heterogeneity is an %s test for interaction between treatment effect and each subgroup in the survival model not including other variables.", + if (compare.method == 'cox') 'Likelihood-ratio' else 'multivariate Wald' + ), + footer) # flextable + if (!overall) result <- result[-3,] if (flextable) { requireNamespace("flextable") requireNamespace("officer") @@ -980,14 +2211,29 @@ sstable.survcomp.subgroup <- function(base.model, subgroup.model, data, digits = tab <- flextable::bg(tab, i = seq(from = 1, to = nrow(result[-c(1:2), ]), by = 2), j = 1:length(header1), bg = bg, part = "body") ### border tabbd <- officer::fp_border(color="black", width = 1.5) - tab <- border_remove(tab) - tab <- hline(tab, border = tabbd, part = "header") - tab <- hline_top(tab, border = tabbd, part = "all") - tab <- hline_bottom(tab, border = tabbd, part = "body") + tab <- flextable::border_remove(tab) + tab <- flextable::hline(tab, border = tabbd, part = "header") + tab <- flextable::hline_top(tab, border = tabbd, part = "all") + tab <- flextable::hline_bottom(tab, border = tabbd, part = "body") } else { tab <- list(table = result, footer = footer) + class(tab$table) <- c('survcomp_tbl', 'ss_tbl', class(tab$table)) } + if (!flextable) class(tab) <- c('ss_survcomp','ss_obj') return(tab) } + +#' @export +print.ss_tbl <- function(sstable, pretty=getOption('ss_pretty.print', TRUE)){ + if (!pretty) return(print.default(sstable)) + tryCatch( + { + print(huxtable::as_hux(sstable) |> huxtable::theme_article()) + }, + error = function(e) {print.default(sstable)} + ) + invisible(sstable) +} + diff --git a/R/toolkits.R b/R/toolkits.R index 40ecc7f..e9c7280 100644 --- a/R/toolkits.R +++ b/R/toolkits.R @@ -1,7 +1,7 @@ #' Do a simple recode via pattern for data #' #' @description -#' A function to re-encode data by using a map. Patterns are accepted. unmentioned data are left intact. +#' A function to re-encode data by using a map. Patterns are accepted. Unmentioned data are left intact. #' #' Method for class data.frame supports a robust replacement for data by providing relevant map in the form of var = map. #' @@ -17,7 +17,7 @@ #' @param ignore.case,perl Parameters passed to gsub(). #' @param .data A data frame to modify #' @param ... -#' For data.frame: Replacement in the form of var = map. Maps must follow the syntax stipulated in the map parameter. +#' For method for data.frame: Replacement in the form of var = map. Maps must follow the syntax stipulated in the map parameter. #' #' For default method: Additional parameters passed to factor() #' @@ -40,11 +40,11 @@ simple_recode <- function(...){ #' @aliases recode_var var_recode #' @method simple_recode data.frame #' @export -simple_recode.data.frame <- function(.data, ..., ignore.case = FALSE, perl = TRUE){ +simple_recode.data.frame <- function(.data, ..., ignore.case = FALSE, fixed = FALSE, perl = TRUE){ .maps <- list(...) .vars <- names(.maps) for (.var in .vars){ - .data[[.var]] <- simple_recode.default(x = .data[[.var]], map = .maps[[.var]], ignore.case = ignore.case, perl = perl) + .data[[.var]] <- simple_recode.default(x = .data[[.var]], map = .maps[[.var]], ignore.case = ignore.case, fixed = fixed, perl = perl) } return(.data) } @@ -52,7 +52,7 @@ simple_recode.data.frame <- function(.data, ..., ignore.case = FALSE, perl = TRU #' @rdname simple_recode #' @method simple_recode default #' @export -simple_recode.default <- function(x, map, as = c('as_is', 'numeric', 'factor', 'character', 'logical'), ignore.case = FALSE, perl = TRUE, ...){ +simple_recode.default <- function(x, map, as = c('as_is', 'numeric', 'factor', 'character', 'logical'), ignore.case = FALSE, fixed = FALSE, perl = TRUE, ...){ requireNamespace('tidyr') as <- match.arg(as) if (missing(map)) stop ('A conversion map should be provided!') @@ -71,7 +71,7 @@ simple_recode.default <- function(x, map, as = c('as_is', 'numeric', 'factor', ' x.recoded <- x for (i in 1:nrow(Map)){ if (is.na(Map$from[i])) x.recoded <- tidyr::replace_na(x.recoded, Map$to[i]) - else x.recoded <- gsub(Map$from[i], Map$to[i], x.recoded, ignore.case = ignore.case, perl=perl) + else x.recoded <- gsub(Map$from[i], Map$to[i], x.recoded, ignore.case = ignore.case, fixed = fixed, perl=perl) } @@ -101,3 +101,109 @@ simple_recode.default <- function(x, map, as = c('as_is', 'numeric', 'factor', ' match.fun(value)(x) } +#' Get or set the reference level +#' @description A function to quickly get or set the reference level of a factor +#' @export +ref_lv <- function(x){ + UseMethod('ref_lv') +} + +#' @rdname ref_lv +#' @param x A factor +#' @return A character object the represents the reference level +#' @export +ref_lv.factor <- function(x){ + levels(x)[[1]] +} + +#' @rdname ref_lv +#' @export +`ref_lv<-` <- function(x, value){ + UseMethod('ref_lv<-') +} + +#' @rdname ref_lv +#' @param value An existing level to be set as reference +#' @export +`ref_lv<-.factor` <- function(x, value){ + relevel(x, value) +} + +#' Get the proportion for each level or range of a vector +#' @description A function to calculate the proportion of each value range +#' @param x An object +#' @param method +#' A method to calculate the percentage. +#' Default is 'auto' which will attempt to choose the most fit method. +#' 'bin' is only meaningful for vector that only has to values. +#' 'fct' is meaningful for descrete variable +#' 'cont' is used for continuous variables. This will break the variable into several ranges +#' depended on the breaks specified in ... +#' @param na.rm A logical value deciding whether NA should be removed +#' @param ... Additional parameters passed to \link{cut}. Only work if method = 'cont' +#' See \link{cut} +#' @return +#' If method == 'bin': the percentage of non-reference level +#' +#' If method == 'fct': the percentages of all levels +#' +#' If method == 'cont': the percentages of all ranges based on specified breaks +#' @export +pct <- function(x, method = c('auto', 'bin', 'cont', 'fct'), na.rm = TRUE, ...){ + method <- match.arg(method) + if (method == 'auto') method <- ._pct_get_method(unlist(x)) + + if (method == 'bin' & !is.logical(x) & !setequal(unique(x), c(0,1))){ + if (length(unique(x)) > 2) stop('Forcing binary method for factor variable is meaningless.') + if (length(unique(x)) == 1) return(100) + if (length(unique(x)) != length(levels(x))) x <- factor(x, levels = unique(x), exclude=NULL) + if (all(!is.na(levels(x)))) + warning('Binary method apply to non logical variable. This will calculate the pct of x != ref_lv') + x <- x == levels(x)[2] + } + + res <- switch(method, + bin = ._pct_bin(x, na.rm), + cont = ._pct_cont(x, na.rm, ...), + fct = ._pct_fct(x, na.rm)) + + return(res) +} + +._pct_get_method <- function(x){ + if (is.logical(x) | length(unique(x)) <= 2) return('bin') + if (is.factor(x) | is.character(x) | (is.numeric(x) & length(unique(x)) <= 5)) return('fct') + return('cont') +} + +._pct_bin <- function(x, na.rm = TRUE){ + n <- if (na.rm) sum(!is.na(x)) else length(x) + return(sum(x, na.rm = TRUE)/n*100) +} + +._pct_fct <- function(x, na.rm = TRUE){ + n <- if (na.rm) sum(!is.na(x)) else length(x) + lvs <- if (na.rm) levels(x) else levels(addNA(x, ifany = TRUE)) + sapply(lvs, + function(lv){ + sum(x == lv)/n*100 + }) +} + +._pct_cont <- function(x, na.rm = TRUE, ...){ + if (na.rm) x <- na.omit(x) + x <- cut(x, ...) + lv <- levels(addNA(as.factor(x), ifany = TRUE)) + if (any(is.na(lv))) lv <- c(NA, lv[!is.na(lv)]) + x2 <- factor(x, levels = lv, exclude = NULL) + # browser() + pct(x2, method = 'auto', na.rm = FALSE) +} + +# Reverse levels +# For public use, please use forcats::fct_rev +._lv_rev_ <- function(x){ + new_x <- factor(x, levels=rev(levels(x)), exclude=NULL) + attributes(new_x) <- utils::modifyList(attributes(x), attributes(new_x)) + new_x +} diff --git a/README.Rmd b/README.Rmd index 53f0540..9b56a30 100644 --- a/README.Rmd +++ b/README.Rmd @@ -22,10 +22,50 @@ You can install C306 from github with: ```{r gh-installation, eval = FALSE} # install.packages("devtools") -devtools::install_github("lampk/C306") +devtools::install_github("oucru-biostats/C306@feature-rbind") ``` -## Website +## List of functions -Documentation of this package can be found at: -[http://lampk.github.io/C306/](http://lampk.github.io/C306/) +### Main functions + +These functions' purpose are to generate report tables, outputting a flextable or a intermediate object of class `ss_table` for post-hoc manipulation. + +- `sstable.baseline` function to generate baseline table 1. +- `sstable.survcomp` function to generate dual arm descriptive and inferential analysis for time-to-event outcome, supporting *Cox pH* and *Restricted mean surival time* models +- `sstable.survcomp.subgroup` extending `sstable.survcomp` for subgroup analyses +- `sstable.ae` function to generate adverse event tables with $\chi^2$ or Fisher test for comparision. + +### sstable manipulation + +These function provides helper to create ss_table-esque output, with supporting function to convert them to flextable or huxtable. + +- `ssformat` function to convert an arbitrary matrix to an sstable +- `ss_flextable` function to convert an sstable to a flextable +- `ss_huxtable` function to convert an sstable to a huxtable +- `ft_sstheme` function to decorate an arbitrary flextable to have an sstable-esque theme +- `ht_theme_markdown` and `ht_theme_kable` functions to decorate huxtable to follow a sstable-esque theme +- `as_sstable` converting objects to sstable + +## Plotting functions + +- `gg_boxcox` same with `MASS::boxcox` but in ggplot +- `ggsurvfit2` same as `ggsurvfit::ggsurvfit` but with strata separated. Note that it relies on `tidy_survfit2` and does not work with `ggsurvfit::survfit2` at the moment. +- `gg_ajsurvplot` plots one Aalen-Johansen curve for competing risks for the event of interest. Note that this is based on `surviminer` due to its flexibility +- `gg_ajsurvplot2` plots **two** Aalen-Johansen curves for main risk (from bottom) and competing risk (from top). Note that this is based `ggsurvfit` with some limitations. However, it has the ability to return a dataset for more flexibility in plotting with ggplot. + +### OUCRU function written by Lam PK + +- `import.info` and `convert.info` import and convert OUCRU dictionary to C306 style dict to use for data inspection +- `insepct.data` function to check data for error based on a dictionary by `convert.info` +- `myformat.data` function to reformat the data to readable form base on the dictionary by `convert.info` +- `labAE` function to determine a laboratory AE based on a threshold + +### Helper function written by Trinh Dong + +- `logist_summary` based on a function by OUCRU Biostats group, reporting the OR of logistic regression +- `subgroup_effect` extends `logist_summary` to report the subgroup OR of variables that have interaction with a common covariate (i.e. treatment arm). +- `mutate_f` and `summarise_f` perform multiple assignment for data.frame by `c(a,b):=list(v_a, v_b)` +- `simple_relevel` relevels a factor correposnding to the level of another factor +- `simple_recode` pattern-based recoding of data by in-place replacement +- `tidy_survfit2` same as \code{\link[ggsurvfit:tidy_survfit]{ggsurvfit:tidy_survfit}} but with strata saved for easier plotting. Note that it, at the moment, does not work with `ggsurvfit::survfit2` ironically. diff --git a/README.md b/README.md index 84880e4..28e390a 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,6 @@ +> [!IMPORTANT] +> THIS BRANCH IS FEATURE-FROZEN, AIMING FOR REPRODUCIBILITY IN 27TB ANALYSIS. ONLY BUG FIXES SHOULD BE ACCEPTED - # C306 @@ -12,10 +13,76 @@ You can install C306 from github with: ``` r # install.packages("devtools") -devtools::install_github("lampk/C306") +devtools::install_github("oucru-biostats/C306@feature-rbind") ``` -## Website +## List of functions -Documentation of this package can be found at: - +### Main functions + +These functions’ purpose are to generate report tables, outputting a +flextable or a intermediate object of class `ss_table` for post-hoc +manipulation. + +- `sstable.baseline` function to generate baseline table 1. +- `sstable.survcomp` function to generate dual arm descriptive and + inferential analysis for time-to-event outcome, supporting *Cox pH* + and *Restricted mean surival time* models +- `sstable.survcomp.subgroup` extending `sstable.survcomp` for subgroup + analyses +- `sstable.ae` function to generate adverse event tables with $\chi^2$ + or Fisher test for comparision. + +### sstable manipulation + +These function provides helper to create ss_table-esque output, with +supporting function to convert them to flextable or huxtable. + +- `ssformat` function to convert an arbitrary matrix to an sstable +- `ss_flextable` function to convert an sstable to a flextable +- `ss_huxtable` function to convert an sstable to a huxtable +- `ft_sstheme` function to decorate an arbitrary flextable to have an + sstable-esque theme +- `ht_theme_markdown` and `ht_theme_kable` functions to decorate + huxtable to follow a sstable-esque theme +- `as_sstable` converting objects to sstable + +## Plotting functions + +- `gg_boxcox` same with `MASS::boxcox` but in ggplot +- `ggsurvfit2` same as `ggsurvfit::ggsurvfit` but with strata separated. + Note that it relies on `tidy_survfit2` and does not work with + `ggsurvfit::survfit2` at the moment. +- `gg_ajsurvplot` plots one Aalen-Johansen curve for competing risks for + the event of interest. Note that this is based on `surviminer` due to + its flexibility +- `gg_ajsurvplot2` plots **two** Aalen-Johansen curves for main risk + (from bottom) and competing risk (from top). Note that this is based + `ggsurvfit` with some limitations. However, it has the ability to + return a dataset for more flexibility in plotting with ggplot. + +### OUCRU function written by Lam PK + +- `import.info` and `convert.info` import and convert OUCRU dictionary + to C306 style dict to use for data inspection +- `insepct.data` function to check data for error based on a dictionary + by `convert.info` +- `myformat.data` function to reformat the data to readable form base on + the dictionary by `convert.info` +- `labAE` function to determine a laboratory AE based on a threshold + +### Helper function written by Trinh Dong + +- `logist_summary` based on a function by OUCRU Biostats group, + reporting the OR of logistic regression +- `subgroup_effect` extends `logist_summary` to report the subgroup OR + of variables that have interaction with a common covariate + (i.e. treatment arm). +- `mutate_f` and `summarise_f` perform multiple assignment for + data.frame by `c(a,b):=list(v_a, v_b)` +- `simple_relevel` relevels a factor correposnding to the level of + another factor +- `simple_recode` pattern-based recoding of data by in-place replacement +- `tidy_survfit2` same as but with strata saved for easier plotting. + Note that it, at the moment, does not work with `ggsurvfit::survfit2` + ironically. diff --git a/inst/.DS_Store b/inst/.DS_Store new file mode 100644 index 0000000..988c67b Binary files /dev/null and b/inst/.DS_Store differ diff --git a/inst/extdata/ae_data.csv b/inst/extdata/ae_data.csv new file mode 100644 index 0000000..b25e272 --- /dev/null +++ b/inst/extdata/ae_data.csv @@ -0,0 +1,535 @@ +usubjid,ctcaename,ctcaegrade,original_ctcaegrade,posrelunrel,unexp +003-001,Nausea,I,I,POSREL,N +003-003,Back pain,I,I,POSREL,N +003-004,Viral infection,I,NA,UNREL,Y +003-006,Headache,I,I,POSREL,N +003-007,Phlebitis,I,I,UNREL,N +003-029,Gastritis,II,II,UNREL,Y +003-034,Constipation,II,II,UNREL,N +003-035,Constipation,II,II,UNREL,N +003-044,Gastritis,II,NA,UNREL,Y +003-073,Hemorrhoids,I,I,UNREL,N +003-087,Skin allergy,II,NA,REL,N +003-095,Phlebitis,I,I,UNREL,N +003-105,Pharyngitis,II,II,UNREL,Y +003-109,Hospital acquired pneumonia,II,NA,UNREL,N +003-122,Headache,I,I,POSREL,N +003-135,Phlebitis,I,I,UNREL,N +003-141,Headache,I,I,POSREL,N +003-144,UTI,II,NA,UNREL,N +003-150,Headache,I,I,POSREL,N +003-167,Headache,I,I,POSREL,N +003-184,Hemorrhoids,I,I,UNREL,N +003-242,Fever,I,I,POSREL,N +003-244,Fever,I,I,POSREL,N +003-261,Skin allergy,II,NA,POSREL,N +003-265,Constipation,II,II,UNREL,N +003-004,Neuralgia,II,II,UNREL,Y +003-006,Hiccup,II,II,UNREL,Y +003-007,Constipation,II,II,UNREL,N +003-014,Skin allergy,II,NA,POSREL,N +003-015,Constipation,II,II,UNREL,N +003-023,Constipation,II,II,UNREL,N +003-027,Myocardial ischaemia,II,NA,UNREL,Y +003-036,UTI,II,NA,UNREL,N +003-037,Oral infection,II,NA,UNREL,Y +003-072,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-074,Skin allergy,II,NA,POSREL,N +003-076,Hospital acquired pneumonia,II,NA,UNREL,N +003-081,Otitis,II,NA,UNREL,Y +003-084,UTI,II,NA,UNREL,N +003-094,Headache,I,I,REL,N +003-101,UTI,II,NA,UNREL,N +003-103,UTI,II,NA,UNREL,N +003-111,UTI,II,NA,UNREL,N +003-118,Atrial thrombosis,II,NA,POSREL,N +003-136,Spinal disc herniation,NA,NA,UNREL,Y +003-141,Fever,I,I,POSREL,N +003-159,Phlebitis,I,I,UNREL,N +003-212,Fever,I,I,POSREL,N +003-242,Headache,I,I,POSREL,N +003-255,Sinusitis,II,II,UNREL,Y +003-258,Oral infection,II,NA,UNREL,Y +003-261,Facial nerve disorder,II,II,UNREL,N +003-007,Constipation,II,II,UNREL,N +003-009,Urinary retention,II,II,UNREL,N +003-027,UTI,II,NA,UNREL,N +003-036,Constipation,II,II,UNREL,N +003-038,Upper gastrointestinal hemorrhage,II,II,UNREL,Y +003-046,Phlebitis,I,I,UNREL,N +003-074,Hyperglycaemia,II,II,UNREL,N +003-081,Constipation,II,II,UNREL,N +003-094,Chills,I,I,REL,N +003-101,Arthritis,II,II,UNREL,Y +003-104,Skin allergy,II,NA,POSREL,N +003-127,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-146,Aspiration pneumonia,II,NA,UNREL,N +003-173,UTI,II,NA,UNREL,N +003-255,Viral infection,II,NA,UNREL,Y +003-258,Constipation,II,II,UNREL,N +003-267,Skin allergy,II,NA,POSREL,N +003-001,Constipation,II,II,UNREL,N +003-005,UTI,II,NA,UNREL,N +003-007,Arthritis,II,II,UNREL,Y +003-017,Ventilator associated pneumonia,II,NA,UNREL,N +003-019,Arthralgia,II,II,UNREL,Y +003-028,Tracheal hemorrhage,II,II,UNREL,N +003-038,UTI,II,NA,UNREL,N +003-042,Ventilator associated pneumonia,II,NA,UNREL,N +003-053,Hypotension,III,III,UNREL,N +003-065,Nose bleed,II,NA,UNREL,N +003-067,Hospital acquired pneumonia,II,NA,UNREL,N +003-090,Wound infection,II,II,UNREL,N +003-094,Fever,I,I,REL,N +003-116,UTI,II,NA,UNREL,N +003-117,Ventilator associated pneumonia,II,NA,UNREL,N +003-123,Allergy,II,NA,POSREL,N +003-127,UTI,II,NA,UNREL,N +003-131,Hyponatremia,II,II,UNREL,N +003-146,Cellulitis,I,I,UNREL,N +003-164,Aspiration pneumonia,II,NA,UNREL,N +003-168,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-172,Hyponatremia,II,II,UNREL,N +003-173,Blood stream infection,II,NA,UNREL,N +003-174,Otitis,II,NA,UNREL,Y +003-176,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-177,Nose bleed,II,NA,UNREL,N +003-178,Hypokalemia,II,II,UNREL,N +003-179,Hypocalcemia,III,III,UNREL,N +003-180,Hypokalemia,II,II,UNREL,N +003-197,Skin allergy,II,NA,POSREL,N +003-199,Torticolis,II,NA,UNREL,Y +003-201,Hypokalemia,III,III,UNREL,N +003-210,Tracheal hemorrhage,II,II,UNREL,N +003-223,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-228,Hospital acquired pneumonia,II,NA,UNREL,N +003-230,Myocarditis,II,NA,UNREL,Y +003-247,UTI,II,NA,UNREL,N +003-253,Hypokalemia,II,II,UNREL,N +003-255,Constipation,II,II,UNREL,N +003-264,Hypokalemia,II,II,UNREL,N +003-267,Gastritis,II,NA,UNREL,Y +003-001,Insomnia,II,II,UNREL,Y +003-005,Myocardial ischaemia,II,NA,UNREL,Y +003-010,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-011,Ventilator associated pneumonia,II,NA,UNREL,N +003-024,Arthritis,II,II,UNREL,Y +003-028,Constipation,II,II,UNREL,N +003-031,Ventilator associated pneumonia,II,NA,UNREL,N +003-032,Constipation,II,II,UNREL,N +003-037,UTI,II,NA,UNREL,N +003-040,Conjunctivitis,II,II,UNREL,N +003-042,Tracheal hemorrhage,II,II,UNREL,N +003-043,Ventilator associated pneumonia,II,NA,UNREL,N +003-047,UTI,II,NA,UNREL,N +003-048,Ventilator associated pneumonia,II,NA,UNREL,N +003-053,Aspiration pneumonia,II,NA,UNREL,N +003-056,Cardiac arrest,IV,IV,UNREL,N +003-057,Ventilator associated pneumonia,II,NA,UNREL,N +003-082,UTI,II,NA,UNREL,N +003-083,Ventilator associated pneumonia,II,NA,UNREL,N +003-090,Phlebitis,I,I,UNREL,N +003-091,Ventilator associated pneumonia,II,NA,UNREL,N +003-092,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-096,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-098,Tracheal hemorrhage,I,I,UNREL,Y +003-099,UTI,II,NA,UNREL,N +003-112,Ventilator associated pneumonia,II,NA,UNREL,N +003-115,UTI,II,NA,UNREL,N +003-116,Skin allergy,II,NA,POSREL,N +003-119,Voice alteration,I,I,UNREL,N +003-131,Hypokalemia,II,II,UNREL,N +003-133,UTI,II,NA,UNREL,N +003-137,UTI,II,NA,UNREL,N +003-139,Blood stream infection,II,NA,UNREL,N +003-146,Arthritis,II,II,UNREL,Y +003-152,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-153,Cardiac arrest,IV,IV,UNREL,N +003-154,UTI,II,NA,UNREL,N +003-161,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-163,Constipation,II,II,UNREL,N +003-171,Hypokalemia,II,II,UNREL,N +003-172,Hypokalemia,II,II,UNREL,N +003-173,Hypokalemia,II,II,UNREL,N +003-174,Hyponatremia,II,II,UNREL,N +003-176,Ventilator associated pneumonia,II,NA,UNREL,N +003-178,Necrotic wound,II,NA,UNREL,N +003-180,Hypomagnesemia,I,I,UNREL,N +003-186,Ventilator associated pneumonia,II,NA,UNREL,N +003-187,Hypokalemia,II,II,UNREL,N +003-191,Ventilator associated pneumonia,II,NA,UNREL,N +003-192,Ventilator associated pneumonia,II,NA,UNREL,N +003-201,Hypocalcemia,III,III,UNREL,N +003-202,UTI,II,NA,UNREL,N +003-203,Headache,I,I,POSREL,N +003-210,Hypokalemia,II,II,UNREL,N +003-213,Hypokalemia,II,II,UNREL,N +003-214,Hypokalemia,II,II,UNREL,N +003-217,Hypokalemia,II,II,UNREL,N +003-218,Tracheal hemorrhage,I,I,UNREL,N +003-221,Hypokalemia,II,II,UNREL,N +003-222,Hypokalemia,II,II,UNREL,N +003-227,Hypokalemia,II,II,UNREL,N +003-228,Hypokalemia,II,II,UNREL,N +003-229,Hypocalcemia,III,III,UNREL,N +003-232,Hypokalemia,III,III,UNREL,N +003-233,Hypocalcemia,II,II,UNREL,N +003-238,Hypokalemia,II,II,UNREL,N +003-247,Constipation,II,II,UNREL,N +003-249,Hematuria,II,II,UNREL,Y +003-250,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-252,Hypokalemia,II,II,UNREL,N +003-259,Subcutaneous emphysema,I,I,UNREL,N +003-263,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-264,Hypocalcemia,III,III,UNREL,N +003-268,Hypokalemia,II,II,UNREL,N +003-269,Heat stroke,NA,NA,UNREL,N +003-270,Hypokalemia,II,II,UNREL,N +003-272,Hypomagnesemia,I,I,UNREL,N +003-001,UTI,II,NA,UNREL,N +003-010,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-011,Ventilator associated pneumonia,II,NA,UNREL,N +003-013,Skin allergy,I,NA,POSREL,N +003-018,UTI,II,NA,UNREL,N +003-021,Constipation,II,II,UNREL,N +003-024,Ventilator associated pneumonia,II,NA,UNREL,N +003-025,Myocardial ischaemia,IV,NA,UNREL,N +003-026,Atrial fibrillation,II,II,UNREL,Y +003-027,Constipation,II,II,UNREL,N +003-028,Dizziness,II,II,UNREL,Y +003-032,Tracheal hemorrhage,II,II,UNREL,N +003-040,Ventilator associated pneumonia,II,NA,UNREL,N +003-042,Ventilator associated pneumonia,II,NA,UNREL,N +003-050,Failed extubation,NA,NA,UNREL,Y +003-061,Ventilator associated pneumonia,II,NA,UNREL,N +003-062,Blood stream infection,II,NA,UNREL,N +003-063,Ventilator associated pneumonia,II,NA,UNREL,N +003-068,Blood stream infection,II,NA,UNREL,N +003-072,Appendicitis,III,III,UNREL,N +003-077,UTI,II,NA,UNREL,N +003-079,UTI,II,NA,UNREL,Y +003-082,Constipation,II,II,UNREL,N +003-083,UTI,II,NA,UNREL,N +003-090,Conjunctivitis,II,II,UNREL,N +003-091,Tracheal hemorrhage,II,II,UNREL,N +003-092,Deep vein thrombosis,II,NA,POSREL,N +003-098,Nose bleed,II,II,UNREL,Y +003-107,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-112,Ventilator associated pneumonia,II,NA,UNREL,N +003-115,Voice alteration,I,I,UNREL,N +003-116,Voice alteration,I,I,UNREL,N +003-128,Hemorrhoids,II,II,UNREL,N +003-146,Arthritis,II,II,UNREL,N +003-148,Blood stream infection,II,NA,UNREL,N +003-152,Atrial fibrillation,II,II,UNREL,Y +003-154,Ventilator associated pneumonia,II,NA,UNREL,N +003-157,Blood stream infection,II,NA,UNREL,N +003-161,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-164,Hypokalemia,II,II,UNREL,N +003-168,Blood stream infection,II,NA,UNREL,N +003-169,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-171,UTI,II,NA,UNREL,N +003-174,Hypocalcemia,III,III,UNREL,N +003-176,Hypocalcemia,III,III,UNREL,N +003-177,Hyponatremia,II,II,UNREL,N +003-178,Myocarditis,II,NA,UNREL,Y +003-182,Hypokalemia,II,II,UNREL,N +003-186,Hypokalemia,II,II,UNREL,N +003-187,Hypotension,II,II,UNREL,N +003-191,Hypokalemia,II,II,UNREL,N +003-192,Hyponatremia,II,II,UNREL,N +003-198,Hyponatremia,II,II,UNREL,N +003-201,Ventilator associated pneumonia,II,NA,UNREL,N +003-202,Blood stream infection,II,NA,UNREL,N +003-204,Ventilator associated pneumonia,II,NA,UNREL,N +003-208,Acute renal failure,II,NA,UNREL,N +003-210,Wound bleed,II,NA,UNREL,N +003-213,Hypocalcemia,III,III,UNREL,N +003-214,Hypocalcemia,III,III,UNREL,N +003-217,Hypomagnesemia,I,I,UNREL,N +003-218,Nose bleed,II,II,UNREL,N +003-221,Nose bleed,II,II,UNREL,N +003-222,UTI,II,NA,UNREL,N +003-223,Hypocalcemia,III,III,UNREL,N +003-228,Hyponatremia,II,II,UNREL,N +003-229,Hypomagnesemia,II,II,UNREL,N +003-230,Hypokalemia,II,II,UNREL,N +003-233,Hypokalemia,II,II,UNREL,N +003-237,Hypokalemia,II,II,UNREL,N +003-238,UTI,II,NA,UNREL,N +003-246,Hypokalemia,II,II,UNREL,N +003-248,Hematuria,II,II,UNREL,N +003-250,Ventilator associated pneumonia,II,NA,UNREL,N +003-252,Hypocalcemia,II,II,UNREL,N +003-253,Skin allergy,II,NA,POSREL,N +003-256,Hypokalemia,II,II,UNREL,N +003-257,Ventilator associated pneumonia,II,NA,UNREL,N +003-259,Constipation,II,II,UNREL,N +003-262,Hypocalcemia,II,II,UNREL,N +003-263,Aspiration pneumonia,II,NA,UNREL,N +003-264,Hyponatremia,II,II,UNREL,N +003-268,Ventilator associated pneumonia,II,NA,UNREL,N +003-269,Hypocalcemia,II,II,UNREL,N +003-270,Hypocalcemia,III,III,UNREL,N +003-271,Hypokalemia,II,II,UNREL,N +003-011,UTI,II,NA,UNREL,N +003-018,arthralgia,II,II,UNREL,Y +003-021,UTI,II,NA,UNREL,N +003-026,Anemia,III,III,UNREL,Y +003-032,Deep vein thrombosis,III,NA,POSREL,N +003-037,Bruising,I,I,UNREL,Y +003-040,UTI,II,NA,UNREL,N +003-043,Otitis,II,NA,UNREL,Y +003-050,Tracheal hemorrhage,III,III,UNREL,N +003-057,Pressure ulcer,II,NA,UNREL,N +003-061,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-062,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-063,Aspiration pneumonia,II,NA,UNREL,N +003-068,arthralgia,II,II,UNREL,Y +003-077,Phlebitis,I,I,UNREL,N +003-082,Hyponatremia,II,II,UNREL,N +003-090,Tracheal stenosis,III,III,UNREL,N +003-097,Ventilator associated pneumonia,II,NA,UNREL,N +003-112,Conjunctivitis,II,II,UNREL,Y +003-115,Skin allergy,II,NA,REL,N +003-128,Upper respiratory infection,II,II,UNREL,N +003-153,Ventilator associated pneumonia,II,NA,UNREL,N +003-154,Blood stream infection,II,NA,UNREL,N +003-157,Ventilator associated pneumonia,II,NA,UNREL,N +003-164,Ventilator associated pneumonia,II,NA,UNREL,N +003-168,Ventilator associated pneumonia,II,NA,UNREL,N +003-169,Ventilator associated pneumonia,II,NA,UNREL,N +003-171,Recurrent tetanus,III,III,UNREL,N +003-174,Gastritis,II,II,UNREL,N +003-176,Constipation,II,II,UNREL,N +003-177,Hypocalcemia,III,III,UNREL,N +003-178,Wound bleed,II,II,UNREL,N +003-180,Nose bleed,II,II,UNREL,N +003-186,Hypokalemia,II,II,UNREL,N +003-191,Hypomagnesemia,I,I,UNREL,N +003-192,Hypocalcemia,III,III,UNREL,N +003-198,Hypokalemia,II,II,UNREL,N +003-202,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-204,Acute renal failure,II,NA,UNREL,N +003-217,Hyponatremia,II,II,UNREL,N +003-221,Hypocalcemia,III,III,UNREL,N +003-223,Hypokalemia,II,II,UNREL,N +003-227,UTI,II,NA,UNREL,N +003-228,Upper respiratory infection,II,II,UNREL,N +003-229,Gastritis,II,II,UNREL,N +003-230,Hyponatremia,II,II,UNREL,N +003-232,Hypocalcemia,II,II,UNREL,N +003-233,Upper respiratory infection,II,II,UNREL,N +003-237,Ventilator associated pneumonia,II,NA,UNREL,N +003-238,Ventilator associated pneumonia,II,NA,UNREL,N +003-244,Hypokalemia,II,II,UNREL,N +003-246,Hyponatremia,I,I,UNREL,N +003-248,Ventilator associated pneumonia,II,NA,UNREL,N +003-249,Hypokalemia,II,II,UNREL,N +003-250,UTI,II,NA,UNREL,N +003-252,Constipation,II,II,UNREL,N +003-253,Blood stream infection,II,NA,UNREL,N +003-256,Ventilator associated pneumonia,II,NA,UNREL,N +003-257,Hypokalemia,II,II,UNREL,N +003-259,Hypocalcemia,III,III,UNREL,N +003-262,Hypokalemia,II,II,UNREL,N +003-266,Gastrointestinal disorder,I,I,UNREL,Y +003-268,Skin allergy,II,NA,POSREL,N +003-269,Blood stream infection,II,NA,UNREL,N +003-270,UTI,II,NA,UNREL,N +003-272,Hypocalcemia,III,III,UNREL,N +003-001,Urinary retention,II,II,POSREL,Y +003-009,UTI,II,NA,UNREL,N +003-010,Phlebitis,I,I,UNREL,N +003-021,Hematuria,II,II,UNREL,N +003-024,Constipation,II,II,UNREL,N +003-026,Ventilator associated pneumonia,II,NA,UNREL,N +003-027,Chronic venous insufficiency,II,NA,UNREL,Y +003-032,Ventilator associated pneumonia,II,NA,UNREL,N +003-037,Hyponatremia,III,III,UNREL,Y +003-038,Aspiration pneumonia,II,NA,UNREL,N +003-043,UTI,II,NA,UNREL,N +003-050,Anemia,II,II,UNREL,Y +003-057,Ventilator associated pneumonia,II,NA,UNREL,N +003-063,Anemia,III,III,UNREL,Y +003-082,Hypokalemia,II,II,UNREL,N +003-097,UTI,II,NA,UNREL,N +003-153,UTI,II,NA,UNREL,N +003-154,Ventilator associated pneumonia,II,NA,UNREL,N +003-164,Pneumothorax,II,II,UNREL,N +003-177,Ventilator associated pneumonia,II,NA,UNREL,N +003-180,Tracheal hemorrhage,II,II,UNREL,N +003-182,Wound infection,II,NA,UNREL,N +003-191,Tracheal hemorrhage,II,II,UNREL,N +003-192,Tracheal hemorrhage,II,II,UNREL,N +003-198,Hypocalcemia,III,III,UNREL,N +003-202,Tracheal hemorrhage,I,I,UNREL,N +003-204,Pressure ulcer,II,NA,UNREL,N +003-208,Hypokalemia,II,II,UNREL,Y +003-210,Hyponatremia,II,II,UNREL,N +003-218,Hyperpyrexia,NA,NA,UNREL,N +003-221,Ventilator associated pneumonia,II,NA,UNREL,N +003-227,Hypocalcemia,II,II,UNREL,N +003-228,Constipation,II,II,UNREL,N +003-230,Hypocalcemia,II,II,UNREL,N +003-232,Hyponatremia,I,I,UNREL,N +003-237,Aspiration pneumonia,II,NA,UNREL,N +003-238,Hypocalcemia,II,II,UNREL,N +003-244,Hyponatremia,I,I,UNREL,N +003-246,Hypomagnesemia,I,I,UNREL,N +003-248,UTI,II,NA,UNREL,N +003-249,Hypocalcemia,III,III,UNREL,N +003-252,Skin allergy,I,NA,POSREL,N +003-253,Constipation,II,II,UNREL,N +003-256,Constipation,II,II,UNREL,N +003-257,Hyponatremia,I,I,UNREL,N +003-259,Ventilator associated pneumonia,II,NA,UNREL,N +003-262,Blood stream infection,II,NA,UNREL,N +003-263,Hyponatremia,II,II,UNREL,N +003-264,Ventilator associated pneumonia,II,NA,UNREL,N +003-266,Constipation,II,II,UNREL,N +003-268,Hyponatremia,II,II,UNREL,N +003-269,Hypokalemia,II,II,UNREL,N +003-270,Ventilator associated pneumonia,II,NA,UNREL,N +003-272,Hyponatremia,I,I,UNREL,N +003-009,UTI,II,NA,UNREL,N +003-010,UTI,II,NA,UNREL,N +003-021,Tracheal hemorrhage,II,II,UNREL,N +003-024,arthralgia,II,II,UNREL,Y +003-025,Anemia,III,III,UNREL,N +003-037,Tracheal hemorrhage,II,II,UNREL,N +003-038,UTI,II,NA,UNREL,N +003-043,Blood stream infection,II,NA,UNREL,Y +003-050,Ventilator associated pneumonia,II,NA,UNREL,N +003-057,UTI,II,NA,UNREL,N +003-153,Blood stream infection,II,NA,UNREL,N +003-154,Acute renal failure,III,NA,UNREL,N +003-164,Tracheal hemorrhage,I,I,UNREL,N +003-177,Acute renal failure,II,NA,UNREL,Y +003-178,Hypocalcemia,III,III,UNREL,N +003-180,Arterial thromboembolism,IV,IV,REL,N +003-182,Hypocalcemia,III,III,UNREL,N +003-198,Anemia,III,III,UNREL,Y +003-202,Hypokalemia,II,II,UNREL,N +003-208,Hypernatremia,I,I,UNREL,Y +003-210,Hypocalcemia,III,III,UNREL,N +003-218,Creatinine increase,III,III,UNREL,Y +003-221,UTI,II,NA,UNREL,N +003-227,Hyponatremia,I,I,UNREL,N +003-229,Constipation,II,II,UNREL,N +003-230,Ventilator associated pneumonia,II,NA,UNREL,N +003-232,Ventilator associated pneumonia,II,NA,UNREL,N +003-237,Hypocalcemia,II,II,UNREL,N +003-244,Dizziness,II,II,UNREL,N +003-246,Hypocalcemia,III,III,UNREL,N +003-248,Hypertension,II,II,UNREL,N +003-249,Ventilator associated pneumonia,II,NA,UNREL,N +003-250,Hypokalemia,II,II,UNREL,N +003-256,Conjunctivitis,II,II,UNREL,N +003-257,Constipation,II,II,UNREL,N +003-262,Nose bleed,I,I,UNREL,N +003-263,Hypocalcemia,III,III,UNREL,N +003-264,Back pain,II,II,UNREL,Y +003-266,Hypokalemia,II,II,UNREL,N +003-269,Skin allergy,II,NA,UNREL,N +003-270,Hyponatremia,II,II,UNREL,N +003-272,Constipation,II,II,UNREL,N +003-009,Dysphagia,IV,IV,UNREL,Y +003-010,UTI,II,NA,UNREL,N +003-024,Cerebral hemorrhage,II,NA,UNREL,Y +003-026,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-038,Cholangitis,NA,NA,UNREL,Y +003-043,Anemia,III,III,UNREL,N +003-057,Ventilator associated pneumonia,II,NA,UNREL,N +003-153,Anemia,III,III,UNREL,Y +003-154,Ventilator associated pneumonia,III,NA,UNREL,Y +003-177,Ventilator associated pneumonia,IV,IV,UNREL,Y +003-178,Deep vein thrombosis,III,III,POSREL,N +003-198,Hypomagnesemia,I,I,UNREL,N +003-204,Hypernatremia,I,I,UNREL,N +003-208,Blood stream infection,II,NA,UNREL,N +003-210,Oral infection,II,II,UNREL,N +003-218,Arterial thromboembolism,IV,IV,POSREL,N +003-221,Blood stream infection,II,NA,UNREL,N +003-227,Constipation,II,II,UNREL,N +003-230,Ventilator associated pneumonia,II,NA,UNREL,N +003-232,Pleural abscess,NA,NA,UNREL,Y +003-237,Hypomagnesemia,I,I,UNREL,N +003-246,Ventilator associated pneumonia,II,NA,UNREL,N +003-248,Hypokalemia,II,II,UNREL,N +003-249,UTI,II,NA,UNREL,N +003-250,Constipation,II,II,UNREL,N +003-257,Dizziness,II,II,UNREL,N +003-262,Oral infection,II,II,UNREL,Y +003-263,Hypokalemia,III,III,UNREL,N +003-266,Hyponatremia,II,II,UNREL,N +003-269,Hyponatremia,I,I,UNREL,N +003-010,Pyloric stenosis,III,III,UNREL,Y +003-025,Anemia,III,III,UNREL,N +003-026,UTI,II,NA,UNREL,N +003-043,UTI,II,NA,UNREL,N +003-107,Cardiac arrest,IV,IV,UNREL,N +003-153,Hyponatremia,III,III,UNREL,N +003-178,Wound infection,II,NA,UNREL,N +003-204,Hypokalemia,II,II,UNREL,N +003-208,Anemia,III,III,UNREL,Y +003-221,Upper respiratory infection,II,II,UNREL,N +003-230,Sinus bradycardia,I,I,UNREL,Y +003-237,Hyponatremia,III,III,UNREL,N +003-246,Pruritus,II,II,POSREL,N +003-248,Skin allergy,II,NA,POSREL,N +003-249,Urinary retention,II,II,UNREL,Y +003-262,Hyponatremia,II,II,UNREL,N +003-263,Ventilator associated pneumonia,II,NA,UNREL,N +003-269,Constipation,II,II,UNREL,N +003-271,Ventilator associated pneumonia,II,NA,UNREL,N +003-025,Anemia,III,III,UNREL,N +003-037,Aspiration pneumonia,II,NA,UNREL,N +003-043,Pressure ulcer,III,NA,UNREL,N +003-153,Hypokalemia,II,II,UNREL,N +003-164,Conjunctivitis,II,II,UNREL,Y +003-178,Blood stream infection,II,NA,UNREL,N +003-204,Hypocalcemia,III,III,UNREL,N +003-208,Hypotension,III,III,UNREL,N +003-230,Dizziness,II,II,UNREL,Y +003-246,Myalgia,II,II,UNREL,N +003-248,Constipation,II,II,UNREL,N +003-262,Constipation,II,II,UNREL,N +003-263,Deep vein thrombosis,III,NA,POSREL,N +003-025,UTI,II,NA,UNREL,N +003-037,Adrenal insufficiency,II,II,UNREL,Y +003-153,Upper gastrointestinal hemorrhage,II,II,UNREL,N +003-178,Tracheal hemorrhage,II,II,UNREL,N +003-204,Rhabdomyolysis,II,II,UNREL,N +003-208,Platelet count decreased,III,III,UNREL,N +003-230,Constipation,II,II,UNREL,N +003-262,Ventilator associated pneumonia,II,NA,UNREL,N +003-263,"Low weight, muscle wasting",II,NA,UNREL,Y +003-269,UTI,II,NA,UNREL,N +003-025,Platelet count decreased,III,III,UNREL,N +003-153,Pressure ulcer,II,II,UNREL,N +003-204,Anemia,III,III,UNREL,Y +003-208,Ventilator associated pneumonia,II,NA,UNREL,N +003-262,"Low weight, muscle wasting",II,NA,UNREL,Y +003-269,"Low weight, muscle wasting",II,NA,UNREL,N +003-271,Postoperative hemorrhage,II,II,UNREL,N +003-025,Hypokalemia,II,II,UNREL,N +003-204,UTI,II,NA,UNREL,N +003-208,Sinus bradycardia,II,II,UNREL,N +003-262,Failed extubation,III,III,UNREL,N +003-271,Constipation,II,II,UNREL,N +003-025,Ventilator associated pneumonia,II,NA,UNREL,N +003-208,Adrenal insufficiency,II,II,UNREL,Y +003-271,Hypotension,IV,IV,UNREL,N +003-025,Hypotension,III,III,UNREL,N +003-208,Pressure ulcer,II,NA,UNREL,N +003-269,Ventilator associated pneumonia,II,NA,UNREL,N +003-025,Hypotension,III,III,UNREL,N +003-208,Hypoalbuminemia,III,III,UNREL,NA +003-269,Ventilator associated pneumonia,II,NA,UNREL,N +003-025,UTI,II,NA,UNREL,N +003-208,Constipation,II,II,UNREL,N +003-269,Ventilator associated pneumonia,II,NA,UNREL,N +003-025,Adrenal insufficiency,II,II,UNREL,N +003-208,Cerebral infarction,IV,IV,POSREL,Y +003-269,Hypotension,IV,IV,POSREL,N diff --git a/inst/extdata/baseline_data.csv b/inst/extdata/baseline_data.csv new file mode 100644 index 0000000..33c3ddb --- /dev/null +++ b/inst/extdata/baseline_data.csv @@ -0,0 +1,272 @@ +"usubjid","age","sex","bmi","source","tetanus","icudays","outcome","hypertension","myocardialinfart","angina","perivascular","chronicpul","connectivetissue","mildliver","hemiplegia","diawithchronic","severeliver","aids","cardiacfailureiii","cerebrovascular","severeresp","pepticulcer","diabetes","severekidney","malignancy","tumour","dementia","renalfailure","electivesurgery","emergencysurgery","timetoadm","incubationperiod","incuperiodonset","wound","diffbreath","ablettscore","asa","maxtemp","resp","fio2","spo2","pao2","ph","plt","wbc","hct","maxhr","minhr","maxsbp","worstdbp","worstsbp","vaso","na","k","creat","apacheii","sofa","tss","Arm","pain_score" +"003-001",78,"F",17.7777777777778,2,"Y",7,3,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,NA,48,"Superficial/other","N","II",2,37,20,21,98,NA,NA,264,6.58,39.6,104,84,200,110,200,"N",136,3.5,60,9,0,8,"Intrathecal treatment",2 +"003-002",60,"F",22.2222222222222,2,"Y",12,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,NA,96,"Superficial/other","N","II",1,37,22,21,98,NA,NA,237,7.25,37.6,92,72,160,90,160,"N",143,3.46,53,8,0,-2,"Sham procedure",1 +"003-003",48,"M",25.8166302126286,2,"Y",8,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,12,36,"Superficial/other","N","II",1,37.1,20,21,94,NA,NA,226,7.81,48.3,88,64,150,100,150,"N",143,3.92,79,5,0,4,"Sham procedure",4 +"003-004",16,"M",19.8140527358634,2,"Y",13,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,5,24,"Superficial/other","Y","II",1,38,26,21,96,NA,NA,308,12.8,40.7,108,84,140,80,140,"N",139,3.56,65,1,0,2,"Sham procedure",4 +"003-005",63,"F",18.7304890738814,2,"Y",22,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,20,24,"Superficial/other","N","II",1,37.5,20,21,95,NA,NA,369,13,39,100,94,110,70,110,"N",140,3,44,6,0,0,"Intrathecal treatment",4 +"003-006",40,"M",20.8116545265349,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,7,NA,"Superficial/other","N","I",1,37,20,21,98,NA,NA,314,8.84,46,92,72,160,90,160,"N",136,3.92,58,3,0,-1,"Intrathecal treatment",3 +"003-007",61,"F",19.53125,2,"Y",18,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,9,48,"Superficial/other","N","II",1,37.6,22,21,96,NA,NA,276,5.37,37,92,76,150,90,150,"N",138,3.83,58,5,0,-1,"Sham procedure",2 +"003-008",71,"M",18.4240362811791,1,"Y",6,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N",4,30,NA,"Deep","N","I",1,37,24,21,96,NA,NA,305,7.78,46,92,80,160,80,120,"N",128,3.32,111,9,1,11,"Intrathecal treatment",2 +"003-009",82,"M",21.3333333333333,2,"Y",75,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,4,72,"Superficial/other","N","I",1,37.5,20,50,85,98,7.4,294,14.7,37,108,84,140,90,140,"N",136,3.85,67,6,2,8,"Intrathecal treatment",3 +"003-010",45,"M",24.2214532871972,2,"Y",23,3,NA,NA,NA,NA,NA,NA,NA,NA,NA,"N","N","N","N","N","N","N","N","N","N","N","N","N","N",1,9,24,"Deep","N","III",2,37.5,24,21,94,NA,7.4,157,9.95,34.5,109,104,120,80,120,"N",134,3.74,50,4,0,11,"Intrathecal treatment",5 +"003-011",84,"M",19.1000918273646,1,"Y",37,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,NA,72,"Superficial/other","N","II",1,37.6,28,21,94,NA,NA,175,7.54,35,64,48,140,80,140,"N",148,2.27,73,13,0,7,"Sham procedure",4 +"003-012",47,"M",21.2585034013605,1,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,NA,NA,"Superficial/other","N","I",1,37,20,21,96,NA,NA,138,7.91,43.6,72,56,130,80,130,"N",140,3.56,85,2,1,-6,"Sham procedure",3 +"003-013",65,"M",19.53125,2,"Y",17,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,14,72,"Superficial/other","N","II",1,37.5,22,21,97,NA,NA,276,8.64,42.3,84,76,140,70,130,"N",136,3.68,83,5,0,-3,"Sham procedure",3 +"003-014",44,"M",20.5761316872428,2,"Y",10,4,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,NA,"N","N","N",5,5,96,"Superficial/other","Y","II",1,37.6,26,21,97,NA,NA,309,11.5,43,100,84,110,60,100,"N",140,3.13,65,2,0,-1,"Intrathecal treatment",1 +"003-015",46,"M",19.1515847936417,2,"Y",12,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,2,24,"Superficial/other","N","I",1,37.5,20,21,96,NA,NA,249,6.53,47.4,88,76,140,80,140,"N",141,3.56,67,3,0,-3,"Sham procedure",5 +"003-016",41,"M",21.8724228190326,2,"Y",15,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,8,24,"Superficial/other","N","II",1,37.5,22,21,94,NA,NA,216,6.72,44,92,72,130,80,120,"N",135,3.45,86,1,0,0,"Intrathecal treatment",5 +"003-017",55,"M",20.7612456747405,2,"Y",22,4,"N","N","N","N","N","N","Y","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,NA,24,"Superficial/other","N","II",2,37.6,26,21,95,NA,NA,217,9.36,47,88,64,160,90,160,"N",155,2.18,110,13,1,2,"Sham procedure",1 +"003-018",33,"F",22.0603537981269,2,"Y",28,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,11,72,"Superficial/other","N","I",1,38,20,21,97,NA,NA,375,9.92,39,92,84,130,80,110,"N",137,4.79,55,0,0,-5,"Sham procedure",1 +"003-019",60,"F",23.4375,2,"Y",10,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,NA,96,"Superficial/other","N","II",2,37.8,22,21,96,NA,NA,255,8.63,39.4,72,64,150,110,140,"N",139,3.74,66,5,0,1,"Sham procedure",1 +"003-020",41,"F",24.5577523413111,1,"Y",5,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,15,NA,"Superficial/other","N","I",2,37.6,24,21,96,NA,NA,334,7.93,44.7,88,68,140,100,140,"N",139,3.39,53,5,0,-1,"Sham procedure",5 +"003-021",27,"M",23.4375,2,"Y",17,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,4,24,"Superficial/other","N","II",1,37.6,22,21,97,NA,NA,340,12.7,45.5,90,84,130,80,120,"N",142,3.37,87,1,0,-5,"Intrathecal treatment",5 +"003-022",23,"M",18.7304890738814,2,"Y",17,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,30,48,"Superficial/other","Y","III",1,38,22,21,97,NA,NA,302,15.3,39.3,100,92,130,80,130,"N",143,3.03,74,2,0,-1,"Intrathecal treatment",4 +"003-023",53,"M",24.3374797187669,1,"Y",10,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,14,NA,"Superficial/other","N","I",1,37.4,26,21,94,NA,NA,266,7.94,47,100,88,160,100,160,"N",136,3.81,90,6,0,4,"Intrathecal treatment",2 +"003-024",42,"M",21.875,2,"Y",34,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,24,"Superficial/other","N","II",1,37.4,22,21,96,NA,NA,349,13.9,42,106,96,130,80,130,"N",141,3.61,55,0,0,1,"Intrathecal treatment",2 +"003-025",63,"F",16.8474687705457,2,"Y",NA,4,"N","N","N","Y","Y","N","N","N","Y","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",1,10,24,"Superficial/other","N","II",3,37.6,24,21,94,NA,NA,358,19.9,32,92,84,160,90,160,"N",130,3.52,37,13,0,9,"Sham procedure",4 +"003-026",80,"F",20,2,"Y",30,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",8,NA,72,"Superficial/other","N","II",2,38.2,24,21,96,NA,NA,212,10.05,34.4,96,80,160,90,160,"N",139,3.35,63,9,0,6,"Sham procedure",2 +"003-027",64,"F",23.9360623149012,1,"Y",15,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,14,NA,"Superficial/other","N","I",2,37.5,24,21,96,NA,NA,221,10.79,40,96,76,180,100,180,"N",137.8,3.49,44,8,0,2,"Intrathecal treatment",1 +"003-028",67,"F",20,2,"Y",19,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","Y","N",5,NA,96,"Superficial/other","N","I",2,37.4,24,21,96,NA,NA,174,7.16,36.9,80,72,140,90,140,"N",139,2.99,61,12,0,0,"Intrathecal treatment",3 +"003-029",33,"M",20.8116545265349,1,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,7,NA,"Superficial/other","N","I",1,37,26,21,97,NA,NA,230,14.4,46,84,76,120,70,120,"N",139,3.95,130,2,1,-5,"Intrathecal treatment",5 +"003-030",46,"M",23.1833910034602,1,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,14,NA,"Superficial/other","N","I",1,37.4,22,21,97,NA,NA,259,7.88,42.6,88,80,130,80,130,"N",140,3.55,89,2,0,-5,"Sham procedure",3 +"003-031",50,"M",21.484375,2,"Y",27,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",2,6,24,"Superficial/other","N","II",1,37.4,22,21,94,NA,NA,279,10.7,46,96,80,160,110,160,"N",140,3.27,62,11,0,4,"Intrathecal treatment",1 +"003-032",63,"M",23.6614386154678,2,"Y",21,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,7,96,"Superficial/other","N","II",2,37,24,21,97,NA,NA,148,4.61,37.9,68,64,130,80,130,"N",145,3.28,111,6,2,-2,"Sham procedure",2 +"003-033",52,"M",15.625,2,"Y",8,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,30,24,"Superficial/other","N","II",1,37,20,21,97,NA,NA,256,10.9,40.5,84,84,130,80,130,"N",140,3.52,79,2,0,-5,"Intrathecal treatment",4 +"003-034",42,"M",20.8116545265349,1,"Y",10,4,"N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","Y",3,NA,24,"Superficial/other","N","II",2,37.6,24,21,98,NA,NA,326,6.19,26.5,100,88,150,100,150,"N",141,2.98,46,18,0,2,"Sham procedure",4 +"003-035",57,"F",18.1786703601108,1,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",10,NA,72,"Superficial/other","N","II",1,37.6,20,21,97,NA,NA,339,6.18,39,88,84,150,100,150,"N",136,4.64,74,5,0,-2,"Intrathecal treatment",1 +"003-036",55,"M",18.6268226245794,1,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,30,48,"Superficial/other","N","II",1,37.6,22,21,97,NA,NA,309,14.15,39.8,88,76,130,80,130,"N",137,3.78,77,3,0,-5,"Sham procedure",5 +"003-037",61,"F",24.9739854318418,2,"Y",28,4,"Y","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","Y","N","N","N","N","N","N","N",5,NA,48,"Superficial/other","Y","III",2,38,22,25,93,NA,NA,142,9.26,36.4,100,88,140,80,140,"N",139,3.07,53,6,1,4,"Intrathecal treatment",1 +"003-038",88,"F",20.4081632653061,2,"Y",26,3,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,NA,72,"Superficial/other","N","II",2,37,24,21,96,NA,NA,217,9.78,38,100,76,180,100,180,"N",140,4.33,60,8,0,12,"Sham procedure",4 +"003-039",54,"M",25.3443526170799,2,"Y",12,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,30,NA,"Superficial/other","N","I",1,37,22,21,96,NA,NA,255,16.5,42,108,60,190,110,190,"N",140,3.62,90,6,0,0,"Sham procedure",3 +"003-040",34,"M",25.9701155481953,1,"Y",23,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,48,"Superficial/other","N","II",1,37,20,21,99,NA,NA,242,7.9,44,104,88,150,80,150,"N",133,3.42,77,1,0,5,"Sham procedure",4 +"003-041",55,"M",25.7116620752984,2,"Y",8,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,5,NA,"Superficial/other","N","I",2,37,24,21,98,NA,NA,322,9.43,38,92,88,130,80,130,"N",141,3.74,109,3,0,-2,"Intrathecal treatment",5 +"003-042",27,"M",21.484375,2,"Y",27,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",1,4,24,"Superficial/other","N","II",2,39,26,40,97,101,7.36,339,16,43,148,88,130,80,130,"N",143,3.12,69,9,1,11,"Intrathecal treatment",5 +"003-043",68,"F",20,2,"Y",43,3,"N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","Y","Y","N","N","N","N","N","N",2,8,24,"Superficial/other","N","II",2,37.6,24,21,80,NA,NA,523,11.4,35,124,104,140,80,140,"N",138,4.28,68,12,0,9,"Sham procedure",4 +"003-044",41,"M",18.9619274241523,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",15,NA,NA,"Superficial/other","N","I",1,38,20,21,98,NA,NA,385,7.16,45,84,80,140,80,140,"N",137,3.72,83,0,0,-4,"Intrathecal treatment",3 +"003-045",49,"F",18.7304890738814,2,"Y",11,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",8,NA,24,"Superficial/other","N","II",1,37.2,20,21,97,NA,NA,361,8.57,38,92,88,110,70,110,"N",143,3.45,56,3,0,-6,"Intrathecal treatment",3 +"003-046",61,"M",22.8373702422145,2,"Y",11,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,24,"Superficial/other","N","II",1,37.5,22,21,97,NA,NA,306,5.98,44,96,84,160,90,140,"N",140,4.62,75,3,0,4,"Intrathecal treatment",2 +"003-047",43,"M",22.0931700542861,1,"Y",31,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",2,5,72,"Superficial/other","N","I",1,37.2,22,21,97,NA,NA,251,6.84,41,86,68,140,80,120,"N",138,3.58,58,5,0,2,"Sham procedure",5 +"003-048",56,"M",22.038567493113,2,"Y",15,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,10,72,"Superficial/other","N","II",1,37.4,22,21,97,NA,NA,351,10.8,38,100,88,140,80,120,"N",144,3.5,80,3,0,-3,"Intrathecal treatment",5 +"003-049",64,"M",19.921875,2,"Y",12,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,NA,120,"Superficial/other","N","II",2,37.4,30,21,91,NA,NA,221,6.93,36,100,64,140,90,140,"N",142,3.74,77,4,0,-1,"Intrathecal treatment",1 +"003-050",59,"M",20.8888888888889,2,"Y",33,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,10,24,"Superficial/other","Y","III",2,37.6,25,40,92,168,7.43,124,6.65,25.3,124,96,180,90,180,"N",138,3.67,65,10,3,15,"Intrathecal treatment",3 +"003-051",63,"M",16.8061342389972,2,"Y",16,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,30,48,"Superficial/other","N","II",1,37.5,20,21,97,NA,NA,244,7.44,40,80,72,140,80,130,"N",143,3.95,84,3,0,-3,"Sham procedure",2 +"003-052",65,"F",23.309053069719,1,"Y",7,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",1,15,24,"Superficial/other","N","II",1,37.3,20,21,97,NA,NA,337,6.58,39,80,72,150,70,120,"N",139,3.85,61,5,0,4,"Sham procedure",3 +"003-053",38,"M",20.0288415318058,1,"Y",23,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,23,"Superficial/other","Y","III",2,37.5,20,21,95,NA,NA,210,9.15,35.3,120,68,160,90,160,"N",140,3.59,47,6,0,15,"Sham procedure",4 +"003-054",73,"M",23.4375,2,"Y",22,4,"Y","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N",3,NA,24,"Superficial/other","N","II",3,38.5,22,36,97,NA,NA,351,13.48,45.9,104,86,170,80,170,"N",138,3.65,112,8,2,10,"Sham procedure",2 +"003-055",57,"F",21.3333333333333,2,"Y",19,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",3,30,72,"Superficial/other","N","II",2,38.4,28,21,92,NA,NA,402,19.16,31.5,108,80,170,90,170,"N",139,4.25,80,7,0,3,"Intrathecal treatment",5 +"003-056",86,"F",22.2222222222222,2,"Y",1,2,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",12,10,120,"Superficial/other","Y","III",2,39,24,40,80,NA,NA,147,8.98,38,128,80,136,60,80,"Y",129,3.63,90,15,7,21,"Sham procedure",3 +"003-057",88,"F",20.703125,2,"Y",37,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,8,48,"Superficial/other","N","II",2,38,32,21,92,NA,NA,189,8.68,42,128,84,190,110,190,"N",144,2.62,101,14,0,16,"Intrathecal treatment",3 +"003-058",40,"M",18.732782369146,2,"Y",2,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,10,NA,"Superficial/other","N","I",1,37.5,20,21,97,NA,NA,313,15.8,41,88,80,130,90,130,"N",NA,NA,84,1,0,-5,"Sham procedure",2 +"003-059",23,"M",20.7756232686981,2,"Y",7,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,7,72,"Superficial/other","N","II",1,37.6,22,21,97,NA,NA,301,11.9,44,88,80,120,70,110,"N",143,3.54,106,0,0,-5,"Sham procedure",2 +"003-060",48,"M",21.6333153055706,1,"Y",3,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,7,NA,"Superficial/other","N","I",1,37.5,20,21,97,NA,NA,276,8.99,42,88,84,110,70,100,"N",144,3.78,88,2,0,-5,"Sham procedure",4 +"003-061",86,"M",20.4152249134948,2,"Y",24,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,NA,48,"Superficial/other","N","II",2,37.4,22,21,97,NA,NA,244,7.94,38,88,80,150,90,150,"N",138,4.07,100,8,0,12,"Sham procedure",2 +"003-062",61,"M",20.7612456747405,2,"Y",24,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,21,48,"Superficial/other","N","II",2,37.4,22,21,92,NA,NA,137,8.2,44,160,88,210,110,210,"N",145,3.44,89,10,1,6,"Intrathecal treatment",1 +"003-063",50,"M",20.2020202020202,2,"Y",23,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,24,"Superficial/other","N","II",1,37.6,18,21,96,NA,NA,243,9.83,35,120,104,120,70,120,"N",137,4.03,108,4,0,4,"Sham procedure",4 +"003-064",61,"M",20.5498866213152,2,"Y",9,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",2,8,24,"Superficial/other","N","I",3,38.2,22,21,93,NA,NA,234,10.4,35,100,80,140,80,140,"N",138,4.36,90,3,0,7,"Intrathecal treatment",1 +"003-065",77,"M",23.1246703720232,2,"Y",19,4,"Y","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N",6,NA,48,"Superficial/other","N","II",2,37.5,25,21,90,NA,NA,185,7.13,42,108,100,150,70,150,"N",138,3.14,82,8,0,7,"Sham procedure",5 +"003-066",61,"F",18.6666666666667,2,"Y",5,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,11,72,"Superficial/other","N","II",2,38.5,20,21,98,NA,NA,289,5.7,36,100,68,190,70,120,"N",139,2.92,84,6,0,2,"Intrathecal treatment",2 +"003-067",39,"M",24.609375,2,"Y",16,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,NA,48,"Superficial/other","N","II",1,38,20,21,95,NA,NA,253,10.2,39.1,86,68,120,60,100,"N",142,3.35,86,1,0,-5,"Intrathecal treatment",5 +"003-068",48,"F",22.6666666666667,1,"Y",22,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,NA,24,"Superficial/other","N","II",2,39,22,21,93,NA,NA,319,8.77,40,108,70,150,90,150,"N",142,3.23,79,8,0,12,"Intrathecal treatment",2 +"003-069",44,"M",21.484375,2,"Y",6,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",1,NA,24,"Superficial/other","N","II",1,37.4,18,21,97,NA,NA,162,7.69,41,64,54,140,70,140,"N",138,3.71,90,2,0,2,"Intrathecal treatment",2 +"003-070",20,"M",22.65625,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,9,96,"Superficial/other","N","II",1,38,18,21,97,NA,NA,286,10.6,39,88,52,110,60,90,"N",139,3.43,75,1,0,-5,"Sham procedure",3 +"003-071",66,"F",20.4444444444444,1,"Y",6,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,NA,72,"Superficial/other","N","II",2,37.6,24,21,96,NA,NA,344,11,37,100,92,110,60,110,"N",138,3.37,74,6,0,-3,"Intrathecal treatment",2 +"003-072",23,"M",23.7386621315193,2,"Y",23,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N",2,14,24,"Superficial/other","N","II",2,37.2,20,21,98,NA,NA,240,11.2,44.1,94,92,120,70,120,"N",140,4.01,97,5,0,3,"Sham procedure",3 +"003-073",37,"M",21.4535737137265,2,"Y",8,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,15,144,"Superficial/other","N","I",1,37,22,21,97,NA,NA,266,6.46,47,84,68,140,90,140,"N",138,3.43,79,2,0,-3,"Sham procedure",3 +"003-074",51,"F",21.6412742382271,2,"Y",8,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,NA,24,"Superficial/other","N","II",2,37.4,20,21,97,NA,NA,335,14.6,46,80,76,160,90,160,"N",141,3.52,77,5,0,7,"Intrathecal treatment",1 +"003-075",60,"M",20.7612456747405,2,"Y",9,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,14,92,"Superficial/other","N","III",1,37.4,22,21,95,NA,NA,225,9.72,46,96,80,170,100,170,"N",133,3.63,56,6,0,-2,"Intrathecal treatment",1 +"003-076",41,"M",18.7304890738814,2,"Y",8,4,"N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,6,48,"Superficial/other","N","II",2,37.4,20,21,98,NA,NA,302,7.17,37,100,80,180,100,180,"N",146,3.4,116,3,1,2,"Sham procedure",5 +"003-077",52,"F",22.2222222222222,2,"Y",19,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,9,24,"Superficial/other","Y","III",1,37.5,20,40,94,NA,NA,364,14.8,33.2,116,84,130,80,130,"N",146,3.86,54,4,1,1,"Sham procedure",1 +"003-078",54,"M",21.484375,2,"Y",10,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,14,72,"Superficial/other","N","II",1,37.4,20,21,97,NA,NA,230,5.99,39.4,84,72,120,80,120,"N",140,3.66,91,2,0,-5,"Intrathecal treatment",5 +"003-079",56,"M",19.53125,2,"Y",27,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,24,"Superficial/other","N","II",1,38,26,21,93,NA,NA,398,10.7,35.3,96,92,160,90,160,"N",138,3.5,92,6,0,4,"Sham procedure",1 +"003-080",77,"M",26.6666666666667,2,"Y",23,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","Y","N","Y",7,13,120,"Superficial/other","N","II",3,37.8,26,21,96,NA,NA,349,7.77,38.9,124,80,150,90,150,"N",140,4.6,140,18,1,12,"Intrathecal treatment",2 +"003-081",73,"F",20,2,"Y",8,4,"Y","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","Y","N","N","N","N","N","N","N",5,NA,48,"Superficial/other","N","II",3,37.4,20,21,96,NA,NA,160,6.81,37.3,92,84,140,80,140,"N",137,3.84,98,5,0,7,"Sham procedure",1 +"003-082",60,"M",21.484375,2,"Y",17,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,10,96,"Superficial/other","N","II",2,37,22,21,96,NA,NA,363,7.85,35.3,84,60,120,80,120,"N",132,3.63,70,3,0,-2,"Sham procedure",3 +"003-083",52,"M",26.6666666666667,2,"Y",18,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,24,"Superficial/other","N","II",1,37,20,21,97,NA,NA,298,8.39,36,80,76,120,80,120,"N",135,3.82,66,2,0,0,"Intrathecal treatment",3 +"003-084",55,"M",22.4913494809689,2,"Y",13,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,10,72,"Superficial/other","N","II",1,37,22,21,97,NA,NA,320,12.21,41,76,72,150,90,150,"N",138,3.29,73,6,0,-1,"Sham procedure",4 +"003-085",43,"M",23.4375,1,"Y",14,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,7,72,"Superficial/other","N","II",1,37.4,20,21,98,NA,NA,279,7.9,40,98,84,140,90,140,"N",137,4.12,117,0,1,-3,"Intrathecal treatment",2 +"003-086",18,"F",22.2222222222222,2,"Y",11,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,NA,24,"Superficial/other","N","II",2,39.5,24,21,97,NA,NA,89,7.89,39.2,112,92,120,80,120,"N",145,4.11,62,5,2,5,"Intrathecal treatment",4 +"003-087",50,"M",21.0771952275208,1,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,NA,48,"Superficial/other","N","II",1,37,20,21,98,NA,NA,287,9.68,36,80,52,130,80,130,"N",140,3.72,89,2,0,-5,"Sham procedure",3 +"003-088",41,"M",27.34375,2,"Y",19,4,"N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N",4,16,24,"Superficial/other","Y","II",2,39,26,21,95,NA,NA,346,12.7,44.7,132,84,200,120,200,"N",137,2.99,85,16,0,14,"Intrathecal treatment",1 +"003-089",63,"M",20.7612456747405,1,"Y",28,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,48,"Superficial/other","N","II",1,37,20,21,97,NA,NA,255,9.29,37.3,92,84,150,90,150,"N",141,3.63,89,5,0,4,"Intrathecal treatment",3 +"003-090",56,"M",20.0692041522491,2,"Y",29,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,3,24,"Superficial/other","N","III",1,37.5,24,30,96,105,7.45,248,8.78,41,88,76,130,80,130,"N",140,3.8,84,3,0,0,"Sham procedure",4 +"003-091",45,"F",22.8928199791883,1,"Y",20,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,8,48,"Superficial/other","N","I",1,37.6,20,21,96,NA,NA,405,8.77,42.7,104,84,140,80,140,"N",132,4.02,66,2,0,3,"Intrathecal treatment",2 +"003-092",70,"M",18.9387755102041,1,"Y",19,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",7,7,24,"Superficial/other","N","II",3,37,22,21,97,NA,NA,235,8.24,36.9,80,72,140,80,140,"N",138,3.72,91,5,0,1,"Sham procedure",5 +"003-093",38,"M",18.2867797339453,2,"Y",7,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",10,10,NA,"Superficial/other","N","I",1,37,20,21,98,NA,NA,251,6.65,44,92,76,130,80,130,"N",135,3.86,79,0,0,-6,"Sham procedure",2 +"003-094",37,"M",26.218820861678,2,"Y",6,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,11,24,"Superficial/other","N","II",1,38,24,21,95,NA,NA,223,7.09,43.5,120,84,130,80,130,"N",136,3.76,73,2,0,4,"Intrathecal treatment",1 +"003-095",49,"M",24.2439184746877,2,"Y",5,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,NA,72,"Superficial/other","N","II",1,37.6,20,21,97,NA,NA,300,7.66,44,96,60,160,100,160,"N",134,3.95,74,4,0,-2,"Sham procedure",2 +"003-096",41,"M",19.9593554942662,2,"Y",21,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,10,24,"Superficial/other","N","II",1,39,30,21,96,NA,NA,374,12.7,38.4,96,84,130,90,130,"N",151,3.54,88,5,0,-2,"Intrathecal treatment",3 +"003-097",66,"F",24.9739854318418,2,"Y",33,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,NA,72,"Superficial/other","N","II",1,37.4,20,21,96,NA,NA,179,15,39.8,100,96,130,80,130,"N",140,3.32,67,7,0,-5,"Sham procedure",3 +"003-098",53,"M",20.8116545265349,2,"Y",22,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,7,48,"Superficial/other","N","II",1,37.2,20,21,99,NA,NA,246,8.54,38.8,76,76,110,70,100,"N",153,3.65,85,3,0,-5,"Sham procedure",2 +"003-099",56,"F",24.9739854318418,2,"Y",24,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",3,6,24,"Superficial/other","Y","II",2,37.4,22,21,95,NA,NA,315,11.3,34.5,106,84,150,100,150,"N",139,4.49,50,12,0,7,"Intrathecal treatment",2 +"003-100",66,"F",20,1,"Y",9,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",5,9,48,"Superficial/other","N","II",1,37.4,22,21,93,NA,NA,374,10.5,38.4,86,76,150,90,150,"N",140,3.89,58,12,0,-1,"Sham procedure",4 +"003-101",60,"M",25.390625,2,"Y",6,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,3,NA,"Superficial/other","N","I",2,37.2,20,21,95,NA,NA,264,9.95,46,100,88,150,90,150,"N",139,3.29,108,7,0,2,"Intrathecal treatment",5 +"003-102",48,"M",17.7777777777778,2,"Y",12,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,13,NA,"Superficial/other","N","I",2,37.6,22,21,97,NA,NA,891,7.72,36.5,92,84,130,90,130,"N",134,4.49,48,4,0,-3,"Sham procedure",2 +"003-103",41,"M",21.875,1,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,10,24,"Superficial/other","N","II",1,37.2,21,21,96,NA,NA,304,7.94,45,96,76,150,90,150,"N",140,3.82,80,2,0,-1,"Intrathecal treatment",3 +"003-104",63,"M",23.4375,2,"Y",12,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,9,72,"Superficial/other","N","II",1,37.7,24,21,94,NA,NA,241,9.19,49,88,68,130,80,130,"N",138,3.61,87,4,0,-5,"Intrathecal treatment",1 +"003-105",38,"M",17.9981634527089,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",14,30,288,"Superficial/other","N","II",1,38,24,21,97,NA,NA,293,10.6,37,64,60,120,60,100,"N",136,3.74,75,2,0,-6,"Intrathecal treatment",5 +"003-106",40,"M",22.8928199791883,2,"Y",12,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,11,24,"Superficial/other","N","II",1,37.4,26,21,94,NA,NA,315,7.1,41.8,92,72,130,90,130,"N",140,3.51,82,1,0,-5,"Sham procedure",3 +"003-107",60,"F",18.6666666666667,2,"Y",9,2,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,3,48,"Superficial/other","N","II",1,38.4,26,21,93,NA,NA,330,16.2,35,136,104,180,150,180,"N",141,3.34,54,12,0,8,"Sham procedure",2 +"003-108",34,"M",22.038567493113,2,"Y",22,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,6,24,"Superficial/other","N","II",1,37.6,22,21,96,NA,NA,375,9.24,42.6,80,72,130,80,130,"N",136,3.62,81,0,0,0,"Intrathecal treatment",1 +"003-109",41,"M",20.5456936226167,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,14,72,"Superficial/other","N","II",1,37.4,20,21,96,NA,NA,219,13.2,38.9,88,80,120,70,120,"N",140,3.67,95,0,0,-5,"Sham procedure",4 +"003-110",57,"M",17.6308539944904,2,"Y",7,4,"N","N","N","N","Y","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,21,120,"Superficial/other","N","II",2,37.6,22,21,96,NA,NA,403,8.56,36.2,88,80,150,80,150,"N",132,2.88,37,12,0,1,"Intrathecal treatment",4 +"003-111",48,"M",22.8928199791883,2,"Y",13,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,28,24,"Superficial/other","N","II",2,37.4,22,21,95,NA,NA,325,11.8,48.8,92,70,140,80,140,"N",144,3.14,72,4,0,5,"Sham procedure",3 +"003-112",34,"M",18.8706633763972,2,"Y",21,4,"N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N",5,NA,48,"Superficial/other","N","II",2,37.6,15,21,95,NA,NA,194,10.1,41.9,92,64,140,80,140,"N",142,3.53,87,5,0,0,"Intrathecal treatment",1 +"003-113",34,"M",22.4913494809689,2,"Y",8,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,4,24,"Superficial/other","Y","II",1,37.5,20,21,97,NA,NA,311,12.4,43.3,84,76,140,80,140,"N",132,3.44,85,1,0,6,"Intrathecal treatment",2 +"003-114",52,"M",21.0961905148282,2,"Y",6,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,30,NA,"Superficial/other","N","I",1,37.5,20,21,96,NA,NA,270,10.6,38.3,94,80,140,80,140,"N",138,3.71,89,2,0,-3,"Intrathecal treatment",3 +"003-115",37,"M",24.092970521542,2,"Y",24,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,28,72,"Superficial/other","N","II",1,37.2,20,21,98,NA,NA,222,8.15,37,80,56,120,70,120,"N",138,3.4,91,1,0,-5,"Sham procedure",1 +"003-116",32,"M",23.1404958677686,2,"Y",21,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,6,48,"Superficial/other","N","II",2,37.5,20,21,95,NA,NA,216,10.35,42.6,104,68,140,80,140,"N",139,2.89,65,2,0,1,"Sham procedure",1 +"003-117",29,"M",24.2214532871972,2,"Y",21,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",8,30,24,"Superficial/other","N","II",1,38.1,35,21,95,120,7.5,183,10.4,44.3,130,96,160,80,160,"N",142,3.31,86,7,0,2,"Sham procedure",2 +"003-118",78,"F",20.8116545265349,2,"Y",7,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,30,120,"Superficial/other","N","II",2,37.4,24,21,90,NA,NA,250,10.6,47.1,90,76,160,80,160,"N",141,3.88,74,7,0,6,"Intrathecal treatment",2 +"003-119",18,"M",25.3515413737155,2,"Y",21,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,4,48,"Superficial/other","N","I",1,37,20,21,96,NA,NA,310,11.4,42,92,88,130,80,130,"N",137,3.13,74,1,0,0,"Sham procedure",4 +"003-120",49,"M",22.265625,1,"Y",9,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,12,92,"Superficial/other","N","II",1,37,20,21,97,NA,NA,356,10.1,42.9,86,64,120,80,120,"N",140,4.2,89,2,0,-5,"Intrathecal treatment",3 +"003-121",36,"M",22.8623685413809,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,25,92,"Superficial/other","N","II",1,37.6,20,21,96,NA,NA,294,7.53,42.3,70,70,130,80,130,"N",140,3.44,87,1,0,-5,"Sham procedure",2 +"003-122",32,"M",21.7738423573813,1,"Y",6,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N",3,12,48,"Superficial/other","N","II",2,37.5,20,21,97,NA,NA,167,5.61,37.8,96,84,120,80,120,"N",137,3.75,93,0,0,-2,"Intrathecal treatment",2 +"003-123",37,"M",22.4913494809689,1,"Y",14,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,18,48,"Superficial/other","N","II",1,37,24,21,98,NA,NA,525,9.41,41,88,76,140,80,140,"N",136,4.01,82,0,0,-3,"Intrathecal treatment",5 +"003-124",72,"F",22.2222222222222,2,"Y",23,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",3,30,24,"Superficial/other","N","II",2,37.5,30,21,93,NA,NA,302,11.2,31.8,100,92,160,80,160,"N",141,3.19,60,7,0,7,"Sham procedure",1 +"003-125",40,"M",26.5731292517007,2,"Y",11,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,10,NA,"Superficial/other","N","I",1,37.4,24,21,97,NA,NA,360,7.11,42.1,104,88,140,100,140,"N",145,3.3,67,3,0,3,"Intrathecal treatment",3 +"003-126",38,"M",20.2020202020202,2,"Y",16,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,30,24,"Superficial/other","N","II",1,37.4,20,21,94,NA,NA,155,7.39,42,92,66,110,80,110,"N",132,3.7,74,0,0,0,"Sham procedure",2 +"003-127",53,"M",20.8116545265349,2,"Y",11,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,7,24,"Superficial/other","N","II",1,37,24,21,97,NA,NA,244,6.34,41,100,88,140,90,140,"N",134,3.8,64,2,0,-4,"Sham procedure",2 +"003-128",55,"M",20.3125,2,"Y",18,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,3,48,"Superficial/other","N","II",1,37.5,22,21,97,NA,NA,281,10.6,43,108,70,150,90,150,"N",130,4.45,47,7,0,0,"Intrathecal treatment",4 +"003-129",39,"M",17.7832495468691,2,"Y",10,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,4,24,"Superficial/other","N","II",2,39,22,21,96,NA,NA,171,6.22,42.7,120,100,140,90,140,"N",133,2.85,50,9,0,8,"Intrathecal treatment",4 +"003-130",55,"M",20.3125,2,"Y",10,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,12,96,"Superficial/other","N","I",1,37,20,21,96,NA,NA,287,11.9,42.8,86,72,140,80,140,"N",135,3.59,71,3,0,2,"Sham procedure",4 +"003-131",59,"M",20.9366391184573,2,"Y",30,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",3,5,48,"Superficial/other","N","II",2,39,27,21,94,NA,NA,351,11.5,43.4,120,92,150,80,150,"N",136,3.94,69,9,0,10,"Intrathecal treatment",5 +"003-132",23,"M",23.5078053259871,2,"Y",25,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,14,24,"Superficial/other","N","II",1,37,22,21,96,NA,NA,366,13.4,50.3,80,72,120,80,120,"N",138,3.74,103,2,0,0,"Sham procedure",5 +"003-133",73,"F",17.8571428571429,2,"Y",20,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,NA,48,"Superficial/other","N","II",2,37.8,26,21,98,NA,NA,274,7.8,29,120,68,180,80,180,"N",143,3.8,79,12,0,11,"Intrathecal treatment",4 +"003-134",40,"M",22.038567493113,2,"Y",21,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,24,"Superficial/other","N","I",1,37.6,22,21,97,NA,NA,224,8.94,49,90,68,170,80,170,"N",143,3.89,70,3,0,4,"Sham procedure",4 +"003-135",43,"M",24.2424242424242,2,"Y",12,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,NA,NA,"Superficial/other","N","I",1,37.6,20,21,96,NA,NA,265,9.22,47.3,88,84,120,80,120,"N",140,3.72,83,1,0,-5,"Sham procedure",2 +"003-136",64,"M",19.8412698412698,2,"Y",4,4,"N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N",3,14,96,"Superficial/other","N","II",2,37.4,20,21,97,NA,NA,114,7.07,42,80,68,130,80,130,"N",138,3.28,69,9,1,-2,"Intrathecal treatment",5 +"003-137",74,"M",26.0374939913475,2,"Y",17,4,"Y","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N",4,15,72,"Superficial/other","N","II",2,37.4,22,21,97,NA,NA,270,9.32,40.7,100,92,130,80,130,"N",140,3.55,61,5,0,3,"Intrathecal treatment",2 +"003-138",39,"M",21.9671201814059,2,"Y",16,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,24,"Superficial/other","N","II",1,37.3,20,21,97,NA,NA,399,9.95,44.7,72,52,130,80,130,"N",139,3.49,78,1,0,0,"Sham procedure",2 +"003-139",56,"M",22.2222222222222,2,"Y",29,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,24,"Superficial/other","N","II",2,37.6,14,21,96,NA,NA,343,8.78,33.7,136,84,258,147,258,"N",141,3.58,65,9,0,11,"Sham procedure",4 +"003-140",58,"M",22.65625,2,"Y",52,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,10,24,"Superficial/other","N","II",2,37.5,26,21,95,NA,NA,308,11,41.2,104,84,110,70,110,"N",144,3.82,78,4,0,4,"Sham procedure",5 +"003-141",44,"M",21.1463199091024,2,"Y",10,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,NA,144,"Superficial/other","N","II",1,37.7,20,21,97,NA,NA,210,8.18,44.4,90,88,120,80,120,"N",137,3.81,83,0,0,-6,"Intrathecal treatment",3 +"003-142",57,"M",18.3654729109275,2,"Y",8,4,"N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","Y","N","N","N","N","N","N",20,NA,NA,"Superficial/other","N","I",1,37,20,21,96,NA,NA,333,7.67,42.6,84,66,150,90,150,"N",140,3.68,65,10,0,-2,"Intrathecal treatment",3 +"003-143",64,"M",18.3142559833507,1,"Y",13,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,11,24,"Superficial/other","N","II",1,37.4,20,21,95,NA,NA,115,6.29,39.9,88,72,140,90,140,"N",140,3.98,77,3,1,-3,"Intrathecal treatment",2 +"003-144",49,"M",25.9515570934256,1,"Y",3,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",9,12,NA,"Superficial/other","N","I",2,37,20,21,95,NA,NA,180,6.17,42.9,76,72,120,80,120,"N",137,3.22,98,3,0,-3,"Sham procedure",2 +"003-145",32,"M",21.3039485766759,2,"Y",8,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,8,96,"Superficial/other","N","II",1,37.2,22,21,96,NA,NA,275,7.96,39,100,96,140,80,140,"N",139,3.87,85,0,0,-4,"Intrathecal treatment",1 +"003-146",68,"M",21.5138585105239,2,"Y",12,4,"Y","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",9,NA,168,"Superficial/other","N","II",2,37,20,21,95,NA,NA,377,12.3,36,76,64,120,80,120,"N",137,3.76,119,5,1,-3,"Intrathecal treatment",3 +"003-147",39,"M",22.3081499107674,1,"Y",7,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,11,NA,"Superficial/other","N","I",1,37.6,20,21,98,NA,NA,338,11.5,39.4,86,72,120,80,120,"N",138,3.33,78,1,0,-5,"Intrathecal treatment",5 +"003-148",64,"M",31.2394143550755,2,"Y",23,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,14,96,"Superficial/other","N","III",1,37,24,21,98,NA,NA,425,13.6,42,106,92,130,80,130,"N",142,3.98,95,3,0,-4,"Sham procedure",3 +"003-149",33,"M",25.390625,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,NA,NA,"Superficial/other","N","I",1,38,20,21,97,NA,NA,214,7.3,41.4,100,92,130,80,130,"N",140,3.6,92,0,0,-6,"Intrathecal treatment",5 +"003-150",39,"M",19.0039083509627,1,"Y",10,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,12,72,"Superficial/other","N","II",2,37.4,20,21,98,NA,NA,309,6.88,42.8,92,76,120,80,120,"N",135,3.81,86,0,0,3,"Intrathecal treatment",1 +"003-151",55,"M",22.77318640955,2,"Y",24,4,NA,"N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,4,72,"Superficial/other","N","II",2,37.6,20,21,94,NA,NA,283,6.44,53,96,72,150,100,150,"N",137,3.83,81,7,0,2,"Sham procedure",2 +"003-152",60,"M",23.4375,2,"Y",28,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,7,72,"Superficial/other","N","II",2,37.5,23,21,96,NA,NA,256,9.13,42.7,84,64,130,90,130,"N",135,3.56,80,3,0,-2,"Sham procedure",4 +"003-153",74,"F",22.2222222222222,2,"Y",57,2,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,10,24,"Superficial/other","N","II",2,38,24,40,94,NA,NA,294,6.37,37.8,104,72,150,80,150,"N",145,3,70,6,1,13,"Sham procedure",3 +"003-154",75,"M",23.7812128418549,2,"Y",31,3,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",6,NA,120,"Superficial/other","N","II",3,37.6,20,21,97,NA,NA,411,13.87,38.3,92,68,150,90,150,"N",137,3.84,87,8,0,8,"Sham procedure",5 +"003-155",36,"M",22.2222222222222,1,"Y",18,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,9,NA,"Superficial/other","N","I",1,37.4,20,21,94,NA,NA,312,10.59,49.6,92,80,120,90,120,"N",139,3.38,80,2,0,0,"Intrathecal treatment",5 +"003-156",44,"M",23.9512265931195,2,"Y",8,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,NA,NA,"Superficial/other","N","I",1,37.4,20,21,98,NA,NA,259,6.03,37.8,84,64,120,80,120,"N",139,3.42,81,1,0,-5,"Sham procedure",5 +"003-157",46,"M",22.038567493113,2,"Y",24,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,7,24,"Superficial/other","N","II",1,37,20,21,96,NA,NA,260,12.8,47.6,100,92,140,90,140,"N",139,3.47,80,4,0,-3,"Intrathecal treatment",4 +"003-158",40,"M",21.875,2,"Y",20,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,NA,36,"Superficial/other","N","II",1,37.5,20,21,96,NA,NA,323,19,48.3,90,70,130,80,130,"N",143,4.02,75,2,0,-5,"Sham procedure",3 +"003-159",42,"M",19.4674012855831,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,3,120,"Superficial/other","N","II",1,37.4,22,21,96,NA,NA,246,8.68,38,92,80,130,70,110,"N",134,3.68,75,0,0,-6,"Sham procedure",3 +"003-160",34,"M",18.3654729109275,2,"Y",14,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,NA,24,"Superficial/other","N","I",1,37.4,20,21,96,NA,NA,182,9.05,39.9,82,68,120,80,120,"N",139,3.6,67,0,0,0,"Sham procedure",2 +"003-161",56,"M",13.840830449827,2,"Y",19,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",8,7,72,"Superficial/other","N","II",1,38,18,21,95,NA,NA,176,4.51,39.2,104,68,130,80,130,"N",139,3.45,55,4,0,-5,"Intrathecal treatment",2 +"003-162",57,"M",20.307412205455,1,"Y",18,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,7,96,"Superficial/other","N","I",1,37.4,18,21,96,NA,NA,274,10.3,44.6,82,72,150,90,150,"N",142,3.53,97,5,0,-1,"Sham procedure",2 +"003-163",54,"M",25.390625,2,"Y",15,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,NA,24,"Superficial/other","N","II",2,37.5,26,40,92,111,7.4,321,7.63,44.5,80,64,160,120,160,"N",134,3.45,96,7,1,2,"Sham procedure",2 +"003-164",53,"M",22.038567493113,1,"Y",36,4,"Y","N","N",NA,NA,"N","N","N",NA,"N","N","N","N","N","N",NA,"Y","N","N","N","Y","N","N",3,4,24,"Superficial/other","N","III",3,39.5,25,40,90,NA,NA,220,20.8,27.3,156,84,190,100,190,"N",141,3.95,698,20,5,14,"Sham procedure",2 +"003-165",36,"M",20.9571711629325,2,"Y",8,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,NA,NA,"Superficial/other","N","I",1,37,20,21,98,NA,NA,278,7.46,41.3,76,68,120,80,120,"N",139,3.37,82,1,0,0,"Intrathecal treatment",3 +"003-166",32,"M",21.484375,2,"Y",20,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,24,"Superficial/other","N","II",2,37.5,26,21,94,NA,NA,309,7.23,42,54,48,120,80,120,"N",141,3.22,66,5,0,3,"Intrathecal treatment",1 +"003-167",33,"M",24.9770431588613,1,"Y",5,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,NA,72,"Superficial/other","N","II",1,37.4,20,21,96,NA,NA,224,9.56,42.9,100,84,150,100,150,"N",136,3.66,109,2,0,-2,"Intrathecal treatment",1 +"003-168",46,"M",21.5138585105239,2,"Y",24,4,"Y","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,2,24,"Superficial/other","N","III",2,37.4,24,21,97,NA,NA,182,12.05,46.9,110,92,160,100,160,"N",140,4.89,85,7,0,8,"Intrathecal treatment",1 +"003-169",40,"M",24.21875,1,"Y",15,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,8,24,"Superficial/other","N","II",2,37.5,20,21,97,NA,NA,272,14.48,45,86,80,160,80,160,"N",136,3.77,64,0,0,7,"Intrathecal treatment",1 +"003-170",36,"M",20.9366391184573,1,"Y",6,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",12,21,NA,"Superficial/other","N","I",1,37.4,20,21,98,NA,NA,329,5.28,40.8,70,44,150,100,150,"N",136,3.35,86,3,0,-2,"Sham procedure",3 +"003-171",48,"M",20.3125,2,"Y",25,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",NA,"N","N","N","N",2,NA,24,"Superficial/other","N","II",3,37,20,21,96,NA,NA,257,9.17,37.9,96,68,110,80,110,"N",134,3.55,83,2,0,5,"Sham procedure",1 +"003-172",39,"M",16.9370318792578,1,"Y",14,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,30,24,"Superficial/other","N","II",2,37.5,20,21,98,NA,NA,270,14.66,43.9,76,66,130,80,130,"N",141,3.86,74,0,0,-2,"Sham procedure",2 +"003-173",49,"M",20.8116545265349,2,"Y",15,4,NA,NA,"N","N","Y","N","Y","N",NA,"N","N","N","N","N","N",NA,"N","N","N","N","N","N","N",7,NA,144,"Superficial/other","N","II",3,37,24,21,96,NA,NA,401,6.74,40.4,96,80,120,90,120,"N",139,5.14,62,2,0,-1,"Sham procedure",3 +"003-174",24,"M",21.3382106386222,2,"Y",23,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,8,48,"Superficial/other","N","II",2,37.3,24,21,95,NA,NA,310,17.22,41.9,98,76,120,90,120,"N",137,3.51,94,1,0,3,"Intrathecal treatment",4 +"003-175",40,"M",23.8751147842057,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,10,72,"Superficial/other","N","II",1,37,20,21,97,NA,NA,233,7.96,42.8,64,48,140,90,140,"N",143,3.33,63,3,0,-3,"Sham procedure",4 +"003-176",37,"M",23.8751147842057,2,"Y",23,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,4,48,"Superficial/other","N","III",1,38,24,30,95,143,7.442,295,8.63,42.9,104,72,140,90,140,"N",141,4.37,89,0,0,-2,"Intrathecal treatment",3 +"003-177",48,"M",20.8116545265349,2,"Y",32,4,"Y","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,NA,24,"Superficial/other","Y","III",2,37.4,24,21,94,NA,NA,278,17.1,42.9,96,88,140,80,140,"N",139,5,137,5,1,9,"Intrathecal treatment",4 +"003-178",43,"M",23.4375,2,"Y",28,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,14,24,"Superficial/other","N","II",2,37.6,20,21,96,NA,NA,331,10.03,44.6,96,76,140,100,140,"N",138,3.7,85,2,0,5,"Intrathecal treatment",2 +"003-179",26,"M",18.3391003460208,2,"Y",17,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,11,48,"Superficial/other","N","II",1,37.5,20,21,98,NA,NA,274,8.16,41.8,74,52,100,70,100,"N",134,4.17,71,0,0,-5,"Sham procedure",3 +"003-180",50,"M",23.4375,2,"Y",4,2,"Y","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,NA,48,"Superficial/other","N","II",2,38,24,21,96,NA,NA,256,9.07,44,110,96,140,80,140,"N",146,3.21,88,5,0,1,"Intrathecal treatment",4 +"003-181",34,"M",20.8209399167162,2,"Y",5,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,14,NA,"Superficial/other","N","I",2,37,20,21,98,NA,NA,441,12.88,42,92,86,140,90,140,"N",132,3.61,75,0,0,5,"Intrathecal treatment",3 +"003-182",63,"M",20.5693296602388,2,"Y",20,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,6,24,"Superficial/other","Y","III",1,37.6,24,30,97,89,7.534,357,5.1,29.4,88,76,130,80,130,"N",137,2.63,56,8,0,-1,"Intrathecal treatment",4 +"003-183",26,"M",17.3010380622837,2,"Y",7,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,18,48,"Superficial/other","N","II",1,37,20,21,96,NA,NA,187,8.68,44.6,72,68,120,80,120,"N",142,3.68,66,0,0,-5,"Sham procedure",5 +"003-184",51,"M",20.3244382551093,1,"Y",7,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,NA,"Superficial/other","N","I",1,37,20,21,96,NA,NA,225,8.87,43.2,92,72,120,80,120,"N",138,3.5,93,2,0,0,"Intrathecal treatment",1 +"003-185",62,"M",19.0039083509627,2,"Y",6,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N",3,10,NA,"Superficial/other","N","I",3,37.4,20,21,96,NA,NA,146,64.1,37.6,88,72,140,80,140,"N",137,3.78,61,7,1,2,"Intrathecal treatment",5 +"003-186",62,"F",18.8775510204082,1,"Y",14,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,NA,144,"Superficial/other","N","II",1,39,20,30,99,129,7.617,250,7.3,38,96,72,110,70,110,"N",144,3.86,60,9,0,-2,"Sham procedure",4 +"003-187",43,"M",17.89802289282,2,"Y",16,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,17,24,"Superficial/other","N","II",2,37.6,22,21,96,NA,NA,122,4.04,35.5,96,88,130,80,130,"N",138,3.14,54,1,1,-2,"Sham procedure",5 +"003-188",29,"M",23.8751147842057,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",6,3,72,"Superficial/other","N","II",1,37,20,21,95,NA,NA,380,8.03,39,88,60,150,70,150,"N",137,3.92,69,5,0,-2,"Sham procedure",1 +"003-189",57,"M",20.2847985719502,2,"Y",19,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,7,48,"Superficial/other","N","II",1,37,22,21,98,NA,NA,294,6.25,41,104,52,140,90,140,"N",138,3.6,79,3,0,-2,"Sham procedure",1 +"003-190",64,"M",20.0796012764889,2,"Y",7,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,NA,NA,"Superficial/other","N","I",2,37.3,20,21,97,NA,NA,230,7.85,42.9,72,68,120,80,120,"N",139,3.8,88,3,0,-3,"Sham procedure",1 +"003-191",65,"M",16.6530612244898,2,"Y",20,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",2,5,24,"Superficial/other","N","II",2,37.6,20,21,96,NA,NA,197,7.23,48.6,116,88,120,90,120,"N",139,3.4,63,14,0,5,"Intrathecal treatment",2 +"003-192",30,"M",17.5770686857761,1,"Y",23,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N",2,5,24,"Superficial/other","N","II",2,38.5,24,30,97,98,7.474,370,12.2,40.7,148,100,160,110,160,"N",140,3.2,76,7,0,11,"Intrathecal treatment",2 +"003-193",47,"M",20.2020202020202,2,"Y",6,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,NA,48,"Superficial/other","N","II",2,37.4,20,21,95,NA,NA,173,7.02,46.1,80,72,130,80,130,"N",138,3.81,64,3,0,-3,"Sham procedure",4 +"003-194",57,"M",22.038567493113,2,"Y",7,4,"N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",9,6,96,"Superficial/other","N","II",2,37,20,21,98,NA,NA,227,6.29,45.1,80,60,140,100,140,"N",134,3.9,63,10,0,-1,"Sham procedure",1 +"003-195",45,"M",17.3061224489796,1,"Y",6,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",5,30,48,"Superficial/other","N","II",2,37.4,23,21,96,NA,NA,327,7.32,37.6,98,80,140,90,140,"N",140,3.27,67,8,0,0,"Intrathecal treatment",2 +"003-196",41,"M",26.171875,1,"Y",6,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",3,10,NA,"Superficial/other","N","I",2,37.1,22,21,96,NA,NA,373,5.86,42.2,86,80,140,90,140,"N",140,3.96,94,5,0,0,"Intrathecal treatment",1 +"003-197",60,"M",18.8271110398974,2,"Y",16,4,"Y","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,9,96,"Superficial/other","N","II",2,37.6,20,21,94,NA,NA,261,9.67,43,132,88,200,100,200,"N",141,4.03,89,8,0,6,"Sham procedure",3 +"003-198",54,"M",18.7304890738814,2,"Y",24,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,7,48,"Superficial/other","Y","III",1,39,30,40,98,127,7.415,401,11.5,32.9,142,88,140,80,140,"N",139,3.37,45,12,1,9,"Intrathecal treatment",3 +"003-199",50,"M",19.9432125473229,2,"Y",16,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,30,24,"Superficial/other","N","II",1,37,20,21,97,NA,NA,274,8.92,40.7,72,48,120,80,120,"N",145,3.99,81,2,0,-5,"Intrathecal treatment",1 +"003-200",43,"M",20.8116545265349,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",10,NA,NA,"Superficial/other","N","I",1,37,20,21,98,NA,NA,285,6.73,42.9,72,60,120,80,120,"N",136,3.87,69,0,0,-6,"Sham procedure",4 +"003-201",42,"M",17.4747174301011,2,"Y",26,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,3,24,"Superficial/other","N","II",1,37,20,21,99,NA,NA,325,15.5,43,88,84,120,70,120,"N",142,3.68,62,1,0,0,"Sham procedure",3 +"003-202",56,"M",23.8751147842057,1,"Y",21,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","Y",2,6,24,"Superficial/other","N","II",1,38.6,24,30,96,NA,NA,289,14.9,46,96,88,130,90,130,"N",140,3.83,88,10,0,0,"Intrathecal treatment",5 +"003-203",35,"M",26.9274376417234,1,"Y",21,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N",2,2,24,"Superficial/other","N","II",3,37.5,22,21,96,NA,NA,218,10.9,43.2,88,74,130,90,130,"N",143,3.72,84,0,0,5,"Intrathecal treatment",2 +"003-204",67,"M",28.2828282828283,2,"Y",36,4,"Y","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",2,5,48,"Superficial/other","N","III",3,37.6,30,21,95,NA,NA,290,8.94,42.8,102,82,160,100,160,"N",134,3.71,74,8,0,10,"Sham procedure",4 +"003-205",46,"M",24.609375,2,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",14,NA,240,"Superficial/other","N","II",1,37,22,21,95,NA,NA,226,8.7,40.2,72,56,140,80,140,"N",134,3.85,75,2,0,-4,"Sham procedure",2 +"003-206",19,"M",23.1404958677686,1,"Y",10,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,4,48,"Superficial/other","N","II",1,37,20,21,97,NA,NA,210,9.05,42,84,68,120,70,120,"N",141,3.89,91,0,0,-5,"Intrathecal treatment",2 +"003-207",53,"M",16.8962350780533,2,"Y",12,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,48,"Superficial/other","N","II",1,37.4,20,21,98,NA,NA,401,9.43,38,72,68,100,60,100,"N",141,3.78,72,2,0,0,"Sham procedure",1 +"003-208",54,"M",23.566632231405,1,"Y",65,2,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",2,6,48,"Superficial/other","N","III",2,39.4,32,40,90,NA,NA,287,6.38,42.1,112,70,160,80,160,"N",140,3.19,58,9,1,15,"Sham procedure",1 +"003-209",19,"M",22.6799524092802,2,"Y",10,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,NA,48,"Superficial/other","N","II",1,37.5,22,21,98,NA,NA,386,8.19,46.3,92,52,130,80,130,"N",140,3.3,69,2,0,-5,"Intrathecal treatment",3 +"003-210",37,"M",21.2305720237141,1,"Y",25,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,8,24,"Superficial/other","N","II",1,37.5,24,30,99,144,7.48,248,11.4,43.2,104,80,120,80,120,"N",139,3.65,82,0,0,1,"Intrathecal treatment",5 +"003-211",56,"M",25.3443526170799,2,"Y",9,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,14,96,"Superficial/other","N","II",1,37.5,20,21,97,NA,NA,174,5.29,40.8,70,52,120,80,120,"N",138,4.48,81,3,0,-5,"Sham procedure",5 +"003-212",69,"F",22.2222222222222,1,"Y",5,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,7,96,"Superficial/other","N","II",1,39,22,21,96,NA,NA,197,8.28,40.5,88,68,140,80,140,"N",142,3.71,74,8,0,0,"Intrathecal treatment",1 +"003-213",48,"M",22.65625,2,"Y",17,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,24,"Superficial/other","N","II",1,37.5,20,21,94,NA,NA,344,6.74,43.9,96,84,140,90,140,"N",142,3.7,66,2,0,2,"Intrathecal treatment",4 +"003-214",42,"M",22.4913494809689,2,"Y",22,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,96,"Superficial/other","N","I",1,37.4,20,21,97,NA,NA,217,8.67,41.6,80,68,100,60,100,"N",141,3.6,87,0,0,0,"Sham procedure",2 +"003-215",27,"M",21.2585034013605,2,"Y",6,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,18,48,"Superficial/other","N","II",1,37.4,22,21,97,NA,NA,246,10.2,40,84,72,120,80,120,"N",136,3.65,65,0,0,-5,"Sham procedure",3 +"003-216",39,"M",19.2233756247597,1,"Y",10,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,NA,24,"Superficial/other","N","II",3,37.4,20,21,97,NA,NA,187,10.8,38.5,80,76,120,80,120,"N",143,3.26,111,1,1,-1,"Intrathecal treatment",3 +"003-217",26,"M",18.4425458240807,1,"Y",11,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,NA,96,"Superficial/other","N","III",2,39.5,19,30,92,NA,NA,313,8.8,44.4,116,76,120,80,120,"N",137,3.58,88,5,0,5,"Sham procedure",2 +"003-218",42,"M",31.1418685121107,2,"Y",6,2,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",1,9,24,"Superficial/other","N","II",2,38.5,22,21,97,NA,NA,335,9.71,43.2,100,88,140,80,140,"N",145,3.67,86,6,0,5,"Intrathecal treatment",5 +"003-219",46,"M",24.21875,1,"Y",7,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,30,72,"Superficial/other","N","II",1,37,20,21,96,NA,NA,292,7.46,46,88,84,140,90,140,"N",140,3.71,63,3,0,-3,"Intrathecal treatment",4 +"003-220",49,"M",23.2334561768947,1,"Y",16,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,30,24,"Superficial/other","N","II",2,37,18,21,97,NA,NA,180,7.39,41.1,92,90,110,60,100,"N",139,3.36,73,3,0,-2,"Sham procedure",1 +"003-221",41,"M",18.1312194299207,2,"Y",26,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,12,"Superficial/other","N","II",1,37.4,26,21,95,NA,NA,339,6.97,42.8,100,88,130,80,130,"N",137,3.95,59,1,0,0,"Intrathecal treatment",4 +"003-222",68,"F",20,2,"Y",13,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,7,24,"Superficial/other","N","III",1,37.6,30,40,80,170,7.492,368,11,40.4,96,80,140,80,140,"N",138,3.07,68,7,2,-3,"Sham procedure",3 +"003-223",55,"M",20.3125,2,"Y",15,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",2,8,48,"Superficial/other","N","II",3,38.4,20,21,98,NA,NA,637,11.7,30.2,94,86,140,90,140,"N",139,3.81,62,8,0,7,"Sham procedure",5 +"003-224",37,"M",19.8176773682124,2,"Y",13,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,4,48,"Superficial/other","N","II",1,37,20,21,98,NA,NA,288,8.93,40.4,88,70,130,90,130,"N",142,3.56,63,0,0,-5,"Intrathecal treatment",5 +"003-225",52,"M",20.8116545265349,2,"Y",18,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,15,96,"Superficial/other","N","II",1,37.6,20,21,96,NA,NA,263,8.69,44,96,72,120,80,120,"N",143,3.6,86,2,0,-5,"Sham procedure",4 +"003-226",65,"F",21.3333333333333,2,"Y",11,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",3,8,48,"Superficial/other","N","II",2,37.4,16,21,94,NA,NA,364,6.43,35,84,76,130,80,130,"N",134,3.92,42,7,0,-2,"Sham procedure",5 +"003-227",47,"M",23.828125,2,"Y",20,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,4,24,"Superficial/other","N","II",1,37.6,22,21,95,NA,NA,328,8.18,40.2,80,68,130,70,130,"N",141,3.3,74,3,0,0,"Intrathecal treatment",1 +"003-228",52,"M",27.0551508844953,2,"Y",15,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,8,24,"Superficial/other","N","II",1,37.6,24,21,97,NA,NA,352,9.01,37.7,96,80,120,80,120,"N",145,3.44,87,3,0,0,"Intrathecal treatment",5 +"003-229",66,"M",17.0655567117586,1,"Y",10,4,"N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,10,96,"Superficial/other","N","II",2,38,22,21,96,NA,NA,217,7.91,37.4,100,80,140,80,140,"N",144,3.15,78,6,0,0,"Sham procedure",4 +"003-230",53,"M",20.8116545265349,2,"Y",46,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,24,"Superficial/other","N","III",2,37.4,24,30,95,NA,NA,279,19.8,41,90,76,140,80,140,"N",137,3.89,68,3,0,5,"Sham procedure",5 +"003-231",52,"M",26.953125,2,"Y",13,4,"Y","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",10,5,96,"Superficial/other","N","II",2,37,20,21,95,NA,NA,283,13.5,41.3,104,100,150,100,150,"N",135,3.51,81,4,0,2,"Intrathecal treatment",5 +"003-232",48,"M",21.484375,2,"Y",57,3,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,4,72,"Superficial/other","N","II",2,38.5,26,30,95,80,7.43,228,11,41.2,128,124,150,90,150,"N",139,4.16,70,8,0,4,"Sham procedure",5 +"003-233",49,"M",19.7210369679802,2,"Y",12,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,7,24,"Superficial/other","N","II",2,38,20,30,93,98,7.321,271,9.95,42.3,132,84,170,92,170,"N",139,4.35,77,8,0,6,"Sham procedure",3 +"003-234",43,"M",21.875,2,"Y",13,4,"Y","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",1,10,24,"Superficial/other","N","II",2,37.4,20,21,96,NA,NA,332,21.3,40,96,84,160,100,160,"N",132,3.66,107,4,0,7,"Intrathecal treatment",4 +"003-235",38,"M",25.390625,2,"Y",9,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,24,"Superficial/other","N","II",2,37,20,21,97,NA,NA,313,12.2,37.8,88,68,150,100,150,"N",141,4.1,136,4,1,7,"Intrathecal treatment",5 +"003-236",29,"M",19.1000918273646,1,"Y",7,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",10,NA,120,"Superficial/other","N","II",1,37.5,20,21,96,NA,NA,203,5.65,42.8,84,64,120,70,120,"N",143,3.68,77,0,0,-6,"Intrathecal treatment",5 +"003-237",59,"M",13.5904499540863,1,"Y",24,4,"N","N","N",NA,"N","N","Y","N","N","N","N","N","N","N","N","N","Y","N","N","N","Y","N","N",4,NA,24,"Superficial/other","N","II",3,38,26,33,98,123,7.351,220,17.2,41.5,124,92,180,40,70,"N",150,3.32,218,15,4,8,"Sham procedure",4 +"003-238",48,"M",34.765625,2,"Y",31,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,11,48,"Superficial/other","N","II",2,37,20,21,96,NA,NA,274,5.83,51.8,88,64,130,80,130,"N",144,4.32,96,4,0,-2,"Sham procedure",4 +"003-239",35,"M",21.2278876170656,2,"Y",9,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,23,144,"Superficial/other","N","II",1,37.5,20,21,97,NA,NA,246,6.57,42.6,72,62,120,80,120,"N",139,3.93,68,0,0,-6,"Intrathecal treatment",3 +"003-240",39,"M",27.34375,2,"Y",8,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,7,48,"Superficial/other","N","II",2,37.4,20,21,97,NA,NA,184,6.83,44.3,100,88,120,60,120,"N",136,3.39,88,1,0,-3,"Intrathecal treatment",3 +"003-241",19,"M",18.491124260355,2,"Y",13,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,16,24,"Superficial/other","N","II",1,37.4,26,21,98,NA,NA,380,16.8,47.9,86,74,130,90,130,"N",140,3.27,74,4,0,-5,"Intrathecal treatment",4 +"003-242",42,"M",20.2812330989724,2,"Y",8,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,9,48,"Superficial/other","N","II",1,37,20,21,96,NA,NA,188,14.4,40.1,96,72,100,60,100,"N",139,2.9,71,2,0,-6,"Intrathecal treatment",1 +"003-243",61,"M",19.921875,2,"Y",5,4,NA,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",12,NA,288,"Superficial/other","N","II",1,37,20,21,95,NA,NA,315,6.67,40.4,96,72,150,90,150,"N",136,4.32,88,5,0,-2,"Sham procedure",4 +"003-244",53,"F",21.875,2,"Y",19,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,7,24,"Superficial/other","N","II",2,39,24,30,95,112,7.46,354,10.9,37.2,98,84,160,90,160,"N",138,4,60,7,0,11,"Intrathecal treatment",2 +"003-245",38,"M",25,2,"Y",7,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",14,9,168,"Superficial/other","N","II",2,38,22,21,98,NA,NA,205,7.09,38,100,68,130,80,130,"N",141,3.05,66,1,0,-3,"Intrathecal treatment",2 +"003-246",57,"M",19.4674012855831,1,"Y",17,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,24,"Superficial/other","N","II",1,37.6,24,30,97,NA,NA,347,10.9,47.9,92,76,160,100,160,"N",134,4.3,75,6,0,4,"Sham procedure",4 +"003-247",56,"F",22.8928199791883,2,"Y",11,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",3,3,48,"Superficial/other","N","II",2,37.5,21,21,97,NA,NA,281,6.02,43.4,72,64,160,100,160,"N",134,4.33,51,7,0,2,"Sham procedure",1 +"003-248",62,"M",17.0205141986921,1,"Y",37,4,"N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,72,"Superficial/other","N","II",2,37,20,21,97,NA,NA,326,9.82,46.4,74,68,120,80,120,"N",134,4.26,58,4,0,3,"Sham procedure",1 +"003-249",36,"M",22.5981404958678,2,"Y",31,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,24,"Superficial/other","N","II",1,37.5,20,21,97,NA,NA,308,9.1,44.8,116,110,140,90,140,"N",139,3.6,80,2,0,4,"Sham procedure",2 +"003-250",46,"M",20.2020202020202,2,"Y",22,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,7,120,"Superficial/other","N","III",1,38.4,22,40,88,130,7.48,252,8.67,36.7,96,76,140,80,140,"N",142,3.1,62,3,2,-4,"Intrathecal treatment",4 +"003-251",30,"M",22.265625,1,"Y",5,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,30,72,"Superficial/other","N","II",2,37,20,21,97,NA,NA,224,10.4,46.8,86,60,110,70,110,"N",137,3.48,63,2,0,-2,"Sham procedure",5 +"003-252",42,"M",23.1833910034602,2,"Y",24,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,5,48,"Superficial/other","N","III",2,37.7,20,35,88,108,7.38,246,7.45,49.9,140,84,150,100,150,"N",136,4.25,74,6,1,11,"Intrathecal treatment",3 +"003-253",49,"M",21.8299521999323,2,"Y",14,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",7,NA,144,"Superficial/other","N","II",2,37.6,26,21,95,NA,NA,265,10.1,45.14,124,75,160,90,160,"N",139,3.76,84,7,0,5,"Intrathecal treatment",1 +"003-255",42,"M",17.0068027210884,2,"Y",3,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",8,NA,72,"Superficial/other","N","II",2,37.5,20,21,96,NA,NA,205,11.2,46.4,88,78,120,80,120,"N",135,4.04,78,2,0,3,"Sham procedure",3 +"003-256",48,"M",19.53125,2,"Y",23,4,"N","N","N","N","N","N","Y","N","N","N","N","N",NA,"N","Y","N","N","N","N","N","N","N","N",2,8,24,"Superficial/other","N","II",2,37.6,22,21,96,NA,NA,315,7.82,39.4,92,86,130,90,130,"N",133,3.8,75,4,0,2,"Intrathecal treatment",3 +"003-257",59,"F",17.89802289282,2,"Y",21,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,NA,24,"Superficial/other","N","II",1,38,22,30,96,150,7.51,335,6.56,34.4,74,64,140,80,140,"N",134,3.6,57,1,0,-6,"Intrathecal treatment",2 +"003-258",34,"M",19.53125,2,"Y",19,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,5,72,"Superficial/other","N","II",1,37.7,22,21,95,NA,NA,317,11.8,47.2,84,72,120,80,120,"N",140,3.82,72,2,0,2,"Sham procedure",4 +"003-259",41,"M",20.2020202020202,2,"Y",28,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,8,24,"Superficial/other","N","II",1,37.5,24,21,96,NA,NA,231,10.9,47.2,86,70,140,80,140,"N",143,3.42,83,0,0,-5,"Sham procedure",1 +"003-260",23,"M",22.4913494809689,2,"Y",9,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",4,16,72,"Superficial/other","N","II",1,37.5,20,21,97,NA,NA,257,13.3,42.4,76,60,110,70,110,"N",139,3.66,78,2,0,-3,"Intrathecal treatment",3 +"003-261",48,"M",20.9366391184573,2,"Y",7,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",21,NA,408,"Superficial/other","N","II",2,37,20,21,97,NA,NA,210,6.42,41.4,92,84,110,60,100,"N",137,3.76,78,5,0,7,"Sham procedure",5 +"003-262",46,"M",21.3039485766759,1,"Y",49,4,"Y","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,2,24,"Superficial/other","N","III",2,37.3,22,30,94,68,7.45,179,8.85,44.6,88,72,200,120,200,"N",141,3.87,69,8,1,4,"Intrathecal treatment",5 +"003-263",51,"M",16.796875,2,"Y",34,4,"N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",1,9,24,"Superficial/other","N","II",2,37.6,26,30,98,107,7.32,456,15.5,40.7,108,88,100,50,80,"N",144,3.87,NA,3,0,4,"Sham procedure",5 +"003-264",57,"M",20.1955782312925,2,"Y",23,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,8,24,"Superficial/other","N","II",1,38,22,30,96,103,7.33,183,8.05,40,96,88,150,80,150,"N",144,3.64,77,0,0,-3,"Intrathecal treatment",2 +"003-265",28,"M",19.4330132601738,2,"Y",17,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",6,7,48,"Superficial/other","N","II",2,37.4,20,21,96,NA,NA,247,7,42.9,88,72,130,80,130,"N",138,3.6,77,8,0,4,"Intrathecal treatment",5 +"003-266",67,"M",24.092970521542,2,"Y",13,4,"Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",5,10,96,"Superficial/other","N","II",3,37,20,21,98,NA,NA,232,7.71,40.3,90,74,190,105,190,"N",137,3.7,56,6,0,-2,"Sham procedure",5 +"003-267",43,"M",16.796875,2,"Y",14,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",3,21,24,"Superficial/other","N","II",2,37,18,21,96,NA,NA,317,8.22,37.2,96,72,120,70,110,"N",140,3.21,57,8,0,3,"Intrathecal treatment",1 +"003-268",59,"M",17.2635445362718,2,"Y",23,4,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","Y",2,6,72,"Superficial/other","N","II",2,37,22,21,96,NA,NA,398,8.5,37.6,82,68,120,80,120,"N",135,3.7,88,8,1,8,"Sham procedure",5 +"003-269",42,"M",23.6244474927602,2,"Y",NA,3,"N","N","N","N","N","N","Y","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",2,NA,12,"Superficial/other","N","II",2,37.4,20,40,92,79,7.24,303,9.58,47.3,110,92,160,90,160,"N",140,4.15,77,5,0,3,"Sham procedure",1 +"003-270",57,"M",19.53125,2,"Y",20,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",5,10,96,"Superficial/other","Y","II",1,37,20,21,95,NA,NA,350,8.97,40.1,76,60,160,100,160,"N",141,3.58,67,15,1,4,"Sham procedure",2 +"003-271",66,"F",26.171875,2,"Y",18,2,"Y","Y","N","N","N","N","N","N","Y","N","N","N","N","N","N","Y","N","N","N","N","N","N","N",3,12,48,"Superficial/other","N","II",3,37.5,22,21,96,NA,NA,313,19.1,33.1,100,92,180,100,180,"N",128,4,118,5,0,1,"Intrathecal treatment",1 +"003-272",23,"M",22.1002895900015,2,"Y",23,4,"N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N","N",3,21,48,"Superficial/other","N","II",1,38.2,20,30,99,144,7.46,305,11.6,44.9,120,76,140,100,140,"N",143,3.2,108,NA,NA,NA,"Intrathecal treatment",1 diff --git a/inst/extdata/group_data.csv b/inst/extdata/group_data.csv new file mode 100644 index 0000000..41de05b --- /dev/null +++ b/inst/extdata/group_data.csv @@ -0,0 +1,89 @@ +ctcaename,class +Nausea,Digestive +Back pain,Musculoskeletal +Viral infection,Infectious +Headache,Neurological +Phlebitis,Cardiovascular +Gastritis,Digestive +Constipation,Digestive +Hemorrhoids,Digestive +Skin allergy,Allergic +Pharyngitis,Respiratory +Hospital acquired pneumonia,Infectious +UTI,Infectious +Fever,General +Neuralgia,Neurological +Hiccup,Digestive +Myocardial ischaemia,Cardiovascular +Oral infection,Infectious +Upper gastrointestinal hemorrhage,Digestive +Otitis,Infectious +Atrial thrombosis,Cardiovascular +Spinal disc herniation,Musculoskeletal +Sinusitis,Respiratory +Facial nerve disorder,Neurological +Urinary retention,Urinary +Hyperglycaemia,Metabolic +Chills,General +Arthritis,Musculoskeletal +Aspiration pneumonia,Respiratory +Ventilator associated pneumonia,Respiratory +arthralgia,Musculoskeletal +Tracheal hemorrhage,Respiratory +Hypotension,Cardiovascular +Nose bleed,Respiratory +Wound infection,Infectious +Allergy,Allergic +Hyponatremia,Metabolic +Cellulitis,Infectious +Blood stream infection,Infectious +Hypokalemia,Metabolic +Hypocalcemia,Metabolic +Torticolis,Musculoskeletal +Myocarditis,Cardiovascular +Insomnia,Neurological +Conjunctivitis,Infectious +Cardiac arrest,Cardiovascular +Voice alteration,Neurological +Necrotic wound,Infectious +Hypomagnesemia,Metabolic +Hematuria,Urinary +Subcutaneous emphysema,Respiratory +Heat stroke,General +Atrial fibrillation,Cardiovascular +Dizziness,Neurological +Failed extubation,Respiratory +Appendicitis,Digestive +Deep vein thrombosis,Cardiovascular +Acute renal failure,Urinary +Wound bleed,Digestive +Arthralgia,Musculoskeletal +Anemia,Hematologic +Bruising,Hematologic +Pressure ulcer,Skin +Tracheal stenosis,Respiratory +Upper respiratory infection,Respiratory +Recurrent tetanus,Neurological +Gastrointestinal disorder,Digestive +Chronic venous insufficiency,Cardiovascular +Pneumothorax,Respiratory +Hyperpyrexia,General +Arterial thromboembolism,Cardiovascular +Hypernatremia,Metabolic +Creatinine increase,Metabolic +Hypertension,Cardiovascular +Dysphagia,Digestive +Cerebral hemorrhage,Neurological +Cholangitis,Digestive +Pleural abscess,Respiratory +Pyloric stenosis,Cardiovascular +Sinus bradycardia,Cardiovascular +Pruritus,Allergic +Myalgia,Musculoskeletal +Adrenal insufficiency,Endocrine +Rhabdomyolysis,Musculoskeletal +Platelet count decreased,Hematologic +"Low weight, muscle wasting",General +Postoperative hemorrhage,Cardiovascular +Hypoalbuminemia,Metabolic +Cerebral infarction,Neurological diff --git a/inst/structure/.DS_Store b/inst/structure/.DS_Store new file mode 100644 index 0000000..7008d3b Binary files /dev/null and b/inst/structure/.DS_Store differ diff --git a/inst/structure/OUCRU_RCT_wInterim/Data/Readme.txt b/inst/structure/OUCRU_RCT_wInterim/Data/Readme.txt index 7f23e2c..515bdac 100644 --- a/inst/structure/OUCRU_RCT_wInterim/Data/Readme.txt +++ b/inst/structure/OUCRU_RCT_wInterim/Data/Readme.txt @@ -1,8 +1,8 @@ -This folder stores all data required for the analysis -1) Raw: stores raw data in the Access database (.mdb) format, plus the data dictionary -2) Randomization_list: stores randomization list(s) (in the interim phase, this folder only stores the dummy-randomization lists) -3) Imported: stores R/SAS raw data imported from Access format -4) VAD: stores value-added dataset that will be used for the analysis (in R/SAS format) -5) VAD_csv: stores value-added dataset that will be used for the analysis (in csv format) - +This folder stores all data required for the analysis +1) Raw: stores raw data in the Access database (.mdb) format, plus the data dictionary +2) Randomization_list: stores randomization list(s) (in the interim phase, this folder only stores the dummy-randomization lists) +3) Imported: stores R/SAS raw data imported from Access format +4) VAD: stores value-added dataset that will be used for the analysis (in R/SAS format) +5) VAD_csv: stores value-added dataset that will be used for the analysis (in csv format) + Data for the interim analysis can be found in the InterimAnalyses folder. \ No newline at end of file diff --git a/inst/structure/OUCRU_RCT_wInterim/InterimAnalysis/Readme.txt b/inst/structure/OUCRU_RCT_wInterim/InterimAnalysis/Readme.txt index b954553..8192e3b 100644 --- a/inst/structure/OUCRU_RCT_wInterim/InterimAnalysis/Readme.txt +++ b/inst/structure/OUCRU_RCT_wInterim/InterimAnalysis/Readme.txt @@ -1,11 +1,11 @@ This folder contains all final data and codes for interim analysis. -Process for an interim analysis: -- Copy value-added data from folder Data/VAD (at top level) to subfolder Data/interimData. -- Copy Dummy-randomization list from folder Data/RandomizationList (at top level) to subfolder Data/RandomizationList. +Process for an interim analysis: +- Copy value-added data from folder Data/VAD (at top level) to subfolder Data/interimData. +- Copy Dummy-randomization list from folder Data/RandomizationList (at top level) to subfolder Data/RandomizationList. - Run interimAnalysis.Rmd to create interim analysis report. -- Zip the whole folder to send to DSMB statistician. - -DSMB statistician needs to: -- Put the true randomization list in the Data/RandomizationList subfolder (and remove the dummy list) +- Zip the whole folder to send to DSMB statistician. + +DSMB statistician needs to: +- Put the true randomization list in the Data/RandomizationList subfolder (and remove the dummy list) - change lines 5,6 and 14 of the code in interimAnalysis.Rmd \ No newline at end of file diff --git a/inst/structure/Project/.DS_Store b/inst/structure/Project/.DS_Store new file mode 100644 index 0000000..5fd0375 Binary files /dev/null and b/inst/structure/Project/.DS_Store differ diff --git a/inst/structure/Project/Analysis/.DS_Store b/inst/structure/Project/Analysis/.DS_Store new file mode 100644 index 0000000..45aa478 Binary files /dev/null and b/inst/structure/Project/Analysis/.DS_Store differ diff --git a/inst/structure/Project/Analysis/Documents/.DS_Store b/inst/structure/Project/Analysis/Documents/.DS_Store new file mode 100644 index 0000000..6a645f0 Binary files /dev/null and b/inst/structure/Project/Analysis/Documents/.DS_Store differ diff --git a/inst/structure/Project/Analysis/Documents/Readme.txt b/inst/structure/Project/Analysis/Documents/Readme.txt new file mode 100644 index 0000000..310f848 --- /dev/null +++ b/inst/structure/Project/Analysis/Documents/Readme.txt @@ -0,0 +1 @@ +This folder contains related documents. \ No newline at end of file diff --git a/inst/structure/Project/Analysis/Documents/SAP/Readme.txt b/inst/structure/Project/Analysis/Documents/SAP/Readme.txt new file mode 100644 index 0000000..dcd855f --- /dev/null +++ b/inst/structure/Project/Analysis/Documents/SAP/Readme.txt @@ -0,0 +1 @@ +This folder contains statistical analysis plan. \ No newline at end of file diff --git a/inst/structure/Project/Analysis/Figures/Readme.txt b/inst/structure/Project/Analysis/Figures/Readme.txt new file mode 100644 index 0000000..383324f --- /dev/null +++ b/inst/structure/Project/Analysis/Figures/Readme.txt @@ -0,0 +1 @@ +This folder contains graphical output. \ No newline at end of file diff --git a/inst/structure/Project/Analysis/Functions/Readme.txt b/inst/structure/Project/Analysis/Functions/Readme.txt new file mode 100644 index 0000000..6a288f1 --- /dev/null +++ b/inst/structure/Project/Analysis/Functions/Readme.txt @@ -0,0 +1 @@ +This folder contains all additional functions/packages \ No newline at end of file diff --git a/inst/structure/Project/Analysis/Output/Readme.txt b/inst/structure/Project/Analysis/Output/Readme.txt new file mode 100644 index 0000000..27ae940 --- /dev/null +++ b/inst/structure/Project/Analysis/Output/Readme.txt @@ -0,0 +1 @@ +This folder contains intermediate/temporary outputs. \ No newline at end of file diff --git a/inst/structure/Project/Analysis/Readme.txt b/inst/structure/Project/Analysis/Readme.txt new file mode 100644 index 0000000..bf87913 --- /dev/null +++ b/inst/structure/Project/Analysis/Readme.txt @@ -0,0 +1 @@ +This folder contains all codes and outputs for the final analysis. \ No newline at end of file diff --git a/inst/structure/Project/Data/.DS_Store b/inst/structure/Project/Data/.DS_Store new file mode 100644 index 0000000..2ce2896 Binary files /dev/null and b/inst/structure/Project/Data/.DS_Store differ diff --git a/inst/structure/Project/Data/Cleaned/Readme.txt b/inst/structure/Project/Data/Cleaned/Readme.txt new file mode 100644 index 0000000..c70aa95 --- /dev/null +++ b/inst/structure/Project/Data/Cleaned/Readme.txt @@ -0,0 +1 @@ +This folder contains cleaned data. \ No newline at end of file diff --git a/inst/structure/Project/Data/Imported/Readme.txt b/inst/structure/Project/Data/Imported/Readme.txt new file mode 100644 index 0000000..0c8b6a9 --- /dev/null +++ b/inst/structure/Project/Data/Imported/Readme.txt @@ -0,0 +1 @@ +This folder contains data imported to R from raw data \ No newline at end of file diff --git a/inst/structure/Project/Data/Info/Readme.txt b/inst/structure/Project/Data/Info/Readme.txt new file mode 100644 index 0000000..408ef11 --- /dev/null +++ b/inst/structure/Project/Data/Info/Readme.txt @@ -0,0 +1 @@ +This folder contains metadata information of the database. \ No newline at end of file diff --git a/inst/structure/Project/Data/Raw/Final/Readme.txt b/inst/structure/Project/Data/Raw/Final/Readme.txt new file mode 100644 index 0000000..156886b --- /dev/null +++ b/inst/structure/Project/Data/Raw/Final/Readme.txt @@ -0,0 +1 @@ +This folder contains raw data for final analysis. \ No newline at end of file diff --git a/inst/structure/Project/Data/Raw/Interim/Readme.txt b/inst/structure/Project/Data/Raw/Interim/Readme.txt new file mode 100644 index 0000000..8cf9e95 --- /dev/null +++ b/inst/structure/Project/Data/Raw/Interim/Readme.txt @@ -0,0 +1 @@ +This folder contains raw data for interim analysis. \ No newline at end of file diff --git a/inst/structure/Project/Data/Raw/Readme.txt b/inst/structure/Project/Data/Raw/Readme.txt new file mode 100644 index 0000000..fece4d8 --- /dev/null +++ b/inst/structure/Project/Data/Raw/Readme.txt @@ -0,0 +1,5 @@ +This folder contains raw data + +Subfolder: +- Interim: raw data for interim analysis +- Final: raw data for final analysis \ No newline at end of file diff --git a/inst/structure/Project/Data/Readme.txt b/inst/structure/Project/Data/Readme.txt new file mode 100644 index 0000000..7f23e2c --- /dev/null +++ b/inst/structure/Project/Data/Readme.txt @@ -0,0 +1,8 @@ +This folder stores all data required for the analysis +1) Raw: stores raw data in the Access database (.mdb) format, plus the data dictionary +2) Randomization_list: stores randomization list(s) (in the interim phase, this folder only stores the dummy-randomization lists) +3) Imported: stores R/SAS raw data imported from Access format +4) VAD: stores value-added dataset that will be used for the analysis (in R/SAS format) +5) VAD_csv: stores value-added dataset that will be used for the analysis (in csv format) + +Data for the interim analysis can be found in the InterimAnalyses folder. \ No newline at end of file diff --git a/inst/structure/Project/Data/VAD/Readme.txt b/inst/structure/Project/Data/VAD/Readme.txt new file mode 100644 index 0000000..d4e558d --- /dev/null +++ b/inst/structure/Project/Data/VAD/Readme.txt @@ -0,0 +1 @@ +This folder contains value-added data for analysis. \ No newline at end of file diff --git a/inst/structure/Project/Published/.DS_Store b/inst/structure/Project/Published/.DS_Store new file mode 100644 index 0000000..6a645f0 Binary files /dev/null and b/inst/structure/Project/Published/.DS_Store differ diff --git a/inst/structure/Project/Published/Readme.txt b/inst/structure/Project/Published/Readme.txt new file mode 100644 index 0000000..5cf50af --- /dev/null +++ b/inst/structure/Project/Published/Readme.txt @@ -0,0 +1 @@ +This folder contains information to publish on GitHub. \ No newline at end of file diff --git a/man/as_sstable.Rd b/man/as_sstable.Rd new file mode 100644 index 0000000..ec9e993 --- /dev/null +++ b/man/as_sstable.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{as_sstable} +\alias{as_sstable} +\alias{as_sstable.default} +\alias{as_sstable.list} +\alias{as_sstable.logist_summary} +\alias{as_sstable.overlap_summary} +\alias{as_sstable.subgroup_logist_summary} +\title{Coerce an object to sstable} +\usage{ +as_sstable(x, ...) + +\method{as_sstable}{default}(x, flextable = FALSE, ...) + +\method{as_sstable}{list}(x, flextable = FALSE, ...) + +\method{as_sstable}{logist_summary}(x, include_footnote = TRUE, flextable = FALSE, ...) + +\method{as_sstable}{overlap_summary}(x, include_footnote = TRUE, flextable = FALSE, ...) + +\method{as_sstable}{subgroup_logist_summary}(x, include_footnote = TRUE, flextable = FALSE, ...) +} +\arguments{ +\item{x}{An object, usually a named list of length 2 whose names are 'table' and 'footer', or a data.frame/matrix (optionally with attribute "footer")} + +\item{...}{additional parameters passed to \link{ss_flextable}} + +\item{flextable}{logical value specifying whether to return a flextable. Default is FALSE} + +\item{include_footnote}{logical value specifying whether to include footnote in the output. Default is FALSE} + +\item{include_footsnote}{logical value specifying whether to include footnote in the output. Default is FALSE} +} +\value{ +A matrix of class ss_tbl if flextable == FALSE, otherwise a flextable +} +\description{ +A function to coerce objects to a sstable +} diff --git a/man/contSummary.Rd b/man/contSummary.Rd index 8ee8d03..3e52ee3 100644 --- a/man/contSummary.Rd +++ b/man/contSummary.Rd @@ -4,8 +4,7 @@ \alias{contSummary} \title{Calculate summary statistics for continuous variable} \usage{ -contSummary(x, statistics = c("med.IQR", "med.90", "med.range", - "mean.sd"), digits = 1, n = TRUE) +contSummary(x, statistics = NULL, digits = 1, n = TRUE) } \arguments{ \item{x}{a numeric vector to be summarised.} diff --git a/man/explicit.Rd b/man/explicit.Rd new file mode 100644 index 0000000..aa939b1 --- /dev/null +++ b/man/explicit.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explicit.R +\name{explicit} +\alias{explicit} +\title{Transform an object to its explicit form} +\usage{ +explicit(x, ...) +} +\arguments{ +\item{x}{An object} +} +\description{ +A function to transform an object to its explicit form if possible +} +\seealso{ +\link{explicit.lm} +} diff --git a/man/explicit.lm.Rd b/man/explicit.lm.Rd new file mode 100644 index 0000000..471731b --- /dev/null +++ b/man/explicit.lm.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/explicit.R +\name{explicit.lm} +\alias{explicit.lm} +\title{Transform a model to its explicit form} +\usage{ +\method{explicit}{lm}(fit) +} +\arguments{ +\item{fit}{An object of class "lm"} +} +\value{ +A model with explicit formula +} +\description{ +A function to transform an lm model formula to its explicit form. +This is useful when you want to use stats::drop1 to drop additional terms in interaction models. +} +\examples{ +iris.model <- lm(Sepal.Width ~ Sepal.Length*Petal.Width, data=iris) +explicit(iris.model) +} +\seealso{ +\link[stats]{add1} +} diff --git a/man/ft_sstheme.Rd b/man/ft_sstheme.Rd new file mode 100644 index 0000000..4978e09 --- /dev/null +++ b/man/ft_sstheme.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ft_sstheme} +\alias{ft_sstheme} +\title{Flextable theming for sstable} +\usage{ +ft_sstheme(ft, bg = "#F2EFEE") +} +\arguments{ +\item{ft}{flextable} +} +\description{ +Theming flextable for sstable +} diff --git a/man/getlabel.Rd b/man/getlabel.Rd index 2dcb9c4..c75c7ee 100644 --- a/man/getlabel.Rd +++ b/man/getlabel.Rd @@ -11,7 +11,7 @@ getlabel(x, meta = NULL, unit = TRUE, fit = FALSE) \item{meta}{a data frame contains metadata of the dataset. This data frame should have the following variables: varname (character variable specifies name of each variable), label (character variable specifies label of each variables), type (character variable specifies type of each variable [numeric, factor, character, datetime], unit (character variable specifies units of each continuous variable), scale (numeric variable specifies how each variable will be scaled).} -\item{unit}{a logical value specifies whether unit will be appendded in the label of continous variables.} +\item{unit}{a logical value specifies whether unit will be appended in the label of continuous variables.} \item{fit}{a logical value specifies whether the label will use presentation as in model fitting.} } diff --git a/man/gg_ajsurvplot.Rd b/man/gg_ajsurvplot.Rd new file mode 100644 index 0000000..4e09afb --- /dev/null +++ b/man/gg_ajsurvplot.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_ajsurvplot.R +\name{gg_ajsurvplot} +\alias{gg_ajsurvplot} +\title{Plot the Aalen-Johansen curve with ggplot for competing risks} +\usage{ +gg_ajsurvplot( + formula, + data, + weights, + subset, + na.action, + etype, + count, + id, + timefix, + ... +) +} +\arguments{ +\item{formula}{A standard model formula, with survival on the left and covariates on the right} + +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model} + +\item{weights, subset, na.action, etype, count, id, timefix}{parameter passed to finegray model. See \code{\link[survival:finegray]{finegray}},} + +\item{...}{optional parameters passed to \code{ggsurvplot}.} +} +\description{ +Extend \link[survminer:ggsurvplot]{ggsurvplot} functionality to plot competing risk curve +} diff --git a/man/gg_ajsurvplot2.Rd b/man/gg_ajsurvplot2.Rd new file mode 100644 index 0000000..b16a2c6 --- /dev/null +++ b/man/gg_ajsurvplot2.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_ajsurvplot.R +\name{gg_ajsurvplot2} +\alias{gg_ajsurvplot2} +\title{Plot 2 Aalen-Johansen curves with ggplot for competing risks} +\usage{ +gg_ajsurvplot2( + formula, + data, + weights, + subset, + na.action, + main.event, + competing.event, + facet.by = ~strata, + count, + id, + timefix, + ci = TRUE, + monochrome = FALSE, + type = c("alternate", "overlaid"), + ... +) +} +\arguments{ +\item{formula}{A standard model formula, with survival on the left and covariates on the right} + +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model} + +\item{weights, subset, na.action, , count, id, timefix}{parameter passed to finegray model. See \code{\link[survival:finegray]{finegray}},} + +\item{main.event, competing.event}{main and competing event to plot} + +\item{facet.by}{formula. default to all strata} + +\item{ci}{[TRUE] Plot confidence band?} + +\item{monochrome}{[FALSE] plot in monochrome? either FALSE (default) or a string of color, TRUE is equivalent to "black"} + +\item{type}{['alternate'] plot in alternative or overlaid style?} + +\item{...}{other parameters passed to finegray (excluding etype)} +} +\description{ +Extend \link[ggsurvfit:ggsurvfit]{ggsurvfit} functionality to plot competing risk curve, with main risk and competing risk in one plot +} diff --git a/man/gg_boxcox.Rd b/man/gg_boxcox.Rd new file mode 100644 index 0000000..e519780 --- /dev/null +++ b/man/gg_boxcox.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_boxcox.R +\name{gg_boxcox} +\alias{gg_boxcox} +\title{Compute and draw Box-Cox transformation plot for linear models using ggplot2} +\usage{ +gg_boxcox(object, ...) +} +\arguments{ +\item{object}{a formula or fitted model object. Currently only lm and aov objects are handled.} + +\item{...}{additional parameters to be used in the model fitting.} + +\item{lambda}{vector of values of lambda – default (-2, 2) in steps of 0.1} + +\item{interp}{logical which controls whether spline interpolation is used. Default to TRUE if plotting with lambda of length less than 100.} + +\item{eps}{Tolerance for lambda = 0; defaults to 0.02} + +\item{xlab}{defaults to "lambda"} + +\item{ylab}{defaults to "log-Likelihood"} +} +\value{ +a ggplot object +} +\description{ +A forked version of MASS::boxcox using ggplot2 +} +\examples{ +gg_boxcox(Volume ~ log(Height) + log(Girth), data = trees, + lambda = seq(-0.25, 0.25, length = 10)) +} +\seealso{ +\link[MASS]{boxcox} +} diff --git a/man/ggsurvfit2.Rd b/man/ggsurvfit2.Rd new file mode 100644 index 0000000..0667203 --- /dev/null +++ b/man/ggsurvfit2.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_ajsurvplot.R +\name{ggsurvfit2} +\alias{ggsurvfit2} +\title{ggsurvfit with strata saved} +\usage{ +ggsurvfit2( + x, + type = "survival", + linetype_aes = FALSE, + theme = theme_ggsurvfit_default(), + ... +) +} +\arguments{ +\item{x, type, linetype_aes, theme, ...}{parameters passed directly \link[ggsurvfit:ggsurvfit]{ggsurvfit}.} +} +\description{ +Same as \link[ggsurvfit:ggsurvfit]{ggsurvfit} but with strata saved, so you can facet by covariables. +} diff --git a/man/hello.Rd b/man/hello.Rd deleted file mode 100644 index 0fa7c4b..0000000 --- a/man/hello.Rd +++ /dev/null @@ -1,12 +0,0 @@ -\name{hello} -\alias{hello} -\title{Hello, World!} -\usage{ -hello() -} -\description{ -Prints 'Hello, world!'. -} -\examples{ -hello() -} diff --git a/man/ht_theme_kable.Rd b/man/ht_theme_kable.Rd new file mode 100644 index 0000000..38d9569 --- /dev/null +++ b/man/ht_theme_kable.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ht_theme_kable} +\alias{ht_theme_kable} +\title{A kable-esque theme for huxtable object} +\usage{ +ht_theme_kable( + ht, + header_rows = 1:2, + header_cols = NULL, + border_width = 1, + border_color = "#dddddd", + bg = c("white", "#f9f9f9") +) +} +\arguments{ +\item{ht}{an object of class huxtable} + +\item{header_rows}{a numeric vector that delimits the header zone.} + +\item{border_width}{a number that defines huxtable border width} + +\item{border_color}{a character string that defines huxtable border color} + +\item{bg}{a character vector that defines background color of the flextable. If length(bg) >= 2, the table will have stripe background, otherwise plain.} +} +\value{ +an object of class huxtable +} +\description{ +This function provides a kable-esque theme for huxtable object +} diff --git a/man/ht_theme_markdown.Rd b/man/ht_theme_markdown.Rd new file mode 100644 index 0000000..b4187b9 --- /dev/null +++ b/man/ht_theme_markdown.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ht_theme_markdown} +\alias{ht_theme_markdown} +\title{A stripe theme for huxtable object} +\usage{ +ht_theme_markdown( + ht, + header_rows = 1:2, + header_cols = NULL, + border_width = 0.8, + border_color = grey(0.75), + bg = c(grey(0.95), "white") +) +} +\arguments{ +\item{ht}{an object of class huxtable} + +\item{header_rows}{a numeric vector that delimits the header zone.} + +\item{border_width}{a number that defines huxtable border width} + +\item{border_color}{a character string that defines huxtable border color} + +\item{bg}{a character vector that defines background color of the flextable. If length(bg) >= 2, the table will have stripe background, otherwise plain.} +} +\value{ +an object of class huxtable +} +\description{ +This function provides a markdown stripe theme for huxtable object +} diff --git a/man/inspect.data.Rd b/man/inspect.data.Rd index ec8e2fd..e4ec4ea 100644 --- a/man/inspect.data.Rd +++ b/man/inspect.data.Rd @@ -4,8 +4,15 @@ \alias{inspect.data} \title{Check formatted data based on a pre-defined information} \usage{ -inspect.data(data, info, id, check_missing = c(TRUE, FALSE), - plot = FALSE, prefix = "", outdir) +inspect.data( + data, + info, + id, + check_missing = c(TRUE, FALSE), + plot = FALSE, + prefix = "", + outdir +) } \arguments{ \item{data}{a formatted data frame to be checked.} diff --git a/man/logist_summary.Rd b/man/logist_summary.Rd new file mode 100644 index 0000000..d080ed2 --- /dev/null +++ b/man/logist_summary.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logist_summary.R +\name{logist_summary} +\alias{logist_summary} +\title{An alternative summary for a logistic model with OR, CI, and p-values} +\usage{ +logist_summary( + fit, + method = c("lik.ratio", "wald"), + stat_digits = 2, + p_digits = 4, + verbose = FALSE, + sstable = FALSE, + flextable = FALSE, + ... +) +} +\arguments{ +\item{fit}{a logistic regression model of class "glm"} + +\item{method}{a string whose value is either +"lik.ratio" for CI and tests based on likelihood ratio statistics (preferred) +or "wald" for CI and tests based on Wald statistics} + +\item{stat_digits}{Number of decimal digits for statistics} + +\item{p_digits}{Number of decimal digits for the p-values} + +\item{verbose}{logical value specifying whether to print out result and notation. Default is FALSE} + +\item{sstable}{logical value specifying whether to return in sstable format. Default is FALSE. Set to TRUE forces verbose to FALSE} + +\item{flextable}{logical value specifying whether to build flextable object. Default it FALSE. Set to TRUE forces sstable to TRUE and verbose to FALSE. +Like other sstable objects, you can still create flextable or huxtable afterwards by using \link{ss_flextable} or \link{ss_huxtable}} + +\item{...}{additional parameters passed to \link{ss_flextable}} +} +\value{ +A data frame of additional class "logist_summary" (if sstable == FALSE), a matrix of class c("summary_tbl", "ss_tbl") otherwise +} +\description{ +a function to create summary table for glm logistic model +} +\seealso{ +\link{ss_format}, \link{ss_huxtable}, \link{ss_flextable} +} +\author{ +Marcel Wolbers, Lam Phung Khanh, and Trinh Dong Huu Khanh +} diff --git a/man/mutate_f.Rd b/man/mutate_f.Rd new file mode 100644 index 0000000..a1da236 --- /dev/null +++ b/man/mutate_f.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/func_mult.R +\name{mutate_f} +\alias{mutate_f} +\alias{mutate_f.data.table} +\alias{mutate_f.tbl} +\alias{mutate_f.grouped_df} +\alias{mutate_f.data.frame} +\title{Create or transform variables, with support for multiple assignment} +\usage{ +mutate_f(.data, ...) + +\method{mutate_f}{data.table}(.data, ...) + +\method{mutate_f}{tbl}(.data, ...) + +\method{mutate_f}{grouped_df}(.data, ...) + +\method{mutate_f}{data.frame}(.data, ...) +} +\arguments{ +\item{.data}{A data.frame, data.table, or tbl} + +\item{...}{Name-value pairs of expressions, following data.table syntax: "new_col" := expression. +Multiple assignments can be done via c("new_col1", "new_col2") := expression_returning_a_list. + +If unnamed, names of each list elements will be used} +} +\value{ +a data.frame, data.table, or a tbl +} +\description{ +A function to create new variable(s) based on existing ones. +} +\examples{ +df <- data.frame(baz = 1:10, foo = c(rep(1, 5), rep(2, 5))) +df \%>\% + dplyr::group_by(foo) \%>\% + mutate_f(c('foo', 'bar') := list(a = cumsum(baz), b = baz*2)) +} diff --git a/man/pct.Rd b/man/pct.Rd new file mode 100644 index 0000000..fa82b03 --- /dev/null +++ b/man/pct.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/toolkits.R +\name{pct} +\alias{pct} +\title{Get the proportion for each level or range of a vector} +\usage{ +pct(x, method = c("auto", "bin", "cont", "fct"), na.rm = TRUE, ...) +} +\arguments{ +\item{x}{An object} + +\item{method}{A method to calculate the percentage. +Default is 'auto' which will attempt to choose the most fit method. +'bin' is only meaningful for vector that only has to values. +'fct' is meaningful for descrete variable +'cont' is used for continuous variables. This will break the variable into several ranges +depended on the breaks specified in ...} + +\item{na.rm}{A logical value deciding whether NA should be removed} + +\item{...}{Additional parameters passed to \link{cut}. Only work if method = 'cont' +See \link{cut}} +} +\value{ +If method == 'bin': the percentage of non-reference level + +If method == 'fct': the percentages of all levels + +If method == 'cont': the percentages of all ranges based on specified breaks +} +\description{ +A function to calculate the proportion of each value range +} diff --git a/man/print.logist_summary.Rd b/man/print.logist_summary.Rd new file mode 100644 index 0000000..e83fd26 --- /dev/null +++ b/man/print.logist_summary.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/logist_summary.R +\name{print.logist_summary} +\alias{print.logist_summary} +\title{Print method for logist_summary} +\usage{ +\method{print}{logist_summary}(x, ...) +} +\arguments{ +\item{x}{an object of class logist_summary} + +\item{...}{additional params passed to print.data.frame} +} +\value{ +invisibly return itself +} +\description{ +Print method for logist_summary table +} +\seealso{ +\link{print.data.frame} +} diff --git a/man/print.subgroup_logist_summary.Rd b/man/print.subgroup_logist_summary.Rd new file mode 100644 index 0000000..5bcbdb3 --- /dev/null +++ b/man/print.subgroup_logist_summary.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/group_effect.R +\name{print.subgroup_logist_summary} +\alias{print.subgroup_logist_summary} +\title{Print method for subgroup_logist_summary} +\usage{ +\method{print}{subgroup_logist_summary}(x, ...) +} +\arguments{ +\item{x}{an object of class subgroup_logist_summary} + +\item{...}{additional params passed to print.data.frame} +} +\value{ +invisibly return itself +} +\description{ +Print method for subgroup_logist_summary +} +\seealso{ +\link{print.data.frame} +} diff --git a/man/rbind.ss_obj.Rd b/man/rbind.ss_obj.Rd new file mode 100644 index 0000000..1bd56db --- /dev/null +++ b/man/rbind.ss_obj.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{rbind.ss_obj} +\alias{rbind.ss_obj} +\alias{rbind.ss_ae} +\alias{rbind.ss_survcomp} +\alias{rbind.ss_baseline} +\title{Row-binding two sstables} +\usage{ +\method{rbind}{ss_obj}(tbl1, tbl2, footer = NULL, ...) + +\method{rbind}{ss_ae}(tbl1, tbl2, footer = NULL) + +\method{rbind}{ss_survcomp}(tbl1, tbl2, footer = NULL) + +\method{rbind}{ss_baseline}(tbl1, tbl2, footer = NULL) +} +\arguments{ +\item{tbl1, tbl2, }{two object of class sstables of the same template. Only export for technical use.} + +\item{footer}{[NULL] default is the joint footer of two ss_tbl} + +\item{...}{args passed to the downstream method} +} +\description{ +Row-binding two sstables +} diff --git a/man/ref_lv.Rd b/man/ref_lv.Rd new file mode 100644 index 0000000..615f1c3 --- /dev/null +++ b/man/ref_lv.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/toolkits.R +\name{ref_lv} +\alias{ref_lv} +\alias{ref_lv.factor} +\alias{ref_lv<-} +\alias{ref_lv<-.factor} +\title{Get or set the reference level} +\usage{ +ref_lv(x) + +\method{ref_lv}{factor}(x) + +ref_lv(x) <- value + +\method{ref_lv}{factor}(x) <- value +} +\arguments{ +\item{x}{A factor} + +\item{value}{An existing level to be set as reference} +} +\value{ +A character object the represents the reference level +} +\description{ +A function to quickly get or set the reference level of a factor +} diff --git a/man/simple_recode.Rd b/man/simple_recode.Rd index 72c34cb..7041d3d 100644 --- a/man/simple_recode.Rd +++ b/man/simple_recode.Rd @@ -10,15 +10,20 @@ \usage{ simple_recode(...) -\method{simple_recode}{data.frame}(.data, ..., ignore.case = FALSE, - perl = TRUE) - -\method{simple_recode}{default}(x, map, as = c("as_is", "numeric", - "factor", "character", "logical"), ignore.case = FALSE, perl = TRUE, - ...) +\method{simple_recode}{data.frame}(.data, ..., ignore.case = FALSE, fixed = FALSE, perl = TRUE) + +\method{simple_recode}{default}( + x, + map, + as = c("as_is", "numeric", "factor", "character", "logical"), + ignore.case = FALSE, + fixed = FALSE, + perl = TRUE, + ... +) } \arguments{ -\item{...}{For data.frame: Replacement in the form of var = map. Maps must follow the syntax stipulated in the map parameter. +\item{...}{For method for data.frame: Replacement in the form of var = map. Maps must follow the syntax stipulated in the map parameter. For default method: Additional parameters passed to factor()} @@ -48,7 +53,7 @@ If input is a vector, return a vector of the same length. If input is a data frame, return a data frame with relevant variables recoded. } \description{ -A function to re-encode data by using a map. Patterns are accepted. unmentioned data are left intact. +A function to re-encode data by using a map. Patterns are accepted. Unmentioned data are left intact. Method for class data.frame supports a robust replacement for data by providing relevant map in the form of var = map. } diff --git a/man/simple_relevel.Rd b/man/simple_relevel.Rd new file mode 100644 index 0000000..28b62d1 --- /dev/null +++ b/man/simple_relevel.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simple_relevel.R +\name{simple_relevel} +\alias{simple_relevel} +\alias{simple_relevel.data.frame} +\alias{simple_relevel.default} +\title{Relevel in correspondence to another factor} +\usage{ +simple_relevel(x, ...) + +\method{simple_relevel}{data.frame}(data, ..., by) + +\method{simple_relevel}{default}(x, by, map, value = c("unsorted", "sorted", "levels")) +} +\arguments{ +\item{x}{a vector that will be relevelled} + +\item{...}{Unquoted variable names that will be relevelled} + +\item{data}{A data.frame} + +\item{by}{a vector that the relevelling process will base on} + +\item{map}{a list that links by to x in the form of list(by.1 = c(x1.1, x1.2...), by.2 = c(x2.1, x2.2...)) +or a data.frame with two columns "from" and "to" serving the same purpose.} + +\item{value}{a string: whether to return + +- "levels": new levels only + +- "unsorted" (default): an unsorted, relevelled factor + +- "sorted": a sorted, relevelled factor} +} +\value{ +An object of the same class as the input + +A factor or a numeric vector of order +} +\description{ +Function to relevel a variable in accordance to a another variable of class "factor". +} diff --git a/man/simple_sort.Rd b/man/simple_sort.Rd new file mode 100644 index 0000000..9d5bab3 --- /dev/null +++ b/man/simple_sort.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/simple_relevel.R +\name{simple_sort} +\alias{simple_sort} +\title{Sort a vector in a user-defined order} +\usage{ +simple_sort(x, order = levels(as.factor(x))) +} +\arguments{ +\item{x}{A vector to be sorted} + +\item{order}{A manually defined order vector} +} +\value{ +A vector +} +\description{ +A function to sort a vector in an user-defined order +} diff --git a/man/ss_body.Rd b/man/ss_body.Rd new file mode 100644 index 0000000..532efa7 --- /dev/null +++ b/man/ss_body.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ss_body} +\alias{ss_body} +\title{Designation of body part for custom sstable} +\usage{ +ss_body(sstable, rows) +} +\arguments{ +\item{sstable}{a data frame following sstable's grammar} + +\item{rows}{a numeric vector} +} +\value{ +a matrix of class ss_tbl +} +\description{ +This function set the designated rows as body part of a sstable +} diff --git a/man/ss_flextable.Rd b/man/ss_flextable.Rd new file mode 100644 index 0000000..06efab2 --- /dev/null +++ b/man/ss_flextable.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ss_flextable} +\alias{ss_flextable} +\alias{ss_flextable.list} +\alias{ss_flextable.ss_obj} +\alias{ss_flextable.default} +\title{Create summary table using flextable package.} +\usage{ +ss_flextable(sstable, ...) + +\method{ss_flextable}{list}(sstable, add_footer = NULL, ...) + +\method{ss_flextable}{ss_obj}(sstable, add_footer = NULL, ...) + +\method{ss_flextable}{default}(sstable, footer = NULL, bg = "#F2EFEE", ...) +} +\arguments{ +\item{sstable}{a data frame following sstable's grammar} + +\item{...}{additional parameters that will be passed to ss_format if the sstable has yet to be formatted.} + +\item{add_footer}{additional footer lines to be appended to object footers} + +\item{footer}{a character vector each of which is the footnote of the flextable} + +\item{bg}{a character string that defines stripped background color of the flextable} +} +\value{ +an object of class flextable +} +\description{ +This function generate a flextable from a sstable. +} +\seealso{ +\link[flextable]{flextable} +} diff --git a/man/ss_format.Rd b/man/ss_format.Rd new file mode 100644 index 0000000..0951d47 --- /dev/null +++ b/man/ss_format.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ss_format} +\alias{ss_format} +\title{Quick format a sstable in preparation for create flextable/huxtable} +\usage{ +ss_format( + sstable, + header = c(), + section = c(), + body = c(), + template = c("baseline", "survcomp", "ae"), + .guess = TRUE +) +} +\arguments{ +\item{sstable}{a data frame following sstable's grammar} + +\item{header}{a numeric vector that will be passed to ss_header} + +\item{section}{a numeric vector that will be passed to ss_section} + +\item{body}{a numeric vector that will be passed to ss_body} + +\item{template}{An accepted template for sstable: must be either 'baseline', 'survcomp', or 'ae'. + +If NA, the existing template in the sstable is kept as-is. It no template built-in, will return a no-template sstable instead.} + +\item{.guess}{a logical value. If TRUE, the function will try to guess to which part each row belongs.} +} +\value{ +a matrix of class ss_tbl +} +\description{ +This function is the combination of ss_header, ss_body, and ss_section. +} diff --git a/man/ss_header.Rd b/man/ss_header.Rd new file mode 100644 index 0000000..8d1880b --- /dev/null +++ b/man/ss_header.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ss_header} +\alias{ss_header} +\title{Designation of header rows for custom sstable} +\usage{ +ss_header(sstable, rows) +} +\arguments{ +\item{sstable}{a data frame following sstable's grammar} + +\item{rows}{a numeric vector} +} +\value{ +a matrix of class ss_tbl +} +\description{ +This function set the designated rows as header rows of a sstable +} diff --git a/man/ss_huxtable.Rd b/man/ss_huxtable.Rd new file mode 100644 index 0000000..6af4387 --- /dev/null +++ b/man/ss_huxtable.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ss_huxtable} +\alias{ss_huxtable} +\alias{ss_huxtable.list} +\alias{ss_huxtable.default} +\title{Create summary table using huxtable package.} +\usage{ +ss_huxtable(sstable, ...) + +\method{ss_huxtable}{list}(sstable, add_footer = NULL, ...) + +\method{ss_huxtable}{default}( + sstable, + footer = NULL, + caption = NULL, + caption_pos = c("top", "bottom", "topleft", "topcenter", "topright", "bottomleft", + "bottomcenter", "bottomright"), + bg = c(grey(0.95), "white"), + border_width = 0.8, + border_color = grey(0.75), + wrap = FALSE, + ... +) +} +\arguments{ +\item{sstable}{a data frame following sstable's grammar} + +\item{...}{additional parameters that will be passed to ss_format if the sstable has yet to be formatted.} + +\item{add_footer}{additional footer lines to be appended to object footers} + +\item{footer}{a character vector each of which is the footnote of the flextable} + +\item{caption}{a string containing table caption. Default is NULL} + +\item{caption_pos}{A length-one character vector, +one of "top", "bottom", "topleft", "topcenter", "topright", "bottomleft", "bottomcenter", "bottomright". +Default is "bottomcenter". + +See also \link[huxtable]{caption_pos}} + +\item{bg}{a character vector that defines background color of the flextable. If length(bg) >= 2, the table will have stripe background, otherwise plain.} + +\item{border_width}{a number that defines huxtable border width} + +\item{border_color}{a character string that defines huxtable border color} + +\item{wrap}{a logical value. Default is FALSE. If TRUE, long texts would be wrapped, long lines would be broken. +This applies to the whole table. Please use huxtable::set_wrap instead if you want a cell-wise approach. +See also \link[huxtable]{wrap}} +} +\value{ +an object of class huxtable +} +\description{ +This function generate a huxtable from a sstable. +} +\seealso{ +\link[huxtable]{huxtable} +} diff --git a/man/ss_section.Rd b/man/ss_section.Rd new file mode 100644 index 0000000..3ac6654 --- /dev/null +++ b/man/ss_section.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ss_section} +\alias{ss_section} +\title{Designation of section title rows for custom sstable} +\usage{ +ss_section(sstable, rows) +} +\arguments{ +\item{sstable}{a data frame following sstable's grammar} + +\item{rows}{a numeric vector} +} +\value{ +a matrix of class ss_tbl +} +\description{ +This function set the designated rows as section title rows of an sstable +} diff --git a/man/ss_template.Rd b/man/ss_template.Rd new file mode 100644 index 0000000..0f95b83 --- /dev/null +++ b/man/ss_template.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ssformat.R +\name{ss_template} +\alias{ss_template} +\title{Set template for sstable} +\usage{ +ss_template(sstable, template = c("baseline", "survcomp", "ae")) +} +\arguments{ +\item{sstable}{a data frame following sstable's grammar} + +\item{template}{An accepted template for sstable: must be either 'baseline', 'survcomp', or 'ae'. + +If NA, the existing template in the sstable is kept as-is. It no template built-in, will return a no-template sstable instead.} +} +\value{ +a matrix of class ss_tbl +} +\description{ +This function set the template for sstable +} diff --git a/man/sstable.ae.Rd b/man/sstable.ae.Rd index 5d7d11b..e5b96bd 100644 --- a/man/sstable.ae.Rd +++ b/man/sstable.ae.Rd @@ -4,25 +4,59 @@ \alias{sstable.ae} \title{Create an adverse event summary table} \usage{ -sstable.ae(ae_data, fullid_data, id.var, aetype.var, grade.var = NULL, - arm.var, digits = 0, test = TRUE, pdigits = 3, pcutoff = 0.001, - chisq.test = FALSE, correct = FALSE, simulate.p.value = FALSE, - B = 2000, workspace = 1e+06, hybrid = FALSE, footer = NULL, - flextable = TRUE, bg = "#F2EFEE") +sstable.ae( + ae_data, + fullid_data, + group_data = NULL, + id.var, + aetype.var, + grade.var = NULL, + group.var = NULL, + group.var.priority = NULL, + arm.var, + sort.by, + digits = 0, + test = TRUE, + pdigits = 3, + pcutoff = 0.001, + chisq.test = FALSE, + correct = FALSE, + simulate.p.value = FALSE, + B = 2000, + workspace = 1e+06, + hybrid = FALSE, + print.aetype.header = length(aetype.var) > 1 | any(length(names(aetype.var)) > 0) | + any(isTRUE(nchar(names(aetype.var)) > 0)), + na.text = "(Missing)", + footer = NULL, + flextable = TRUE, + bg = "#F2EFEE" +) } \arguments{ \item{ae_data}{a data frame contains adverse event data.} \item{fullid_data}{a data frame contains treatment arm data of all participants (not just those had adverse event).} +\item{group_data}{a reference data frame contains the group name of each ae.} + \item{id.var}{a character specifies name of study id variable (exists in both adverse event data and treatment arm data).} \item{aetype.var}{a character specifies name of adverse event type variable (exists in adverse event data).} -\item{grade.var}{a character specifies name of adverse event grade variable (exists in adverse event data).} +\item{grade.var}{NULL or character specifies name of adverse event grade variable (exists in adverse event data).} + +\item{group.var}{a character specifies group (exists in adverse event data if group_data = NULL or group_data otherwise).} + +\item{group.var.priority}{a vector that specifies which groups will be appear first in the table.} \item{arm.var}{a character specifies name of treatment arm variable (exists in treatment arm data).} +\item{sort.by}{An unquoted formula of sorting options. + +Available options are `ep`, `pt`, `p`, or a combination of them (eg ep+pt-p); +A minus sign indicates a descending order.} + \item{digits}{a number specifies number of significant digits for numeric statistics.} \item{test}{a logical value specifies whether a statistical test will be performed to compare between treatment arms.} @@ -31,7 +65,9 @@ sstable.ae(ae_data, fullid_data, id.var, aetype.var, grade.var = NULL, \item{pcutoff}{a number specifies threshold value of p value to be displayed as "< pcutoff".} -\item{chisq.test}{a logical value specifies whether Chi-squared test or Fisher's exact test will be used to compare between treatment arms.} +\item{chisq.test}{a logical value specifies whether Chi-squared test or Fisher's exact test will be used to compare between treatment arms. + +Be aware that even when chisq.test==TRUE, if expected values are < 1, the later test will take over.} \item{correct}{a parameter for chisq.test().} @@ -43,6 +79,10 @@ sstable.ae(ae_data, fullid_data, id.var, aetype.var, grade.var = NULL, \item{hybrid}{a parameter for fisher.test().} +\item{print.aetype.header}{a logical value, whether to print the label of aetype.header.} + +\item{na.text}{[`(Missing)`] in-placed text for missing AE} + \item{footer}{a vector of strings to be used as footnote of table.} \item{flextable}{a logical value specifies whether output will be a flextable-type table.} diff --git a/man/sstable.baseline.Rd b/man/sstable.baseline.Rd index cca6013..b6414c6 100644 --- a/man/sstable.baseline.Rd +++ b/man/sstable.baseline.Rd @@ -4,15 +4,38 @@ \alias{sstable.baseline} \title{Create baseline table} \usage{ -sstable.baseline(formula, data, bycol = TRUE, pooledGroup = FALSE, - statistics = "med.IQR", continuous = NA, fullfreq = TRUE, - digits = 1, test = FALSE, pdigits = 3, pcutoff = 1e-04, - chisq.test = FALSE, correct = FALSE, simulate.p.value = FALSE, - B = 2000, workspace = 1e+06, hybrid = FALSE, footer = NULL, - flextable = FALSE, bg = "#F2EFEE") +sstable.baseline( + formula, + data, + bycol = TRUE, + pooledGroup = FALSE, + keepEmptyGroup = FALSE, + statistics = "mean, median (Q1-Q3)", + cont = NULL, + cate = NULL, + fullfreq = TRUE, + digits = 1, + test = FALSE, + pdigits = 3, + pcutoff = 1e-04, + chisq.test = FALSE, + correct = FALSE, + simulate.p.value = FALSE, + B = 2000, + workspace = 1e+06, + hybrid = FALSE, + footer = NULL, + flextable = FALSE, + bg = "#F2EFEE", + df = FALSE +) } \arguments{ -\item{formula}{a formula specifies variables for rows, variable for column and third-dimension variable.} +\item{formula}{a formula specifies variables for rows, variable for column and third-dimension variable. + +If formula is in the form of x+y ~ a, the function will summary x and y with respects to each value of a + +If formula is in the form of x+y ~ a|z, the function will summary z with respects to each value of {a,x} and {a, y}} \item{data}{a data frame to derive baseline table from.} @@ -20,9 +43,13 @@ sstable.baseline(formula, data, bycol = TRUE, pooledGroup = FALSE, \item{pooledGroup}{a logical value specifies whether to pool all subgroups of column variable.} +\item{keepEmptyGroup}{a logical value specifying whether should keep empty groups} + \item{statistics}{a character specifies summary statistics for continuous row variables.} -\item{continuous}{a logical vector specifies whether each row variables is continuous or categorical.} +\item{cont}{a vector specifies whether each row variables is continuous.} + +\item{cate}{a vector specifies whether each row variables is categorical.} \item{digits}{a number specifies number of significant digits for numeric statistics.} @@ -49,6 +76,8 @@ sstable.baseline(formula, data, bycol = TRUE, pooledGroup = FALSE, \item{flextable}{a logical value specifies whether output will be a flextable-type table.} \item{bg}{a character specifies color of the odd rows in the body of flextable-type table.} + +\item{df}{a logical values specifies whether output will be a draw dataframe.} } \value{ a flextable-type table or a list with values/headers/footers diff --git a/man/sstable.baseline.edit.Rd b/man/sstable.baseline.edit.Rd new file mode 100644 index 0000000..fed57b2 --- /dev/null +++ b/man/sstable.baseline.edit.Rd @@ -0,0 +1,87 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sstable.R +\name{sstable.baseline.edit} +\alias{sstable.baseline.edit} +\title{Create baseline table} +\usage{ +sstable.baseline.edit( + value, + formula, + data, + bycol = TRUE, + pooledGroup = FALSE, + keepEmptyGroup = FALSE, + statistics = "mean, median (Q1-Q3)", + cont = NULL, + cate = NULL, + fullfreq = TRUE, + digits = 1, + test = FALSE, + pdigits = 3, + pcutoff = 1e-04, + chisq.test = FALSE, + correct = FALSE, + simulate.p.value = FALSE, + B = 2000, + workspace = 1e+06, + hybrid = FALSE, + footer = NULL, + flextable = FALSE, + bg = "#F2EFEE" +) +} +\arguments{ +\item{formula}{a formula specifies variables for rows, variable for column and third-dimension variable. + +If formula is in the form of x+y ~ a, the function will summary x and y with respects to each value of a + +If formula is in the form of x+y ~ a|z, the function will summary z with respects to each value of {a,x} and {a, y}} + +\item{data}{a data frame to derive baseline table from.} + +\item{bycol}{a logical value specifies whether the summary will be by column or by row.} + +\item{pooledGroup}{a logical value specifies whether to pool all subgroups of column variable.} + +\item{keepEmptyGroup}{a logical value specifying whether should keep empty groups} + +\item{statistics}{a character specifies summary statistics for continuous row variables.} + +\item{cont}{a vector specifies whether each row variables is continuous.} + +\item{cate}{a vector specifies whether each row variables is categorical.} + +\item{digits}{a number specifies number of significant digits for numeric statistics.} + +\item{test}{a logical value specifies whether a statistical test will be performed to compare between treatment arms.} + +\item{pdigits}{a number specifies number of significant digits for p value.} + +\item{pcutoff}{a number specifies threshold value of p value to be displayed as "< pcutoff".} + +\item{chisq.test}{a logical value specifies whether Chi-squared test or Fisher's exact test will be used to compare between treatment arms.} + +\item{correct}{a parameter for chisq.test().} + +\item{simulate.p.value}{a parameter for chisq.test() and fisher.test().} + +\item{B}{a parameter for chisq.test() and fisher.test().} + +\item{workspace}{a parameter for fisher.test().} + +\item{hybrid}{a parameter for fisher.test().} + +\item{footer}{a vector of strings to be used as footnote of table.} + +\item{flextable}{a logical value specifies whether output will be a flextable-type table.} + +\item{bg}{a character specifies color of the odd rows in the body of flextable-type table.} + +\item{df}{a logical values specifies whether output will be a draw dataframe.} +} +\value{ +a flextable-type table or a list with values/headers/footers +} +\description{ +A function to create a simple summary baseline table. +} diff --git a/man/sstable.survcomp.Rd b/man/sstable.survcomp.Rd index ab086a5..0d43fef 100644 --- a/man/sstable.survcomp.Rd +++ b/man/sstable.survcomp.Rd @@ -2,40 +2,80 @@ % Please edit documentation in R/sstable.R \name{sstable.survcomp} \alias{sstable.survcomp} -\title{Summarize results for a Cox survival model with the treatment arm as the main covariate} +\title{Summarize results for a Cox survival model or restricted mean survival time with the treatment arm as the main covariate} \usage{ -sstable.survcomp(model, data, add.risk = TRUE, - add.prop.haz.test = TRUE, medsum = TRUE, digits = 2, pdigits = 3, - pcutoff = 0.001, footer = NULL, flextable = TRUE, bg = "#F2EFEE") +sstable.survcomp( + model, + data, + add.risk = TRUE, + time = Inf, + reference.arm = c("B", "A"), + compare.method = c("cox", "rmst", "cuminc"), + compare.args = list(), + add.prop.haz.test = TRUE, + medsum = TRUE, + p.compare = TRUE, + digits = 2, + pdigits = 3, + pcutoff = 0.001, + footer = NULL, + flextable = TRUE, + bg = "#F2EFEE" +) } \arguments{ -\item{model}{a formula which can be used to fit the Cox survival model. This formula can include other covariates than arm BUT arm must be the first covariate in the model.} +\item{model}{a formula which can be used to fit the survival model. This formula can include other covariates than arm BUT arm must be the first covariate in the model.} -\item{data}{a data frame to fir the Cox survival model.} +\item{data}{a data frame to fit the survival model.} -\item{add.risk}{a logical value specifies whether the event probability ("absolute risk") at time "infinity" should be displayed.} +\item{add.risk}{[\code{TRUE}] a logical value specifies whether the event probability ("absolute risk") at time "infinity" should be displayed.} -\item{add.prop.haz.test}{a logical value specifies whether a test for proportional hazards should be added.} +\item{time}{[\code{Inf}] the truncation time, affecting the descriptive and the RMST model, set to \code{Inf} to perform analyses at maximum time available +(minimax of the observed time across two arms in RMST model)} -\item{medsum}{a logical value specifies whether median (IQR) of time to event should be described.} +\item{reference.arm}{[\code{B}] reference arm, default to the second arm ("B"), change to "A" for base on the first arm} -\item{digits}{a number specifies number of significant digits for numeric statistics.} +\item{compare.method}{[\code{cox}] a string, either "cox" for CoxPH model, "cuminc" for cumulative incidence, or "rmst" for restricted mean survival time. +Note that if "cox" is specified and model is a mstate model, a Fine-Gray model is used. +If CoxPH is preferred, used Surv(t, ev == 'event-of-interest') on the LHS.} -\item{pdigits}{a number specifies number of significant digits for p value.} +\item{add.prop.haz.test}{[\code{TRUE}] (legacy, depricated), please move this to compare.args} -\item{pcutoff}{a number specifies threshold value of p value to be displayed as "< pcutoff".} +\item{medsum}{[\code{TRUE}] a logical value, specifying whether median (IQR) of time to event should be described.} -\item{footer}{a vector of strings to be used as footnote of table.} +\item{p.compare}{[\code{TRUE}] a logical value, specifying whether we should report p-value for the main comparison} -\item{flextable}{a logical value specifies whether output will be a flextable-type table.} +\item{digits}{[\code{2}] a number specifies number of significant digits for numeric statistics.} -\item{bg}{a character specifies color of the odd rows in the body of flextable-type table.} +\item{pdigits}{[\code{3}] a number specifies number of significant digits for p value.} + +\item{pcutoff}{[\code{0.001}] a number specifies threshold value of p value to be displayed as "< pcutoff".} + +\item{footer}{a [\code{NULL}] vector of strings to be used as footnote of table.} + +\item{flextable}{[\code{TRUE}] a logical value specifies whether output will be a flextable-type table.} + +\item{bg}{[\code{#F2EFEE}] a character specifies color of the odd rows in the body of flextable-type table.} + +\item{compare.args:}{a list of additional args for compare.methods, + + For compare.method = 'cox', it is + `add.prop.haz.test` [\code{TRUE}]: a logical value specifies whether a test for proportional hazards should be added,, additional args are fed directly to `survival::coxph`. + only when model is a mstate model, `cause`, default to whatever the first cause. + + For compare.method = 'cuminc', args are fed to \code{\link[eventglm:cumincglm]{cumincglm}} + `type`: [\code{diff}] a string, "diff" for difference in cumulative incidence, "ratio' for ratio of cumulative incidence, + other optional args include: model.censoring, formula.censoring, ipcw.method. See \code{\link[eventglm:cumincglm]{cumincglm}} for more details. + + For compare.method = 'rmst', args are fed to \code{\link[eventglm:rmeanglm]{rmeanglm}} , + `type`: [\code{diff}] a string, "diff" for difference in RMST, "ratio' for ratio of RMST, "lost.diff" for difference in restricted mean time lost (RMTL, = -diff), and "lost.ratio" for ratio of RMTL + other optional args include: model.censoring, formula.censoring, ipcw.method. See \code{\link[eventglm:rmeanglm]{rmeanglm}} for more details.} } \value{ a flextable-type table or a list with values/headers/footers } \description{ -A function to summarize results for a Cox survival model with the treatment arm (variable "arm") as the main covariate +A function to summarize results for a survival model with the treatment arm (variable "arm") as the main covariate } \author{ This function was originally written by Marcel Wolbers. Lam Phung Khanh did some modification. diff --git a/man/sstable.survcomp.subgroup.Rd b/man/sstable.survcomp.subgroup.Rd index 119cdde..d2cf6f2 100644 --- a/man/sstable.survcomp.subgroup.Rd +++ b/man/sstable.survcomp.subgroup.Rd @@ -2,39 +2,86 @@ % Please edit documentation in R/sstable.R \name{sstable.survcomp.subgroup} \alias{sstable.survcomp.subgroup} -\title{Summarize results for a Cox survival model by treatment arm and subgroup} +\title{Summarize results for a survival model by treatment arm and subgroup} \usage{ -sstable.survcomp.subgroup(base.model, subgroup.model, data, digits = 2, - pdigits = 3, pcutoff = 0.001, footer = NULL, flextable = TRUE, - bg = "#F2EFEE", ...) +sstable.survcomp.subgroup( + base.model, + subgroup.model, + overall.model, + data, + time = Inf, + reference.arm = c("B", "A"), + compare.method = c("cox", "rmst", "cuminc"), + compare.args = list(), + p.compare = TRUE, + digits = 2, + pdigits = 3, + pcutoff = 0.001, + footer = NULL, + flextable = TRUE, + bg = "#F2EFEE", + overall = TRUE, + ... +) } \arguments{ \item{base.model}{a formula from which sub-group specific estimates are extracted (!! arm must be the first covariate in the model).} \item{subgroup.model}{a formula of the form "~subgrouping.variable1+subgrouping.variable2" (!! subgrouping.variable must be factors and there should be nothing on the left-hand side of the formula).} -\item{data}{a data frame to fir the Cox survival model.} +\item{overall.model}{an optional one-sided formula for additional terms for overall population only} -\item{digits}{a number specifies number of significant digits for numeric statistics.} +\item{data}{a data frame to fit the survival model.} -\item{pdigits}{a number specifies number of significant digits for p value.} +\item{time}{[\code{Inf}] the truncation time, affecting the descriptive and the RMST model, set to \code{Inf} to perform analyses at maximum time available +(minimax of the observed time across two arms in RMST model)} -\item{pcutoff}{a number specifies threshold value of p value to be displayed as "< pcutoff".} +\item{reference.arm}{[\code{B}] reference arm, default to the second arm ("B"), change to "A" for base on the first arm} -\item{footer}{a vector of strings to be used as footnote of table.} +\item{compare.method}{[\code{cox}] a string, either "cox" for CoxPH model, "cuminc" for cumulative incidence, or "rmst" for restricted mean survival time. +Note that if "cox" is specified and model is a mstate model, a Fine-Gray model is used. +If CoxPH is preferred, used Surv(t, ev == 'event-of-interest') on the LHS.} -\item{flextable}{a logical value specifies whether output will be a flextable-type table.} +\item{p.compare}{[\code{TRUE}] a logical value, specifying whether we should report p-value for the main comparison} -\item{bg}{a character specifies color of the odd rows in the body of flextable-type table.} +\item{digits}{[\code{2}] a number specifies number of significant digits for numeric statistics.} -\item{...}{arguments that are passed to sstable.survcomp.} +\item{pdigits}{[\code{3}] a number specifies number of significant digits for p value.} + +\item{pcutoff}{[\code{0.001}] a number specifies threshold value of p value to be displayed as "< pcutoff".} + +\item{footer}{a [\code{NULL}] vector of strings to be used as footnote of table.} + +\item{flextable}{[\code{TRUE}] a logical value specifies whether output will be a flextable-type table.} + +\item{bg}{[\code{#F2EFEE}] a character specifies color of the odd rows in the body of flextable-type table.} + +\item{overall}{[\code{TRUE}] where to print overall model} + +\item{...}{arguments that are passed to sstable.survcomp} + +\item{add.risk}{[\code{TRUE}] a logical value specifies whether the event probability ("absolute risk") at time "infinity" should be displayed.} + +\item{compare.args:}{a list of additional args for compare.methods, + + For compare.method = 'cox', it is + `add.prop.haz.test` [\code{TRUE}]: a logical value specifies whether a test for proportional hazards should be added,, additional args are fed directly to `survival::coxph`. + only when model is a mstate model, `cause`, default to whatever the first cause. + + For compare.method = 'cuminc', args are fed to \code{\link[eventglm:cumincglm]{cumincglm}} + `type`: [\code{diff}] a string, "diff" for difference in cumulative incidence, "ratio' for ratio of cumulative incidence, + other optional args include: model.censoring, formula.censoring, ipcw.method. See \code{\link[eventglm:cumincglm]{cumincglm}} for more details. + + For compare.method = 'rmst', args are fed to \code{\link[eventglm:rmeanglm]{rmeanglm}} , + `type`: [\code{diff}] a string, "diff" for difference in RMST, "ratio' for ratio of RMST, "lost.diff" for difference in restricted mean time lost (RMTL, = -diff), and "lost.ratio" for ratio of RMTL + other optional args include: model.censoring, formula.censoring, ipcw.method. See \code{\link[eventglm:rmeanglm]{rmeanglm}} for more details.} } \value{ a flextable-type table or a list with values/headers/footers } \description{ -A function to summarize results for a Cox survival model by treatment arm (variable "arm") and subgroup. +A function to summarize results for a survival model by treatment arm (variable "arm") and subgroup. } \author{ -This function was originally written by Marcel Wolbers. Lam Phung Khanh did some modification. +This function was originally written by Marcel Wolbers. Trinh Dong and Lam Phung Khanh did some modification. } diff --git a/man/subgroup_effect.Rd b/man/subgroup_effect.Rd new file mode 100644 index 0000000..2ed5358 --- /dev/null +++ b/man/subgroup_effect.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/group_effect.R +\name{subgroup_effect} +\alias{subgroup_effect} +\title{Calculation of covariable effects within each value of another covariable that has interaction} +\usage{ +subgroup_effect( + formula, + model, + method = c("lik.ratio", "wald"), + transpose = FALSE, + stat_digits = 2, + p_digits = 4, + sstable = FALSE, + flextable = FALSE, + simplify = TRUE, + ... +) +} +\arguments{ +\item{formula}{A formula in the the form of A + B ~ X, where + +- X is the covariable to be concerned. X must be of type factor. +- A, B are the covarables having interaction with X whose effects will be calculated. +If . or blank. All covariables having interaction with X would be included.} + +\item{model}{A fitted glm model or a formula} + +\item{method}{a string whose value is either +"lik.ratio" for CI and tests based on likelihood ratio statistics (preferred) +or "wald" for CI and tests based on Wald statistics} + +\item{transpose}{logical value, default is FALSE, whether to return a transposed summary. See also \link{t.subgroup_logist_summary}} + +\item{stat_digits}{Number of decimal digits for statistics} + +\item{p_digits}{Number of decimal digits for the p-values} + +\item{sstable}{logical value specifying whether to return in sstable format. Default is FALSE. Set to TRUE forces verbose to FALSE} + +\item{flextable}{logical value specifying whether to build flextable object. Default it FALSE. Set to TRUE forces sstable to TRUE.} + +\item{simplify}{by default, if there is only one variable on each side of the formula and +no LHS is a binary, then the function will combine tables in each state of X to one. +Set to FALSE to avoid this behaviour.} + +\item{...}{additional parameters passed to glm to fit "model" (if model is a formula)} +} +\value{ +Under certain circumstances defined in param simplify, a flextable, an sstable, +a data.frame of class 'subgroup_logist_summary', +or a 'subgroup_logist_summary'/list of logist_summary, each represents one state of X. +} +\description{ +This function calculate the OR, CI, an p.value within each value of specified covariable. +} +\examples{ +y = sample(0:1, 1000, replace = T) +x1 = sample(1:100, 1000, replace = T) +x2 = sample(c("A", "B"), 1000, replace = T) +x3 = sample(c("C", "D", "E"), 1000, replace = T) +x4 = sample(c("F", "G"), 1000, replace = T) +fakefit = glm(y ~ x1*x3 + x2*x3 + x2*x4, family = binomial()) +C306::subgroup_effect(~x3, fakefit) +} +\seealso{ +\link{logist_summary}, \link{print.subgroup_logist_summary}, \link{t.subgroup_logist_summary} +} +\author{ +Trinh Dong Huu Khanh +} diff --git a/man/summarise_f.Rd b/man/summarise_f.Rd new file mode 100644 index 0000000..2359b22 --- /dev/null +++ b/man/summarise_f.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/func_mult.R +\name{summarise_f} +\alias{summarise_f} +\alias{summarise_f.data.frame} +\alias{summarise_f.data.table} +\alias{summarise_f.tbl} +\alias{summarise_f.grouped_df} +\title{Reduce multiple values by summarisation functions.} +\usage{ +summarise_f(.data, ...) + +\method{summarise_f}{data.frame}(.data, ...) + +\method{summarise_f}{data.table}(.data, ...) + +\method{summarise_f}{tbl}(.data, ...) + +\method{summarise_f}{grouped_df}(.data, ...) +} +\arguments{ +\item{.data}{A data.frame, data.table, or tbl} + +\item{...}{Summarisation functions. +Each of which must return a named list, whose names stand for new variables' names. +Anonymous functions must be wrapped in parentheses.} +} +\value{ +a data.frame, data.table, or a tbl +} +\description{ +Create variables summarising exisiting variables, by using summarisation function. +} +\examples{ +df <- data.frame(baz = 1:10, foo = c(rep(1, 5), rep(2, 5)), bar =4:13) +df \%>\% + dplyr::group_by(foo) \%>\% + summarise_f((function(baz) list(a = cumsum(baz), b = baz*2))(baz), rangemisc::overlap_collapse(bar, baz)) +} diff --git a/man/t.subgroup_logist_summary.Rd b/man/t.subgroup_logist_summary.Rd new file mode 100644 index 0000000..3ce41d3 --- /dev/null +++ b/man/t.subgroup_logist_summary.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/group_effect.R +\name{t.subgroup_logist_summary} +\alias{t.subgroup_logist_summary} +\title{Transpose a subgroup logist summary table} +\usage{ +\method{t}{subgroup_logist_summary}(x) +} +\arguments{ +\item{x}{an object of class subgroup_logist_summary} +} +\value{ +If x is a simplified subgroup_logist_summary (aka a data.frame), return itself. Otherwise, a transposed list of class subgroup_logist_summary +} +\description{ +A method to transpose logist summary table, rather than stratify by subgroup, it stratifies by covariables. +} +\examples{ +y = sample(0:1, 1000, replace = T) +x1 = sample(1:100, 1000, replace = T) +x2 = sample(c("A", "B"), 1000, replace = T) +x3 = sample(c("C", "D", "E"), 1000, replace = T) +x4 = sample(c("F", "G"), 1000, replace = T) +fakefit = glm(y ~ x1*x3 + x2*x3 + x2*x4, family = binomial()) +se = C306::subgroup_effect(~x3, fakefit) +t(se) +} +\seealso{ +\link{t} +} +\author{ +Trinh Dong Huu Khanh +} diff --git a/man/tidy_competingevent.Rd b/man/tidy_competingevent.Rd new file mode 100644 index 0000000..6796826 --- /dev/null +++ b/man/tidy_competingevent.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_ajsurvplot.R +\name{tidy_competingevent} +\alias{tidy_competingevent} +\title{Tidy competing risk mstate survival fit.} +\usage{ +tidy_competingevent( + formula, + data, + weights, + subset, + na.action, + main.event, + competing.event, + count, + id, + timefix, + tidy_types, + ... +) +} +\arguments{ +\item{formula}{A standard model formula, with survival on the left and covariates on the right} + +\item{data}{an optional data frame, list or environment (or object coercible by as.data.frame to a data frame) containing the variables in the model} + +\item{weights, subset, na.action, , count, id, timefix}{parameter passed to finegray model. See \code{\link[survival:finegray]{finegray}},} + +\item{main.event, competing.event}{main and competing event to plot} + +\item{tidy_types}{[c(main='risk', competing='survival')] summarisiation for main and competing events} + +\item{...}{other parameters passed to finegray (excluding etype)} +} +\value{ +a tibble +} +\description{ +This complements gg_ajurvplot2, provides the intermediate data for advanced ggplot manipulation +} diff --git a/man/tidy_survfit2.Rd b/man/tidy_survfit2.Rd new file mode 100644 index 0000000..5d0648b --- /dev/null +++ b/man/tidy_survfit2.Rd @@ -0,0 +1,14 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_ajsurvplot.R +\name{tidy_survfit2} +\alias{tidy_survfit2} +\title{Tidy survfit with strata save} +\usage{ +tidy_survfit2(x, times = NULL, type = "survival") +} +\arguments{ +\item{x, times, type}{same as \link[ggsurvfit:tidy_survfit]{tidy_survfit}} +} +\description{ +Same as \link[ggsurvfit:tidy_survfit]{tidy_survfit} but with strata saved. +} diff --git a/man/untidy_strata.Rd b/man/untidy_strata.Rd new file mode 100644 index 0000000..ee5a1a8 --- /dev/null +++ b/man/untidy_strata.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_ajsurvplot.R +\name{untidy_strata} +\alias{untidy_strata} +\title{Untidy the tidy_survfit} +\usage{ +untidy_strata(x, strata.col = "strata") +} +\description{ +Untidy the tidy_survfit +}