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.
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.
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.servercomponents/server_tables_tablescode.R
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:
## 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.