From 3388693477c0533d40eee12a734db5e0793205be Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Tue, 25 Jan 2022 21:08:55 -0500 Subject: [PATCH 01/11] Adding cumulative events and censored obs to survfit `*_risktable()` fns --- R/get_risktable.R | 89 +++++++++++++++++------------ man/add_risktable.Rd | 6 +- man/get_risktable.Rd | 6 +- tests/testthat/test-get_risktable.R | 57 +++++++++--------- 4 files changed, 89 insertions(+), 69 deletions(-) diff --git a/R/get_risktable.R b/R/get_risktable.R index e23d6f67..97f28910 100644 --- a/R/get_risktable.R +++ b/R/get_risktable.R @@ -19,10 +19,10 @@ get_risktable <- function(x, ...){ #' @param x an object of class `survfit` or `tidycuminc` #' @param times Numeric vector indicating the times at which the risk set, censored subjects, events are calculated. -#' @param statlist Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor". +#' @param statlist Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cumulative.event", "cumulative.censor". #' Default is "n.risk". Competing risk models also have the option of "cumulative.event" and "cumulative.censor" -#' @param label Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events" and "n.censor" -#' with "Censored". +#' @param label Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events", "n.censor" +#' with "Censored", "cumulative.event" with "Cum. Event", and "cumulative.censor" with "Cum. Censor". #' @param group String indicating the grouping variable for the risk tables. #' Current options are: #' \itemize{ @@ -53,10 +53,11 @@ get_risktable.survfit <- function( ,collapse = FALSE ,... ){ - + # User input validation --------------------------------------------------- - if (!base::all(statlist %in% c("n.risk", "n.censor", "n.event"))) + if (!base::all(statlist %in% c("n.risk", "n.censor", "n.event", + "cumulative.censor", "cumulative.event"))) stop("statlist argument not valid. Current options are n.risk, n.censor and n.event.") if (!is.null(label) & !base::all(is.character(label)) & !base::inherits(label, "factor")) @@ -70,28 +71,30 @@ get_risktable.survfit <- function( if (length(group)>1 | !(base::all(group %in% c("statlist", "strata")))) stop("group should equal statlist or strata.") - + # Clean input ------------------------------------------------------------ tidy_object <- tidyme(x) statlist <- unique(statlist) - + # Match amount of elements in label with statlist ------------------------- - + if (length(label) <= length(statlist)) { - - vlookup <- data.frame( statlist = c("n.risk", "n.censor", "n.event") - ,label = c("At risk", "Censored", "Events") + + vlookup <- data.frame(statlist = c("n.risk", "n.censor", "n.event", + "cumulative.censor", "cumulative.event") + ,label = c("At risk", "Censored", "Events", + "Cum. Censored", "Cum. Events") ,check.names = FALSE ,stringsAsFactors = FALSE) - + label <- c(label, rep(NA, length(statlist)-length(label))) - + have <- data.frame( cbind(label, statlist) ,check.names = FALSE ,stringsAsFactors = TRUE) - + label_lookup <- vlookup %>% dplyr::right_join(have, by = "statlist") %>% dplyr::mutate(label = dplyr::coalesce(label.y, label.x)) %>% @@ -99,21 +102,21 @@ get_risktable.survfit <- function( as.data.frame() } else if (length(label) > length(statlist)) { - + label_lookup <- data.frame( statlist = statlist ,label = label[1:length(statlist)] ,check.names = FALSE ,stringsAsFactors = TRUE) - + } - + # Ensure the order of the label corresponds to statlist order------------- - + statlist_order <- factor(statlist, levels = statlist) label_lookup[["statlist"]] <- factor(label_lookup[["statlist"]], levels = statlist) label_lookup <- label_lookup[order(label_lookup[["statlist"]]), ] - + # Generate time ticks ---------------------------------------------------- if (is.null(times)) { @@ -129,18 +132,27 @@ get_risktable.survfit <- function( # Risk table per statlist ------------------------------------------------- ## labels of risk table are strata, titles are specified through `label - - per_statlist <- data.frame( - time = survfit_summary$time, - strata = base::factor(.get_strata(survfit_summary[["strata"]]), levels = unique(.get_strata(survfit_summary[["strata"]]))), - n.risk = survfit_summary$n.risk, - n.event = survfit_summary$n.event, - n.censor = survfit_summary$n.censor - ) %>% - dplyr::arrange(strata, time)%>% - dplyr::rename(y_values = strata)%>% + + per_statlist <- + data.frame( + time = survfit_summary$time, + strata = + base::factor(.get_strata(survfit_summary[["strata"]]), + levels = unique(.get_strata(survfit_summary[["strata"]]))), + n.risk = survfit_summary$n.risk, + n.event = survfit_summary$n.event, + n.censor = survfit_summary$n.censor + ) %>% + dplyr::arrange(strata, time) %>% + dplyr::group_by(.data$strata) %>% + dplyr::mutate( + cumulative.event = cumsum(.data$n.event), + cumulative.censor = cumsum(.data$n.censor) + ) %>% + dplyr::ungroup() %>% + dplyr::rename(y_values = strata) %>% as.data.frame() - + final <- per_statlist[ , c("time", "y_values", levels(statlist_order))] attr(final, 'time_ticks') <- times @@ -152,17 +164,21 @@ get_risktable.survfit <- function( if (group == "strata" & collapse == FALSE){ per_strata <- per_statlist %>% dplyr::arrange(time) %>% - tidyr::pivot_longer( cols = c("n.risk", "n.censor", "n.event") + tidyr::pivot_longer( cols = c("n.risk", "n.censor", "n.event", + "cumulative.censor", "cumulative.event") ,names_to = "statlist" ,values_to = "values") %>% tidyr::pivot_wider(names_from = "y_values", values_from = values) %>% dplyr::rename(y_values = statlist) %>% dplyr::filter(y_values %in% statlist)%>% as.data.frame() - - per_strata[["y_values"]] <- factor(per_strata[["y_values"]], levels = levels(label_lookup[["statlist"]]), labels = label_lookup[["label"]]) + + per_strata[["y_values"]] <- + factor(per_strata[["y_values"]], + levels = levels(label_lookup[["statlist"]]), + labels = label_lookup[["label"]]) per_strata <- per_strata[order(per_strata[["y_values"]]), ] - + title <- levels(per_statlist[["y_values"]]) final <- per_strata @@ -182,10 +198,13 @@ get_risktable.survfit <- function( n.risk = sum(n.risk) ,n.event = sum(n.event) ,n.censor = sum(n.censor) + ,cumulative.event = sum(.data$cumulative.event) + ,cumulative.censor = sum(.data$cumulative.censor) ) %>% dplyr::ungroup() %>% dplyr::select(-strata) %>% - tidyr::pivot_longer( cols = c("n.risk", "n.censor", "n.event") + tidyr::pivot_longer( cols = c("n.risk", "n.censor", "n.event", + "cumulative.censor", "cumulative.event") ,names_to = "y_values" ,values_to = "Overall") %>% dplyr::filter(y_values %in% statlist) %>% diff --git a/man/add_risktable.Rd b/man/add_risktable.Rd index 1a560209..bd37bb33 100644 --- a/man/add_risktable.Rd +++ b/man/add_risktable.Rd @@ -35,11 +35,11 @@ add_risktable(gg, ...) \item{times}{Numeric vector indicating the times at which the risk set, censored subjects, events are calculated.} -\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor". +\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cumulative.event", "cumulative.censor". Default is "n.risk". Competing risk models also have the option of "cumulative.event" and "cumulative.censor"} -\item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events" and "n.censor" -with "Censored".} +\item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events", "n.censor" +with "Censored", "cumulative.event" with "Cum. Event", and "cumulative.censor" with "Cum. Censor".} \item{group}{String indicating the grouping variable for the risk tables. Current options are: diff --git a/man/get_risktable.Rd b/man/get_risktable.Rd index 375ed0ae..760e8c58 100644 --- a/man/get_risktable.Rd +++ b/man/get_risktable.Rd @@ -35,11 +35,11 @@ get_risktable(x, ...) \item{times}{Numeric vector indicating the times at which the risk set, censored subjects, events are calculated.} -\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor". +\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cumulative.event", "cumulative.censor". Default is "n.risk". Competing risk models also have the option of "cumulative.event" and "cumulative.censor"} -\item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events" and "n.censor" -with "Censored".} +\item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events", "n.censor" +with "Censored", "cumulative.event" with "Cum. Event", and "cumulative.censor" with "Cum. Censor".} \item{group}{String indicating the grouping variable for the risk tables. Current options are: diff --git a/tests/testthat/test-get_risktable.R b/tests/testthat/test-get_risktable.R index ca9e5ce5..ad7f6ab5 100644 --- a/tests/testthat/test-get_risktable.R +++ b/tests/testthat/test-get_risktable.R @@ -141,9 +141,9 @@ testthat::test_that("T2.3 The function proposes 11 times which are equally space testthat::test_that("T2.4 The risktable is correctly calculated when only 1 timepoint is used",{ survfit_object <- visR::estimate_KM(adtte) - risktable <- visR::get_risktable(survfit_object, times = 20, statlist = c("n.risk", "n.event", "n.censor")) - - expect <- c(summary(survfit_object, times=20)[["n.risk"]], summary(survfit_object, times=20)[["n.event"]], summary(survfit_object, times=20)[["n.censor"]]) + risktable <- visR::get_risktable(survfit_object, times = 20, statlist = c("n.risk", "n.event", "n.censor", "cumulative.event", "cumulative.censor")) + + expect <- c(summary(survfit_object, times=20)[["n.risk"]], summary(survfit_object, times=20)[["n.event"]], summary(survfit_object, times=20)[["n.censor"]], summary(survfit_object, times=20)[["n.event"]], summary(survfit_object, times=20)[["n.censor"]]) testthat::expect_equal(risktable[["Overall"]], expect) }) @@ -259,12 +259,12 @@ testthat::test_that("T5.5 The calculations are grouped by strata when group = `s survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") risktable <- visR::get_risktable( - survfit_object, - group = "strata", + survfit_object, + group = "strata", statlist=c("n.risk", "n.censor", "n.event") ) testthat::expect_equal( - object = colnames(risktable[3:length(colnames(risktable))]), + object = colnames(risktable[3:length(colnames(risktable))]), expected = gsub("^.*=", "", names(survfit_object$strata)) ) @@ -273,20 +273,20 @@ testthat::test_that("T5.5 The calculations are grouped by strata when group = `s testthat::test_that("T5.6 The calculations are grouped by statlist when group = `statlist`", { survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") - + risktable <- visR::get_risktable( - survfit_object, - group = "statlist", - statlist = c("n.risk", "n.censor", "n.event") + survfit_object, + group = "statlist", + statlist = c("n.risk", "n.censor", "n.event", "cumulative.censor", "cumulative.event") ) - + testthat::expect_equal( - object = levels(risktable[["y_values"]]), + object = levels(risktable[["y_values"]]), expected = gsub("^.*=", "", names(survfit_object$strata)) ) testthat::expect_equal( - object = colnames(risktable[3:length(colnames(risktable))]), - expected = c("n.risk", "n.censor", "n.event") + object = colnames(risktable[3:length(colnames(risktable))]), + expected = c("n.risk", "n.censor", "n.event", "cumulative.censor", "cumulative.event") ) }) @@ -313,25 +313,26 @@ testthat::test_that("T5.7 The calculations are in agreement with what is expecte class(risktable_ref) <- c("risktable", class(risktable_ref)) testthat::expect_equal(risktable_visR, risktable_ref) - + ## test for statlist survfit_object <- visR::estimate_KM(adtte) - risktable_visR <- visR::get_risktable(survfit_object, times = c(0,20), statlist = c("n.censor", "n.risk", "n.event")) + risktable_visR <- visR::get_risktable(survfit_object, times = c(0,20), + statlist = c("n.censor", "n.risk", "n.event", "cumulative.censor", "cumulative.event")) attr(risktable_visR, "time_ticks") <- NULL attr(risktable_visR, "title") <- NULL attr(risktable_visR, "statlist") <- NULL - - risktable_ref <- structure( - list(time = c(0, 20, 0, 20, 0, 20), - y_values = structure(c(1L,1L, 2L, 2L, 3L, 3L), .Label = c("Censored", "At risk", "Events"), class = "factor"), - Overall = c(0, 19, 254, 181, 0, 57) + + risktable_ref <- structure( + list(time = c(0, 20, 0, 20, 0, 20, 0, 20, 0, 20), + y_values = structure(c(1L,1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L), .Label = c("Censored", "At risk", "Events", "Cum. Censored", "Cum. Events"), class = "factor"), + Overall = c(0, 19, 254, 181, 0, 57, 0, 19, 0, 57) ), - row.names = c(2L, 5L, 1L, 4L, 3L, 6L), + row.names = c(2L, 7L, 1L, 6L, 3L, 8L, 4L, 9L, 5L, 10L), class = c("risktable", "data.frame") ) - + testthat::expect_equal(risktable_visR, risktable_ref) - + attributes(risktable_ref) }) @@ -356,15 +357,15 @@ testthat::test_that("T6.3 The calculations are grouped overall when collapse = T survfit_object_trt <- visR::estimate_KM(adtte, strata = "TRTA") survfit_object_all <- visR::estimate_KM(adtte) - + risktable_visR_trt <- visR::get_risktable(survfit_object_trt, group = "strata", collapse = TRUE) risktable_visR_all <- visR::get_risktable(survfit_object_all, group = "strata") - + testthat::expect_equal(risktable_visR_trt, risktable_visR_all) }) testthat::test_that("T6.4 The calculations are in agreement with expectations when grouped overall", { - + survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") risktable_ungroup <- visR::get_risktable(survfit_object, collapse = FALSE) risktable_group <- visR::get_risktable(survfit_object, collapse = TRUE) @@ -375,7 +376,7 @@ testthat::test_that("T6.4 The calculations are in agreement with expectations wh attributes(risktable_group) <- NULL attributes(risktable_test) <- NULL - + testthat::expect_equal(risktable_test, risktable_group) }) From ed134ccf87c004832b4da4e8f8d74157468b60ab Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Sun, 30 Jan 2022 14:34:14 -0500 Subject: [PATCH 02/11] Update get_risktable.R --- R/get_risktable.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/get_risktable.R b/R/get_risktable.R index 97f28910..88785105 100644 --- a/R/get_risktable.R +++ b/R/get_risktable.R @@ -139,15 +139,15 @@ get_risktable.survfit <- function( strata = base::factor(.get_strata(survfit_summary[["strata"]]), levels = unique(.get_strata(survfit_summary[["strata"]]))), - n.risk = survfit_summary$n.risk, - n.event = survfit_summary$n.event, - n.censor = survfit_summary$n.censor + n.risk = survfit_summary[["n.risk"]], + n.event = survfit_summary[["n.event"]], + n.censor = survfit_summary[["n.censor"]] ) %>% dplyr::arrange(strata, time) %>% - dplyr::group_by(.data$strata) %>% + dplyr::group_by(.data[["strata"]]) %>% dplyr::mutate( - cumulative.event = cumsum(.data$n.event), - cumulative.censor = cumsum(.data$n.censor) + cumulative.event = cumsum(.data[["n.event"]]), + cumulative.censor = cumsum(.data[["n.censor"]]) ) %>% dplyr::ungroup() %>% dplyr::rename(y_values = strata) %>% From 6516a2b296614024286b585162dce47997c55105 Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Mon, 31 Jan 2022 20:13:36 -0500 Subject: [PATCH 03/11] renamed cumulative.* to cum.* --- R/estimate_cuminc.R | 2 +- R/get_risktable.R | 36 ++++++++++++++--------------- man/add_risktable.Rd | 6 ++--- man/estimate_cuminc.Rd | 2 +- man/get_risktable.Rd | 6 ++--- tests/testthat/test-get_risktable.R | 8 +++---- 6 files changed, 30 insertions(+), 30 deletions(-) diff --git a/R/estimate_cuminc.R b/R/estimate_cuminc.R index 8ad844d6..1e52b855 100644 --- a/R/estimate_cuminc.R +++ b/R/estimate_cuminc.R @@ -26,7 +26,7 @@ #' ) %>% #' visr() %>% #' add_CI() %>% -#' add_risktable(statlist = c("n.risk", "cumulative.event")) +#' add_risktable(statlist = c("n.risk", "cum.event")) estimate_cuminc <- function(data ,strata = NULL diff --git a/R/get_risktable.R b/R/get_risktable.R index 88785105..f295cbdf 100644 --- a/R/get_risktable.R +++ b/R/get_risktable.R @@ -19,10 +19,10 @@ get_risktable <- function(x, ...){ #' @param x an object of class `survfit` or `tidycuminc` #' @param times Numeric vector indicating the times at which the risk set, censored subjects, events are calculated. -#' @param statlist Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cumulative.event", "cumulative.censor". -#' Default is "n.risk". Competing risk models also have the option of "cumulative.event" and "cumulative.censor" +#' @param statlist Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cum.event", "cum.censor". +#' Default is "n.risk". Competing risk models also have the option of "cum.event" and "cum.censor" #' @param label Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events", "n.censor" -#' with "Censored", "cumulative.event" with "Cum. Event", and "cumulative.censor" with "Cum. Censor". +#' with "Censored", "cum.event" with "Cum. Event", and "cum.censor" with "Cum. Censor". #' @param group String indicating the grouping variable for the risk tables. #' Current options are: #' \itemize{ @@ -57,7 +57,7 @@ get_risktable.survfit <- function( # User input validation --------------------------------------------------- if (!base::all(statlist %in% c("n.risk", "n.censor", "n.event", - "cumulative.censor", "cumulative.event"))) + "cum.censor", "cum.event"))) stop("statlist argument not valid. Current options are n.risk, n.censor and n.event.") if (!is.null(label) & !base::all(is.character(label)) & !base::inherits(label, "factor")) @@ -82,7 +82,7 @@ get_risktable.survfit <- function( if (length(label) <= length(statlist)) { vlookup <- data.frame(statlist = c("n.risk", "n.censor", "n.event", - "cumulative.censor", "cumulative.event") + "cum.censor", "cum.event") ,label = c("At risk", "Censored", "Events", "Cum. Censored", "Cum. Events") ,check.names = FALSE @@ -146,8 +146,8 @@ get_risktable.survfit <- function( dplyr::arrange(strata, time) %>% dplyr::group_by(.data[["strata"]]) %>% dplyr::mutate( - cumulative.event = cumsum(.data[["n.event"]]), - cumulative.censor = cumsum(.data[["n.censor"]]) + cum.event = cumsum(.data[["n.event"]]), + cum.censor = cumsum(.data[["n.censor"]]) ) %>% dplyr::ungroup() %>% dplyr::rename(y_values = strata) %>% @@ -165,7 +165,7 @@ get_risktable.survfit <- function( per_strata <- per_statlist %>% dplyr::arrange(time) %>% tidyr::pivot_longer( cols = c("n.risk", "n.censor", "n.event", - "cumulative.censor", "cumulative.event") + "cum.censor", "cum.event") ,names_to = "statlist" ,values_to = "values") %>% tidyr::pivot_wider(names_from = "y_values", values_from = values) %>% @@ -198,13 +198,13 @@ get_risktable.survfit <- function( n.risk = sum(n.risk) ,n.event = sum(n.event) ,n.censor = sum(n.censor) - ,cumulative.event = sum(.data$cumulative.event) - ,cumulative.censor = sum(.data$cumulative.censor) + ,cum.event = sum(.data$cum.event) + ,cum.censor = sum(.data$cum.censor) ) %>% dplyr::ungroup() %>% dplyr::select(-strata) %>% tidyr::pivot_longer( cols = c("n.risk", "n.censor", "n.event", - "cumulative.censor", "cumulative.event") + "cum.censor", "cum.event") ,names_to = "y_values" ,values_to = "Overall") %>% dplyr::filter(y_values %in% statlist) %>% @@ -242,8 +242,8 @@ get_risktable.tidycuminc <- function(x list(n.risk = "At Risk", n.event = "N Event", n.censor = "N Censored", - cumulative.event = "Cum. N Event", - cumulative.censor = "Cum. N Censored") + cum.event = "Cum. N Event", + cum.censor = "Cum. N Censored") label <- .reconcile_statlist_and_labels( @@ -266,8 +266,8 @@ get_risktable.tidycuminc <- function(x dplyr::group_by(dplyr::across(dplyr::any_of(c("time", "outcome", "strata")))) %>% dplyr::mutate( dplyr::across( - dplyr::any_of(c("n.risk", "n.event", "cumulative.event", - "n.censor", "cumulative.censor")), + dplyr::any_of(c("n.risk", "n.event", "cum.event", + "n.censor", "cum.censor")), ~sum(., na.rm = TRUE)) ) %>% dplyr::filter(dplyr::row_number() == 1L) %>% @@ -278,7 +278,7 @@ get_risktable.tidycuminc <- function(x result <- tidy %>% dplyr::select(dplyr::any_of(c("time", "strata", "n.risk", "n.event", - "cumulative.event", "n.censor", "cumulative.censor"))) %>% + "cum.event", "n.censor", "cum.censor"))) %>% tidyr::pivot_longer(cols = -c(.data$time, .data$strata)) %>% tidyr::pivot_wider( id_cols = c(.data$time, .data$name), @@ -299,8 +299,8 @@ get_risktable.tidycuminc <- function(x tidy %>% dplyr::select(.data$time, y_values = .data$strata, dplyr::any_of(c("n.risk", - "n.event", "cumulative.event", - "n.censor", "cumulative.censor"))) %>% + "n.event", "cum.event", + "n.censor", "cum.censor"))) %>% as.data.frame() attr(result, "statlist") <- names(lst_stat_labels_default[statlist]) diff --git a/man/add_risktable.Rd b/man/add_risktable.Rd index bd37bb33..ff95e976 100644 --- a/man/add_risktable.Rd +++ b/man/add_risktable.Rd @@ -35,11 +35,11 @@ add_risktable(gg, ...) \item{times}{Numeric vector indicating the times at which the risk set, censored subjects, events are calculated.} -\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cumulative.event", "cumulative.censor". -Default is "n.risk". Competing risk models also have the option of "cumulative.event" and "cumulative.censor"} +\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cum.event", "cum.censor". +Default is "n.risk". Competing risk models also have the option of "cum.event" and "cum.censor"} \item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events", "n.censor" -with "Censored", "cumulative.event" with "Cum. Event", and "cumulative.censor" with "Cum. Censor".} +with "Censored", "cum.event" with "Cum. Event", and "cum.censor" with "Cum. Censor".} \item{group}{String indicating the grouping variable for the risk tables. Current options are: diff --git a/man/estimate_cuminc.Rd b/man/estimate_cuminc.Rd index 90b9aef6..2f5445d4 100644 --- a/man/estimate_cuminc.Rd +++ b/man/estimate_cuminc.Rd @@ -44,5 +44,5 @@ estimate_cuminc( ) \%>\% visr() \%>\% add_CI() \%>\% - add_risktable(statlist = c("n.risk", "cumulative.event")) + add_risktable(statlist = c("n.risk", "cum.event")) } diff --git a/man/get_risktable.Rd b/man/get_risktable.Rd index 760e8c58..769b19d0 100644 --- a/man/get_risktable.Rd +++ b/man/get_risktable.Rd @@ -35,11 +35,11 @@ get_risktable(x, ...) \item{times}{Numeric vector indicating the times at which the risk set, censored subjects, events are calculated.} -\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cumulative.event", "cumulative.censor". -Default is "n.risk". Competing risk models also have the option of "cumulative.event" and "cumulative.censor"} +\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cum.event", "cum.censor". +Default is "n.risk". Competing risk models also have the option of "cum.event" and "cum.censor"} \item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events", "n.censor" -with "Censored", "cumulative.event" with "Cum. Event", and "cumulative.censor" with "Cum. Censor".} +with "Censored", "cum.event" with "Cum. Event", and "cum.censor" with "Cum. Censor".} \item{group}{String indicating the grouping variable for the risk tables. Current options are: diff --git a/tests/testthat/test-get_risktable.R b/tests/testthat/test-get_risktable.R index ad7f6ab5..f18f97a6 100644 --- a/tests/testthat/test-get_risktable.R +++ b/tests/testthat/test-get_risktable.R @@ -141,7 +141,7 @@ testthat::test_that("T2.3 The function proposes 11 times which are equally space testthat::test_that("T2.4 The risktable is correctly calculated when only 1 timepoint is used",{ survfit_object <- visR::estimate_KM(adtte) - risktable <- visR::get_risktable(survfit_object, times = 20, statlist = c("n.risk", "n.event", "n.censor", "cumulative.event", "cumulative.censor")) + risktable <- visR::get_risktable(survfit_object, times = 20, statlist = c("n.risk", "n.event", "n.censor", "cum.event", "cum.censor")) expect <- c(summary(survfit_object, times=20)[["n.risk"]], summary(survfit_object, times=20)[["n.event"]], summary(survfit_object, times=20)[["n.censor"]], summary(survfit_object, times=20)[["n.event"]], summary(survfit_object, times=20)[["n.censor"]]) testthat::expect_equal(risktable[["Overall"]], expect) @@ -277,7 +277,7 @@ testthat::test_that("T5.6 The calculations are grouped by statlist when group = risktable <- visR::get_risktable( survfit_object, group = "statlist", - statlist = c("n.risk", "n.censor", "n.event", "cumulative.censor", "cumulative.event") + statlist = c("n.risk", "n.censor", "n.event", "cum.censor", "cum.event") ) testthat::expect_equal( @@ -286,7 +286,7 @@ testthat::test_that("T5.6 The calculations are grouped by statlist when group = ) testthat::expect_equal( object = colnames(risktable[3:length(colnames(risktable))]), - expected = c("n.risk", "n.censor", "n.event", "cumulative.censor", "cumulative.event") + expected = c("n.risk", "n.censor", "n.event", "cum.censor", "cum.event") ) }) @@ -317,7 +317,7 @@ testthat::test_that("T5.7 The calculations are in agreement with what is expecte ## test for statlist survfit_object <- visR::estimate_KM(adtte) risktable_visR <- visR::get_risktable(survfit_object, times = c(0,20), - statlist = c("n.censor", "n.risk", "n.event", "cumulative.censor", "cumulative.event")) + statlist = c("n.censor", "n.risk", "n.event", "cum.censor", "cum.event")) attr(risktable_visR, "time_ticks") <- NULL attr(risktable_visR, "title") <- NULL attr(risktable_visR, "statlist") <- NULL From 976b49e8ff6b87302cc7b47b7ea31fb5ef1eba87 Mon Sep 17 00:00:00 2001 From: Steven Haesendonckx <47894155+SHAESEN2@users.noreply.github.com> Date: Sat, 5 Feb 2022 15:06:45 +0100 Subject: [PATCH 04/11] Updated testing for PR310 --- R/get_risktable.R | 32 +++--- tests/testthat/test-get_risktable.R | 157 +++++++++++++++++++++------- 2 files changed, 134 insertions(+), 55 deletions(-) diff --git a/R/get_risktable.R b/R/get_risktable.R index f295cbdf..d3d98c0c 100644 --- a/R/get_risktable.R +++ b/R/get_risktable.R @@ -19,10 +19,11 @@ get_risktable <- function(x, ...){ #' @param x an object of class `survfit` or `tidycuminc` #' @param times Numeric vector indicating the times at which the risk set, censored subjects, events are calculated. -#' @param statlist Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cum.event", "cum.censor". -#' Default is "n.risk". Competing risk models also have the option of "cum.event" and "cum.censor" -#' @param label Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events", "n.censor" -#' with "Censored", "cum.event" with "Cum. Event", and "cum.censor" with "Cum. Censor". +#' @param statlist Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" +#' "n.censor", "cum.event", "cum.censor". +#' Default is "n.risk". +#' @param label Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with +#' "Events", "n.censor" with "Censored", "cum.event" with "Cum. Event", and "cum.censor" with "Cum. Censor". #' @param group String indicating the grouping variable for the risk tables. #' Current options are: #' \itemize{ @@ -58,7 +59,8 @@ get_risktable.survfit <- function( if (!base::all(statlist %in% c("n.risk", "n.censor", "n.event", "cum.censor", "cum.event"))) - stop("statlist argument not valid. Current options are n.risk, n.censor and n.event.") + stop("statlist argument not valid. Current options are n.risk, n.censor, + n.event, cum.event, cum.censor") if (!is.null(label) & !base::all(is.character(label)) & !base::inherits(label, "factor")) stop("label arguments should be of class `character` or `factor`.") @@ -144,7 +146,7 @@ get_risktable.survfit <- function( n.censor = survfit_summary[["n.censor"]] ) %>% dplyr::arrange(strata, time) %>% - dplyr::group_by(.data[["strata"]]) %>% + dplyr::group_by(.data$strata) %>% dplyr::mutate( cum.event = cumsum(.data[["n.event"]]), cum.censor = cumsum(.data[["n.censor"]]) @@ -198,8 +200,8 @@ get_risktable.survfit <- function( n.risk = sum(n.risk) ,n.event = sum(n.event) ,n.censor = sum(n.censor) - ,cum.event = sum(.data$cum.event) - ,cum.censor = sum(.data$cum.censor) + ,cum.event = sum(.data[["cum.event"]]) + ,cum.censor = sum(.data[["cum.censor"]]) ) %>% dplyr::ungroup() %>% dplyr::select(-strata) %>% @@ -242,8 +244,8 @@ get_risktable.tidycuminc <- function(x list(n.risk = "At Risk", n.event = "N Event", n.censor = "N Censored", - cum.event = "Cum. N Event", - cum.censor = "Cum. N Censored") + cumulative.event = "Cum. N Event", + cumulative.censor = "Cum. N Censored") label <- .reconcile_statlist_and_labels( @@ -266,8 +268,8 @@ get_risktable.tidycuminc <- function(x dplyr::group_by(dplyr::across(dplyr::any_of(c("time", "outcome", "strata")))) %>% dplyr::mutate( dplyr::across( - dplyr::any_of(c("n.risk", "n.event", "cum.event", - "n.censor", "cum.censor")), + dplyr::any_of(c("n.risk", "n.event", "cumulative.event", + "n.censor", "cumulative.censor")), ~sum(., na.rm = TRUE)) ) %>% dplyr::filter(dplyr::row_number() == 1L) %>% @@ -278,7 +280,7 @@ get_risktable.tidycuminc <- function(x result <- tidy %>% dplyr::select(dplyr::any_of(c("time", "strata", "n.risk", "n.event", - "cum.event", "n.censor", "cum.censor"))) %>% + "cumulative.event", "n.censor", "cumulative.censor"))) %>% tidyr::pivot_longer(cols = -c(.data$time, .data$strata)) %>% tidyr::pivot_wider( id_cols = c(.data$time, .data$name), @@ -299,8 +301,8 @@ get_risktable.tidycuminc <- function(x tidy %>% dplyr::select(.data$time, y_values = .data$strata, dplyr::any_of(c("n.risk", - "n.event", "cum.event", - "n.censor", "cum.censor"))) %>% + "n.event", "cumulative.event", + "n.censor", "cumulative.censor"))) %>% as.data.frame() attr(result, "statlist") <- names(lst_stat_labels_default[statlist]) diff --git a/tests/testthat/test-get_risktable.R b/tests/testthat/test-get_risktable.R index f18f97a6..8cb72119 100644 --- a/tests/testthat/test-get_risktable.R +++ b/tests/testthat/test-get_risktable.R @@ -27,27 +27,33 @@ #' T4.1 The function supplies defaults to increase the length of the `label` vector to same length as the `statlist` vector #' T4.2 The supplied defaults for the `label` vector match the arguments specified in the `statlist` #' T4.3 The function limits the length of the `label` vector to the length of the `statlist` vector -#' T5. The function groups the calculation by strata, by statlist or overall -#' T5.1 An error when the `group` argument is not equal to `strata` or `statlist` -#' T5.2 An error when the `group` argument is not of length 1 -#' T5.3 No error when the `group` argument is `strata` -#' T5.4 No error when the `group` arguments is `statlist` -#' T5.5 The calculations are grouped by strata when group = `strata` -#' T5.6 The calculations are grouped by statlist when group = `statlist` -#' T5.7 The calculations are in agreement with what is expected -#' T6. The function allows the calculations to be grouped overall -#' T6.1 An error when the argument collapse is not boolean -#' T6.2 No error when the argument collapse is boolean -#' T6.3 The calculations are grouped overall when collapse = TRUE -#' T6.4 The calculations are in agreement with expectations when grouped overall -#' T6.5 No error when there is only one strata available and collapse = TRUE -#' T7. The output dataset is a data.frame with attributes for downstream processing -#' T7.1 The output dataset is a data.frame -#' T7.2 The output dataset has the attribute `time_ticks` that specifies the times -#' T7.3 The output dataset has the attribute `title` that specifies the labels used in downstream functions -#' T7.4 The output dataset has the attribute `statlist` that reflects the ´group´ used -#' T7. Tests for `get_risktable.tidycmprsk()` -#' T7.1 Results are accurate without error +#' T5. The functions calculates requested summary across time +#' T5.1 The function is able to calculate the number of events from a `survfit` object +#' T5.2 The function is able to calculate the number of censored events from a `survfit` object +#' T5.3 The function is able to calculate the number of at risk from a `survfit` object +#' T5.4 The function is able to calculate the cumulative number of censored events from a `survfit` object +#' T5.5 The function is able to calculate the cumulative number of events from a `survfit` object +#' T6. The function groups the calculation by strata, by statlist or overall +#' T6.1 An error when the `group` argument is not equal to `strata` or `statlist` +#' T6.2 An error when the `group` argument is not of length 1 +#' T6.3 No error when the `group` argument is `strata` +#' T6.4 No error when the `group` arguments is `statlist` +#' T6.5 The calculations are grouped by strata when group = `strata` +#' T6.6 The calculations are grouped by statlist when group = `statlist` +#' T6.7 The calculations are in agreement with what is expected +#' T7. The function allows the calculations to be grouped overall +#' T7.1 An error when the argument collapse is not boolean +#' T7.2 No error when the argument collapse is boolean +#' T7.3 The calculations are grouped overall when collapse = TRUE +#' T7.4 The calculations are in agreement with expectations when grouped overall +#' T7.5 No error when there is only one strata available and collapse = TRUE +#' T8. The output dataset is a data.frame with attributes for downstream processing +#' T8.1 The output dataset is a data.frame +#' T8.2 The output dataset has the attribute `time_ticks` that specifies the times +#' T8.3 The output dataset has the attribute `title` that specifies the labels used in downstream functions +#' T8.4 The output dataset has the attribute `statlist` that reflects the ´group´ used +#' T9. Tests for `get_risktable.tidycmprsk()` +#' T9.1 Results are accurate without error # Requirement T1 ---------------------------------------------------------- @@ -228,34 +234,105 @@ testthat::test_that("T4.3 The function limits the length of the `label` vector t # Requirement T5 --------------------------------------------------------------- -testthat::context("get_risktable.survfit - T5. The function groups the calculation by strata, by statlist or overall") +testthat::context("get_risktable.survfit - T5. T5. The functions calculates requested summary across time") -testthat::test_that("T5.1 An error when the `group` argument is not equal to `strata` or `statlist`",{ +testthat::test_that("T5.1 The function is able to calculate the number of events from a `survfit` object",{ + + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, 1-CNSR) ~ 1) + atrisk <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.risk"]] + + atrisk_visr <- visR::estimate_KM(adtte) %>% + visR::get_risktable(group = "statlist") %>% + dplyr::pull(n.risk) + + testthat::expect_equal(atrisk, atrisk_visr) + +}) + +testthat::test_that("T5.2 The function is able to calculate the number of censored events from a `survfit` object",{ + + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, CNSR) ~ 1) + censored <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.event"]] + + censor_visr <- visR::estimate_KM(adtte) %>% + visR::get_risktable(group = "statlist", statlist="n.censor") %>% + dplyr::pull(n.censor) + + testthat::expect_equal(censored, censor_visr) + +}) + +testthat::test_that("T5.3 The function is able to calculate the number of at risk from a `survfit` object",{ + + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, 1-CNSR) ~ 1) + events <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.event"]] + + events_visr <- visR::estimate_KM(adtte) %>% + visR::get_risktable(group = "statlist", statlist="n.event") %>% + dplyr::pull(n.event) + + testthat::expect_equal(events, events_visr) + +}) + +testthat::test_that("T5.4 The function is able to calculate the cumulative number of censored events from a `survfit` object",{ + + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, CNSR) ~ 1) + censored <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.event"]] + cum.censor <- cumsum(censored) + + cumcensor_visr <- visR::estimate_KM(adtte) %>% + visR::get_risktable(group = "statlist", statlist="cum.censor") %>% + dplyr::pull(cum.censor) + + testthat::expect_equal(cum.censor, cumcensor_visr) + +}) + +testthat::test_that("T5.5 The function is able to calculate the cumulative number of events from a `survfit` object",{ + + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, 1-CNSR) ~ 1) + events <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.event"]] + cum.events <- cumsum(events) + + cumevents_visr <- visR::estimate_KM(adtte) %>% + visR::get_risktable(group = "statlist", statlist="cum.event") %>% + dplyr::pull(cum.event) + + testthat::expect_equal(cum.events, cumevents_visr) + +}) + +# Requirement T6 --------------------------------------------------------------- + +testthat::context("get_risktable.survfit - T6. The function groups the calculation by strata, by statlist or overall") + +testthat::test_that("T6.1 An error when the `group` argument is not equal to `strata` or `statlist`",{ survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") testthat::expect_error(visR::get_risktable(survfit_object, group = "blah")) }) -testthat::test_that("T5.2 An error when the `group` argument is not of length 1", { +testthat::test_that("T6.2 An error when the `group` argument is not of length 1", { survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") testthat::expect_error(visR::get_risktable(survfit_object, group = c("statlist", "strata"))) }) -testthat::test_that("T5.3 No error when the `group` argument is `strata`", { +testthat::test_that("T6.3 No error when the `group` argument is `strata`", { survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") testthat::expect_error(visR::get_risktable(survfit_object, group = "strata"), NA) }) -testthat::test_that("T5.4 No error when the `group` arguments is `statlist`", { +testthat::test_that("T6.4 No error when the `group` arguments is `statlist`", { survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") testthat::expect_error(visR::get_risktable(survfit_object, group = "statlist"), NA) }) -testthat::test_that("T5.5 The calculations are grouped by strata when group = `strata`", { +testthat::test_that("T6.5 The calculations are grouped by strata when group = `strata`", { survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") risktable <- visR::get_risktable( @@ -270,7 +347,7 @@ testthat::test_that("T5.5 The calculations are grouped by strata when group = `s }) -testthat::test_that("T5.6 The calculations are grouped by statlist when group = `statlist`", { +testthat::test_that("T6.6 The calculations are grouped by statlist when group = `statlist`", { survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") @@ -290,7 +367,7 @@ testthat::test_that("T5.6 The calculations are grouped by statlist when group = ) }) -testthat::test_that("T5.7 The calculations are in agreement with what is expected", { +testthat::test_that("T6.7 The calculations are in agreement with what is expected", { ## test for strata survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") @@ -337,23 +414,23 @@ testthat::test_that("T5.7 The calculations are in agreement with what is expecte }) -# Requirement T6 --------------------------------------------------------------- +# Requirement T7 --------------------------------------------------------------- -testthat::context("get_risktable.survfit - T6. The function allows the calculations to be grouped overall ") +testthat::context("get_risktable.survfit - T7. The function allows the calculations to be grouped overall ") -testthat::test_that("T6.1 An error when the argument collapse is not boolean", { +testthat::test_that("T7.1 An error when the argument collapse is not boolean", { survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") testthat::expect_error(visR::get_risktable(survfit_object, collapse = "blah")) }) -testthat::test_that("T6.2 No error when the argument collapse is boolean", { +testthat::test_that("T7.2 No error when the argument collapse is boolean", { survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") testthat::expect_error(visR::get_risktable(survfit_object, collapse = TRUE), NA) }) -testthat::test_that("T6.3 The calculations are grouped overall when collapse = TRUE", { +testthat::test_that("T7.3 The calculations are grouped overall when collapse = TRUE", { survfit_object_trt <- visR::estimate_KM(adtte, strata = "TRTA") survfit_object_all <- visR::estimate_KM(adtte) @@ -364,7 +441,7 @@ testthat::test_that("T6.3 The calculations are grouped overall when collapse = T testthat::expect_equal(risktable_visR_trt, risktable_visR_all) }) -testthat::test_that("T6.4 The calculations are in agreement with expectations when grouped overall", { +testthat::test_that("T7.4 The calculations are in agreement with expectations when grouped overall", { survfit_object <- visR::estimate_KM(adtte, strata = "TRTA") risktable_ungroup <- visR::get_risktable(survfit_object, collapse = FALSE) @@ -380,7 +457,7 @@ testthat::test_that("T6.4 The calculations are in agreement with expectations wh testthat::expect_equal(risktable_test, risktable_group) }) -testthat::test_that("T6.5 No error when there is only one strata available and collapse = TRUE", { +testthat::test_that("T7.5 No error when there is only one strata available and collapse = TRUE", { survfit_object <- visR::estimate_KM(adtte) risktable_visR <- visR::get_risktable(survfit_object, collapse = TRUE) @@ -430,17 +507,17 @@ testthat::test_that("T7.4 The output dataset has the attribute `statlist` that r }) -testthat::context("T7. Tests for `get_risktable.tidycmprsk()`") +testthat::context("T8. Tests for `get_risktable.tidycmprsk()`") -testthat::test_that("T7.1 Results are accurate without error", { +testthat::test_that("T8.1 Results are accurate without error", { cuminc <- - estimate_cuminc( + visR::estimate_cuminc( tidycmprsk::trial, AVAL = "ttdeath", CNSR = "death_cr" ) - expect_equal( + testthat::expect_equal( cuminc %>% get_risktable(times = 12, statlist = c("n.risk", "n.event", "n.censor")), cuminc %>% From e6e62fc9381d3a1885b86f603767ef594c56a4cc Mon Sep 17 00:00:00 2001 From: Steven Haesendonckx <47894155+SHAESEN2@users.noreply.github.com> Date: Sat, 12 Feb 2022 08:36:14 +0100 Subject: [PATCH 05/11] Readress issue --- R/tidyme.R | 6 ++++-- tests/testthat/test-tidyme.R | 27 ++++++++++++++------------- 2 files changed, 18 insertions(+), 15 deletions(-) diff --git a/R/tidyme.R b/R/tidyme.R index a2eb1fb6..57962138 100644 --- a/R/tidyme.R +++ b/R/tidyme.R @@ -22,7 +22,9 @@ #' lm_tidied <- visR::tidyme(lm_object) #' lm_tidied #' -#' @return Tibble containing all list elements of the S3 object as columns +#' @return Tibble containing all list elements of the S3 object as columns. +#' The column 'strata' is a factor to ensure that the strata are sorted +#' in agreement with the order in the `survfit` object #' #' @rdname tidyme #' @@ -82,12 +84,12 @@ tidyme.survfit <- function(x, ...) { if (!is.null(x[["strata"]])) { retme[["strata"]] <- rep(names(x[["strata"]]), x[["strata"]]) - retme[["n.strata"]] <- rep(x[["n"]], x[["strata"]]) } } attr(retme, "survfit_object") <- survfit_object + retme[["strata"]] <- factor(retme[["strata"]], levels = unique(retme[["strata"]])) return(as.data.frame(retme)) } \ No newline at end of file diff --git a/tests/testthat/test-tidyme.R b/tests/testthat/test-tidyme.R index 5b63657a..6fade0c1 100644 --- a/tests/testthat/test-tidyme.R +++ b/tests/testthat/test-tidyme.R @@ -102,27 +102,28 @@ testthat::test_that("T3.2 The S3 method, associated with a `survfit` object, has dplyr::mutate(call = rep(list(survfit_object[["call"]]), sum(survfit_object[["strata"]]))) - surv_object_df["strata"] <- rep(names(survfit_object[["strata"]]), - survfit_object[["strata"]]) - - surv_object_df["strata"] <- factor(surv_object_df[["strata"]], levels = unique(surv_object_df[["strata"]])) - - surv_object_df["n.strata"] <- rep(survfit_object[["n"]], - survfit_object[["strata"]]) - surv_object_df["PARAM"] <- rep(survfit_object[["PARAM"]], sum(survfit_object[["strata"]])) surv_object_df["PARAMCD"] <- rep(survfit_object[["PARAMCD"]], sum(survfit_object[["strata"]])) - surv_object_df[["std.error"]] <- surv_object_df[["std.err"]] surv_object_df[["estimate"]] <- surv_object_df[["surv"]] + surv_object_df[["std.error"]] <- surv_object_df[["std.err"]] surv_object_df[["conf.low"]] <- surv_object_df[["lower"]] surv_object_df[["conf.high"]] <- surv_object_df[["upper"]] - cn <- colnames(survfit_object_tidy) + surv_object_df["strata"] <- rep(names(survfit_object[["strata"]]), + survfit_object[["strata"]]) + + surv_object_df["strata"] <- factor(surv_object_df[["strata"]], levels = unique(surv_object_df[["strata"]])) + + surv_object_df["n.strata"] <- rep(survfit_object[["n"]], + survfit_object[["strata"]]) - testthat::expect_equal(surv_object_df, survfit_object_tidy) + colnames(survfit_object_tidy) + colnames(surv_object_df) + + testthat::expect_equal(surv_object_df, survfit_object_tidy, check.attributes = FALSE) }) @@ -141,7 +142,7 @@ testthat::test_that("T3.3 The S3 method, associated with a `survfit` object, tur testthat::test_that("T3.4 The S3 method, assocated with a `survfit` object, turns the strata into a factor",{ dt <- adtte - dt[["TRTA"]] <- factor(dt[["TRTA"]], levels = c("Placebo", "Xanomeline Low Dose", "Xanomeline High Dose")) + dt[["TRTA"]] <- factor(dt[["TRTA"]], levels = c("Xanomeline Low Dose", "Xanomeline High Dose", "Placebo")) survfit_object <- visR::estimate_KM(data = dt, strata = "TRTA") survfit_object_tidy <- tidyme(survfit_object) @@ -187,4 +188,4 @@ testthat::test_that("T4.1 The S3 method, associated with a `survfit` object, cop }) -# END OF CODE ------------------------------------------------------------- +# END OF CODE ------------------------------------------------------------- \ No newline at end of file From ea5b5ca94f9d269792f8bd2f3860a5899d18e1db Mon Sep 17 00:00:00 2001 From: Steven Haesendonckx <47894155+SHAESEN2@users.noreply.github.com> Date: Sat, 12 Feb 2022 08:46:39 +0100 Subject: [PATCH 06/11] adressed comments --- R/get_risktable.R | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/R/get_risktable.R b/R/get_risktable.R index d3d98c0c..bbf42ca4 100644 --- a/R/get_risktable.R +++ b/R/get_risktable.R @@ -50,7 +50,7 @@ get_risktable.survfit <- function( ,times = NULL ,statlist = c("n.risk") ,label = NULL - ,group = "strata" + ,group = c("strata", "group") ,collapse = FALSE ,... ){ @@ -73,6 +73,8 @@ get_risktable.survfit <- function( if (length(group)>1 | !(base::all(group %in% c("statlist", "strata")))) stop("group should equal statlist or strata.") + + group <- match.arg(group) # Clean input ------------------------------------------------------------ @@ -236,16 +238,19 @@ get_risktable.tidycuminc <- function(x ,times = pretty(x$tidy$time, 10) ,statlist = c("n.risk") ,label = NULL - ,group = "strata" + ,group = c("strata", "statlist") ,collapse = FALSE ,...) { + + group <- match.arg(group) + # list of statistics and their default labels lst_stat_labels_default <- list(n.risk = "At Risk", - n.event = "N Event", - n.censor = "N Censored", - cumulative.event = "Cum. N Event", - cumulative.censor = "Cum. N Censored") + n.event = "Events", + n.censor = "Censored", + cumulative.event = "Cum. Events", + cumulative.censor = "Cum. Censored") label <- .reconcile_statlist_and_labels( @@ -276,7 +281,7 @@ get_risktable.tidycuminc <- function(x dplyr::ungroup() } - if (group %in% "strata" || isTRUE(collapse)) { + if (group == "strata" || isTRUE(collapse)) { result <- tidy %>% dplyr::select(dplyr::any_of(c("time", "strata", "n.risk", "n.event", @@ -296,7 +301,7 @@ get_risktable.tidycuminc <- function(x attr(result, "title") <- names(result) %>% setdiff(c("time", "y_values")) attr(result, "statlist") <- names(result) %>% setdiff(c("time", "y_values")) } - else if (group %in% "statlist") { + else if (group == "statlist") { result <- tidy %>% dplyr::select(.data$time, y_values = .data$strata, From 7817e43710a2bcf6e182da0f7a99ef2a05dcdaa5 Mon Sep 17 00:00:00 2001 From: GitHub Actions Date: Sat, 12 Feb 2022 08:01:21 +0000 Subject: [PATCH 07/11] Re-build README.Rmd --- README.md | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index 6fa53884..c871841f 100644 --- a/README.md +++ b/README.md @@ -43,9 +43,7 @@ current focus on developing a stable API. | [![R-CMD-check](https://github.com/openpharma/visR/actions/workflows/check-standard.yaml/badge.svg?branch=main)](https://github.com/openpharma/visR/actions/workflows/check-standard.yaml) | `main` branch | | [![pkgdown](https://github.com/openpharma/visR/actions/workflows/makedocs.yml/badge.svg)](https://github.com/openpharma/visR/actions/workflows/makedocs.yml) | Documentation building to [Github pages](https://openpharma.github.io/visR/) | | [![CRAN status](https://www.r-pkg.org/badges/version/visR)](https://CRAN.R-project.org/package=visR) | Latest CRAN release | - -| | `riskmetric` score | - +| | `riskmetric` score | @@ -119,8 +117,10 @@ covr::package_coverage( code = "tools::testInstalledPackage(pkg = 'visR', types = c('tests'))", quiet = FALSE ) -#> visR Coverage: 99.64% +#> visR Coverage: 97.51% +#> R/render.R: 81.44% #> R/estimate_cuminc.R: 85.71% +#> R/get_risktable.R: 97.38% #> R/visr.R: 99.12% #> R/add_annotation.R: 100.00% #> R/add_CI.R: 100.00% @@ -135,10 +135,8 @@ covr::package_coverage( #> R/get_COX_HR.R: 100.00% #> R/get_pvalue.R: 100.00% #> R/get_quantile.R: 100.00% -#> R/get_risktable.R: 100.00% #> R/get_summary.R: 100.00% #> R/get_tableone.R: 100.00% -#> R/render.R: 100.00% #> R/tableone.R: 100.00% #> R/tidyme.R: 100.00% #> R/utils_general.R: 100.00% From ed61406436276adcafe3f7b98011f69de3d6e83c Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Mon, 14 Feb 2022 12:38:05 -0500 Subject: [PATCH 08/11] risktable updates --- .gitignore | 1 + DESCRIPTION | 5 +--- R/add_risktable.R | 4 +-- R/estimate_cuminc.R | 13 ++------- R/get_risktable.R | 34 +++++++++++++----------- R/visr.R | 3 +++ man/add_risktable.Rd | 13 ++++----- man/get_risktable.Rd | 15 ++++++----- man/tidyme.Rd | 4 ++- tests/testthat/test-get_risktable.R | 41 ++++++++++++++--------------- 10 files changed, 65 insertions(+), 68 deletions(-) diff --git a/.gitignore b/.gitignore index 97ebdbf2..63eff68d 100644 --- a/.gitignore +++ b/.gitignore @@ -39,3 +39,4 @@ inst/doc README.html docs/ tests/testthat/_snaps/ +.Rprofile diff --git a/DESCRIPTION b/DESCRIPTION index ba226523..71f876e2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,13 +49,10 @@ Suggests: rmarkdown, testthat (>= 2.1.0), tibble, - tidycmprsk, + tidycmprsk (>= 0.1.1), vdiffr VignetteBuilder: knitr -Remotes: - MSKCC-Epi-Bio/tidycmprsk, - tidymodels/hardhat biocViews: Encoding: UTF-8 Roxygen: list(markdown = TRUE) diff --git a/R/add_risktable.R b/R/add_risktable.R index c297e431..8eccffb1 100644 --- a/R/add_risktable.R +++ b/R/add_risktable.R @@ -65,14 +65,14 @@ add_risktable <- function(gg, ...){ add_risktable.ggsurvfit <- function( gg ,times = NULL - ,statlist = c("n.risk") + ,statlist = "n.risk" ,label = NULL ,group = "strata" ,collapse = FALSE ,... ){ - # Obtain the relevant table ----------------------------------------------- + # Obtain the relevant table -------------------------------------------------- tidy_object <- gg$data estimate_object <- .extract_estimate_object(gg) diff --git a/R/estimate_cuminc.R b/R/estimate_cuminc.R index 048e9d19..ed6d9191 100644 --- a/R/estimate_cuminc.R +++ b/R/estimate_cuminc.R @@ -35,18 +35,9 @@ estimate_cuminc <- function(data ,CNSR = "CNSR" ,AVAL = "AVAL" ,conf.int = 0.95 - ,...){ + ,...) { # check for installation of tidycmprsk package - if (!"tidycmprsk" %in% rownames(utils::installed.packages()) || - utils::packageVersion("tidycmprsk") < "0.1.0.9003") { - message("Install updated version of 'tidycmprsk' with `devtools::install_github('MSKCC-Epi-Bio/tidycmprsk')`") - return(invisible()) - } - if (!"hardhat" %in% rownames(utils::installed.packages()) || - utils::packageVersion("hardhat") <= "0.1.6") { - message("Install updated version of 'hardhat' with `devtools::install_github('tidymodels/hardhat')`") - return(invisible()) - } + rlang::check_installed("tidycmprsk", version = "0.1.1") # checking/prepping inputs --------------------------------------------------- strata <- strata %||% "1" %>% paste(collapse = " + ") diff --git a/R/get_risktable.R b/R/get_risktable.R index bbf42ca4..18f72d3b 100644 --- a/R/get_risktable.R +++ b/R/get_risktable.R @@ -48,14 +48,15 @@ get_risktable <- function(x, ...){ get_risktable.survfit <- function( x ,times = NULL - ,statlist = c("n.risk") + ,statlist = "n.risk" ,label = NULL - ,group = c("strata", "group") + ,group = c("strata", "statlist") ,collapse = FALSE ,... ){ # User input validation --------------------------------------------------- + group <- match.arg(group) if (!base::all(statlist %in% c("n.risk", "n.censor", "n.event", "cum.censor", "cum.event"))) @@ -71,11 +72,6 @@ get_risktable.survfit <- function( if (base::any(times < 0)) stop("Negative times are not valid.") - if (length(group)>1 | !(base::all(group %in% c("statlist", "strata")))) - stop("group should equal statlist or strata.") - - group <- match.arg(group) - # Clean input ------------------------------------------------------------ tidy_object <- tidyme(x) @@ -241,16 +237,17 @@ get_risktable.tidycuminc <- function(x ,group = c("strata", "statlist") ,collapse = FALSE ,...) { - + # check for installation of tidycmprsk package + rlang::check_installed("tidycmprsk", version = "0.1.1") group <- match.arg(group) - + # list of statistics and their default labels lst_stat_labels_default <- list(n.risk = "At Risk", n.event = "Events", n.censor = "Censored", - cumulative.event = "Cum. Events", - cumulative.censor = "Cum. Censored") + cum.event = "Cum. Events", + cum.censor = "Cum. Censored") label <- .reconcile_statlist_and_labels( @@ -273,8 +270,8 @@ get_risktable.tidycuminc <- function(x dplyr::group_by(dplyr::across(dplyr::any_of(c("time", "outcome", "strata")))) %>% dplyr::mutate( dplyr::across( - dplyr::any_of(c("n.risk", "n.event", "cumulative.event", - "n.censor", "cumulative.censor")), + dplyr::any_of(c("n.risk", "n.event", "cum.event", + "n.censor", "cum.censor")), ~sum(., na.rm = TRUE)) ) %>% dplyr::filter(dplyr::row_number() == 1L) %>% @@ -282,21 +279,26 @@ get_risktable.tidycuminc <- function(x } if (group == "strata" || isTRUE(collapse)) { + strata_levels <- unique(tidy[["strata"]]) %>% sort() %>% as.character() + result <- tidy %>% dplyr::select(dplyr::any_of(c("time", "strata", "n.risk", "n.event", - "cumulative.event", "n.censor", "cumulative.censor"))) %>% + "cum.event", "n.censor", "cum.censor"))) %>% tidyr::pivot_longer(cols = -c(.data$time, .data$strata)) %>% tidyr::pivot_wider( id_cols = c(.data$time, .data$name), values_from = "value", names_from = "strata" ) %>% + dplyr::relocate(dplyr::any_of(strata_levels), .after = dplyr::last_col()) %>% dplyr::mutate( y_values = dplyr::recode(.data$name, !!!lst_stat_labels) ) %>% dplyr::filter(.data$name %in% .env$statlist) %>% dplyr::select(.data$time, .data$y_values, dplyr::everything(), -.data$name) %>% + dplyr::mutate(y_values = factor(.data[["y_values"]], levels = .env$label)) %>% + dplyr::arrange(.data[["y_values"]], .data[["time"]]) %>% as.data.frame() attr(result, "title") <- names(result) %>% setdiff(c("time", "y_values")) attr(result, "statlist") <- names(result) %>% setdiff(c("time", "y_values")) @@ -306,8 +308,8 @@ get_risktable.tidycuminc <- function(x tidy %>% dplyr::select(.data$time, y_values = .data$strata, dplyr::any_of(c("n.risk", - "n.event", "cumulative.event", - "n.censor", "cumulative.censor"))) %>% + "n.event", "cum.event", + "n.censor", "cum.censor"))) %>% as.data.frame() attr(result, "statlist") <- names(lst_stat_labels_default[statlist]) diff --git a/R/visr.R b/R/visr.R index 2d040aa8..915d1a2f 100644 --- a/R/visr.R +++ b/R/visr.R @@ -527,6 +527,9 @@ visr.tidycuminc <- function(x = NULL ,y_ticks = pretty(c(0, 1), 5) ,legend_position = "right" ,...){ + # check for installation of tidycmprsk package + rlang::check_installed("tidycmprsk", version = "0.1.1") + if (!is.null(x_units)) { x_label <- paste0(x_label, " (", x_units, ")") } diff --git a/man/add_risktable.Rd b/man/add_risktable.Rd index ff95e976..197d27a6 100644 --- a/man/add_risktable.Rd +++ b/man/add_risktable.Rd @@ -11,7 +11,7 @@ add_risktable(gg, ...) \method{add_risktable}{ggsurvfit}( gg, times = NULL, - statlist = c("n.risk"), + statlist = "n.risk", label = NULL, group = "strata", collapse = FALSE, @@ -21,7 +21,7 @@ add_risktable(gg, ...) \method{add_risktable}{ggtidycuminc}( gg, times = NULL, - statlist = c("n.risk"), + statlist = "n.risk", label = NULL, group = "strata", collapse = FALSE, @@ -35,11 +35,12 @@ add_risktable(gg, ...) \item{times}{Numeric vector indicating the times at which the risk set, censored subjects, events are calculated.} -\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cum.event", "cum.censor". -Default is "n.risk". Competing risk models also have the option of "cum.event" and "cum.censor"} +\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" +"n.censor", "cum.event", "cum.censor". +Default is "n.risk".} -\item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events", "n.censor" -with "Censored", "cum.event" with "Cum. Event", and "cum.censor" with "Cum. Censor".} +\item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with +"Events", "n.censor" with "Censored", "cum.event" with "Cum. Event", and "cum.censor" with "Cum. Censor".} \item{group}{String indicating the grouping variable for the risk tables. Current options are: diff --git a/man/get_risktable.Rd b/man/get_risktable.Rd index 769b19d0..bd4c611c 100644 --- a/man/get_risktable.Rd +++ b/man/get_risktable.Rd @@ -11,9 +11,9 @@ get_risktable(x, ...) \method{get_risktable}{survfit}( x, times = NULL, - statlist = c("n.risk"), + statlist = "n.risk", label = NULL, - group = "strata", + group = c("strata", "statlist"), collapse = FALSE, ... ) @@ -23,7 +23,7 @@ get_risktable(x, ...) times = pretty(x$tidy$time, 10), statlist = c("n.risk"), label = NULL, - group = "strata", + group = c("strata", "statlist"), collapse = FALSE, ... ) @@ -35,11 +35,12 @@ get_risktable(x, ...) \item{times}{Numeric vector indicating the times at which the risk set, censored subjects, events are calculated.} -\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" "n.censor", "cum.event", "cum.censor". -Default is "n.risk". Competing risk models also have the option of "cum.event" and "cum.censor"} +\item{statlist}{Character vector indicating which summary data to present. Current choices are "n.risk" "n.event" +"n.censor", "cum.event", "cum.censor". +Default is "n.risk".} -\item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with "Events", "n.censor" -with "Censored", "cum.event" with "Cum. Event", and "cum.censor" with "Cum. Censor".} +\item{label}{Character vector with labels for the statlist. Default matches "n.risk" with "At risk", "n.event" with +"Events", "n.censor" with "Censored", "cum.event" with "Cum. Event", and "cum.censor" with "Cum. Censor".} \item{group}{String indicating the grouping variable for the risk tables. Current options are: diff --git a/man/tidyme.Rd b/man/tidyme.Rd index bd2ba8f3..d131664c 100644 --- a/man/tidyme.Rd +++ b/man/tidyme.Rd @@ -18,7 +18,9 @@ tidyme(x, ...) \item{...}{other arguments passed on to the method} } \value{ -Tibble containing all list elements of the S3 object as columns +Tibble containing all list elements of the S3 object as columns. +The column 'strata' is a factor to ensure that the strata are sorted +in agreement with the order in the \code{survfit} object } \description{ S3 method for extended tidying of selected model outputs. Note diff --git a/tests/testthat/test-get_risktable.R b/tests/testthat/test-get_risktable.R index c3c4d5d1..5a6becba 100644 --- a/tests/testthat/test-get_risktable.R +++ b/tests/testthat/test-get_risktable.R @@ -239,68 +239,68 @@ testthat::test_that("T4.3 The function limits the length of the `label` vector t testthat::context("get_risktable.survfit - T5. T5. The functions calculates requested summary across time") testthat::test_that("T5.1 The function is able to calculate the number of events from a `survfit` object",{ - + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, 1-CNSR) ~ 1) atrisk <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.risk"]] - + atrisk_visr <- visR::estimate_KM(adtte) %>% visR::get_risktable(group = "statlist") %>% dplyr::pull(n.risk) - + testthat::expect_equal(atrisk, atrisk_visr) }) testthat::test_that("T5.2 The function is able to calculate the number of censored events from a `survfit` object",{ - + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, CNSR) ~ 1) censored <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.event"]] - + censor_visr <- visR::estimate_KM(adtte) %>% visR::get_risktable(group = "statlist", statlist="n.censor") %>% dplyr::pull(n.censor) - + testthat::expect_equal(censored, censor_visr) }) testthat::test_that("T5.3 The function is able to calculate the number of at risk from a `survfit` object",{ - + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, 1-CNSR) ~ 1) events <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.event"]] - + events_visr <- visR::estimate_KM(adtte) %>% visR::get_risktable(group = "statlist", statlist="n.event") %>% dplyr::pull(n.event) - + testthat::expect_equal(events, events_visr) }) testthat::test_that("T5.4 The function is able to calculate the cumulative number of censored events from a `survfit` object",{ - + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, CNSR) ~ 1) censored <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.event"]] cum.censor <- cumsum(censored) - + cumcensor_visr <- visR::estimate_KM(adtte) %>% visR::get_risktable(group = "statlist", statlist="cum.censor") %>% dplyr::pull(cum.censor) - + testthat::expect_equal(cum.censor, cumcensor_visr) }) testthat::test_that("T5.5 The function is able to calculate the cumulative number of events from a `survfit` object",{ - + survobj <- survival::survfit.formula(data = adtte, formula = survival::Surv(AVAL, 1-CNSR) ~ 1) events <- summary(survobj, times = c(0,20,40,60,80,100,120,140,160,180,200), extend = TRUE)[["n.event"]] cum.events <- cumsum(events) - + cumevents_visr <- visR::estimate_KM(adtte) %>% visR::get_risktable(group = "statlist", statlist="cum.event") %>% dplyr::pull(cum.event) - + testthat::expect_equal(cum.events, cumevents_visr) }) @@ -523,24 +523,23 @@ testthat::test_that("T8.1 Results are accurate without error", { testthat::expect_equal( cuminc %>% - get_risktable(times = 12, statlist = c("n.risk", "n.event", "n.censor")), + get_risktable(times = 12, statlist = c("n.event", "n.risk", "n.censor")), cuminc %>% tidycmprsk::tidy(times = 12) %>% dplyr::filter(outcome %in% "death from cancer") %>% dplyr::select(time, n.risk, n.event, n.censor) %>% tidyr::pivot_longer(cols = c(n.risk, n.event, n.censor)) %>% dplyr::mutate( - name = dplyr::recode(name, - n.risk = "At Risk", - n.event = "N Event", - n.censor = "N Censored") + name = factor(name, + levels = c("n.event", "n.risk", "n.censor"), + labels = c("Events", "At Risk", "Censored")) ) %>% + dplyr::arrange(.data$name) %>% rlang::set_names(c("time", "y_values", "Overall")) %>% as.data.frame(), ignore_attr = TRUE, check.attributes = FALSE ) - }) # END OF CODE ------------------------------------------------------------- From b1ea3e65e048a85424d2431c08fa824107353fa5 Mon Sep 17 00:00:00 2001 From: GitHub Actions Date: Mon, 14 Feb 2022 17:46:05 +0000 Subject: [PATCH 09/11] Re-build README.Rmd --- README.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index c871841f..8caff649 100644 --- a/README.md +++ b/README.md @@ -43,7 +43,7 @@ current focus on developing a stable API. | [![R-CMD-check](https://github.com/openpharma/visR/actions/workflows/check-standard.yaml/badge.svg?branch=main)](https://github.com/openpharma/visR/actions/workflows/check-standard.yaml) | `main` branch | | [![pkgdown](https://github.com/openpharma/visR/actions/workflows/makedocs.yml/badge.svg)](https://github.com/openpharma/visR/actions/workflows/makedocs.yml) | Documentation building to [Github pages](https://openpharma.github.io/visR/) | | [![CRAN status](https://www.r-pkg.org/badges/version/visR)](https://CRAN.R-project.org/package=visR) | Latest CRAN release | -| | `riskmetric` score | +| | `riskmetric` score | @@ -117,10 +117,7 @@ covr::package_coverage( code = "tools::testInstalledPackage(pkg = 'visR', types = c('tests'))", quiet = FALSE ) -#> visR Coverage: 97.51% -#> R/render.R: 81.44% -#> R/estimate_cuminc.R: 85.71% -#> R/get_risktable.R: 97.38% +#> visR Coverage: 99.88% #> R/visr.R: 99.12% #> R/add_annotation.R: 100.00% #> R/add_CI.R: 100.00% @@ -130,13 +127,16 @@ covr::package_coverage( #> R/add_risktable.R: 100.00% #> R/apply_attrition.R: 100.00% #> R/apply_theme.R: 100.00% +#> R/estimate_cuminc.R: 100.00% #> R/estimate_KM.R: 100.00% #> R/get_attrition.R: 100.00% #> R/get_COX_HR.R: 100.00% #> R/get_pvalue.R: 100.00% #> R/get_quantile.R: 100.00% +#> R/get_risktable.R: 100.00% #> R/get_summary.R: 100.00% #> R/get_tableone.R: 100.00% +#> R/render.R: 100.00% #> R/tableone.R: 100.00% #> R/tidyme.R: 100.00% #> R/utils_general.R: 100.00% From eb273ea38d9256c18e754ec779ac69de0c93ace7 Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Wed, 16 Feb 2022 07:57:46 -0500 Subject: [PATCH 10/11] rlang prefix updates --- R/estimate_cuminc.R | 8 ++++---- R/get_risktable.R | 18 +++++++++--------- tests/testthat/test-get_risktable.R | 2 +- 3 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/estimate_cuminc.R b/R/estimate_cuminc.R index ed6d9191..aaf61d3a 100644 --- a/R/estimate_cuminc.R +++ b/R/estimate_cuminc.R @@ -60,12 +60,12 @@ estimate_cuminc <- function(data visr_tidy_tidycuminc <- function(x, times = NULL) { df_visr_tidy <- tidycmprsk::tidy(x, times = times) %>% - dplyr::filter(.data$outcome %in% names(x$failcode)[1]) %>% + dplyr::filter(.data[["outcome"]] %in% names(x$failcode)[1]) %>% # renaming to match column name in the survfit equivalent of these functions dplyr::rename( - est = .data$estimate, - est.lower = .data$conf.low, - est.upper = .data$conf.high + est = .data[["estimate"]], + est.lower = .data[["conf.low"]], + est.upper = .data[["conf.high"]] ) # adding strata column if not already present diff --git a/R/get_risktable.R b/R/get_risktable.R index 18f72d3b..17d2448c 100644 --- a/R/get_risktable.R +++ b/R/get_risktable.R @@ -143,8 +143,8 @@ get_risktable.survfit <- function( n.event = survfit_summary[["n.event"]], n.censor = survfit_summary[["n.censor"]] ) %>% - dplyr::arrange(strata, time) %>% - dplyr::group_by(.data$strata) %>% + dplyr::arrange(.data[["strata"]], .data[["time"]]) %>% + dplyr::group_by(.data[["strata"]]) %>% dplyr::mutate( cum.event = cumsum(.data[["n.event"]]), cum.censor = cumsum(.data[["n.censor"]]) @@ -285,19 +285,19 @@ get_risktable.tidycuminc <- function(x tidy %>% dplyr::select(dplyr::any_of(c("time", "strata", "n.risk", "n.event", "cum.event", "n.censor", "cum.censor"))) %>% - tidyr::pivot_longer(cols = -c(.data$time, .data$strata)) %>% + tidyr::pivot_longer(cols = -c(.data[["time"]], .data[["strata"]])) %>% tidyr::pivot_wider( - id_cols = c(.data$time, .data$name), + id_cols = c(.data[["time"]], .data[["name"]]), values_from = "value", names_from = "strata" ) %>% dplyr::relocate(dplyr::any_of(strata_levels), .after = dplyr::last_col()) %>% dplyr::mutate( - y_values = dplyr::recode(.data$name, !!!lst_stat_labels) + y_values = dplyr::recode(.data[["name"]], !!!lst_stat_labels) ) %>% - dplyr::filter(.data$name %in% .env$statlist) %>% - dplyr::select(.data$time, .data$y_values, dplyr::everything(), -.data$name) %>% - dplyr::mutate(y_values = factor(.data[["y_values"]], levels = .env$label)) %>% + dplyr::filter(.data[["name"]] %in% .env[["statlist"]]) %>% + dplyr::select(.data[["time"]], .data[["y_values"]], dplyr::everything(), -.data[["name"]]) %>% + dplyr::mutate(y_values = factor(.data[["y_values"]], levels = .env[["label"]])) %>% dplyr::arrange(.data[["y_values"]], .data[["time"]]) %>% as.data.frame() attr(result, "title") <- names(result) %>% setdiff(c("time", "y_values")) @@ -306,7 +306,7 @@ get_risktable.tidycuminc <- function(x else if (group == "statlist") { result <- tidy %>% - dplyr::select(.data$time, y_values = .data$strata, + dplyr::select(.data[["time"]], y_values = .data[["strata"]], dplyr::any_of(c("n.risk", "n.event", "cum.event", "n.censor", "cum.censor"))) %>% diff --git a/tests/testthat/test-get_risktable.R b/tests/testthat/test-get_risktable.R index 5a6becba..f7f28bed 100644 --- a/tests/testthat/test-get_risktable.R +++ b/tests/testthat/test-get_risktable.R @@ -534,7 +534,7 @@ testthat::test_that("T8.1 Results are accurate without error", { levels = c("n.event", "n.risk", "n.censor"), labels = c("Events", "At Risk", "Censored")) ) %>% - dplyr::arrange(.data$name) %>% + dplyr::arrange(.data[["name"]]) %>% rlang::set_names(c("time", "y_values", "Overall")) %>% as.data.frame(), ignore_attr = TRUE, From dd0ed28df26a39803f3b1d84d4b9ea2265320e15 Mon Sep 17 00:00:00 2001 From: GitHub Actions Date: Wed, 16 Feb 2022 13:03:56 +0000 Subject: [PATCH 11/11] Re-build README.Rmd --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 8caff649..97d1167a 100644 --- a/README.md +++ b/README.md @@ -43,7 +43,7 @@ current focus on developing a stable API. | [![R-CMD-check](https://github.com/openpharma/visR/actions/workflows/check-standard.yaml/badge.svg?branch=main)](https://github.com/openpharma/visR/actions/workflows/check-standard.yaml) | `main` branch | | [![pkgdown](https://github.com/openpharma/visR/actions/workflows/makedocs.yml/badge.svg)](https://github.com/openpharma/visR/actions/workflows/makedocs.yml) | Documentation building to [Github pages](https://openpharma.github.io/visR/) | | [![CRAN status](https://www.r-pkg.org/badges/version/visR)](https://CRAN.R-project.org/package=visR) | Latest CRAN release | -| | `riskmetric` score | +| | `riskmetric` score |