Trouble Deploying Shiny App for ML Predicting Mortality with SHAP plot

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:

  1. Patient Data Input: Users can input individual patient data (e.g., age, sepsis condition, pneumonia, etc.).
  2. 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:

  1. I’ve double-checked the code, ensuring there are no runtime errors when running locally.
  2. 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

Hello

It looks like the last line of your application is trying run a deploy. This likely means the last step of a deploy is to perform another deploy, and this is getting an error since only 1 deploy of a given application is allowed at a time. Try removing this line:

rsconnect::deployApp(forceUpdate = TRUE)

thanks
sam

1 Like

It worked, bro, Thanks a lot

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.