How to prevent a plot to be drawn multiple times in shiny when an input element changes dynamically

Question

In this shiny app, I have a plot that depends on two input variables: cases_deaths and min_n.

When cases_deaths changes, min_n is automagically adjusted:

min_n = 10 for cases_deaths = "deaths"
min_n = 100 for cases_deaths = "cases"

My issue is that when I change the value of cases_deaths, the ggplot is drawn two times.

Imagine I start with the default values cases_deaths = "cases" and min_n = 100. I switch cases_deaths to "deaths". What happens is:

1. ggplot drawn with cases_deaths = "deaths" and min_n = 100
2. min_n is changed to 10
3. ggplot drawn with cases_deaths = "deaths" and min_n = 10

How can I avoid step 1 so the ggplot is drawn only once?

Below a fully reproducible example.

library(dplyr)
library(ggplot2)
library(shiny)

cases_deaths = "cases" 

DF = data.frame(
  stringsAsFactors = FALSE,
  country = c("Denmark","Denmark","Denmark","Denmark","US","US","US","US"),
  time = c("2020-03-06","2020-03-07","2020-03-17","2020-03-18","2020-02-05","2020-02-06","2020-03-11","2020-03-12"),
  cases_sum = c(24L, 24L, 1024L, 1115L, 11L, 11L, 1281L, 1663L),
  deaths_sum = c(11L, 50L, 14L, 24L, 110L, 120L, 36L, 40L),
  cases_diff = c(13L, 70L, 92L, 91L, 10L, 220L, 322L, 382L),
  deaths_diff = c(11L, 20L, 31L, 40L, 110L, 220L, 118L, 24L)
)

ui <- function(request) {
    fluidPage(
      sidebarLayout(
        sidebarPanel(width = 2,

          radioButtons(inputId = "cases_deaths", label = " ", selected = "cases", 
                       choices = c("cases", "deaths"), inline = TRUE),

          # Dynamically change with cases_deaths
          uiOutput('min_n2')), 

        mainPanel(plotOutput("distPlot", height = "700px", width = "100%"))

        )
      )
  }

server <- function(input, output) {

  # min_n changes depending on cases_deaths value
  output$min_n2 = renderUI({

    if (input$cases_deaths == "cases") {
      sliderInput('min_n', paste0("# of cases"), min = 1, max = 200, value = 100)
    } else {
      sliderInput('min_n', paste0("# of deaths"), min = 1, max = 200, value = 10)
    }

  })

    final_df = reactive({ 

      dta = DF %>% 
        rename(value = paste0(input$cases_deaths, "_diff")) %>% 
        mutate(days_after_100 = 0:(length(country)-1))

      # Slow down so the redrawing is more clear
      Sys.sleep(.5)

      req(input$min_n)

      # Filter by min_n
      dta %>% filter(value >= input$min_n)

      }) 

  # Show plot
  output$distPlot <- renderPlot({

      ggplot(data = final_df(), aes(x = days_after_100, y = value)) +
        geom_point() +
        theme_minimal(base_size = 14)

  })
}

shinyApp(ui = ui, server = server)

I've seen the How to prevent shiny plot from being redrawn multiple times per UI interaction? post but I am not sure how that logic applies here.

Answer 1

Thanks to @pork-chop for the great answer! I had to make a few modifications for the min_n_cases / min_n_deaths values to work when switching cases_deaths. The slide would work if moved, but otherwise would keep the old value.

library(dplyr)
library(ggplot2)
library(shiny)
library(shinyjs)

cases_deaths = "cases" 

DF = data.frame(
  stringsAsFactors = FALSE,
  country = c("Denmark","Denmark","Denmark","Denmark","US","US","US","US"),
  time = c("2020-03-06","2020-03-07","2020-03-17","2020-03-18","2020-02-05","2020-02-06","2020-03-11","2020-03-12"),
  cases_sum = c(24L, 24L, 1024L, 1115L, 11L, 11L, 1281L, 1663L),
  deaths_sum = c(11L, 50L, 14L, 24L, 110L, 120L, 36L, 40L),
  cases_diff = c(13L, 70L, 92L, 91L, 10L, 220L, 322L, 382L),
  deaths_diff = c(11L, 20L, 31L, 40L, 110L, 220L, 118L, 24L)
)

