fix for #166

kassambara · Mar 26, 2017 · 94ca402 · 94ca402
1 parent 96f7436
commit 94ca402
Show file tree

Hide file tree

Showing 9 changed files with 166 additions and 80 deletions.
diff --git a/R/ggcumcensor.R b/R/ggcumcensor.R
@@ -33,6 +33,7 @@ NULL
 #'
 #'@export
 ggcumcensor <- function (fit, data = NULL, color = "black", palette = NULL, break.time.by = NULL,  xlim = NULL,
+                         xscale = 1,
                          title = "Number of cenored subjects", xlab = "Time", ylab = "Strata",
                          xlog = FALSE, legend = "top",
                          legend.title = "Strata", legend.labs = NULL, y.text = TRUE, y.text.col = TRUE, fontsize = 4.5,
@@ -73,8 +74,9 @@ ggcumcensor <- function (fit, data = NULL, color = "black", palette = NULL, brea
 
   p <- ggpubr::ggpar(p, legend = legend, palette = palette,...)
 
-  if(!xlog) p <- p + ggplot2::scale_x_continuous(breaks = times)
-  else p <- p + ggplot2::scale_x_continuous(breaks = times, trans = "log10")
+  xticklabels <- .format_xticklabels(labels = times, xscale = xscale)
+  if(!xlog) p <- p + ggplot2::scale_x_continuous(breaks = times, labels = xticklabels)
+  else p <- p + ggplot2::scale_x_continuous(breaks = times, trans = "log10", labels = xticklabels)
 
   if(!y.text) p <- .set_large_dash_as_ytext(p)
   # color table tick labels by strata

diff --git a/R/ggcumevents.R b/R/ggcumevents.R
@@ -32,6 +32,7 @@ NULL
 #'
 #'@export
 ggcumevents <- function (fit, data = NULL, color = "black", palette = NULL, break.time.by = NULL,  xlim = NULL,
+                         xscale = 1,
                          title = "Cumulative number of events", xlab = "Time", ylab = "Strata",
                          xlog = FALSE, legend = "top",
                          legend.title = "Strata", legend.labs = NULL, y.text = TRUE, y.text.col = TRUE, fontsize = 4.5,
@@ -72,8 +73,9 @@ ggcumevents <- function (fit, data = NULL, color = "black", palette = NULL, brea
 
   p <- ggpubr::ggpar(p, legend = legend, palette = palette,...)
 
-  if(!xlog) p <- p + ggplot2::scale_x_continuous(breaks = times)
-  else p <- p + ggplot2::scale_x_continuous(breaks = times, trans = "log10")
+  xticklabels <- .format_xticklabels(labels = times, xscale = xscale)
+  if(!xlog) p <- p + ggplot2::scale_x_continuous(breaks = times, labels = xticklabels)
+  else p <- p + ggplot2::scale_x_continuous(breaks = times, trans = "log10", labels = xticklabels)
 
   if(!y.text) p <- .set_large_dash_as_ytext(p)
   # color table tick labels by strata

diff --git a/R/ggrisktable.R b/R/ggrisktable.R
@@ -36,7 +36,7 @@ NULL
 #'
 #'@export
 ggrisktable <- function (fit, data = NULL, type = c("absolute", "percentage", "abs_pct", "nrisk_cumcensor", "nrisk_cumevents"),
-                         color = "black", palette = NULL, break.time.by = NULL,  xlim = NULL,
+                         color = "black", palette = NULL, break.time.by = NULL,  xlim = NULL, xscale = 1,
                          title = NULL, xlab = "Time", ylab = "Strata",
                          xlog = FALSE,
                          legend = "top",
@@ -103,8 +103,9 @@ ggrisktable <- function (fit, data = NULL, type = c("absolute", "percentage", "a
   p <- .set_risktable_gpar(p, ...)
   p <- ggpubr::ggpar(p, legend = legend, palette = palette,...)
 
-  if(!xlog) p <- p + ggplot2::scale_x_continuous(breaks = times)
-  else p <- p + ggplot2::scale_x_continuous(breaks = times, trans = "log10")
+  xticklabels <- .format_xticklabels(labels = times, xscale = xscale)
+  if(!xlog) p <- p + ggplot2::scale_x_continuous(breaks = times, labels = xticklabels)
+  else p <- p + ggplot2::scale_x_continuous(breaks = times, trans = "log10", labels = xticklabels)
 
 
   if(!y.text) p <- .set_large_dash_as_ytext(p)

diff --git a/R/ggsurvplot.R b/R/ggsurvplot.R
@@ -16,6 +16,13 @@
 #'  probability in percentage.
 #'@param surv.scale scale transformation of survival curves. Allowed values are
 #'  "default" or "percent".
+#'@param xscale numeric or character value specifying x-axis scale. \itemize{
+#'  \item If numeric, the value is used to divide the labels on the x axis. For
+#'  example, a value of 365.25 will give labels in years instead of the original
+#'  days. \item If character, allowed options include one of c("d_m", "d_y",
+#'  "m_d", "m_y", "y_d", "y_m"), where d = days, m = months and y = years. For
+#'  example, xscale = "d_m" will transform labels from days to months; xscale =
+#'  "m_y", will transform labels from months to years.}
 #'@param color color to be used for the survival curves. This argument is
 #'  ignored when the number of strata (groups > 1). In this case, use the
 #'  argument palette.
@@ -26,8 +33,10 @@
 #'@param linetype line types. Allowed values includes i) "strata" for changing
 #'  linetypes by strata (i.e. groups); ii) a numeric vector (e.g., c(1, 2)) or a
 #'  character vector c("solid", "dashed").
-#'@param break.time.by numeric value controlling time axis breaks. Default value is NULL.
-#'@param break.x.by alias of break.time.by. Numeric value controlling x axis breaks. Default value is NULL.
+#'@param break.time.by numeric value controlling time axis breaks. Default value
+#'  is NULL.
+#'@param break.x.by alias of break.time.by. Numeric value controlling x axis
+#'  breaks. Default value is NULL.
 #'@param break.y.by same as break.x.by but for y axis.
 #'@param conf.int logical value. If TRUE, plots confidence interval.
 #'@param conf.int.fill fill color to be used for confidence interval.
@@ -71,9 +80,9 @@
 #'  of all tables under the main survival plot.
 #'@param tables.y.text logical. Default is TRUE. If FALSE, the y axis tick
 #'  labels of tables will be hidden.
-#'@param tables.col color to be used for all tables under the main plot. Default value is
-#'  "black". If you want to color by strata (i.e. groups), use tables.col =
-#'  "strata".
+#'@param tables.col color to be used for all tables under the main plot. Default
+#'  value is "black". If you want to color by strata (i.e. groups), use
+#'  tables.col = "strata".
 #'@param tables.theme function, ggplot2 theme name. Default value is
 #'  \link{theme_survminer}. Allowed values include ggplot2 official themes: see
 #'  \code{\link[ggplot2]{theme}}.
@@ -93,7 +102,8 @@
 #'@param cumevents logical value specifying whether to show or not the table of
 #'  the cumulative number of events. Default is FALSE.
 #'@param cumevents.title The title to be used for the cumulative events table.
-#'@param cumevents.col same as tables.col but for the cumulative events table only.
+#'@param cumevents.col same as tables.col but for the cumulative events table
+#'  only.
 #'@param cumevents.y.text logical. Default is TRUE. If FALSE, the y axis tick
 #'  labels of the cumulative events table  will be hidden.
 #'@param cumevents.y.text.col logical. Default value is FALSE. If TRUE, the y
@@ -134,27 +144,27 @@
 #'  \code{log.rank.weights} name
 #'@param pval.method.coord the same as \code{pval.coord} but for displaying
 #'  \code{log.rank.weights} name
-#'@details \itemize{ \item \strong{legend position}: The argument \strong{legend} can be also a
-#'  numeric vector c(x,y). In this case it is possible to position the legend
-#'  inside the plotting area. x and y are the coordinates of the legend box.
-#'  Their values should be between 0 and 1. c(0,0) corresponds to the "bottom
-#'  left" and c(1,1) corresponds to the "top right" position. For instance use
-#'  legend = c(0.8, 0.2).\cr \item \strong{Color palettes}: The argument
-#'  \strong{palette} can be used to specify the color to be used for each group.
-#'  By default, the first color in the palette is used to color the first level
-#'  of the factor variable. This default behavior can be changed by assigning
-#'  correctly a named vector. That is, the names of colors should match the
-#'  strata names as generated by the \code{ggsurvplot()} function in the
-#'  legend.\cr \item \strong{Customizing the plots}: The plot can be easily
-#'  customized using additional arguments to be passed to the function ggpar().
-#'  Read ?ggpubr::ggpar. These arguments include
-#'  \emph{font.title, font.subtitle, font.caption, font.x, font.y, font.tickslab and font.legend}:
-#'   a vector of length 3 indicating respectively the size (e.g.: 14), the style
-#'  (e.g.: "plain", "bold", "italic", "bold.italic") and the color (e.g.: "red")
-#'  of main title, subtitle, caption, xlab and ylab, axis tick labels and legend,
-#'  respectively. For example \emph{font.x = c(14, "bold", "red")}.  Use font.x
-#'  = 14, to change only font size; or use font.x = "bold", to change only font
-#'  face.}
+#'@details \itemize{ \item \strong{legend position}: The argument
+#'  \strong{legend} can be also a numeric vector c(x,y). In this case it is
+#'  possible to position the legend inside the plotting area. x and y are the
+#'  coordinates of the legend box. Their values should be between 0 and 1.
+#'  c(0,0) corresponds to the "bottom left" and c(1,1) corresponds to the "top
+#'  right" position. For instance use legend = c(0.8, 0.2).\cr \item
+#'  \strong{Color palettes}: The argument \strong{palette} can be used to
+#'  specify the color to be used for each group. By default, the first color in
+#'  the palette is used to color the first level of the factor variable. This
+#'  default behavior can be changed by assigning correctly a named vector. That
+#'  is, the names of colors should match the strata names as generated by the
+#'  \code{ggsurvplot()} function in the legend.\cr \item \strong{Customizing the
+#'  plots}: The plot can be easily customized using additional arguments to be
+#'  passed to the function ggpar(). Read ?ggpubr::ggpar. These arguments include
+#'  \emph{font.title, font.subtitle, font.caption, font.x, font.y, font.tickslab
+#'  and font.legend}: a vector of length 3 indicating respectively the size
+#'  (e.g.: 14), the style (e.g.: "plain", "bold", "italic", "bold.italic") and
+#'  the color (e.g.: "red") of main title, subtitle, caption, xlab and ylab,
+#'  axis tick labels and legend, respectively. For example \emph{font.x = c(14,
+#'  "bold", "red")}.  Use font.x = 14, to change only font size; or use font.x =
+#'  "bold", to change only font face.}
 #'
 #'@return return an object of class ggsurvplot which is list containing the
 #'  following components: \itemize{ \item plot: the survival plot (ggplot
@@ -263,7 +273,7 @@
 ggsurvplot <- function(fit, data = NULL, fun = NULL,
                        color = NULL, palette = NULL, linetype = 1,
                        break.x.by = NULL, break.y.by = NULL,  break.time.by = NULL,
-                       surv.scale = c("default", "percent"),
+                       surv.scale = c("default", "percent"), xscale = 1,
                        conf.int = FALSE, conf.int.fill = "gray", conf.int.style = "ribbon",
                        censor = TRUE,
                        pval = FALSE, pval.size = 5, pval.coord = c(NULL, NULL),
@@ -300,6 +310,8 @@ ggsurvplot <- function(fit, data = NULL, fun = NULL,
   surv.median.line <- match.arg(surv.median.line)
   stopifnot(log.rank.weights %in% c("survdiff", "1", "n", "sqrtN", "S1", "S2","FH_p=1_q=1"))
   log.rank.weights <- match.arg(log.rank.weights)
+  if(!is.numeric(xscale) & !(xscale %in% c("d_m", "d_y", "m_d", "m_y", "y_d", "y_m")))
+    stop('xscale should be numeric or one of c("d_m", "d_y", "m_d", "m_y", "y_d", "y_m").')
 
   # Make sure that user can do either ncensor.plot or cumcensor
   # But not both
@@ -404,12 +416,13 @@ ggsurvplot <- function(fit, data = NULL, fun = NULL,
   if(!is.null(break.x.by)) break.time.by <- break.x.by
   times <- .get_default_breaks(d$time, .log = xlog)
   if(!is.null(break.time.by) & !xlog) times <- seq(0, max(c(d$time, xlim)), by = break.time.by)
+  xticklabels <- .format_xticklabels(labels = times, xscale = xscale)
 
   if(!.is_cloglog(fun)) {
-    p <- p + ggplot2::scale_x_continuous(breaks = times) +
+    p <- p + ggplot2::scale_x_continuous(breaks = times, labels = xticklabels) +
       ggplot2::expand_limits(x = 0, y = 0)
   }
-  else p <- p + ggplot2::scale_x_continuous(breaks = times, trans = "log10")
+  else p <- p + ggplot2::scale_x_continuous(breaks = times, trans = "log10", labels = xticklabels)
 
 
   # Add confidence interval
@@ -488,7 +501,7 @@ ggsurvplot <- function(fit, data = NULL, fun = NULL,
                              legend = legend, legend.title = legend.title, legend.labs = legend.labs,
                              y.text = risk.table.y.text, y.text.col = risk.table.y.text.col,
                              fontsize = risk.table.fontsize, ggtheme = ggtheme,
-                             xlab = xlab, ylab = legend.title, xlog = xlog,
+                             xlab = xlab, ylab = legend.title, xlog = xlog, xscale = xscale,
                              ...)
      risktable <- risktable + tables.theme
      if(!risk.table.y.text) risktable <- .set_large_dash_as_ytext(risktable)
@@ -506,7 +519,7 @@ ggsurvplot <- function(fit, data = NULL, fun = NULL,
                                   legend = legend, legend.title = legend.title, legend.labs = legend.labs,
                                   y.text = cumevents.y.text, y.text.col = cumevents.y.text.col,
                                   fontsize = fontsize, ggtheme = ggtheme, xlab = xlab, ylab = legend.title,
-                                  xlog = xlog, ...)
+                                  xlog = xlog, xscale = xscale, ...)
     res$cumevents <- res$cumevents + tables.theme
     if(!cumevents.y.text) res$cumevents <- .set_large_dash_as_ytext(res$cumevents)
     if(cumevents.y.text.col)
@@ -532,8 +545,8 @@ ggsurvplot <- function(fit, data = NULL, fun = NULL,
   ncensor_plot <- .set_ncensorplot_gpar(ncensor_plot,  ...) # specific graphical params
   ncensor_plot <- ncensor_plot + tables.theme
 
-  if(!xlog) ncensor_plot <- ncensor_plot + ggplot2::scale_x_continuous(breaks = times)
-  else ncensor_plot <- ncensor_plot + ggplot2::scale_x_continuous(breaks = times, trans = "log10")
+  if(!xlog) ncensor_plot <- ncensor_plot + ggplot2::scale_x_continuous(breaks = times, labels = xticklabels)
+  else ncensor_plot <- ncensor_plot + ggplot2::scale_x_continuous(breaks = times, trans = "log10", labels = xticklabels)
 
   }
   else if(cumcensor){
@@ -543,7 +556,7 @@ ggsurvplot <- function(fit, data = NULL, fun = NULL,
                                   legend = legend, legend.title = legend.title, legend.labs = legend.labs,
                                   y.text = cumcensor.y.text, y.text.col = cumcensor.y.text.col,
                                   fontsize = fontsize, ggtheme = ggtheme, xlab = xlab, ylab = legend.title,
-                                 xlog = xlog, ...)
+                                 xlog = xlog, xscale = xscale, ...)
     ncensor_plot <- ncensor_plot + tables.theme
     if(!cumcensor.y.text) ncensor_plot <- .set_large_dash_as_ytext(ncensor_plot)
     if(cumcensor.y.text.col)

diff --git a/R/utilities.R b/R/utilities.R
@@ -212,3 +212,32 @@ GeomConfint <- ggplot2::ggproto('GeomConfint', ggplot2::GeomRibbon,
         axis.ticks.y = element_blank())
 }
 
+
+# Transform x-axis labels according to the scale see ggsurvplot().
+#
+# labels: numeric vector (x-axis labels)
+#xscale: numeric or character values (see
+# gsurvplot). If numeric, the value is used to divide the labels on the x axis.
+# For example, a value of 365.25 will give labels in years instead of the
+# original days. If character, allowed options include one of c("d_m", "d_y",
+# "m_d", "m_y", "y_d", "y_m"), where d = days, m = months and y = years. For
+# example, xscale = "d_m" will transform labels from days to months; xscale =
+# "m_y", will transform labels from months to years.
+.format_xticklabels <- function(labels, xscale){
+
+  # 1 year = 365.25 days
+  # 1 month = 365.25/12 = 30.4375 days
+  if(is.numeric(xscale)) xtrans <- 1/xscale
+  else
+    xtrans <- switch(xscale,
+                     d_m = 12/365.25,
+                     d_y = 1/365.25,
+                     m_d = 365.25/12,
+                     m_y = 1/12,
+                     y_d = 365.25,
+                     y_m = 12,
+                     1
+    )
+  round(labels*xtrans,2)
+}
+
diff --git a/man/ggcumcensor.Rd b/man/ggcumcensor.Rd
diff --git a/man/ggcumevents.Rd b/man/ggcumevents.Rd