Merge pull request #111 from zzawadz/master

Fix #110

R/ggcoxfunctional.R

@@ -94,10 +94,11 @@ ggcoxfunctional <- function (formula, data, iter = 0, f = 0.6,
 
 #' @param x an object of class ggcoxfunctional
 #' @param ... further arguments passed to print, but really it's unused
+#' @param newpage open a new page. See \code{\link{grid.arrange}}.
 #' @method print ggcoxfunctional
 #' @rdname ggcoxfunctional
 #' @export
-print.ggcoxfunctional <- function(x, ...){
+print.ggcoxfunctional <- function(x, ..., newpage = TRUE){
   if(!inherits(x, "ggcoxfunctional"))
     stop("An object of class ggcoxfunctional is required.")
   plots <- x
@@ -111,6 +112,6 @@ print.ggcoxfunctional <- function(x, ...){
     grobs[[i]]$widths[2:5] <- as.list(maxwidth)
   }
   y.text <- attr(plots, "y.text")
-  do.call(gridExtra::grid.arrange, c(grobs, left = y.text))
+  do.call(gridExtra::grid.arrange, c(grobs, left = y.text, newpage = newpage))
 }
 

R/ggcoxzph.R

@@ -153,10 +153,11 @@ ggcoxzph <- function (fit, resid = TRUE, se = TRUE, df = 4, nsmo = 40, var,
 
 #' @param x an object of class ggcoxzph
 #' @param ... further arguments passed to print, but really it's unused
+#' @param newpage open a new page. See \code{\link{grid.arrange}}.
 #' @method print ggcoxzph
 #' @rdname ggcoxzph
 #' @export
-print.ggcoxzph <- function(x, ...){
+print.ggcoxzph <- function(x, ..., newpage = TRUE){
   if(!inherits(x, "ggcoxzph"))
     stop("An object of class ggcoxzph is required.")
   plots <- x
@@ -173,6 +174,6 @@ print.ggcoxzph <- function(x, ...){
 
   if(!is.null(pval)) main <- paste0("Global Schoenfeld Test p: ", signif(pval, 4), "\n")
   else main <- NULL
-  do.call(gridExtra::grid.arrange, c(grobs, top = main))
+  do.call(gridExtra::grid.arrange, c(grobs, top = main, newpage = newpage))
 }
 

R/ggsurvplot.R

@@ -530,10 +530,11 @@ ggsurvplot <- function(fit, fun = NULL,
 }
 
 #' @param x an object of class ggsurvplot
+#' @param newpage open a new page. See \code{\link{grid.arrange}}.
 #' @method print ggsurvplot
 #' @rdname ggsurvplot
 #' @export
-print.ggsurvplot <- function(x, surv.plot.height = NULL, risk.table.height = NULL, ncensor.plot.height = NULL, ...){
+print.ggsurvplot <- function(x, surv.plot.height = NULL, risk.table.height = NULL, ncensor.plot.height = NULL, ..., newpage = TRUE){
   if(!inherits(x, "ggsurvplot"))
     stop("An object of class ggsurvplot is required.")
 
@@ -581,7 +582,7 @@ print.ggsurvplot <- function(x, surv.plot.height = NULL, risk.table.height = NUL
     for (i in 1:length(grobs)) {
       grobs[[i]]$widths[2:5] <- as.list(maxwidth)
     }
-    do.call(gridExtra::grid.arrange, c(grobs, nrow = nplot, heights = heights ))
+    do.call(gridExtra::grid.arrange, c(grobs, nrow = nplot, heights = heights, newpage = newpage))
   }
 }
 

R/surv_cutpoint.R

@@ -242,10 +242,11 @@ plot.surv_cutpoint <- function(x, variables = NULL, ggtheme = theme_classic2(),
   p
 }
 
+#' @param newpage open a new page. See \code{\link{grid.arrange}}.
 #' @method print plot_surv_cutpoint
 #' @rdname surv_cutpoint
 #' @export
-print.plot_surv_cutpoint <- function(x, ...){
+print.plot_surv_cutpoint <- function(x, ..., newpage = TRUE){
   if(!inherits(x, "plot_surv_cutpoint"))
     stop("x must be an object of class plot_surv_cutpoint.")
   x$distribution <- x$distribution  + theme(legend.position = "none")+labs(x = NULL)
@@ -265,7 +266,7 @@ print.plot_surv_cutpoint <- function(x, ...){
   cutpoint <- attr(x, "cutpoint")
   main <- name <- attr(x, "name")
   # main <- paste0(name,"- cutpoint: ", attr(x, "cutpoint"))
-  do.call(gridExtra::grid.arrange, c(grobs, top = main))
+  do.call(gridExtra::grid.arrange, c(grobs, top = main, newpage = newpage))
 }