'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