Shiny disconnects after two clicks

General
1

I would like to deploy a predictive model via a ShinyApp. My app works locally but when I publish it online, it disconnects after two clicks. Any Idea why that is the case? You can check out the link below to check the website and use the code below to reproduce the error. Any comment would be appreciated. I've spent so much time already trying to figure it out but I have no more ideas.

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(tidymodels)
library(tidyverse)
library(stringr)
library(plotly)
library(ranger)
library(caret)


model_rate <- readRDS("model_forest_rate.rds")
model_rate_activism <- readRDS("model_forest_rate_activism.rds")

# function to predict the probability 
predict_probability <- function(model, dat){
    stats::predict(model, dat, type = "prob") %>%
        tidyr::gather() %>%
        dplyr::mutate(value = as.numeric(value)) 
}

# Define UI for application that draws a histogram
# Define UI for app that draws a histogram ----
ui <- fluidPage(

    # App title ----
    titlePanel("Auswertung der Umfrageergebnisse zur Abstimmung des CO2-Gesetz vom 13.06.21"),

    # Sidebar layout with input and output definitions ----
    sidebarLayout(
    
        # Sidebar panel for inputs ----
        sidebarPanel(

            selectInput("pol_party", label = "Welche Partei entspricht in den Zielen und Forderungen am ehesten Ihren eigenen 
                        Ansichten und Wünschen?",
                        choices = c("SVP (Schweizerische Volkspartei)", 
                                    "SP (Sozialdemokratische Partei)", 
                                    "FDP.Die Liberalen (Freisinnig Demokratische Partei)", 
                                    "CVP (Christlichdemokratische Volkspartei)",
                                    "GPS (Grüne Partei Schweiz)",
                                    "GLP (Grünliberale Partei)",
                                    "BDP (Bürgerlich Demokratische Partei)",
                                    "EVP (Evangelische Volkspartei der Schweiz)",
                                    "Lega dei Ticinesi",
                                    "PdA (Partei der Arbeit Schweiz)",
                                    "MCG (Mouvement Citoyens Genevois)",
                                    "CSP (Christlichsoziale Partei Schweiz)",
                                    "EDU (Eidgenössisch-Demokratische Union)",
                                    "Sol. (SolidaritéS)",
                                    "Andere:",
                                    "Keine",
                                    "Weiss nicht / keine Antwort")
            ),
        
        ),
    
        # Main panel for displaying outputs ----
        mainPanel(
        
            # Output: Histogram ----
            plotOutput(outputId = "Plot1", height = "200px")
            # ,plotOutput(outputId = "Plot2", height = "200px")
        
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {



    output$Plot1 <- renderPlot({
  
    
        dat <- tibble(
           "civi_stat" = 1,
            "fin_cond" = 1,
            "pol_party" = if(input$pol_party == "SVP (Schweizerische Volkspartei)") {1}
            else if (input$pol_party == "SP (Sozialdemokratische Partei)") {2}
            else if (input$pol_party == "FDP.Die Liberalen (Freisinnig Demokratische Partei)") {3}
            else if (input$pol_party == "CVP (Christlichdemokratische Volkspartei)") {4}
            else if (input$pol_party == "GPS (Grüne Partei Schweiz)") {5}
            else if (input$pol_party == "GLP (Grünliberale Partei)") {6}
            else if (input$pol_party == "BDP (Bürgerlich Demokratische Partei)") {7}
            else if (input$pol_party == "EVP (Evangelische Volkspartei der Schweiz)") {8}
            else if (input$pol_party == "Lega dei Ticinesi") {9}
            else if (input$pol_party == "PdA (Partei der Arbeit Schweiz)") {10}
            else if (input$pol_party == "MCG (Mouvement Citoyens Genevois)") {11}
            else if (input$pol_party == "CSP (Christlichsoziale Partei Schweiz)") {12}
            else if (input$pol_party == "EDU (Eidgenössisch-Demokratische Union)") {13}
            else if (input$pol_party == "Sol. (SolidaritéS)") {14}
            else if (input$pol_party == "Andere:") {15}
            else if (input$pol_party == "Keine") {16}
            else if (input$pol_party == "Weiss nicht / keine Antwort") {17},
            "renew_heating" = 1,
            "left_right" = 1,
            "prior_benefit" = 1,
            "ren_driver" = 1,
            "home_owner" = 1,
            "educ" = 1,
            "empl_sect" = 1,
            "empl_stat" = 2,
            "gender" = 1,
            "region" = 1,
            "know_targ" = 1,
            "know_build" = 1,
            "know_trans" = 1,
            "know_food" = 1,
            "know_avia" = 1,
            "know_wast" = 1,
            "efficiency" = 3,
            "effectiveness" = 3,
            "competitiveness" = 3,
            "justice" = 3,
            "transformation" = 3
       
        )
    
            predict_probability(model_rate, dat) %>%
             dplyr::mutate(
              value = ifelse(key == ".pred_2", value*(-1), value),
              value = ifelse(key == ".pred_1", value*(-1), value),
              value = ifelse(key == ".pred_3", value/2, value),
              dv = ""
            ) %>%
            dplyr::bind_rows(.[.$key == ".pred_3",] %>% dplyr::mutate(value = value *(-1))) %>%
            dplyr::mutate(key = factor(key, levels = c(".pred_3", ".pred_2", ".pred_1", ".pred_4", ".pred_5"))) %>%
            ggplot2::ggplot(.) +
            ggplot2::geom_bar(aes(x = dv, y = value, fill = key), stat = "identity", position = position_stack(reverse = TRUE)) +
            ggplot2::theme_minimal() +
            ggplot2::coord_flip() +
            ggplot2::ylim(-1,1) +
            ggplot2::labs(
            title = "Public Support",
            x = "",
            y = "Probability"
        ) +
            ggplot2::scale_fill_manual(name = "", labels =c("Viel Aufwand zur Unterstützung", "Etwas Aufwand zur Unterstützung", "Viel Aufwand zur Verhinderung", "Etwas Aufwand zur Verhinderung", "Weder noch"), limits = rev, values = c("darkgreen", "lightgreen", "red4", "red3",  "grey")) +
        ggplot2::theme(plot.title = element_text(margin = ggplot2::margin(30,30,30,30)), legend.position = "bottom") +
        guides(fill=guide_legend(nrow=2,byrow=TRUE))
   
    })

}

# Run the application 
shinyApp(ui = ui, server = server)

link to the app

two models for download

Logs:

2022-06-27T10:46:35.294545+00:00 shinyapps[5076563]: ✔ parsnip      0.2.1     ✔ workflowsets 0.2.1
2022-06-27T10:46:35.294454+00:00 shinyapps[5076563]: ✔ infer        1.0.2     ✔ tune         0.2.0
2022-06-27T10:46:35.294633+00:00 shinyapps[5076563]: ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
2022-06-27T10:46:35.294310+00:00 shinyapps[5076563]: ✔ dials        1.0.0     ✔ rsample      0.1.1
2022-06-27T10:46:35.294849+00:00 shinyapps[5076563]: ✖ recipes::step()  masks stats::step()
2022-06-27T10:46:35.294502+00:00 shinyapps[5076563]: ✔ modeldata    0.1.1     ✔ workflows    0.2.6
2022-06-27T10:46:35.294590+00:00 shinyapps[5076563]: ✔ purrr        0.3.4     ✔ yardstick    1.0.0
2022-06-27T10:46:35.295012+00:00 shinyapps[5076563]: ✔ readr   2.1.2     ✔ forcats 0.5.1
2022-06-27T10:46:35.294806+00:00 shinyapps[5076563]: ✖ infer::observe() masks shiny::observe()
2022-06-27T10:46:35.294894+00:00 shinyapps[5076563]: • Dig deeper into tidy modeling with R at https://www.tmwr.org
2022-06-27T10:46:35.294719+00:00 shinyapps[5076563]: ✖ dplyr::filter()  masks stats::filter()
2022-06-27T10:46:35.294762+00:00 shinyapps[5076563]: ✖ dplyr::lag()     masks stats::lag()
2022-06-27T10:46:35.295062+00:00 shinyapps[5076563]: ✔ stringr 1.4.0     
2022-06-27T10:46:35.294676+00:00 shinyapps[5076563]: ✖ purrr::discard() masks scales::discard()
2022-06-27T10:46:35.294962+00:00 shinyapps[5076563]: ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.1 ──
2022-06-27T10:46:36.296606+00:00 shinyapps[5076563]: ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
2022-06-27T10:46:36.296676+00:00 shinyapps[5076563]: ✖ readr::col_factor() masks scales::col_factor()
2022-06-27T10:46:36.296744+00:00 shinyapps[5076563]: ✖ purrr::discard()    masks scales::discard()
2022-06-27T10:46:36.296792+00:00 shinyapps[5076563]: ✖ dplyr::filter()     masks stats::filter()
2022-06-27T10:46:36.296851+00:00 shinyapps[5076563]: ✖ stringr::fixed()    masks recipes::fixed()
2022-06-27T10:46:36.296898+00:00 shinyapps[5076563]: ✖ dplyr::lag()        masks stats::lag()
2022-06-27T10:46:36.296988+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.296944+00:00 shinyapps[5076563]: ✖ readr::spec()       masks yardstick::spec()
2022-06-27T10:46:36.297127+00:00 shinyapps[5076563]: The following object is masked from ‘package:ggplot2’:
2022-06-27T10:46:36.297032+00:00 shinyapps[5076563]: Attaching package: ‘plotly’
2022-06-27T10:46:36.297077+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.297213+00:00 shinyapps[5076563]:     last_plot
2022-06-27T10:46:36.297170+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.297257+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.297304+00:00 shinyapps[5076563]: The following object is masked from ‘package:stats’:
2022-06-27T10:46:36.297345+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.297476+00:00 shinyapps[5076563]:     filter
2022-06-27T10:46:36.297529+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.297583+00:00 shinyapps[5076563]: The following object is masked from ‘package:graphics’:
2022-06-27T10:46:36.297634+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.297679+00:00 shinyapps[5076563]:     layout
2022-06-27T10:46:36.297724+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.297784+00:00 shinyapps[5076563]: Loading required package: lattice
2022-06-27T10:46:36.297830+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.297875+00:00 shinyapps[5076563]: Attaching package: ‘caret’
2022-06-27T10:46:36.297918+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.297966+00:00 shinyapps[5076563]: The following objects are masked from ‘package:yardstick’:
2022-06-27T10:46:36.298010+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.298054+00:00 shinyapps[5076563]:     precision, recall, sensitivity, specificity
2022-06-27T10:46:36.298095+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.298162+00:00 shinyapps[5076563]: The following object is masked from ‘package:purrr’:
2022-06-27T10:46:36.298207+00:00 shinyapps[5076563]: 
2022-06-27T10:46:36.298254+00:00 shinyapps[5076563]:     lift
2022-06-27T10:46:36.298300+00:00 shinyapps[5076563]: 
2022-06-27T10:46:43.294162+00:00 shinyapps[5076563]: 
2022-06-27T10:46:43.294219+00:00 shinyapps[5076563]: Listening on http://127.0.0.1:42379
2

I checked your shiny app link, specifically the console output when the disconnect happens:
Connection closed. Info: {"type":"close","bubbles":false,"cancelable":false,"timeStamp":1656371220026,"wasClean":true,"code":4702,"reason":"Error reading from Shiny"}

However, this is not enough information. Have you tried checking the logs to see the source of the error? This post explains how to do that. Please take a look and see if any errors are logged.

EDIT: sorry, I didn't realize it was hosted on the free shinyapps.io server and not your own server. I am not exactly familiar with that, but hopefully this will guide you in the right direction.

EDIT2: found a guide on how to check logs on shinyapps.io for you: Chapter 9 Troubleshooting | shinyapps.io user guide

3

Thank you so much for the reply and the suggestions. I have adapted the code to reflect your requests. Unfortunately, the logs have not provided me with much guidance on how to solve the problem. Any idea? Maybe I should try to host the App myself. Probably this could solve my incessant problems with this server. But on the other hand, many people are using the shinypps.io server. So I assume that should somehow work.

4

Can you share the logs so we can take a look? Otherwise we don't have enough information to help you out.

5

Please check the logs above

6

This is what the browser console is showing:

image

7

Do the logs flat out stop at Listening on http://127.0.0.1:42379? The crash should happen after that. Also what did you mean by Anaconda issues? I don't see anything.

8

Hi, I deployed your application here: Auswertung der Umfrageergebnisse zur Abstimmung des CO2-Gesetz vom 13.06.21

It crashed when I used the default 1GB of memory, but after I increased it to 2GB, it has been running without trouble.

9

This topic was automatically closed 21 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.