Rstudio Crashes after I close the shiny app


#1

I have a shiny app. This is the code. It runs fine but when I close it. entire Rstudio crashes and then I have to restart it again. I have no idea what am I doing wrong. It's portable so if you copy and paste the code it should run on your machine too..






# Load_Libraries ----------------------------------------------------------

library(RPostgres)
library(readxl)
library(ggthemes)
library(plotly)
library(lubridate)
library(DBI)
library(pool)
library(data.table)
library(shiny)
library(shinyBS)
library(flexdashboard)
library(shinydashboard)
library(dashboardthemes)
library(tidyverse)
library(shinyjs)
library(DT)
library(RSQLite)
library(DBI)

options(shiny.maxRequestSize = 200 * 1024 ^ 2)

dir.create("www", showWarnings = FALSE)

# Header ------------------------------------------------------------------

main_header <- dashboardHeader(
    title = shinyDashboardLogoDIY(
        boldText = "HR",
        mainText = "Dashboard",
        badgeText = "Beta",
        textSize = 18,
        badgeTextColor = "white",
        badgeTextSize = 2,
        badgeBackColor = "#40E0D0",
        badgeBorderRadius = 3
    )
)


# Sidebar -----------------------------------------------------------------

main_siderbar <- dashboardSidebar(
    sidebarUserPanel(name = h4('Test User'),
                     image = 'www/logo.png'),
    
    sidebarMenu(
        # upload_file_menu --------------------------------------------------------
        
        
        menuItem(
            text = 'upload file',
            icon = icon('file-excel-o', lib = 'font-awesome'),
            tabName = 'file_tab'
            
        ),
        
        # see_file_menu -----------------------------------------------------------
        
        menuItem(
            text = 'Retreive Data',
            tabName = 'sql_tab',
            icon = icon('database', lib = 'font-awesome')
            
        ),
        
        
        
        # Dashboard_menu ----------------------------------------------------------
        menuItem(
            text = 'Dashboard',
            tabName = 'dashboard',
            icon = icon('dashboard', lib = 'font-awesome')
            
        )
    )
    
)

# Body --------------------------------------------------------------------

main_body <-
    dashboardBody(# themes ------------------------------------------------------------------
                  
                  # shinyDashboardThemes(
                  #     theme = "grey_light"
                  # ),
                  
                  
                  # file_tab -----------------------------------------------------------------
                  
                  
                  tabItems(
                      tabItem(
                          tabName = "file_tab",
                          
                          sidebarLayout(
                              sidebarPanel = sidebarPanel(
                                  radioButtons(
                                      "file_type",
                                      label = ("Please Select the Type of File uploaded"),
                                      choices = list("XLSX" = 'XLSX', "CSV" = 'CSV'),
                                      selected = "XLSX"
                                  ),
                                  
                                  fileInput(
                                      "file_upload",
                                      "Choose a File",
                                      accept = c(
                                          "text/csv",
                                          "xlsx",
                                          "xls",
                                          "text/comma-separated-values,text/plain",
                                          ".csv"
                                      )
                                  ),
                                  
                                  uiOutput('select_sheet'),
                                  
                                  selectInput(
                                      'table_sql',
                                      label = 'Please select the Table',
                                      choices = c('casual', 'attendence', 'permanent', 'costing'),
                                      multiple = FALSE
                                  ),
                                  radioButtons(
                                      inputId = 'checkaction',
                                      label = 'Please select an action',
                                      choices = list("Append" = 'append', "overwrite" = 'overwrite'),
                                      selected = "append"
                                  ),
                                  
                                  actionButton(
                                      'file_upload_sql',
                                      '  upload in database',
                                      icon = icon('database', lib = 'font-awesome'),
                                      width = '90%'
                                  )
                                  
                              ),
                              mainPanel = mainPanel(DTOutput('file_data'))
                              
                              
                          )
                      ),
                      
                      
                      # sql_tab -----------------------------------------------------------------
                      
                      tabItem(
                          tabName = "sql_tab",
                          sidebarLayout(
                              sidebarPanel = sidebarPanel(uiOutput('select_input_table1')),
                              mainPanel = mainPanel(DTOutput('sql_data'))
                          )
                          
                      ),
                      
                      
                      
                      # Dashboard tab -----------------------------------------------------------
                      tabItem(
                          tabName = 'dashboard',
                          
                          fluidRow(
                              infoBoxOutput('info_salary_ot'),
                              column(gaugeOutput('guage_chart', height = "auto"), width = 4),
                              infoBoxOutput('info_ot_hours')
                          ),
                          fluidRow(
                              infoBoxOutput('max_OT_Dept')  
                          ),
                          fluidRow(column(6,
                                          plotlyOutput('heatmap')))
                          
                      )
                      
                      
                      # endTab ------------------------------------------------------------------
                      
                  ))




