Search code examples
rshiny

Shiny.io deployment issue, unexpected end to file


I built an interactive app for my masters thesis and after attempting to deploy the app on shiny.io there is an issue.

All of the tool code can be found on github here.

The main goal of the tool is to generate outputs with an uploaded dataset and save them to an outputs folder that can be downloaded. To do this, code is generated using the shiny user inputs, placed into a script, which is then sourced and used to display outputs in the app.

The tool works locally, however when it gets deployed the generated code file that is used to create the app outputs has an unexpected end to the file. Is there a missing piece that needs to be included in this script so that it can work on shiny.io?

Any help, or inputs towards the tool are appreciated! It has taken quite a long time to get it to this point and getting the tool to deploy is the last step.


Solution

  • First, this is a pretty cool app and it seems like a lot of work! I looked at the codebase and this is what I found:

    If the user uploads a .csv into MURPH and clicks upload, the file is pushed into mydata. If you then go to the "Tables" tab for example and change "Grouping Variables" & click "Update Table" this will in turn overwrite an R-file "servercomponents/server_tables_tablescode.R":

    # Generate Table
    generate_tables_tablecode <- paste0(
      generate_tables_table() # this is used to generate the tables code to write to "server_components/server_tables_tablecode.R"
    )
    
    ## Save Table Code
    writeChar(paste(generate_tables_tablecode, collapse = "\n"), "server_components/server_tables_tablecode.R")
    

    And this is what fails if you publish this App to Shiny.io. Then the server will execute writeChar, but this will not change the file "server_components/server_tables_tablecode.R" which you source. The dynamic writing or sourcing part is what fails.

    Fix

    1. First, I deleted generate_tables_tablecode.R because it is not needed. We can instead generate the code dynamically in reactive() with the added bonus, that the update button is obsolete.
    2. Then I removed the file servercomponents/server_tables_tablescode.R
    3. Finally, I adjusted server_tables.R:

    As you can see, I calculate the content of renderDT() with result reactively without overwriting files, which fixes the Tables-part of the app:

    out

    server_tables.R

    ## Sidebar Outputs
    # Table Variables
    output$ui_tables_variables <- renderUI({
      tagList(
        h1("Format Table Options"),
        p("Using the options below, create and customize summary tables to communicate your research data. Click Update Table to view your custom table."),
        # Select All Grouping Variables
        varSelectInput("server_tables_groupingvariables", label = "Select Grouping Variables",
                       data = myData$data, multiple = TRUE),
        # Select Summary Variable
        varSelectInput("server_tables_summaryvariable", label = "Select Summary Variable",
                       data = myData$data, multiple = FALSE),
        # Select Summary Function
        selectInput("server_tables_summaryfunction", label = "Select Summary Option",
                    choices = c("Sum", "Mean", "Number of Observations", "Unique Observations"),
                    multiple = FALSE)
      )
    })
    
    # Update Table
    output$ui_tables_update <- renderUI({
      tagList(
        actionButton("server_tables_updatetable", label = "Update Table"),
        p(" ")
      )
    })
    
    # Save Table
    output$ui_tables_savetable <- renderUI({
      tagList(
        p("Click below to save table to downloadable outputs folder."),
        actionButton("server_tables_savetable", label = "Save Table")
      )
    })
    
    ## Main Panel Outputs
    # Table output
    output$ui_tables_tableoutput <- renderUI({
      DTOutput("server_tables_mytable")
    })
    
    ## Generate Table Code
    observeEvent(input$server_tables_updatetable, {
      
      # Validate inputs
      if(input$server_tables_summaryfunction %in% c("Sum", "Mean") && 
         !is.numeric(pull(myData$data, !!sym(input$server_tables_summaryvariable)))) {
        shinyalert(
          title = "Hold On!",
          text = "Your selected summary variable is not numeric. Select another variable or go back and review your dataset to check for errors.",
          confirmButtonText = "Go Back"
        )
        return()
      }
      
      output$server_tables_mytable <- renderDT({
        # Handle case when no grouping variables selected
        if(length(input$server_tables_groupingvariables) == 0) {
          return(myData$data)
        }
        
        # Convert string of grouping variables to list of symbols
        group_vars <- syms(input$server_tables_groupingvariables)
        
        # Create the table based on selection
        result <- myData$data %>%
          group_by(!!!group_vars)
        
        result <- switch(input$server_tables_summaryfunction,
                         "Sum" = result %>% 
                           summarise(!!sym(input$server_tables_summaryvariable) := 
                                       sum(!!sym(input$server_tables_summaryvariable), na.rm = TRUE), 
                                     .groups = "drop"),
                         "Mean" = result %>% 
                           summarise(!!sym(input$server_tables_summaryvariable) := 
                                       mean(!!sym(input$server_tables_summaryvariable), na.rm = TRUE), 
                                     .groups = "drop"),
                         "Number of Observations" = result %>% 
                           summarise(!!sym(input$server_tables_summaryvariable) := n(), 
                                     .groups = "drop"),
                         "Unique Observations" = result %>% 
                           distinct(!!!group_vars, !!sym(input$server_tables_summaryvariable))
        )
        
        result
      })
    })
    
    # Create a counter value for exporting tables
    server_tables_tablecounter <- reactiveValues(tablecounter = 0)
    
    ## Save Table
    observeEvent(input$server_tables_savetable, {
      mytable <- source("server_components/server_tables_tablecode.R", local = TRUE)$value
      
      # Generate File Names
      server_tables_tablecounter$tablecounter <- server_tables_tablecounter$tablecounter + 1
      
      file_name_table <- paste0("outputs/MURPH table - ", server_tables_tablecounter$tablecounter, ".csv")
      file_name_tablecode <- paste0("outputs/MURPH table Code - ", server_tables_tablecounter$tablecounter, ".R")
      
      write.csv(mytable, file_name_table)
      # Export table Code
      file.copy("server_components/server_tables_tablecode.R", file_name_tablecode)
      
    })
    

    Analog to this, I would change the server_plot file too. Instead of writing a plot command with paste0() to an R-file and sourcing it, try to generate the plot dynamically based on inputs using !!sym for example. Not only will this make your app more reactive, but it will also make it work on a server. Hope this helps.