survival_shiny.R

library(tidyverse)
library(hrbrthemes)
library(janitor)
library(survival)
library(survminer)
library(shiny)
library(miniUI)

theme_set(theme_ipsum())
pals <- rownames(RColorBrewer::brewer.pal.info)

set.seed(123)

## Preliminary Analysis ----

# source: https://www.kaggle.com/blastchar/telco-customer-churn
raw <- pins::pin_get("telco_customer_churn")
raw <- raw %>% 
    clean_names() %>% 
    mutate(churn = if_else(churn == "Yes", 1L, 0L))

# kaplan-meier analysis
km <- with(raw, Surv(tenure, churn))
km_fit <- survfit(Surv(tenure, churn) ~ 1, data = raw)
km_fit %>% 
    ggsurvplot(
        data     = raw,
        linetype = "solid",
        conf.int = FALSE,
        ggtheme  = theme_ipsum(),
        xlab = "Time",
        ylab = "Surv. Prob"
    )

# convert into partial app
sc <- . %>%
    ggsurvplot(
        data     = raw,
        linetype = "solid",
        conf.int = FALSE,
        pval     = TRUE,
        censor   = FALSE,
        palette  = sample(pals, 1),
        ggtheme  = theme_ipsum(),
        break.time.by = 14,
        xlab = "Time",
        ylab = "Surv. Prob"
    )

survival_gadget <- function(dat) {
    
    ui <- miniPage(
        miniContentPanel(
            varSelectInput("var", "Variable", dat),
            actionButton("go", "Fit"),
            plotOutput("survplot")
        )
    )
    
    server <- function(input, output, session) {
        
        txt <- eventReactive(input$go, {
            sprintf("survfit(Surv(tenure, churn) ~ %s, data = dat)",
                    as.character(input$var))
        })
        
        pals <- rownames(RColorBrewer::brewer.pal.info)
        
        output$survplot <- renderPlot({
            fit  <- eval(parse(text = txt()))
            gg <- ggsurvplot(
                fit      = fit,
                data     = dat,
                linetype = "solid",
                conf.int = FALSE,
                pval     = TRUE,
                censor   = FALSE,
                ggtheme  = theme_ipsum(),
                palette  = sample(pals, 1),
                break.time.by = 14,
                xlab = "Time",
                ylab = "Surv. Prob"
            )
            print(gg)
        })
    }
    
    runGadget(ui, server)
}
survival_gadget(raw)