# Ui_function -------------------------------------------------------------

main_ui <- dashboardPage(skin = 'green',
                         main_header,
                         main_siderbar,
                         main_body)


# Server_Function ---------------------------------------------------------


main_server <- function(input, output, session) {
    # connect_database --------------------------------------------------------
    
    sql <- reactive({
        dbPool(SQLite(),
               dbname = 'www/maindata.sqlite')
    })
    
    
    
    # Check number of Sheets --------------------------------------------------
    
    output$select_sheet <- renderUI({
        req(input$file_upload)
        if (input$file_type == 'XLSX') {
            if (input$file_upload$name %>% str_detect('.xlsx')) {
                selectInput(
                    'i_select_sheet',
                    'Select Sheet',
                    choices = excel_sheets(input$file_upload$datapath),
                    multiple = FALSE,
                    selected = 1
                )
            } else{
                return(NULL)
            }
        } else{
            return(NULL)
        }
    })
    
    
    # create_data -------------------------------------------------------------
    
    file_table <- reactive({
        req(input$file_upload)
        
        if (input$file_type == 'XLSX') {
            if (input$file_upload$name %>% str_detect('.xlsx')) {
                req(input$i_select_sheet)
                setDT(
                    read_excel(
                        input$file_upload$datapath,
                        sheet = input$i_select_sheet
                    )
                )
            } else{
                return(NULL)
            }
        } else{
            if (input$file_upload$name %>% str_detect('.csv')) {
                fread(input$file_upload$datapath)
            } else{
                return(NULL)
            }
        }
    })
    
    
    # Render_Table ------------------------------------------------------------
    
    output$file_data <- renderDT(
        # put CSV, XLS, and PDF in a collection
        file_table(),
        extensions = 'Buttons',
        filter = 'top',
        options = list(
            dom = 'TlBfrtip',
            scrollX = TRUE,
            scrollY = 400,
            scrollCollapse = TRUE,
            lengthMenu = c(5, 10, 50, 100, 200),
            pageLength = 5,
            buttons =
                list(
                    'colvis',
                    'copy',
                    'print',
                    list(
                        extend = 'collection',
                        buttons = c('csv', 'excel', 'pdf'),
                        text = 'Download'
                    )
                )
        )
    )
    
    
    # number of tables --------------------------------------------------------
    
    sql_list_table <- reactive({
        dbListTables(sql())
    })
    
    
    
    
    
    
    # Create Select input widget 2 --------------------------------------------
    
    output$select_input_table1 <- renderUI({
        selectInput(
            'sql_table',
            label = 'Please select the Table',
            choices = sql_list_table(),
            multiple = FALSE
        )
    })
    
    
    
    # Upload_in_SQL -------------------------------------------------------------
    
    observeEvent(input$file_upload_sql,
                 {
                     if (input$checkaction == 'append') {
                         dbWriteTable(sql(),
                                      input$table_sql,
                                      value = file_table(),
                                      append = TRUE)
                     } else{
                         dbWriteTable(sql(),
                                      input$table_sql,
                                      value = file_table(),
                                      overwrite = TRUE)
                     }
                 })
    
    
    # reset_fileinput ---------------------------------------------------------------
    
    observeEvent(input$file_upload_sql, {
        reset('file_upload')
    })
    
    
    
    # get data SQL----------------------------------------------------------------
    
    sql_table_data <- reactive({
        dbGetQuery(sql(),
                   paste('select * from ',
                         input$sql_table))
    })
    
    
    # render_data -------------------------------------------------------------
    
    output$sql_data <- renderDT(
        # put CSV, XLS, and PDF in a collection
        sql_table_data(),
        
        extensions = 'Buttons',
        filter = 'top',
        options = list(
            dom = 'TlBfrtip',
            scrollX = TRUE,
            scrollY = 400,
            scrollCollapse = TRUE,
            lengthMenu = c(5, 10, 50, 100, 200),
            pageLength = 5,
            buttons =
                list(
                    'colvis',
                    'copy',
                    'print',
                    list(
                        extend = 'collection',
                        buttons = c('csv', 'excel', 'pdf'),
                        text = 'Download'
                    )
                )
        )
    )
    
    # show_message ------------------------------------------------------------
    
    observeEvent(input$file_upload_sql, {
        showModal(
            modalDialog(
                title = "data uploaded",
                "Please Don't click upload again untill you change the file!",
                easyClose = FALSE
            )
        )
    })
    
    
    # Get_Full_Data from SQL --------------------------------------------------
    
    attendence <- reactive({
        attendence <- dbGetQuery(
            sql(),
            'select * from attendence left join casual on attendence.EMP_ID= casual.EMP_ID'
        )
        setDT(attendence)
        setkey(attendence, EMP_ID)
        attendence[, ':='(OT_DATE = as.POSIXct.numeric(OT_DATE, origin = '1970-01-01'))]
        attendence[, ':='(SALARY_today = SALARY / days_in_month(OT_DATE))]
    })
    
    # Create HeatMap ----------------------------------------------------------
    
    output$heatmap <- renderPlotly({
        (
            (
                attendence()[, .(
                    Salary = round(sum(SALARY_today, na.rm = TRUE))
                    ,
                    OverTime = sum(MAN_OT),
                    Numbers = .N
                ), DEPT_NAME][, .(
                    DEPT_NAME,
                    Salary = scale(Salary),
                    OverTime = scale(OverTime),
                    Numbers = scale(Numbers)
                )] %>%
                    melt.data.table(id.vars = 'DEPT_NAME')
            ) %>%
                ggplot(aes(variable, DEPT_NAME)) +
                geom_tile(aes(fill = value), colour = "white") +
                scale_fill_gradient(low = "white", high = "steelblue") +
                theme_economist() +
                theme(
                    axis.title.y = element_blank(),
                    axis.title.x = element_blank()
                )
        ) %>%
            ggplotly()
    })
    
    
    # render Guage Chart ------------------------------------------------------
    
    output$guage_chart = renderGauge({
        gauge(
            attendence()[MAN_OT > 0 & (!is.na(MAN_OT)) , .N],
            min = 0,
            max = attendence()[, .N],
            gaugeSectors(
                success = c(0, (attendence()[, .N]) * 30 / 100),
                warning = c(((
                    attendence()[, .N]
                ) * 30 / 100) + 1, (attendence()[, .N]) * 65 / 100),
                danger = c(((
                    attendence()[, .N]
                ) * 65 / 100) + 1, (attendence()[, .N]))
            )
        )
    })
    
    
    # Info_Box_salary ---------------------------------------------------------
    
    output$info_salary_ot <- renderInfoBox({
        infoBox(
            'Total Money Spent on OverTime Today',
            subtitle = 'Please control it',
            fill = TRUE,
            value = attendence()[, (Total_OT = round(sum(
                2 * SALARY_today * MAN_OT / 24, na.rm = TRUE
            )))]
            ,
            icon = icon('money')
        )
    })
    
    
    # info_Box_OverTime -------------------------------------------------------
    
    output$info_ot_hours <- renderInfoBox({
        infoBox(
            'Total Hours of OverTime Today',
            subtitle = 'Please control it',
            fill = TRUE,
            value = attendence()[, (sum(MAN_OT))],
            icon = icon('male')
        )
    })
    
    

    # Value_Box_Top_ OverTime -------------------------------------------------
    
    
    output$max_OT_Dept <- renderInfoBox({
        infoBox(
            attendence()[,.(OverTime=sum(MAN_OT,na.rm = TRUE)),DEPT_NAME][
                which.max(OverTime),][,DEPT_NAME],
            subtitle = "Maximum OT",
            fill = TRUE,
            value = attendence()[,.(OverTime=sum(MAN_OT,na.rm = TRUE)),DEPT_NAME][
                which.max(OverTime),][,OverTime],
            icon = icon('users')
        )
    })
    
    # Session_close -----------------------------------------------------------
    
    session$onSessionEnded(function() {
        poolClose(sql())
    })
    
    
    # endServer ---------------------------------------------------------------
    
    
}

