diff --git a/R/onco_resp.R b/R/onco_resp.R index 03c3b57..9d8d593 100644 --- a/R/onco_resp.R +++ b/R/onco_resp.R @@ -104,13 +104,13 @@ #' "7", "2020-02-02", "2020-02-16", "CR", #' "7", "2020-02-02", "2020-04-01", "NE", #' "8", "2020-02-01", "2020-02-16", "PD" -#' ) %>% +#' ) |> #' dplyr::mutate( #' ADT = lubridate::ymd(ADTC), #' TRTSDT = lubridate::ymd(TRTSDTC), #' PARAMCD = "OVR", #' PARAM = "Overall Response by Investigator" -#' ) %>% +#' ) |> #' dplyr::select(-TRTSDTC) #' #' # Derive BOR without confirmation. diff --git a/R/summarize-lsmeans.R b/R/summarize-lsmeans.R index 6381ba9..45b68ea 100644 --- a/R/summarize-lsmeans.R +++ b/R/summarize-lsmeans.R @@ -94,8 +94,8 @@ #' #' #' # fit ANCOVA model: -#' fit2 <- fev_data %>% -#' dplyr::filter(VISITN == 4 & !is.na(FEV1)) %>% +#' fit2 <- fev_data |> +#' dplyr::filter(VISITN == 4 & !is.na(FEV1)) |> #' lm(formula = FEV1 ~ FEV1_BL + RACE + SEX + ARMCD) #' #' s_get_lsmeans(fit2, "ARMCD") diff --git a/R/summarize-survival.R b/R/summarize-survival.R index bbeb027..a312947 100644 --- a/R/summarize-survival.R +++ b/R/summarize-survival.R @@ -66,7 +66,7 @@ #' data("whas500") #' #' # reorder the grouping variable -#' dat <- whas500 %>% +#' dat <- whas500 |> #' dplyr::mutate( #' AFB = factor(AFB, levels = c(1, 0)) #' ) @@ -94,7 +94,7 @@ #' # dummy three groups #' set.seed(123) #' subj <- sample(dat$ID, 100) -#' dat2 <- whas500 %>% +#' dat2 <- whas500 |> #' dplyr::mutate( #' AFB = dplyr::case_when( #' ID %in% subj ~ 2, @@ -103,12 +103,11 @@ #' AFB = factor(AFB, levels = c(1, 2, 0)) #' ) #' -#' # pairwise comparison #' s_get_survfit( #' data = dat2, #' formula = Surv(LENFOL, FSTAT) ~ AFB, #' time_point = c(12, 36, 60), -#' pairwise = TRUE +#' pairwise = FALSE #' ) s_get_survfit <- function(data, formula, @@ -126,7 +125,7 @@ s_get_survfit <- function(data, assert_numeric(time_point, null.ok = TRUE) assert_number(conf_level, lower = 0, upper = 1) assert_subset(strata, names(data)) - assert_number(rho) + assert_int(rho, lower = 0, upper = 1) assert_logical(pairwise) conf_type <- match.arg(conf_type, c("log-log", "log", "plain"), several.ok = FALSE) @@ -140,9 +139,11 @@ s_get_survfit <- function(data, ) grps <- if (is.null(km_fit$strata)) { - "Total" + grp_var <- "new_col" + data[[grp_var]] <- "Total" } else { - names(km_fit$strata) + grp_var <- attr(stats::terms(formula), "term.labels") + sub(paste0(grp_var, "="), "", names(km_fit$strata)) } # quantile survival time @@ -155,8 +156,9 @@ s_get_survfit <- function(data, } }) %>% purrr::list_rbind() %>% - tidyr::pivot_longer(cols = dplyr::all_of(grps), names_to = "group") %>% + tidyr::pivot_longer(cols = dplyr::contains(grps), names_to = "group") %>% mutate( + group = sub(paste0(grp_var, "="), "", .data$group), type = rep(c("time", "lower", "upper"), each = length(quantile) * length(grps)), quantile = rep(quantile * 100, each = length(grps), times = 3) ) %>% @@ -175,7 +177,7 @@ s_get_survfit <- function(data, # overall survival rate cols <- c("time", "n.risk", "n.event", "n.censor", "surv", "std.err", "lower", "upper") - overall <- summary(km_fit) + overall <- summary(km_fit, censored = TRUE) surv_overall_rate <- if (is.null(km_fit$strata)) { tibble::as_tibble(overall[cols]) %>% mutate(group = grps) @@ -211,7 +213,8 @@ s_get_survfit <- function(data, split(time_point) %>% purrr::map(function(x) { tibble::tibble( - group = paste(rev(x$group), collapse = " vs. "), + reference = x[["group"]][1], + comparison = x[["group"]][2], time = unique(x$time), surv.diff = diff(x$surv), std.err = sqrt(sum(x$std.err^2)), @@ -238,7 +241,8 @@ s_get_survfit <- function(data, rho = rho ) tibble::tibble( - comparsion = paste(bylist[, 2], bylist[, 1], sep = " vs. "), + reference = bylist[, 1], + comparison = bylist[, 2], method = survdiff$method, pval = as.numeric(mapply(function(x, y) { survdiff$p.value[x, y] @@ -273,6 +277,7 @@ s_get_survfit <- function(data, structure( list( + data = data, surv = list( median = surv_tb, quantile = quant, @@ -286,6 +291,7 @@ s_get_survfit <- function(data, ), params = list( formula = format(formula), + var = grp_var, quantile = quantile, time_point = time_point, conf_type = conf_type, @@ -346,7 +352,7 @@ s_get_survfit <- function(data, #' data("whas500") #' #' # reorder the grouping variable -#' dat <- whas500 %>% +#' dat <- whas500 |> #' dplyr::mutate( #' AFB = factor(AFB, levels = c(1, 0)) #' ) @@ -354,7 +360,7 @@ s_get_survfit <- function(data, #' #' s_get_coxph(data = dat, formula = Surv(LENFOL, FSTAT) ~ AFB, pval_method = "sc") #' -#' # specify the stratified log-rank test +#' # specify the stratified analysis #' s_get_coxph( #' data = dat, #' formula = Surv(LENFOL, FSTAT) ~ AFB, @@ -364,7 +370,7 @@ s_get_survfit <- function(data, #' # dummy three groups #' set.seed(123) #' subj <- sample(dat$ID, 100) -#' dat2 <- whas500 %>% +#' dat2 <- whas500 |> #' dplyr::mutate( #' AFB = dplyr::case_when( #' ID %in% subj ~ 2, @@ -395,7 +401,7 @@ s_get_coxph <- function(data, wald = "waldtest" ) - group_var <- attr(stats::terms(formula), "term.labels") + grp_var <- attr(stats::terms(formula), "term.labels") formula <- if (!is.null(strata)) { as.formula( paste0(format(formula), " + strata(", paste(strata, collapse = ", "), ")") @@ -404,7 +410,7 @@ s_get_coxph <- function(data, as.formula(formula) } - vardf <- unlist(data[, group_var]) + vardf <- unlist(data[, grp_var]) group <- if (!is.factor(vardf)) { droplevels(as.factor(vardf)) } else { @@ -419,8 +425,8 @@ s_get_coxph <- function(data, mods <- split(bylist, 1:nrow(bylist)) %>% purrr::map(function(x) { - cox_ss <- filter(data, !!sym(group_var) %in% x) %>% - mutate(!!sym(group_var) := droplevels(!!sym(group_var))) %>% + cox_ss <- filter(data, !!sym(grp_var) %in% x) %>% + mutate(!!sym(grp_var) := droplevels(!!sym(grp_var))) %>% coxph(formula = formula, ties = ties, ...) %>% summary(conf.int = conf_level, extend = TRUE) }) @@ -429,21 +435,19 @@ s_get_coxph <- function(data, purrr::imap(function(x, idx) { x[pval_name] %>% dplyr::bind_rows(.id = "method") %>% - mutate(comparsion = paste( - paste0(group_var, "=", rev(bylist[as.numeric(idx), ])), - collapse = " vs. " - )) %>% - select("comparsion", "method", "test", "df", "pval" = "pvalue") + mutate( + reference = bylist[as.numeric(idx), ][1], + comparison = bylist[as.numeric(idx), ][2] + ) %>% + select("reference", "comparison", "method", "test", "df", "pval" = "pvalue") }) %>% purrr::list_rbind() hr_tb <- mods %>% purrr::imap(function(x, idx) { tibble::tibble( - comparsion = paste( - paste0(group_var, "=", rev(bylist[as.numeric(idx), ])), - collapse = " vs. " - ), + reference = bylist[as.numeric(idx), ][1], + comparison = bylist[as.numeric(idx), ][2], n = x[["n"]], events = x[["nevent"]], hr = x[["conf.int"]][, 1], @@ -455,11 +459,13 @@ s_get_coxph <- function(data, structure( list( + data = data, hr = hr_tb, pval = pval_tb, params = list( formula = format(formula), - group = paste(group_var, grps, sep = "="), + var = grp_var, + group = grps, ties = ties, conf_level = conf_level, strata = strata, diff --git a/R/utils.R b/R/utils.R index c835cf9..c40ef2e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -51,7 +51,7 @@ h_pairwise_survdiff <- function(formula, } level.names <- levels(group) - ix <- setNames(seq_along(level.names), paste0(group_var, "=", level.names)) + ix <- setNames(seq_along(level.names), level.names) pval <- outer( ix[-1L], ix[-length(ix)], function(ivec, jvec) { diff --git a/man/derive_bor.Rd b/man/derive_bor.Rd index 5c16582..5a52d41 100644 --- a/man/derive_bor.Rd +++ b/man/derive_bor.Rd @@ -142,13 +142,13 @@ adrs <- tibble::tribble( "7", "2020-02-02", "2020-02-16", "CR", "7", "2020-02-02", "2020-04-01", "NE", "8", "2020-02-01", "2020-02-16", "PD" -) \%>\% +) |> dplyr::mutate( ADT = lubridate::ymd(ADTC), TRTSDT = lubridate::ymd(TRTSDTC), PARAMCD = "OVR", PARAM = "Overall Response by Investigator" - ) \%>\% + ) |> dplyr::select(-TRTSDTC) # Derive BOR without confirmation. diff --git a/man/s_get_coxph.Rd b/man/s_get_coxph.Rd index 21fed90..35660e8 100644 --- a/man/s_get_coxph.Rd +++ b/man/s_get_coxph.Rd @@ -57,7 +57,7 @@ hazards ratio, confidence interval and p-value for common clinical survival anal data("whas500") # reorder the grouping variable -dat <- whas500 \%>\% +dat <- whas500 |> dplyr::mutate( AFB = factor(AFB, levels = c(1, 0)) ) @@ -65,7 +65,7 @@ s_get_coxph(data = dat, formula = Surv(LENFOL, FSTAT) ~ AFB) s_get_coxph(data = dat, formula = Surv(LENFOL, FSTAT) ~ AFB, pval_method = "sc") -# specify the stratified log-rank test +# specify the stratified analysis s_get_coxph( data = dat, formula = Surv(LENFOL, FSTAT) ~ AFB, @@ -75,7 +75,7 @@ s_get_coxph( # dummy three groups set.seed(123) subj <- sample(dat$ID, 100) -dat2 <- whas500 \%>\% +dat2 <- whas500 |> dplyr::mutate( AFB = dplyr::case_when( ID \%in\% subj ~ 2, diff --git a/man/s_get_lsmeans.Rd b/man/s_get_lsmeans.Rd index 9b41ce4..5e27294 100644 --- a/man/s_get_lsmeans.Rd +++ b/man/s_get_lsmeans.Rd @@ -103,8 +103,8 @@ s_get_lsmeans(fit, "ARMCD", by = "AVISIT", null = 2, alternative = "greater") # fit ANCOVA model: -fit2 <- fev_data \%>\% - dplyr::filter(VISITN == 4 & !is.na(FEV1)) \%>\% +fit2 <- fev_data |> + dplyr::filter(VISITN == 4 & !is.na(FEV1)) |> lm(formula = FEV1 ~ FEV1_BL + RACE + SEX + ARMCD) s_get_lsmeans(fit2, "ARMCD") diff --git a/man/s_get_survfit.Rd b/man/s_get_survfit.Rd index 02acca5..d1532ed 100644 --- a/man/s_get_survfit.Rd +++ b/man/s_get_survfit.Rd @@ -7,7 +7,7 @@ \alias{h_pairwise_survdiff} \title{Summarize Survival Curves Analysis} \usage{ -\method{print}{s_survival}(x, ...) +\method{print}{s_survival}(x, fm = "months", ...) s_get_survfit( data, @@ -92,7 +92,7 @@ be no changes to other outputs when the \code{strata} argument is defined. data("whas500") # reorder the grouping variable -dat <- whas500 \%>\% +dat <- whas500 |> dplyr::mutate( AFB = factor(AFB, levels = c(1, 0)) ) @@ -120,7 +120,7 @@ s_get_survfit( # dummy three groups set.seed(123) subj <- sample(dat$ID, 100) -dat2 <- whas500 \%>\% +dat2 <- whas500 |> dplyr::mutate( AFB = dplyr::case_when( ID \%in\% subj ~ 2, @@ -129,12 +129,11 @@ dat2 <- whas500 \%>\% AFB = factor(AFB, levels = c(1, 2, 0)) ) -# pairwise comparison s_get_survfit( data = dat2, formula = Surv(LENFOL, FSTAT) ~ AFB, time_point = c(12, 36, 60), - pairwise = TRUE + pairwise = FALSE ) } \references{ diff --git a/tests/spelling.R b/tests/spelling.R index 6713838..13f77d9 100644 --- a/tests/spelling.R +++ b/tests/spelling.R @@ -1,3 +1,6 @@ -if(requireNamespace('spelling', quietly = TRUE)) - spelling::spell_check_test(vignettes = TRUE, error = FALSE, - skip_on_cran = TRUE) +if (requireNamespace("spelling", quietly = TRUE)) { + spelling::spell_check_test( + vignettes = TRUE, error = FALSE, + skip_on_cran = TRUE + ) +}