Hello everyone,
Iβm currently developing a Shiny application for predicting mortality in DM stroke patient using the Random Forest algorithm. Here are the key features of the app:
- Patient Data Input: Users can input individual patient data (e.g., age, sepsis condition, pneumonia, etc.).
- Prediction and Explanation: After clicking the Predict button, the app generates the mortality risk prediction, along with a narrative explanation based on SHAP plots to describe contributing factors.
The Problem:
Iβve successfully deployed and tested this application on my intranet, and it works perfectly.
However, Iβve encountered repeated failures when trying to deploy it to Shinyapps.io.
What Iβve Tried So Far:
- Iβve double-checked the code, ensuring there are no runtime errors when running locally.
- Iβve attempted to resolve the issue by adding the
forceUpdate = TRUE
parameter, but the deployment still fails.
Below, Iβm sharing:
App.R code
rsconnect::setAccountInfo(name='dhitebayu', token='91E2192A87EDA5C53E3B89BE49E81F01', secret='u7Q902Y9Fa2Nz1CA9LCrBs7PTrWtsttAy1Ce6344')
library(shiny)
library(tidyverse)
library(randomForest)
library(DALEX)
library(shapper)
library(ggpubr)
library(hablar)
#dataset
dmstroke_web <- read.csv2("dmstroke_web_v6jan.csv")
dmstroke_web <-
dmstroke_web %>%
hablar::convert(fct(status,
Sepsis,
Pneumonia,
Dyslipidemia,
Hemiplegia),
num(Length_of_Stay_days,
Age_years
))
dmstroke_rf <- randomForest(status ~.,
data = dmstroke_web)
explain_rf <- DALEX::explain(model = dmstroke_rf,
data = dmstroke_web,
y = dmstroke_web$status == "meninggal",
label = "Random Forest")
#rsconnect
ui <- fluidPage(
titlePanel("DM Stroke ML Prediction for Mortality"),
sidebarLayout(
sidebarPanel(
# Input fields for each feature
selectInput("sepsis", "Sepsis", choices = c("No", "Yes")),
numericInput("age", "Age Years", value = 55),
selectInput("pneumonia", "Pneumonia", choices = c("No", "Yes")),
selectInput("dyslipidemia", "Dyslipidemia", choices = c("No", "Yes")),
numericInput("los", "Length of Stay (days)", value = 4),
selectInput("hemiplegia", "Hemiplegia", choices = c("No", "Yes")), # Added Hemiplegia input
actionButton("predict", "Predict")
),
# Main panel in UI
mainPanel(
h4("Prediction Output"),
verbatimTextOutput("predictionOutput"),
h4("Real-world Implication"),
textOutput("predictionExplanation"), # Ensure this matches the output ID in server
h4("SHAP Value Plot"),
plotOutput("shapPlot")
)
)
)
server <- function(input, output) {
observeEvent(input$predict, {
patient_data <- data.frame(
Sepsis = factor(input$sepsis, levels = c("No", "Yes")),
Age_years = as.numeric(input$age),
Pneumonia = factor(input$pneumonia, levels = c("No", "Yes")),
Dyslipidemia = factor(input$dyslipidemia, levels = c("No", "Yes")),
Length_of_Stay_days = as.numeric(input$los),
Hemiplegia = factor(input$hemiplegia, levels = c("No", "Yes"))
)
prediction <- predict(explain_rf, newdata = patient_data)[1]
output$predictionOutput <- renderPrint({ round(prediction * 100, 2) })
shap_values <- predict_parts(explainer = explain_rf, new_observation = patient_data, type = "break_down", B = 25)
output$shapPlot <- renderPlot({
plot(shap_values) +
ggtitle("SHAP Values") +
theme(plot.title = element_text(size = 14, face = "bold", hjust = 0.5))
})
output$predictionExplanation <- renderText({
paste(
"The model predicts a", round(prediction * 100, 2), "% probability that this patient with Type 2 Diabetes Mellitus (T2DM) and stroke will experience mortality"
)
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
rsconnect::deployApp(forceUpdate = TRUE)
Error Log from Shinyapps.io:
2025-01-07T07:03:59.488831+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.492735+00:00 shinyapps[13672858]: Attaching package: βDALEXβ
2025-01-07T07:03:59.496913+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.501003+00:00 shinyapps[13672858]: The following object is masked from βpackage:dplyrβ:
2025-01-07T07:03:59.505835+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.509874+00:00 shinyapps[13672858]: explain
2025-01-07T07:03:59.514051+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.518473+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.522415+00:00 shinyapps[13672858]: Attaching package: βhablarβ
2025-01-07T07:03:59.526731+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.530984+00:00 shinyapps[13672858]: The following object is masked from βpackage:forcatsβ:
2025-01-07T07:03:59.535564+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.539820+00:00 shinyapps[13672858]: fct
2025-01-07T07:03:59.543970+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.547963+00:00 shinyapps[13672858]: The following object is masked from βpackage:dplyrβ:
2025-01-07T07:03:59.551989+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.556455+00:00 shinyapps[13672858]: na_if
2025-01-07T07:03:59.560319+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.564558+00:00 shinyapps[13672858]: The following object is masked from βpackage:tibbleβ:
2025-01-07T07:03:59.568606+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.572752+00:00 shinyapps[13672858]: num
2025-01-07T07:03:59.576732+00:00 shinyapps[13672858]:
2025-01-07T07:03:59.580777+00:00 shinyapps[13672858]: Preparation of a new explainer is initiated
2025-01-07T07:03:59.585054+00:00 shinyapps[13672858]: -> model label : Random Forest
2025-01-07T07:03:59.590412+00:00 shinyapps[13672858]: -> data : 749 rows 7 cols
2025-01-07T07:03:59.594547+00:00 shinyapps[13672858]: -> target variable : 749 values
2025-01-07T07:03:59.599065+00:00 shinyapps[13672858]: -> predict function : yhat.randomForest will be used ( default )
2025-01-07T07:03:59.603117+00:00 shinyapps[13672858]: -> predicted values : No value for predict function target column. ( default )
2025-01-07T07:03:59.607393+00:00 shinyapps[13672858]: -> model_info : package randomForest , ver. 4.7.1.2 , task classification ( default )
2025-01-07T07:03:59.611488+00:00 shinyapps[13672858]: -> model_info : Model info detected classification task but 'y' is a logical . Converted to numeric. ( NOTE )
2025-01-07T07:03:59.615624+00:00 shinyapps[13672858]: -> predicted values : numerical, min = 0 , mean = 0.1921949 , max = 0.99
2025-01-07T07:03:59.619729+00:00 shinyapps[13672858]: -> residual function : difference between y and yhat ( default )
2025-01-07T07:03:59.623725+00:00 shinyapps[13672858]: -> residuals : numerical, min = -0.83 , mean = 0.06414686 , max = 0.99
2025-01-07T07:03:59.627807+00:00 shinyapps[13672858]: A new explainer has been created!
2025-01-07T07:03:59.632339+00:00 shinyapps[13672858]: ββ Preparing for deployment ββββββββββββββββββββββββββββββββββββββββββββββββββββ
2025-01-07T07:03:59.636625+00:00 shinyapps[13672858]: β Re-deploying "dmdeath_stroke" using "server: shinyapps.io / username: dhitebayu"
2025-01-07T07:03:59.640669+00:00 shinyapps[13672858]: βΉ Looking up application with id 13672858...
2025-01-07T07:03:59.644926+00:00 shinyapps[13672858]: β Found application <https://dhitebayu.shinyapps.io/dmdeath_stroke/>
2025-01-07T07:03:59.649048+00:00 shinyapps[13672858]: βΉ Bundling 2 files: 'app.R' and 'dmstroke_web_v6jan.csv'
2025-01-07T07:03:59.652943+00:00 shinyapps[13672858]: βΉ Capturing R dependencies
2025-01-07T07:04:00.740089+00:00 shinyapps[13672858]: β Found 157 dependencies
2025-01-07T07:04:00.744927+00:00 shinyapps[13672858]: β Created 93,797b bundle
2025-01-07T07:04:00.749117+00:00 shinyapps[13672858]: βΉ Uploading bundle...
2025-01-07T07:04:01.724366+00:00 shinyapps[13672858]: β Uploaded bundle with id 9614572
2025-01-07T07:04:01.728769+00:00 shinyapps[13672858]: ββ Deploying to server βββββββββββββββββββββββββββββββββββββββββββββββββββββββββ
2025-01-07T07:04:01.733710+00:00 shinyapps[13672858]: Waiting for task: 1495610510
2025-01-07T07:04:02.738871+00:00 shinyapps[13672858]: building: Building image: 11788885
2025-01-07T07:04:08.736903+00:00 shinyapps[13672858]: building: Installing system dependencies
2025-01-07T07:04:17.745525+00:00 shinyapps[13672858]: building: Fetching packages
2025-01-07T07:04:21.740876+00:00 shinyapps[13672858]: building: Installing packages
working intranet web