My SHINY app works fine locally but turns grey after upload to the shinyapps.io
Others have posted about this "grayed out" issue and I have utilized the possible solutions (e.g. adding timeout parameters, using full directory paths, etc). My code for global, ui and server are below. The APP is intended to plot uploaded data as a scatter-plot onto a static area chart that is specified in the global script.
Any advice?
------CODE FOLLOWS------
##### GLOBAL: #####
statewide<-structure(list(Domain = c("Cement", "Cement", "Cement", "Cement"), Group =
c("Charlatans", "Charlatans", "Charlatans", "Charlatans"), Percentile = c("80th", "60th", "40th",
"20th"), PL1 = c(135L, 123L, 113L, 92L), PL15 = c(91L, 79L, 70L, 51L), PL2 = c(69L, 52L, 39L, 24L),
PL25 = c(55L, 36L, 23L, 10L), PL3 = c(46L, 28L, 15L, 2L), PL35 = c(42L, 26L, 12L, -3L), PL4 =
c(40L, 26L, 9L,-6L), PL45 = c(39L, 23L, 7L, -10L), PL5 = c(38L, 23L, 8L, -11L), PL55 = c(35L, 21L, 9L, -7L), PL6 = c(29L, 19L, 9L, -4L)), row.names = c(NA, -4L), class = "data.frame")
library(ggplot2);library(purrr);library(dplyr);library(readxl)
rsconnect::setAccountInfo(name='name',
token='tokentoken',
secret='secretsecret')
# prepare data for background area chart
aref <- statewide # this is normally a read.csv statement
aref_g1<-aref %>% filter(Group=="Charlatans") # full app will have multiple groups
df<-reshape2::melt(data=aref_g1,
id.vars=c("Percentile"),
measure.vars=c("PL1" ,"PL15","PL2","PL25","PL3", "PL35","PL4","PL45" ,"PL5","PL55","PL6"))
df$pl_axis<-ifelse(df$variable=="PL1",1,ifelse(df$variable=="PL15",1.5, (df$variable=="PL2",2, ifelse(df$variable=="PL25",2.5, ifelse(df$variable=="PL3",3, (df$variable=="PL35",3.5, ifelse(df$variable=="PL4",4, ifelse(df$variable=="PL45",4.5, (df$variable=="PL5",5, ifelse(df$variable=="PL55",5.5, ifelse(df$variable=="PL6",6,NA)))))))))))
layerArea<-function(){
geom_area(data=df, aes(pl_axis,value,group=Percentile,fill=df$Percentile),
alpha=.4, position = "dodge")}
##### UI for app #####
ui<-fluidPage(
headerPanel("Visualize Your ACCESS Data"),# title
sidebarLayout(
sidebarPanel(
fileInput("file1", "Choose CSV File", # Input: Select a file ----
multiple = TRUE,
accept = c("text/csv","text/comma-separated-values,text/plain",".csv")),
checkboxInput("header", "Header", TRUE),# Input: Checkbox if file has header
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Semicolon = ";",
Comma = ",",Tab = "\t"),
selected = ","),
tags$hr(), # add a Horizontal line
# Input: Select what to display
selectInput("dataset","Data:",choices=list(iris="iris",uploaded_file="inFile"), selected = NULL),
selectInput("x_axis","X-axis:", choices = NULL),
selectInput("y_axis","Y-axis:", choices = NULL)
), # end sidebarPanel ; place last parentheses of a section on a new line!
# mainPanel must be called inside the sidebarLayout function
mainPanel(
h3(textOutput("caption")),
#h3(htmlOutput("caption")),
plotOutput("finalplot") # quoted object is named in server code
) # end mainPanel
) # end sideBarLayout
)
###### SERVER #########
library(shiny)
# shiny server side code for each call
server<-(function(input, output, session){
#update variable and group based on dataset
observe({
if(!exists(input$dataset)) return() #make sure upload exists
var.opts<-colnames(get(input$dataset))
updateSelectInput(session, "x_axis", choices = var.opts)
updateSelectInput(session, "y_axis", choices = var.opts)
}) # end `observe`
#get data object
get_data<-reactive({
# set uploaded file
upload_data<-reactive({
inFile <- input$file1
if (is.null(inFile)) return(NULL)
#do I need to store in a reactiveValues object?
read.csv(inFile$datapath,
header = input$header,
sep = input$sep)
}) # end `upload data`
observeEvent(input$file1,{
inFile<<-upload_data()
}) # section end
if(!exists(input$dataset)) return() # if no upload
check<-function(x){is.null(x) || x==""}
if(check(input$dataset)) return()
obj<-list(data=get(input$dataset), # get the dataset and then choose the inputs
x_axis=input$x_axis,y_axis=input$y_axis )
#require all to be set to proceed
if(any(sapply(obj,check))) return()
#make sure choices had a chance to update
check<-function(obj){
!all(c(obj$x_axis,obj$y_axis) %in% colnames(obj$data))
}
if(check(obj)) return()
obj
}) # end `get data`
#plotting function using ggplot2
output$finalplot<-renderPlot({ # the object "finalplot" must be referenced in the ui
plot.obj<-get_data() # is this creating a blank object to fill?
# conditions for plotting
if(is.null(plot.obj)) return()
if(plot.obj$x_axis == "" | plot.obj$y_axis=="") return(NULL)
# plot.obj$x_axis<-as.numeric(plot.obj$x_axis)
# plot.obj$y_axis<-as.numeric(plot.obj$y_axis)
require(ggplot2)
#plotting theme
#.theme<- theme(axis.line = element_line(colour = 'gray', size = .75),
# panel.background = element_blank() )
p<-ggplot()
p<-p+geom_point(data=plot.obj$data,
mapping=aes(x= plot.obj$x_axis,
y= plot.obj$y_axis )) #read.csv might be issue with NAs
p<-p+layerArea()+
labs(x= input$x_axis, ### I want the points to display over the area chart
y=input$y_axis )+
ggplot2::theme_classic()
plot(p)
}) # end renderPlot
output$plot <- renderUI({plotOutput("finalplot") })
})
# Create Shiny app ----
shinyApp(ui, server) # this MUST be the last line of code!