Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
d7ddf20
commit e24d87d
Showing
12 changed files
with
225 additions
and
300 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file was deleted.
Oops, something went wrong.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,72 +1,73 @@ | ||
| #' @title Step function confidence intervals for ggplot2 | ||
| #' @description Produces a step function confidence interval for survival curves. Essentially | ||
| #' the geom_step() for confidence intervals which ggplot2 elects not to provide. | ||
| #' @param mapping Aesthetic mappings with aes() function. Like geom_ribbon(), you must provide | ||
| #' columns for x, ymin (lower limit), ymax (upper limit). | ||
| #' @param data The data to be displayed in this layer. Can inherit from ggplot parent. | ||
| #' @param stat The statistical transformation to use on the data for this layer, as a string. | ||
| #' Defaults to 'identity'. | ||
| #' @param position Position adjustment, either as a string, or the result of a call to a | ||
| #' position adjustment function. | ||
| #' @param na.rm If FALSE, the default, missing values are removed with a warning. If TRUE, | ||
| #' missing values are silently removed. | ||
| #' @param ... Optional. All the other miscellaneous ggplot geom_ribbon() arguments. | ||
| #' @note Adapted from the survminer package <https://github.com/kassambara/survminer>. | ||
| #' @examples | ||
| #' library(survival) | ||
| #' library(broom) | ||
| #' library(ggplot2) | ||
| #' | ||
| #' fit <- survfit(Surv(time, status) ~ trt, data = diabetic) | ||
| #' | ||
| #' ggplot( | ||
| #' data = tidy(fit), | ||
| #' mapping = aes(x = time, y = estimate) | ||
| #' ) + | ||
| #' geom_step(aes(color = strata)) + | ||
| #' geom_stepconfint(aes(ymin = conf.low, ymax = conf.high, fill = strata), alpha = 0.3) + | ||
| #' coord_cartesian(c(0, 50)) + | ||
| #' scale_x_continuous(expand = c(0.02,0)) + | ||
| #' labs(x = 'Time', y = 'Freedom From Event') + | ||
| #' scale_color_manual( | ||
| #' values = c('#d83641', '#1A45A7'), | ||
| #' name = 'Treatment', | ||
| #' labels = c('None', 'Laser'), | ||
| #' aesthetics = c('colour', 'fill')) + | ||
| #' theme_black() | ||
| #' @export | ||
| geom_stepconfint <- function ( | ||
| mapping = NULL, data = NULL, stat = "identity", | ||
| position = "identity", na.rm = FALSE, ... | ||
| ) { | ||
| ggplot2::layer( | ||
| mapping = mapping, | ||
| data = data, | ||
| stat = stat, | ||
| geom = ggplot2::ggproto( | ||
| `_class` = 'GeomConfint', | ||
| `_inherit` = ggplot2::GeomRibbon, | ||
| required_aes = c("x", "ymin", "ymax"), | ||
| draw_group = function (self, data, panel_scales, coord, na.rm = FALSE) { | ||
| if (na.rm) data <- data[stats::complete.cases(self$required_aes), ] | ||
| data <- data[order(data$group, data$x), ] | ||
| data <- self$stairstep_confint(data) | ||
| ggplot2::GeomRibbon$draw_group(data, panel_scales, coord, na.rm = FALSE) | ||
| }, | ||
| stairstep_confint = function (data) { | ||
| data <- as.data.frame(data)[order(data$x), ] | ||
| n <- nrow(data) | ||
| ys <- rep(1:n, each = 2)[-2 * n] | ||
| xs <- c(1, rep(2:n, each = 2)) | ||
| data.frame( | ||
| x = data$x[xs], | ||
| ymin = data$ymin[ys], | ||
| ymax = data$ymax[ys], | ||
| data[xs, setdiff(names(data), c("x", "ymin", "ymax"))] | ||
| ) | ||
| } | ||
| ), | ||
| position = position, | ||
| params = list(na.rm = na.rm, ...) | ||
| ) | ||
| } | ||
| #' @title Step function confidence intervals for ggplot2 | ||
| #' @description Produces a step function confidence interval for survival curves. Essentially | ||
| #' the geom_step() for confidence intervals which ggplot2 does not provide. | ||
| #' @param mapping Aesthetic mappings with aes() function. Like geom_ribbon(), you must provide | ||
| #' columns for x, ymin (lower limit), ymax (upper limit). | ||
| #' @param data The data to be displayed in this layer. Can inherit from ggplot parent. | ||
| #' @param stat The statistical transformation to use on the data for this layer, as a string. | ||
| #' Defaults to 'identity'. | ||
| #' @param position Position adjustment, either as a string, or the result of a call to a | ||
| #' position adjustment function. | ||
| #' @param na.rm If FALSE, the default, missing values are removed with a warning. If TRUE, | ||
| #' missing values are silently removed. | ||
| #' @param ... Optional. Any other ggplot geom_ribbon() arguments. | ||
| #' @note Adapted from the survminer package <https://github.com/kassambara/survminer>. | ||
| #' @examples | ||
| #' library(survival) | ||
| #' library(broom) | ||
| #' library(ggplot2) | ||
| #' | ||
| #' fit <- survfit(Surv(time, status) ~ trt, data = diabetic) | ||
| #' fit <- survfit0(fit) # connect origin | ||
| #' | ||
| #' ggplot( | ||
| #' data = tidy(fit), | ||
| #' mapping = aes(x = time, y = estimate) | ||
| #' ) + | ||
| #' geom_step(aes(color = strata)) + | ||
| #' geom_stepconfint(aes(ymin = conf.low, ymax = conf.high, fill = strata), alpha = 0.3) + | ||
| #' coord_cartesian(c(0, 50)) + | ||
| #' scale_x_continuous(expand = c(0.02,0)) + | ||
| #' labs(x = 'Time', y = 'Freedom From Event') + | ||
| #' scale_color_manual( | ||
| #' values = c('#d83641', '#1A45A7'), | ||
| #' name = 'Treatment', | ||
| #' labels = c('None', 'Laser'), | ||
| #' aesthetics = c('colour', 'fill')) + | ||
| #' theme_black() | ||
| #' @export | ||
| geom_stepconfint <- function ( | ||
| mapping = NULL, data = NULL, stat = "identity", | ||
| position = "identity", na.rm = FALSE, ... | ||
| ) { | ||
| ggplot2::layer( | ||
| mapping = mapping, | ||
| data = data, | ||
| stat = stat, | ||
| geom = ggplot2::ggproto( | ||
| `_class` = 'GeomConfint', | ||
| `_inherit` = ggplot2::GeomRibbon, | ||
| required_aes = c("x", "ymin", "ymax"), | ||
| draw_group = function (self, data, panel_scales, coord, na.rm = FALSE) { | ||
| if (na.rm) data <- data[stats::complete.cases(self$required_aes), ] | ||
| data <- data[order(data$group, data$x), ] | ||
| data <- self$stairstep_confint(data) | ||
| ggplot2::GeomRibbon$draw_group(data, panel_scales, coord, na.rm = FALSE) | ||
| }, | ||
| stairstep_confint = function (data) { | ||
| data <- as.data.frame(data)[order(data$x), ] | ||
| n <- nrow(data) | ||
| ys <- rep(1:n, each = 2)[-2 * n] | ||
| xs <- c(1, rep(2:n, each = 2)) | ||
| data.frame( | ||
| x = data$x[xs], | ||
| ymin = data$ymin[ys], | ||
| ymax = data$ymax[ys], | ||
| data[xs, setdiff(names(data), c("x", "ymin", "ymax"))] | ||
| ) | ||
| } | ||
| ), | ||
| position = position, | ||
| params = list(na.rm = na.rm, ...) | ||
| ) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,51 +1,51 @@ | ||
| utils::globalVariables(c('time', 'strata', 'n.risk')) | ||
|
|
||
| #' @title Create a ggplot2 table showing the number at risk | ||
| #' @description A simple wrapper function which calculates the | ||
| #' numbers at risk for a survival model and a given set of time points then | ||
| #' creates a ggplot2 table with them. | ||
| #' @param fit Required. survival::survfit() object. | ||
| #' @param times Required. Numeric. One or more time points to calculate | ||
| #' the number at risk for. | ||
| #' @param text.color Optional. Character. Color of text within table. Defaults | ||
| #' to 'black'. | ||
| #' @param strata.order Optional. Character. Ordered names of strata factor | ||
| #' levels. | ||
| #' @return An unformatted ggplot2 table showing the number at risk. | ||
| #' @examples | ||
| #' library(survival) | ||
| #' | ||
| #' fit <- survfit(Surv(time, status) ~ trt, data = diabetic) | ||
| #' | ||
| #' ggrisktable( | ||
| #' fit = fit, | ||
| #' times = c(0, 10, 20, 30, 40, 50), | ||
| #' strata.order = c('0', '1') | ||
| #' ) + theme_risk_black() | ||
| #' @export | ||
| ggrisktable <- function (fit = NULL, times = NULL, text.color = 'black', strata.order = NULL) { | ||
|
|
||
| # Hard stops | ||
| if (is.null(fit) | class(fit) != 'survfit') stop('No valid fit object provided. [Check: \'fit\']') | ||
| if (is.null(times) | !is.numeric(times)) stop('No valid time points provided. [Check: \'times\']') | ||
| if (!is.null(strata.order) & !is.character(strata.order)) stop('Invalid strata order data provided. [Check: \'strata.order\']') | ||
|
|
||
| # Generate risk table and order | ||
| risk_table <- .tabulate_at_risk(fit, times) | ||
|
|
||
| # Reorder strata | ||
| if (is.character(strata.order)) | ||
| risk_table$strata <- factor( | ||
| risk_table$strata, | ||
| levels = unique(c( | ||
| rev(strata.order[strata.order %in% levels(risk_table$strata)]), | ||
| levels(risk_table$strata) | ||
| )) | ||
| ) | ||
|
|
||
| # Return plotted table | ||
| ggplot2::ggplot( | ||
| risk_table, | ||
| ggplot2::aes(x = time, y = strata, label = n.risk) | ||
| ) + ggplot2::geom_text(color = text.color) | ||
| } | ||
| utils::globalVariables(c('time', 'strata', 'n.risk')) | ||
|
|
||
| #' @title Create a ggplot2 table showing the number at risk | ||
| #' @description A simple wrapper function which calculates the | ||
| #' numbers at risk for a survival model and a given set of time points then | ||
| #' creates a ggplot2 table with them. | ||
| #' @param fit Required. survival::survfit() object. | ||
| #' @param times Required. Numeric. One or more time points to calculate | ||
| #' the number at risk for. | ||
| #' @param text.color Optional. Character. Color of text within table. Defaults | ||
| #' to 'black'. | ||
| #' @param strata.order Optional. Character. Ordered names of strata factor | ||
| #' levels. | ||
| #' @return An unformatted ggplot2 table showing the number at risk. | ||
| #' @examples | ||
| #' library(survival) | ||
| #' | ||
| #' fit <- survfit(Surv(time, status) ~ trt, data = diabetic) | ||
| #' | ||
| #' ggrisktable( | ||
| #' fit = fit, | ||
| #' times = c(0, 10, 20, 30, 40, 50), | ||
| #' strata.order = c('0', '1') | ||
| #' ) + theme_risk_black() | ||
| #' @export | ||
| ggrisktable <- function (fit = NULL, times = NULL, text.color = 'black', strata.order = NULL) { | ||
|
|
||
| # Hard stops | ||
| if (is.null(fit) | class(fit) != 'survfit') stop('No valid fit object provided. [Check: \'fit\']') | ||
| if (is.null(times) | !is.numeric(times)) stop('No valid time points provided. [Check: \'times\']') | ||
| if (!is.null(strata.order) & !is.character(strata.order)) stop('Invalid strata order data provided. [Check: \'strata.order\']') | ||
|
|
||
| # Generate risk table and order | ||
| risk_table <- .tabulate_at_risk(fit, times) | ||
|
|
||
| # Reorder strata | ||
| if (is.character(strata.order)) | ||
| risk_table$strata <- factor( | ||
| risk_table$strata, | ||
| levels = unique(c( | ||
| rev(strata.order[strata.order %in% levels(risk_table$strata)]), | ||
| levels(risk_table$strata) | ||
| )) | ||
| ) | ||
|
|
||
| # Return plotted table | ||
| ggplot2::ggplot( | ||
| risk_table, | ||
| ggplot2::aes(x = time, y = strata, label = n.risk) | ||
| ) + ggplot2::geom_text(color = text.color) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,15 +1,15 @@ | ||
| .tabulate_at_risk <- function(fit = NULL, times = NULL) { | ||
| fit_summary <- summary(fit, times = times) | ||
| dplyr::bind_cols( | ||
| strata = as.factor( | ||
| if (is.null(fit$strata)) rep('All', length(times)) | ||
| else | ||
| purrr::map_chr( | ||
| as.character(fit_summary$strata), | ||
| ~ strsplit(.x, '=')[[1]][2] | ||
| ) | ||
| ), | ||
| time = fit_summary$time, | ||
| n.risk = fit_summary$n.risk, | ||
| ) | ||
| } | ||
| .tabulate_at_risk <- function(fit = NULL, times = NULL) { | ||
| fit_summary <- summary(fit, times = times) | ||
| dplyr::bind_cols( | ||
| strata = as.factor( | ||
| if (is.null(fit$strata)) rep('All', length(times)) | ||
| else | ||
| purrr::map_chr( | ||
| as.character(fit_summary$strata), | ||
| ~ strsplit(.x, '=')[[1]][2] | ||
| ) | ||
| ), | ||
| time = fit_summary$time, | ||
| n.risk = fit_summary$n.risk | ||
| ) | ||
| } |
Oops, something went wrong.