From 03ac1a805243ebcc3479ecb9fa0634c5a99b278c Mon Sep 17 00:00:00 2001 From: Dan Chaltiel Date: Mon, 15 Jul 2019 17:00:39 +0200 Subject: [PATCH 1/8] Exclude all categorical variables to avoid the error "Error in xy.coords(x, y, setLab = FALSE) : 'x' and 'y' lengths differ" --- R/ggcoxfunctional.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/ggcoxfunctional.R b/R/ggcoxfunctional.R index 05da6f2..34ca6a5 100644 --- a/R/ggcoxfunctional.R +++ b/R/ggcoxfunctional.R @@ -58,6 +58,9 @@ ggcoxfunctional <- function (formula, data = NULL, fit, iter = 0, f = 0.6, } formula <- fit$formula data <- .get_data(fit, data) + remov = sapply(attr(stats::terms(formula), "term.labels"), + function(x){!is.numeric(data[[x]])}) + formula = drop.terms(terms(formula), which(remov), keep.response=TRUE) attr(stats::terms(formula), "term.labels") -> explanatory.variables.names stats::model.matrix(formula, data = data) -> explanatory.variables.values From e23ac7ad86a4079bedf55bf7a76462d99a501b35 Mon Sep 17 00:00:00 2001 From: Dan Chaltiel Date: Mon, 15 Jul 2019 17:38:28 +0200 Subject: [PATCH 2/8] Exclude all categorical variables to avoid the error "Error in xy.coords(x, y, setLab = FALSE) : 'x' and 'y' lengths differ" --- R/ggcoxfunctional.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/ggcoxfunctional.R b/R/ggcoxfunctional.R index 34ca6a5..e4486be 100644 --- a/R/ggcoxfunctional.R +++ b/R/ggcoxfunctional.R @@ -31,7 +31,7 @@ NULL #' #' library(survival) #' data(mgus) -#' res.cox <- coxph(Surv(futime, death) ~ mspike + log(mspike) + I(mspike^2) + +#' res.cox <- coxph(Surv(futime, death) ~ mspike + sex + log(mspike) + I(mspike^2) + #' age + I(log(age)^2) + I(sqrt(age)), data = mgus) #' ggcoxfunctional(res.cox, data = mgus, point.col = "blue", point.alpha = 0.5) #' ggcoxfunctional(res.cox, data = mgus, point.col = "blue", point.alpha = 0.5, @@ -58,9 +58,9 @@ ggcoxfunctional <- function (formula, data = NULL, fit, iter = 0, f = 0.6, } formula <- fit$formula data <- .get_data(fit, data) - remov = sapply(attr(stats::terms(formula), "term.labels"), + remov <- sapply(attr(stats::terms(formula), "term.labels"), function(x){!is.numeric(data[[x]])}) - formula = drop.terms(terms(formula), which(remov), keep.response=TRUE) + formula <- drop.terms(terms(formula), which(remov), keep.response=TRUE) attr(stats::terms(formula), "term.labels") -> explanatory.variables.names stats::model.matrix(formula, data = data) -> explanatory.variables.values From 0b4a1065246f1f0e92c6b11cc0c868b35c3d24a1 Mon Sep 17 00:00:00 2001 From: Dan Chaltiel Date: Mon, 15 Jul 2019 17:48:03 +0200 Subject: [PATCH 3/8] Exclude all categorical variables to avoid the error "Error in xy.coords(x, y, setLab = FALSE) : 'x' and 'y' lengths differ" --- R/ggcoxfunctional.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ggcoxfunctional.R b/R/ggcoxfunctional.R index e4486be..024e677 100644 --- a/R/ggcoxfunctional.R +++ b/R/ggcoxfunctional.R @@ -59,7 +59,7 @@ ggcoxfunctional <- function (formula, data = NULL, fit, iter = 0, f = 0.6, formula <- fit$formula data <- .get_data(fit, data) remov <- sapply(attr(stats::terms(formula), "term.labels"), - function(x){!is.numeric(data[[x]])}) + function(x){is.character(data[[x]]) || is.factor(data[[x]])}) formula <- drop.terms(terms(formula), which(remov), keep.response=TRUE) attr(stats::terms(formula), "term.labels") -> explanatory.variables.names From cc9684258dc21d4f22ba3fb38b849ce87d9d44a4 Mon Sep 17 00:00:00 2001 From: Dan Chaltiel Date: Tue, 16 Jul 2019 14:04:58 +0200 Subject: [PATCH 4/8] Added support for coxph fit, and a horizontal line for the estimated coefficient. Added some documentation and tests. --- R/ggcoxzph.R | 64 +++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 53 insertions(+), 11 deletions(-) diff --git a/R/ggcoxzph.R b/R/ggcoxzph.R index 7932751..6746c48 100644 --- a/R/ggcoxzph.R +++ b/R/ggcoxzph.R @@ -1,7 +1,7 @@ #'Graphical Test of Proportional Hazards with ggplot2 #'@description Displays a graph of the scaled Schoenfeld residuals, along with a -#' smooth curve using \pkg{ggplot2}. Wrapper around \link{plot.cox.zph}. -#'@param fit an object of class \link{cox.zph}. +#' smooth curve using \pkg{ggplot2}. Wrapper around \link{plot.cox.zph}. If fit is a \code{coxph}, the function will also plot the coefficient estimated by the model as a horizontal line. +#'@param fit an object of class \link{coxph} or \link{cox.zph}. #'@param resid a logical value, if TRUE the residuals are included on the plot, #' as well as the smooth fit. #'@param se a logical value, if TRUE, confidence bands at two standard errors @@ -11,8 +11,11 @@ #'@param nsmo number of points used to plot the fitted spline. #'@param var the set of variables for which plots are desired. By default, plots #' are produced in turn for each variable of a model. +#'@param var_pval the max Grambsch-Therneau test pvalue for which plots are desired. Use only one of \code{var} or \code{var_pval}. #'@param point.col,point.size,point.shape,point.alpha color, size, shape and visibility to be used for points. #'@param caption the caption of the final \link{grob} (\code{bottom} in \link{arrangeGrob}) +#'@param zph.transform the argument to pass to \code{survival::cox.zph} if \code{fit} is a \code{coxph} object +#'@param hline_size the argument to pass to \code{survival::cox.zph} if \code{fit} is a \code{coxph} object #'@param ggtheme function, ggplot2 theme name. #' Allowed values include ggplot2 official themes: see \code{\link[ggplot2]{theme}}. #'@param ... further arguments passed to either the print() function or to the \code{\link[ggpubr]{ggpar}} function for customizing the plot (see Details section). @@ -37,6 +40,9 @@ #' cox.zph.fit <- cox.zph(fit) #' # plot all variables #' ggcoxzph(cox.zph.fit) +#' ggcoxzph(fit) +#' # plot all variables for which the Grambsch-Therneau test pvalue is less than 0.55 +#' ggcoxzph(fit, var_pval=0.55) #' # plot all variables in specified order #' ggcoxzph(cox.zph.fit, var = c("ecog.ps", "rx", "age"), font.main = 12) #' # plot specified variables in specified order @@ -44,15 +50,33 @@ #' #'@describeIn ggcoxzph Graphical Test of Proportional Hazards using ggplot2. #'@export -ggcoxzph <- function (fit, resid = TRUE, se = TRUE, df = 4, nsmo = 40, var, +ggcoxzph <- function (fit, resid = TRUE, se = TRUE, df = 4, nsmo = 40, var, var_pval, point.col = "red", point.size = 1, point.shape = 19, point.alpha = 1, - caption = NULL, - ggtheme = theme_survminer(), ...){ - - x <- fit - if(!methods::is(x, "cox.zph")) - stop("Can't handle an object of class ", class(x)) - + caption = NULL, zph.transform="km", hline_size = 1.25, + ggtheme = theme_survminer(), ...){ + + + if(!methods::is(fit, "cox.zph") && !methods::is(fit, "coxph")) + stop("Can't handle an object of class ", class(fit)) + + if(methods::is(fit, "coxph")){ + COX_FIT <- TRUE + x <- cox.zph(fit, transform = zph.transform) + } else{ + COX_FIT <- FALSE + x <- fit + } + + if(!missing(var_pval)){ + if(!is.numeric(var_pval)) + stop("var_pval should be a numeric vector") + if(!missing(var)) + stop("Can't handle both var and var_pval") + tmp <- x$table[,"p"] + var <- names(tmp[tmp Date: Tue, 16 Jul 2019 16:32:51 +0200 Subject: [PATCH 5/8] Added manual documentation files. Added package-prefixes for external calls --- R/ggcoxfunctional.R | 2 +- R/ggcoxzph.R | 2 +- man/ggcoxfunctional.Rd | 2 +- man/ggcoxzph.Rd | 18 ++++++++++++++---- 4 files changed, 17 insertions(+), 7 deletions(-) diff --git a/R/ggcoxfunctional.R b/R/ggcoxfunctional.R index 024e677..c05e567 100644 --- a/R/ggcoxfunctional.R +++ b/R/ggcoxfunctional.R @@ -60,7 +60,7 @@ ggcoxfunctional <- function (formula, data = NULL, fit, iter = 0, f = 0.6, data <- .get_data(fit, data) remov <- sapply(attr(stats::terms(formula), "term.labels"), function(x){is.character(data[[x]]) || is.factor(data[[x]])}) - formula <- drop.terms(terms(formula), which(remov), keep.response=TRUE) + formula <- stats::drop.terms(terms(formula), which(remov), keep.response=TRUE) attr(stats::terms(formula), "term.labels") -> explanatory.variables.names stats::model.matrix(formula, data = data) -> explanatory.variables.values diff --git a/R/ggcoxzph.R b/R/ggcoxzph.R index 6746c48..5a591a8 100644 --- a/R/ggcoxzph.R +++ b/R/ggcoxzph.R @@ -61,7 +61,7 @@ ggcoxzph <- function (fit, resid = TRUE, se = TRUE, df = 4, nsmo = 40, var, var_ if(methods::is(fit, "coxph")){ COX_FIT <- TRUE - x <- cox.zph(fit, transform = zph.transform) + x <- survival::cox.zph(fit, transform = zph.transform) } else{ COX_FIT <- FALSE x <- fit diff --git a/man/ggcoxfunctional.Rd b/man/ggcoxfunctional.Rd index 998e458..76dbc38 100644 --- a/man/ggcoxfunctional.Rd +++ b/man/ggcoxfunctional.Rd @@ -61,7 +61,7 @@ should be linear to satisfy cox proportional hazards model assumptions. library(survival) data(mgus) -res.cox <- coxph(Surv(futime, death) ~ mspike + log(mspike) + I(mspike^2) + +res.cox <- coxph(Surv(futime, death) ~ mspike + sex + log(mspike) + I(mspike^2) + age + I(log(age)^2) + I(sqrt(age)), data = mgus) ggcoxfunctional(res.cox, data = mgus, point.col = "blue", point.alpha = 0.5) ggcoxfunctional(res.cox, data = mgus, point.col = "blue", point.alpha = 0.5, diff --git a/man/ggcoxzph.Rd b/man/ggcoxzph.Rd index 3a4122e..17962aa 100644 --- a/man/ggcoxzph.Rd +++ b/man/ggcoxzph.Rd @@ -6,13 +6,14 @@ \title{Graphical Test of Proportional Hazards with ggplot2} \usage{ ggcoxzph(fit, resid = TRUE, se = TRUE, df = 4, nsmo = 40, var, - point.col = "red", point.size = 1, point.shape = 19, - point.alpha = 1, caption = NULL, ggtheme = theme_survminer(), ...) + var_pval, point.col = "red", point.size = 1, point.shape = 19, + point.alpha = 1, caption = NULL, zph.transform = "km", + hline_size = 1.25, ggtheme = theme_survminer(), ...) \method{print}{ggcoxzph}(x, ..., newpage = TRUE) } \arguments{ -\item{fit}{an object of class \link{cox.zph}.} +\item{fit}{an object of class \link{coxph} or \link{cox.zph}.} \item{resid}{a logical value, if TRUE the residuals are included on the plot, as well as the smooth fit.} @@ -28,10 +29,16 @@ a linear fit.} \item{var}{the set of variables for which plots are desired. By default, plots are produced in turn for each variable of a model.} +\item{var_pval}{the max Grambsch-Therneau test pvalue for which plots are desired. Use only one of \code{var} or \code{var_pval}.} + \item{point.col, point.size, point.shape, point.alpha}{color, size, shape and visibility to be used for points.} \item{caption}{the caption of the final \link{grob} (\code{bottom} in \link{arrangeGrob})} +\item{zph.transform}{the argument to pass to \code{survival::cox.zph} if \code{fit} is a \code{coxph} object} + +\item{hline_size}{the argument to pass to \code{survival::cox.zph} if \code{fit} is a \code{coxph} object} + \item{ggtheme}{function, ggplot2 theme name. Allowed values include ggplot2 official themes: see \code{\link[ggplot2]{theme}}.} @@ -46,7 +53,7 @@ Returns an object of class \code{ggcoxzph} which is a list of ggplots. } \description{ Displays a graph of the scaled Schoenfeld residuals, along with a - smooth curve using \pkg{ggplot2}. Wrapper around \link{plot.cox.zph}. + smooth curve using \pkg{ggplot2}. Wrapper around \link{plot.cox.zph}. If fit is a \code{coxph}, the function will also plot the coefficient estimated by the model as a horizontal line. } \details{ \strong{Customizing the plots}: The plot can be easily @@ -72,6 +79,9 @@ fit <- coxph(Surv(futime, fustat) ~ age + ecog.ps + rx, data=ovarian) cox.zph.fit <- cox.zph(fit) # plot all variables ggcoxzph(cox.zph.fit) +ggcoxzph(fit) +# plot all variables for which the Grambsch-Therneau test pvalue is less than 0.55 +ggcoxzph(fit, var_pval=0.55) # plot all variables in specified order ggcoxzph(cox.zph.fit, var = c("ecog.ps", "rx", "age"), font.main = 12) # plot specified variables in specified order From 6fa698c111fdac7e5aaf04c6009945eb829807ea Mon Sep 17 00:00:00 2001 From: Dan Chaltiel Date: Tue, 16 Jul 2019 16:54:17 +0200 Subject: [PATCH 6/8] Correct a bug caused by last commit, in which a formula without categorical variable caused an error --- R/ggcoxfunctional.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/ggcoxfunctional.R b/R/ggcoxfunctional.R index c05e567..d64fbd6 100644 --- a/R/ggcoxfunctional.R +++ b/R/ggcoxfunctional.R @@ -60,7 +60,8 @@ ggcoxfunctional <- function (formula, data = NULL, fit, iter = 0, f = 0.6, data <- .get_data(fit, data) remov <- sapply(attr(stats::terms(formula), "term.labels"), function(x){is.character(data[[x]]) || is.factor(data[[x]])}) - formula <- stats::drop.terms(terms(formula), which(remov), keep.response=TRUE) + if(any(remov)) + formula <- stats::drop.terms(stats::terms(formula), which(remov), keep.response=TRUE) attr(stats::terms(formula), "term.labels") -> explanatory.variables.names stats::model.matrix(formula, data = data) -> explanatory.variables.values From b33dc60bc85f7348745a3c47cf507ef968e8f1a2 Mon Sep 17 00:00:00 2001 From: Dan Chaltiel Date: Mon, 11 Nov 2019 15:39:46 +0100 Subject: [PATCH 7/8] Improved ggcoxfunctional(): re-enabled operations, enabled variable choice --- R/ggcoxfunctional.R | 24 ++++++++++++++++-------- fork_survminer.Rproj | 18 ++++++++++++++++++ 2 files changed, 34 insertions(+), 8 deletions(-) create mode 100644 fork_survminer.Rproj diff --git a/R/ggcoxfunctional.R b/R/ggcoxfunctional.R index d64fbd6..0389487 100644 --- a/R/ggcoxfunctional.R +++ b/R/ggcoxfunctional.R @@ -3,18 +3,19 @@ #' @importFrom stats approx #' @importFrom stats resid #' @importFrom survival coxph -#' @importFrom magrittr %>% NULL #' Functional Form of Continuous Variable in Cox Proportional Hazards Model #'@description Displays graphs of continuous explanatory variable against martingale residuals of null #'cox proportional hazards model, for each term in of the right side of \code{formula}. This might help to properly #'choose the functional form of continuous variable in cox model (\link{coxph}). Fitted lines with \link{lowess} function #'should be linear to satisfy cox proportional hazards model assumptions. +#' #'@param fit an object of class \link{coxph.object} - created with \link{coxph} function. -#'@param formula a formula object, with the response on the left of a ~ operator, and the terms on the right. The response must be a survival object as returned by the \link{Surv} function. +#'@param formula (deprecated) a formula object, with the response on the left of a ~ operator, and the terms on the right. The response must be a survival object as returned by the \link{Surv} function. #'@param data a \code{data.frame} in which to interpret the variables named in the formula, #'@param iter parameter of \link{lowess}. #'@param f parameter of \link{lowess}. +#'@param vars.keep character vector of variables for which we want to draw the plot. #'@param xlim,ylim x and y axis limits e.g. xlim = c(0, 1000), ylim = c(0, 1). #'@param ylab y axis label. #'@param title the title of the final \link{grob} (\code{top} in \link{arrangeGrob}) @@ -33,14 +34,15 @@ NULL #' data(mgus) #' res.cox <- coxph(Surv(futime, death) ~ mspike + sex + log(mspike) + I(mspike^2) + #' age + I(log(age)^2) + I(sqrt(age)), data = mgus) -#' ggcoxfunctional(res.cox, data = mgus, point.col = "blue", point.alpha = 0.5) +#' ggcoxfunctional(res.cox, data = mgus, point.col = "blue", point.alpha = 0.5) +#' ggcoxfunctional(res.cox, data = mgus, vars.keep=c("mspike", "log(mspike)")) #' ggcoxfunctional(res.cox, data = mgus, point.col = "blue", point.alpha = 0.5, #' title = "Pass the title", caption = "Pass the caption") #' #' #'@describeIn ggcoxfunctional Functional Form of Continuous Variable in Cox Proportional Hazards Model. #'@export -ggcoxfunctional <- function (formula, data = NULL, fit, iter = 0, f = 0.6, +ggcoxfunctional <- function (formula, data = NULL, fit, iter = 0, f = 0.6, vars.keep, point.col = "red", point.size = 1, point.shape = 19, point.alpha = 1, xlim = NULL, ylim = NULL, ylab = "Martingale Residuals \nof Null Cox Model", @@ -58,13 +60,19 @@ ggcoxfunctional <- function (formula, data = NULL, fit, iter = 0, f = 0.6, } formula <- fit$formula data <- .get_data(fit, data) - remov <- sapply(attr(stats::terms(formula), "term.labels"), - function(x){is.character(data[[x]]) || is.factor(data[[x]])}) + remov = sapply(attr(stats::terms(formula), "term.labels"), + function(x) {!is.numeric(with(data, eval(parse(text=x))))}) if(any(remov)) formula <- stats::drop.terms(stats::terms(formula), which(remov), keep.response=TRUE) - attr(stats::terms(formula), "term.labels") -> explanatory.variables.names - stats::model.matrix(formula, data = data) -> explanatory.variables.values + explanatory.variables.names <- attr(stats::terms(formula), "term.labels") + + if(!missing(vars.keep)){ + if(!all(vars.keep %in% explanatory.variables.names)) stop("Unknown or non-numeric `vars.keep`") + explanatory.variables.names <- vars.keep + } + + explanatory.variables.values <- stats::model.matrix(formula, data = data) SurvFormula <- deparse(formula[[2]]) martingale_resid <- lowess_x <- lowess_y <- NULL lapply(explanatory.variables.names, function(i){ diff --git a/fork_survminer.Rproj b/fork_survminer.Rproj new file mode 100644 index 0000000..eaa6b81 --- /dev/null +++ b/fork_survminer.Rproj @@ -0,0 +1,18 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source +PackageRoxygenize: rd,collate,namespace From 529ceae08f843e30adbd244c3c6f99af5be0225e Mon Sep 17 00:00:00 2001 From: Dan Chaltiel Date: Wed, 13 Nov 2019 21:00:31 +0100 Subject: [PATCH 8/8] corrected bug in ggcoxfunctional When there was missing values, explanatory.variables.values and data were not the dame size --- R/ggcoxfunctional.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/ggcoxfunctional.R b/R/ggcoxfunctional.R index 0389487..5669b08 100644 --- a/R/ggcoxfunctional.R +++ b/R/ggcoxfunctional.R @@ -73,6 +73,7 @@ ggcoxfunctional <- function (formula, data = NULL, fit, iter = 0, f = 0.6, vars. } explanatory.variables.values <- stats::model.matrix(formula, data = data) + data = data[rownames(explanatory.variables.values), ] SurvFormula <- deparse(formula[[2]]) martingale_resid <- lowess_x <- lowess_y <- NULL lapply(explanatory.variables.names, function(i){