Search code examples
rshinyflexdashboard

flex_dashboard shiny_prerendered with eventReactive filtering


I am trying to build a data heavy, calculation heavy shiny flex_dashboard with runtime: shiny_prerendered. I would like all calculation and filtering be done on the server side and the rendering on the client side. shiny_prerendered allows me to save on startup times for both the client and the server. In the below I have a simplified version of what I do. I have a large dataset (faithful in the below). I am filtering that data according to the client's need. That filtered data should be used in all of the plots and results of the dashboard. I put the libraries in context="setup", the UI with context="render" (not needed as it is default).

I also want to do the filtering and the plotting reactive to a button click. so I put in context="server" two eventReactive functions. one for the filtering of data and one for the selection of histogram bins.

Finally for each result (plot or table), I put into the output variable the renderPlot and renderTable in the context="server" and display them in the context="render". In the render functions (Plot or Table), I use the eventReactive functions that filter the data (and get the number of bins).

The faithful_filtered() does the filtering and is called inside 2 renderPlot below. 1- Does that mean that the data is filtered twice? 2- Is the operation done two times? Since my data is very large I have many more outputs in the real projects, that would be a very slow and inefficient. 3- If the above 2 questions are affirmative, how do I get the button to filter the data first, then have that data be used in all the plots and tables to be rendered?

here is the prototype code:

---
title: "test shiny_prerendered with button"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
editor_options: 
  chunk_output_type: console
runtime: shiny_prerendered 
---


```{r, include=FALSE, message=FALSE, context="setup"}
library(tidyverse)
library(flexdashboard)
library(plotly)
library(shiny)
library(knitr)
```

Input {.sidebar data-width=300}
-------------------------------------

```{r, echo=FALSE, context="render"}
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30)
textInput("min_e", "min eruptions", min(faithful$eruptions))
textInput("max_e", "max eruptions", max(faithful$eruptions))
actionButton(inputId = "OK", label = "OK")
```

```{r, context="server"}
nbins = eventReactive(input$OK, {input$bins})
faithful_filtered = eventReactive(input$OK, {faithful %>% filter(eruptions>=input$min_e,
                                                                 eruptions<=input$max_e)})

```

Row
-----------------------------------------------------------------------

### Plot 1 - filter reactive, bin reactive

```{r, context="server"}
output$distPlot1 <- renderPlot({
  x <- faithful_filtered()[, 2]  # Old Faithful Geyser data
  bins <- seq(min(x), max(x), length.out =  nbins() + 1)
  hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
```

```{r, echo=FALSE}
plotOutput("distPlot1")
```

### Plot 2 - twice the number of bins - filter reactive, bin is not

```{r, context="server"}
output$distPlot2 <- renderPlot({
  x <- faithful_filtered()[, 2]  # Old Faithful Geyser data
  bins <- seq(min(x), max(x), length.out = input$bins*2 + 1)
  hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
```

```{r, echo=FALSE}
plotOutput("distPlot2")
```

### Table - filter reactive

```{r, message=FALSE, context="server"}
output$table = renderTable({
  head(faithful_filtered())
})

```

```{r, echo=FALSE}
tableOutput("table")
```

Solution

  • My understanding is that:

    1. the data is only filtered once when the eventReactive is initialized, and after that, with every update by clicking the action button
    2. when the action button is clicked I do expect the operation to be executed once, not twice.
    3. Therefore I think that the button behaves as expected.

    A good place to inspect what is going on under the hood, would be the Reactive Log Visualizer. However, in the current form of your dashboard (being in rmarkdown with shiny_prerendered) I was not able to get it running.

    A vanilla shiny approach of your dashboard would look like the following:

    library(tidyverse)
    library(flexdashboard)
    library(plotly)
    library(shiny)
    library(knitr)
    
    shinyApp(ui = fluidPage(
    
      sidebarLayout(
    
        sidebarPanel(
          sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
          textInput("min_e", "min eruptions", min(faithful$eruptions)),
          textInput("max_e", "max eruptions", max(faithful$eruptions)),
          actionButton(inputId = "OK", label = "OK")
        ),
    
        mainPanel(
          fluidRow(
            column(4, plotOutput("distPlot1")),
            column(4, plotOutput("distPlot2")),
            column(4, tableOutput("table"))
        )
    
      )
    
    )
    ),
    
      server = function(input, output) {
    
        nbins = eventReactive(input$OK, {input$bins})
    
        faithful_filtered = eventReactive(input$OK, {
    
          faithful %>% filter(eruptions >= input$min_e,
                              eruptions <= input$max_e)
    
          })
    
        output$distPlot1 <- renderPlot({
          x <- faithful_filtered()[, 2]  # Old Faithful Geyser data
          bins <- seq(min(x), max(x), length.out =  nbins() + 1)
          hist(x, breaks = bins, col = 'darkgray', border = 'white')
        })
    
    
        output$distPlot2 <- renderPlot({
          x <- faithful_filtered()[, 2]  # Old Faithful Geyser data
          bins <- seq(min(x), max(x), length.out = input$bins*2 + 1)
          hist(x, breaks = bins, col = 'darkgray', border = 'white')
        })
    
        output$table = renderTable({
          head(faithful_filtered())
        })
    
    
      }
    
    )
    

    You can run the reactive log visualizer here, but - at least to my understanding - it is not easy to see what is going on within the eventReactives.

    We can rewrite the dashboard using reactives with isolate:

    library(tidyverse)
    library(flexdashboard)
    library(plotly)
    library(shiny)
    library(knitr)
    
    shinyApp(ui = fluidPage(
    
      sidebarLayout(
    
        sidebarPanel(
          sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
          textInput("min_e", "min eruptions", min(faithful$eruptions)),
          textInput("max_e", "max eruptions", max(faithful$eruptions)),
          actionButton(inputId = "OK", label = "OK")
        ),
    
        mainPanel(
          fluidRow(
            column(4, plotOutput("distPlot1")),
            column(4, plotOutput("distPlot2")),
            column(4, tableOutput("table"))
        )
    
      )
    
    )
    ),
    
      server = function(input, output) {
    
        nbins = reactive({input$OK
                         isolate(input$bins)})
    
         faithful_filtered = reactive({input$OK
    
          faithful %>% filter(eruptions >= isolate(input$min_e),
                              eruptions <= isolate(input$max_e))
    
          })
    
        output$distPlot1 <- renderPlot({
          x <- faithful_filtered()[, 2]  # Old Faithful Geyser data
          bins <- seq(min(x), max(x), length.out =  nbins() + 1)
          hist(x, breaks = bins, col = 'darkgray', border = 'white')
        })
    
    
        output$distPlot2 <- renderPlot({
          x <- faithful_filtered()[, 2]  # Old Faithful Geyser data
          bins <- seq(min(x), max(x), length.out = input$bins*2 + 1)
          hist(x, breaks = bins, col = 'darkgray', border = 'white')
        })
    
        output$table = renderTable({
          head(faithful_filtered())
        })
    
    
      }
    
    )
    

    And here the reactive log visualizer basically confirms that the reactive is only executed once the button is clicked.

    I expect both other approaches using eventReactive to behave pretty much the same, but I have no way to know for sure yet.