# run_app -----------------------------------------------------------------

shinyApp(main_ui, main_server)


> runApp() Error in basename(all_files) : file name conversion problem -- name too long?
#2

I get this error everytime I close the app and I don't know what it means. I have rechecked all the codes they all look good to me and it works just fine only when I close it. this creates problem

Warning in origRenderFunc() :
  Ignoring explicitly provided widget ID "10c4425251d8"; Shiny doesn't use them
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
Stack trace (innermost first):
    35: .getReactiveEnvironment()$currentContext
    34: .dependents$register
    33: sql
    32: poolClose [#311]
    31: callback [#311]
     4: <Anonymous>
     3: do.call
     2: print.shiny.appobj
     1: <Promise>

#3

I get this error when I try to update the app into shinyapps.io

Preparing to deploy application...DONE
Uploading bundle for application: 329850...Error in createAppManifest(bundleDir, appMode, contentCategory, hasParameters,  : 
  Application mode static requires at least one document.
Calls: <Anonymous> ... withStatus -> force -> bundleApp -> createAppManifest
Execution halted

while the app runs just fine and interactively.

Please does anybody have any idea what just happened here.


#4

This is my app on server

https://vikramsinghrawat.shinyapps.io/HRDashboard/

this is what happens when I try to open it..


#5

The error is telling you that there is an issue with this chunk of code at the end:

session$onSessionEnded(function() {
        poolClose(sql())
    })

This is a total guess and am not sure whether it will work as I have never tried it before but you could try moving it to an observe like this:

session$onSessionEnded(function() {
        observe(poolClose(sql()))
    })

#6

Thanks for the reply @tbradley

I tried it but it didn't work. It still crashed. I have no idea why is it happening.


#7

It works on my computer it even works on shinyapps.io

https://vikramsinghrawat.shinyapps.io/HRDashboard/

but somehow when I close the app it crashes the entire app. I have no idea why?


#8

I had the same issue. The problem was resolved when I commented the q() below:
session$onSessionEnded(function() {
stopApp()
q("no")
})
This app is running on my own machine so I can't speak to whether it's a good idea to comment the q() command in a different setting.


#9

I don't have this code in my app. It crashes even without it.


#10

FYI, I was having the same issue and it turned out to be an issue with the "later" package that shiny uses. You can see the related (closed) issue on github at https://github.com/rstudio/shiny/issues/2081 .

To fix it, install the latest version of "later" from github:

devtools::install_github('r-lib/later')


#11

Thanks for the reply. I think they have uploaded the latest version of later package in CRAN. I updated it today and It didn't crash for now.

I hope it stays that way.
:hugs::hugs::hugs::hugs: