search

kassambara / survminer

Survival Analysis and Visualization
https://rpkgs.datanovia.com/survminer/
507 stars 162 forks source link

some ggsurv plots fails in a for loop in a shiny app #95

Closed msquatrito closed 7 years ago

msquatrito commented 7 years ago

Hi, First of all thanks for this great package! I'm having an issue with the last releases 0.23 and 0.24, but I didn't have any problem with 0.22. I'm generating multiple survival ggsurvplot through a for loop in a shiny app. With the latest survminer release the plot fail when there is more than one categorical variable.

Expected behavior

Generate multiple Kaplan Meier plots using a for loop For the expected behaviour check: http://gliovis.bioinfo.cnio.es Select: Explore/Summary/Dataset summary plots

Actual behavior

Plots with multiple curves fail

Steps to reproduce the problem

library(shiny)
library(survival)
library(survminer)
data(myeloma)
server <- function(input, output) {

    output$survPlots <- renderUI({
      df <- myeloma[ ,c("molecular_group", "chr1q21_status", "treatment", "event",  "time")]
      groups <- names(df)[!names(df) %in% c("event",  "time")]
      plot_output_list <- lapply(groups, function(i) {
        plot_surv_name <- paste("plotSurv", i, sep = "")
        plotOutput(plot_surv_name, height = 300, width = 400)
      })
      do.call(tagList, plot_output_list)
    })

    observe({
      df <- myeloma[ ,c("molecular_group", "chr1q21_status", "treatment", "event",  "time")]
      groups <- names(df)[!names(df) %in% c("event",  "time")]
      for (i in groups) {
        local({
          my_Survi <- i
          plot_surv_name <- paste0("plotSurv", my_Survi)
          output[[plot_surv_name]] <- renderPlot({
            df1 <- na.omit(data.frame(status = df[ ,"event"], time = df[ ,"time"], strata = df[ ,my_Survi]))
            df1$strata <- droplevels(df1$strata)
            fit <- survfit(Surv(time, status == 1) ~ strata, data = df1)
            ggsurvplot(fit, legend = c(0.75,0.75), surv.scale = "percent", ylab = "Surviving", legend.labs = levels(df1$strata), color = "red",
                       xlab = "Survival time (Months)", main = paste0("\n",my_Survi), legend.title = "", font.legend = 12, palette = "Set1")
          })
        })
      }
    })
  }

ui <-  bootstrapPage(
           uiOutput(outputId = "survPlots")
         )

shinyApp(ui = ui, server = server)

session_info()

R version 3.3.2 (2016-10-31) Platform: x86_64-apple-darwin13.4.0 (64-bit) Running under: OS X Yosemite 10.10.5

locale: [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages: [1] stats graphics grDevices utils datasets methods base

other attached packages: [1] survival_2.40-1 survminer_0.2.4 ggplot2_2.2.0 shiny_0.14.2

loaded via a namespace (and not attached): [1] Rcpp_0.12.8 rstudioapi_0.6 magrittr_1.5 splines_3.3.2 devtools_1.12.0 munsell_0.4.3 colorspace_1.3-1 xtable_1.8-2 lattice_0.20-34 [10] R6_2.2.0 plyr_1.8.4 tools_3.3.2 grid_3.3.2 gtable_0.2.0 withr_1.0.2 htmltools_0.3.5 lazyeval_0.2.0 digest_0.6.10
[19] assertthat_0.1 tibble_1.2 Matrix_1.2-7.1 memoise_1.0.0 mime_0.5 labeling_0.3 scales_0.4.1 jsonlite_1.1 httpuv_1.3.3 

# please paste here the result of
devtools::session_info()

Session info --------------------------------------------------------------------------------------------------------------------------------------------------------- setting value
version R version 3.3.2 (2016-10-31) system x86_64, darwin13.4.0
ui RStudio (1.0.44)
language (EN)
collate en_US.UTF-8
tz Europe/Madrid
date 2016-12-12

Packages ------------------------------------------------------------------------------------------------------------------------------------------------------------- package version date source
assertthat 0.1 2013-12-06 CRAN (R 3.1.0) colorspace 1.3-1 2016-11-18 CRAN (R 3.3.2) devtools 1.12.0 2016-06-24 CRAN (R 3.3.0) digest 0.6.10 2016-08-02 CRAN (R 3.3.0) ggplot2 2.2.0 2016-11-11 CRAN (R 3.3.2) gtable 0.2.0 2016-02-26 CRAN (R 3.2.3) htmltools 0.3.5 2016-03-21 CRAN (R 3.2.4) httpuv 1.3.3 2015-08-04 CRAN (R 3.2.2) jsonlite 1.1 2016-09-14 CRAN (R 3.3.0) labeling 0.3 2014-08-23 CRAN (R 3.1.1) lattice 0.20-34 2016-09-06 CRAN (R 3.3.2) lazyeval 0.2.0 2016-06-12 CRAN (R 3.3.0) magrittr 1.5 2014-11-22 CRAN (R 3.1.2) Matrix 1.2-7.1 2016-09-01 CRAN (R 3.3.2) memoise 1.0.0 2016-01-29 CRAN (R 3.2.3) mime 0.5 2016-07-07 CRAN (R 3.3.0) munsell 0.4.3 2016-02-13 CRAN (R 3.2.3) plyr 1.8.4 2016-06-08 CRAN (R 3.3.0) R6 2.2.0 2016-10-05 CRAN (R 3.3.0) Rcpp 0.12.8 2016-11-17 CRAN (R 3.3.2) scales 0.4.1 2016-11-09 CRAN (R 3.3.2) shiny 0.14.2 2016-11-01 CRAN (R 3.3.0) survival 2.40-1 2016-10-30 CRAN (R 3.3.0) survminer * 0.2.4 2016-12-11 CRAN (R 3.3.2) tibble 1.2 2016-08-26 CRAN (R 3.3.0) withr 1.0.2 2016-06-20 CRAN (R 3.3.0) xtable 1.8-2 2016-02-05 CRAN (R 3.2.3)

kassambara commented 7 years ago

Hi,

In the for() loop you used:

ggsurvplot(fit, ....)

Does the following code resolve the problem?

p <- ggsurvplot(fit, ...)
print(p)
msquatrito commented 7 years ago

No, unfortunately it doesn't.

kassambara commented 7 years ago

Hi,

To evaluate the survfit object provided by users, survminer uses a risky function eval() with default environment = parent.frame(). I'll figure it out how to fix definitively this issue.

In the meantime, using the function do.call() in your script should resolve the ploblem.

In your for() loop, please replace this line:

fit <- survfit(Surv(time, status == 1) ~ strata, data = df1)

by:

fit <- do.call(survfit, list(formula = Surv(time, status == 1) ~ strata, data = df1))

Let me know if it works.

The final script looks like this:

library(shiny)
library(survival)
library(survminer)
data(myeloma)

server <- function(input, output) {

  output$survPlots <- renderUI({
    df <- myeloma[ ,c("molecular_group", "chr1q21_status", "treatment", "event",  "time")]
    groups <- names(df)[!names(df) %in% c("event",  "time")]
    plot_output_list <- lapply(groups, function(i) {
      plot_surv_name <- paste("plotSurv", i, sep = "")
      plotOutput(plot_surv_name, height = 300, width = 400)
    })
    do.call(tagList, plot_output_list)
  })

  observe({
    df <- myeloma[ ,c("molecular_group", "chr1q21_status", "treatment", "event",  "time")]
    groups <- "treat"
   groups <- names(df)[!names(df) %in% c("event",  "time")]
    for (i in groups) {
      local({
        my_Survi <- i
        plot_surv_name <- paste0("plotSurv", my_Survi)
        output[[plot_surv_name]] <- renderPlot({
          df1 <- na.omit(data.frame(status = df[ ,"event"], time = df[ ,"time"], strata = df[ ,my_Survi]))
          fit <- do.call(survfit, list(formula = Surv(time, status == 1) ~ strata, data = df1))
          # fit <- survfit(Surv(time, status == 1) ~ strata, data = df1)
          ggsurvplot(fit, legend = c(0.75,0.75), surv.scale = "percent", ylab = "Surviving",  legend.labs = levels(df1$strata), color = "red",
                     xlab = "Survival time (Months)", main = paste0("\n",my_Survi), legend.title = "", font.legend = 12, palette = "Set1")
        })
      })
    }
  })
}

ui <-  bootstrapPage(
  uiOutput(outputId = "survPlots")
)

shinyApp(ui = ui, server = server)

Best, /A

msquatrito commented 7 years ago

Great! The do.call() fixed the issue. Thanks for your time! Best, M.

kassambara commented 7 years ago

so, we can close this issue