'Why is bindCache not working in my app with multiple inputs?
I am trying to speed a page in my shiny app, as it is extremely slow when selecting different inputs (it revaluates with each change of input (there are 4 different inputs on the page). I am trying to learn how to use bindCache however despite adding it to the reactive function that handles the data it is still very slow. I also cannot produce any change with bindCache with the renderPlotly object. The observe event here is to update one of the dropdowns on the page which is dependent on another dropdown, any help would be much apprieciated.
#tab4
#reactive function thing to select geographies
geo_op1 <- reactive({
req(input$selgeotab4)
ptsex %>%
filter(AREA_OF_RESIDENCE %in% input$selgeotab4 | NM == 'England') %>%
filter(SEX==input$selsex & PREVDURATION==input$selprev)
}) %>%
bindCache(input$selgeotab4, input$selsex, input$selprev)
#reactive function thing to help resize height the graph dependent on geography type chosen
plotht1 <- reactive({
if (input$selgeotab4=='Clinical Commissioning Group') {
temp <- 1900
}
if (input$selgeotab4=='Cancer Alliance') {
temp <- 450
}
if (input$selgeotab4=='Local Authority (LTLA)') {
temp <- 5000
}
if (input$selgeotab4=='England') {
temp <- 100
}
else if (input$selgeotab4=='Sustainability Transformation Partnership') {
temp <- 800
}
return(temp)
})
#reactive function for legend
legendGeo <- reactive({
if (input$selgeotab4=='Clinical Commissioning Group') {
temp <- "CCG"
}
if (input$selgeotab4=='Cancer Alliance') {
temp <- "CA"
}
if (input$selgeotab4=='Local Authority (LTLA)') {
temp <- "LTLA"
}
if (input$selgeotab4=='England') {
temp <- "England"
}
else if (input$selgeotab4=='Sustainability Transformation Partnership') {
temp <- "STP"
}
return(temp)
})
#reactive function for labels
nudge_y_val <- reactive({
if (input$selgeotab4=='Clinical Commissioning Group') {
temp <- 125
}
if (input$selgeotab4=='Cancer Alliance') {
temp <- 115
}
if (input$selgeotab4=='Local Authority (LTLA)') {
temp <- 150
}
if (input$selgeotab4=='England') {
temp <- 125
}
else if (input$selgeotab4=='Sustainability Transformation Partnership') {
temp <- 125
}
return(temp)
})
observeEvent(input$selgeotab4, {
observe({
a <- geo_op1()
a <- a$NM[a$AREA_OF_RESIDENCE == input$selgeotab4]
a <- as.list(sort(unique(a)))
updateSelectInput(session,
inputId='selloctab4',
choices=a
)
})
})
#bar chart on tab4#
output$tab4<-renderPlotly({
ptsex <- geo_op1()
#order all other trusts then England so england always draw in blue
ptsex$dummy <- factor(ifelse(ptsex$NM == 'England','England',
ifelse(ptsex$NM == input$selloctab4, paste("Selected" , legendGeo()), paste("Other" , legendGeo()))),
levels=c('England',paste("Other" , legendGeo()), paste("Selected" , legendGeo())))
ptsex$NMnew <- reorder(ptsex$NM, ptsex$Ratep100k)
plot1 <- ggplot(ptsex, aes(x = NMnew, y = Ratep100k, fill=dummy, color=dummy ))+
suppressWarnings(geom_bar(stat='identity', width = 0.6, aes(text=paste(stringr::str_wrap(NMnew, width = 15), paste(format(Ratep100k, big.mark=","), "per 100,000"), sep="<br>")))) +
geom_text(size=2.9, nudge_y=nudge_y_val(), label=paste(" ",format(ptsex$Ratep100k, big.mark=","))) +
coord_flip() +
scale_fill_manual(name='', values = c('#017ABC','grey60','red')) +
scale_color_manual(name='', values = c('#017ABC','grey60','red')) +
ylab('Rate per 100,000') +
xlab('') +
theme_bw() +
theme(panel.border = element_blank(), panel.grid.minor = element_blank(), panel.grid.major = element_blank(),
axis.ticks.y=element_blank(), panel.background = element_rect(fill = 'white'), axis.text.y = element_text(size=8, colour="black"),
axis.title.x=element_blank(), axis.text.x=element_blank(), axis.ticks.x=element_blank(), legend.position="none",
plot.margin = margin(0, 50, 0, 0))+
expand_limits(y = max(ptsex$Ratep100k)*1.1)+
scale_x_discrete(label= function(x) stringr::str_trunc(x, 20))
ggplotly(plot1, tooltip="text", height=plotht1(), width=600) %>%
style(hoverlabel = list(font=list(size=10))) %>%
style(hoverinfo = "none", traces = 5) %>%
config(displayModeBar = F)
})
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|
