Hello Rstudio community,
A similar question has been answered for how to read xlsx file from url for r shiny app. However, it didn't help me. I am trying to develop a dynamic nomogram. The following shiny code finally worked for me (after reading through dozens of previously answered rstudio questions 
). However, because the files are available in my local computer. Only I can see the published shiny app, it is not available globally.
This code follows a nomogram code, which is a separate file. Shiny code below reads some of the RDS dataframe from that code, which appear at the first four lines of the code after the libraries. So I don't think I need to host the original excel data but rather tha RDS files that is required for the Shiny app. I was wondering how can I get the shiny to read the requires RDS files from github or from another host? I tried the following code but it didn't work. Or is there another way to do this (e.g. instead of the RDS files, reading the entire workspace?)
Can you please help me?
## ================ APP - DATAX======================= ##
library(shiny)
library(shinythemes)
library(ggplot2)
library(survival)
library(tidyverse)
library(rsconnect)
library(utile.visuals)
library(plotly)
library(reshape2)
library(rms)
library(RColorBrewer)
## === INPUT data ====================================================== ##
## ---- coxph output from ALL data
rg_quantiles <- readRDS(gzcon(url("https://github.com/biohacker/nomogram/blob/main/rg_quantiles.RDS")))
readRDS(gzcon(url("https://github.com/biohacker/nomogram/blob/main/surve_curve_alldata_imp_df.RDS")))
data_select <- readRDS(gzcon(url("https://github.com/biohacker/nomogram/blob/main/data_select.RDS")))
surv_formula <- readRDS(gzcon(url("https://github.com/biohacker/nomogram/blob/main/surv_formula.RDS")))
## ---- PARAMETERS
surv_months <- 120
## === Model training ====================================================== ##
options(contrasts=c("contr.treatment", "contr.treatment"))
cphfit <- cph(as.formula(surv_formula),
data = data_select,
surv = T, x=T, y=T,
id = data_select$ID)
# cphfit <- coxph(as.formula(surv_formula),
# data = data_select,
# id = data_select$study_number)
## === USER INTERFACE - HTML =============================================== ##
ui <- fluidPage(
theme = shinytheme("superhero"),
titlePanel("Datax Recurrence"),
sidebarLayout(
sidebarPanel(
selectInput("VarA", "VarA", selected = "0", choices = c("0","1")),
sliderInput("VarB", "VarB", min=18, max=100, value=50),
sliderInput("VarC", "VarC", min=0, max=2500, value=100),
sliderInput("VarD", "VarD", min=0, max=3000, value=500),
selectInput("VarE", "VarE", selected = "1",
choices = c("1","2","3")),
selectInput("VarF", "VarF", selected = "2",
choices = c("2","3","4","5","6")),
selectInput("VarG", "VarG", selected = "2",
choices = c("2","3")),
selectInput("VarH", "VarH", selected = "1",
choices = c("1","2")),
selectInput("VarI", "VarI", selected = "1",
choices = c("1","2","3","4")),
selectInput("VarJ", "VarJ", selected = "1",
choices = c("1","2","3")),
selectInput("VarK", "VarK", selected = "2",
choices = c("1","2","3","4","5","6","7","8")),
sliderInput("VarL", "VarL", min=0, max=100, value=10),
selectInput("VarM", "VarM", selected = "1",
choices = c("1","2","3","4")),
selectInput("VarN", "VarN", selected = "0",
choices = c("0","1")),
actionButton("eval_button", "Calculate")
),
mainPanel(
#tableOutput("TEST"),
textOutput("RG"),
textOutput("SURV"),
plotOutput("SURVPLOT")
)
)
)
## === SERVER ============================================================== ##
server <- function(input, output, session){
## -- REFORMAT INPUTS
newdat <- eventReactive(input$eval_button, {
data.frame(
VarA = input$VarA,
VarB = input$VarB,
VarC = input$VarC,
VarD = input$VarD,
VarE = input$VarE,
VarF = input$VarF,
VarG = input$VarG,
VarH = input$VarH,
VarI = input$VarI,
VarJ = input$VarJ,
VarK = input$VarK,
VarL = input$VarL,
VarM = input$VarM,
VarN = input$VarN
)
})
survfit_pred <- reactive({
survest(cphfit, newdata = newdat())
})
survfit_pred_survcurve <- reactive({
data.frame(time=as.vector(survfit_pred()$time),
surv=as.vector(survfit_pred()$surv),
lower=as.vector(survfit_pred()$lower),
upper=as.vector(survfit_pred()$upper))
})
surv_curve_all <- reactive({
bind_rows(surv_curve_alldata_imp_df,
data.frame(time=survfit_pred_survcurve()$time,
surv=survfit_pred_survcurve()$surv,
rg=rep("ID",nrow(survfit_pred_survcurve())),
type=rep("ID",nrow(survfit_pred_survcurve()))
)
)
})
#!!!!!!!!!!!times=surv_months
survfit_pred120 <- reactive({survest(cphfit, newdata=newdat(), times=surv_months)})
surv_pred <- reactive({round(survfit_pred120()$surv*100, 1)})
surv_pred_lower <- reactive({round(survfit_pred120()$lower*100, 1)})
surv_pred_upper <- reactive({round(survfit_pred120()$upper*100, 1)})
## -- evaluate PI
lp_predited <- reactive({predict(cphfit, newdata = newdat())})
## -- allocate RG
rg_predicted <- reactive({
cut(lp_predited(), rg_quantiles, labels = 1:(length(rg_quantiles)-1))
})
output$RG <- renderText({
paste0("The predictor index of ", round(lp_predited(),3),
" places this in risk group VarX ",
rg_predicted(), " (1=lowest, 4=highest).")
})
output$SURV <- renderText({
paste0("The 120 month non-recurrence (95% CI) is ",
surv_pred(), "% (",surv_pred_lower(),",",surv_pred_upper(),").")
})
output$SURVPLOT <- renderPlot({
surv_curve_all() %>%
filter(time<surv_months) %>%
filter(type=="obs" | type=="ID") %>%
mutate(surv=surv*100) %>%
ggplot() +
geom_smooth(aes(x=time,y=surv, linetype=type, color=rg)) +
scale_colour_brewer(type = "seq", palette = "Set1") +
ylim(0,100) + xlab("Time (months)") + ylab("Recurrence %") +
theme_bw() +
#theme(plot.background = element_rect(fill = RColorBrewer::brewer.pal(3,"Blues")[3], colour = NA)) +
labs(color="Risk Group") + scale_size(guide = "none") +
scale_linetype_discrete(name = "",
labels = c("Observed","ID"))
})
}
shinyApp(ui = ui, server = server)