ui <- function(request) {
    fluidPage(
      useShinyjs(),

      sidebarLayout(
        sidebarPanel(width = 2,

          radioButtons(inputId = "cases_deaths", label = " ", selected = "cases", 
                       choices = c("cases", "deaths"), inline = TRUE),

          # Dynamically change with cases_deaths
          # uiOutput('min_n2')), 
        sliderInput('min_n_cases', paste0("# of cases"), min = 1, max = 200, value = 100), 
        sliderInput('min_n_deaths', paste0("# of deaths"), min = 1, max = 200, value = 10)),

        mainPanel(plotOutput("distPlot", height = "700px", width = "100%"))

        )
      )
  }

server <- function(input, output) {

  observeEvent(input$cases_deaths,{

    if (input$cases_deaths == "cases") {
      hide("min_n_deaths")
      show("min_n_cases")
    }else{
      hide("min_n_cases")
      show("min_n_deaths")
    }
  })

  VAR_min_n = reactive({
    if (input$cases_deaths == "cases") {
      input$min_n_cases
    }else{
      input$min_n_deaths
    }
  })


    final_df = reactive({ 

      dta = DF %>% 
        rename(value = paste0(input$cases_deaths, "_diff")) %>% 
        mutate(days_after_100 = 0:(length(country)-1))

      # Slow down so the redrawing is more clear
      Sys.sleep(.5)

      req(VAR_min_n())

      # Filter by min_n
      dta %>% 
        filter(value >= VAR_min_n())

      }) 

  # Show plot
  output$distPlot <- renderPlot({

      ggplot(data = final_df(), aes(x = days_after_100, y = value)) +
        geom_point() +
        theme_minimal(base_size = 14)

  })
}

shinyApp(ui = ui, server = server)

Answer 2

There are few things you can do to improve:

1. Dont use renderui but updatesliderInput instead, this way you wont need to crate objects all the time
2. I've also used shinyjs package with its hide and show functions so you dont have to create objects
3. Finally, we are going to use reactiveValues to record the value you need to filter by

---

library(dplyr)
library(ggplot2)
library(shiny)
library(shinyjs)

cases_deaths = "cases" 

DF = data.frame(
    stringsAsFactors = FALSE,
    country = c("Denmark","Denmark","Denmark","Denmark","US","US","US","US"),
    time = c("2020-03-06","2020-03-07","2020-03-17","2020-03-18","2020-02-05","2020-02-06","2020-03-11","2020-03-12"),
    cases_sum = c(24L, 24L, 1024L, 1115L, 11L, 11L, 1281L, 1663L),
    deaths_sum = c(11L, 50L, 14L, 24L, 110L, 120L, 36L, 40L),
    cases_diff = c(13L, 70L, 92L, 91L, 10L, 220L, 322L, 382L),
    deaths_diff = c(11L, 20L, 31L, 40L, 110L, 220L, 118L, 24L)
)

ui <- function(request) {
    fluidPage(
        useShinyjs(),
        sidebarLayout(
            sidebarPanel(width = 2,
                         radioButtons(inputId = "cases_deaths", label = " ", selected = "cases", 
                                      choices = c("cases", "deaths"), inline = TRUE),

                         # Dynamically change with cases_deaths
                         sliderInput('min_n_cases', paste0("# of cases"), min = 1, max = 200, value = 100), 
                         sliderInput('min_n_deaths', paste0("# of deaths"), min = 1, max = 200, value = 10)
            ),
            mainPanel(plotOutput("distPlot", height = "700px", width = "100%"))

        )
    )
}

v <- reactiveValues()

server <- function(input, output, session) {

    observeEvent(input$cases_deaths,{

        if (input$cases_deaths == "cases") {
            hide("min_n_deaths")
            show("min_n_cases")
        }else{
            hide("min_n_cases")
            show("min_n_deaths")
        }
    })

    observeEvent(c(input$min_n_cases,input$min_n_deaths),{
        if (input$cases_deaths == "cases") {
            v$value <- input$min_n_cases
        }else{
            v$value <- input$min_n_deaths
        }
    })


    final_df <- reactive({
        req(v$value)

        dta = DF %>%
            rename(value = paste0(input$cases_deaths, "_diff")) %>%
            mutate(days_after_100 = 0:(length(country)-1))

        # Slow down so the redrawing is more clear
        Sys.sleep(.5)

        # Filter by min_n
        dta %>% filter(value >= v$value)

    })

    # Show plot
    output$distPlot <- renderPlot({
        ggplot(data = final_df(), aes(x = days_after_100, y = value)) +
            geom_point() +
            theme_minimal(base_size = 14)

    })
}

shinyApp(ui = ui, server = server)