Hi there,
I have my app working, but for some reason, before displaying the plot, my app flashes up Error: object variable not found and then, a little later, draws the plot fine. The object 'variable' is a column created in the plotting data when I have melted a data table. This problem only happens when changing a particular control ('group' - which controls the dataset being plotted). I have some edited code below. I presume the plot is trying to draw before the dataset is finished being built. How do I get it to wait? I have tried req(plotdata()) within the reactive 'heatmap' section, but it doesn't seem to work.
Any suggestions would be greatly appreciated,
Will
#Load data
#=========
qlist <- fread('./App/data/qlist.csv')
grdropdown <- fread('./App/data/groupreportdropdown.csv')
reportgroups <- unique(grdropdown[,group])
qgroups <- fread('./App/data/qgroups.csv')
schools <- fread('./App/data/schools.csv')
schdists <- fread('./App/data/schoolsdistricts.csv')
ulist <- fread('./App/data/userlist.csv')
dat <- readRDS('./App/data/dat.rds')
dat <- dat[,All:='All'] #add All column for use in not analysing by a variable
#Identify user
#=============
user <- 'Joe Bloggs' #Sys.getenv("SHINYPROXY_USERNAME")
role <- ulist[email==user, role] #Sys.getenv("SHINYPROXY_USERGROUPS")
# Define UI
#==========
ui <- fluidPage(
fluidRow(
column(10, titlePanel(img(src='logo.svg', style='width:300px;', align='left'), windowTitle = 'Demo app')),
column(2, style = "margin-top: 50px;", actionButton('dlbutt', 'Download PDF'))
),
fluidRow(
br(),
column(3, tagList(
selectInput('group', 'Report group', choices = reportgroups),
uiOutput('reportdd')
)
),
column(3, selectInput('by', 'Plot by', choices = c('All', 'Sex', 'Year group','Survey year'))),
column(3, selectInput('comp', 'Comparator', choices = c('County', 'District', 'Neighbour'))),
column(3, uiOutput('radbutt'), uiOutput('maindd'))
),
plotOutput('heatmap')
)
# Define server logic
#====================
server <- function(input, output) {
output$reportdd <- renderUI({
selectInput('report', 'Report', grdropdown[group==input$group, report])
})
output$radbutt <- renderUI({
if (role=='Super'){
radioButtons('mainchoice', 'Analysing', choices = c('District', 'School'), selected='District')
}
})
output$maindd <- renderUI({
if (role=='Super'){
selectInput('main', '', choices = schdists[type==input$mainchoice][['area']])
}
else if (role=='GC' | role=='Partner'){
selectInput('main', 'Analysing', choices = schdists[type=='District'][['area']])
}
})
qvars <- reactive({
req(input$report, input$group)
qgroups[group==input$group & report==input$report][['bvar']]
})
pheight <- reactive({
length(qvars())*50 + 50
})
plotdata <- reactive({
req(input$by, input$comp)
by <- qlist[qtext==input$by, var]
compname <- input$comp
comp <- if(compname=='County'){'*'} else {input$comp}
compfield <- if(compname=='County'){'District'} else {input$comp}
mainchoice <- if (role=='Super'){input$mainchoice} else if (role=='School') {'School'} else {'District'}
main <- if (role=='School'){ulist[email==user, School]} else {input$main}
idvars <- c('School', 'District', 'Neighbour', by)
vars <- c(idvars, qvars())
a1 <- dat[, ..vars] #select the columns for this analysis
a2 <- melt(a1, id.vars=idvars, measure.vars=qvars()) #change to long format
a3 <- a2[get(mainchoice)==main,]
a4 <- a3[, .N, keyby=.(by=get(by), variable, value)] #count up values by comparators
a5 <- dcast(a4, by + variable ~ value, value.var='N', fun.aggregate = sum) #change to wide format
a6 <- a5[, .(Y, N, Sum=sum(Y,N), Percent=Y/sum(Y, N)), keyby=.(by, variable)]#calculate percentages
setnames(a6, old = 'by', new = paste0(qlist[var==by, qtext]))
a7 <- a6[, Facet:=main]
c1 <- a2[grepl(comp, get(compfield)),] #create comparator dataset
c2 <- c1[, .N, keyby=.(by=get(by), variable, value)] #count up values by comparators
c3 <- dcast(c2, by + variable ~ value, value.var='N', fun.aggregate = sum) #change to wide format
c4 <- c3[, .(Y, N, Sum=sum(Y,N), Percent=Y/sum(Y, N)), keyby=.(by, variable)]#calculate percentages
setnames(c4, old = 'by', new = paste0(qlist[var==by, qtext]))
c5 <- c4[, Facet:=compname]
plotdat <- rbindlist(list(a7, c5), use.names = T)
plotdat$Facet <- factor(plotdat$Facet, levels=c(main, compname))
return(na.omit(plotdat))
})
th <- theme_minimal()
observe({
output$heatmap <- renderPlot({
ggplot(plotdata(), aes(x=get(input$by), y=variable, label=paste0(round(Percent*100,1),'%'))) +
geom_tile(aes(fill = Percent), colour = "white", size=2) + th +
guides(fill='none', color='none', alpha='none') + facet_wrap(~Facet, ncol=2) +
scale_fill_gradientn(colors=c('#f03b20', '#ffeda0', '#31a354'), values=c(0,0.5,1)) +
geom_text(size=5) + labs(y=element_blank(), x=input$by)
}
, height=pheight()
)
})
}
# Create Shiny object
#====================
shinyApp(ui = ui, server = server)