Как предотвратить рисование графика несколько раз в блестящем при динамическом изменении элемента ввода - PullRequest
Новая
       0

Как предотвратить рисование графика несколько раз в блестящем при динамическом изменении элемента ввода

1 голос
/ 19 марта 2020

В этом блестящем приложении у меня есть график, который зависит от двух входных переменных: cases_deaths и min_n.

Когда изменяется cases_deaths, min_n настраивается автоматически:

min_n = 10 для cases_deaths = "смертей"
min_n = 100 для cases_deaths = "случаев"

Моя проблема заключается в том, что при изменении значения cases_deaths , ggplot рисуется два раза.

Представьте, что я начинаю со значений по умолчанию cases_deaths = "case" и min_n = 100. Я переключаю cases_deaths на "deaths". Происходит следующее:

  1. ggplot, нарисованный с cases_deaths = "deaths" и min_n = 100
  2. min_n, изменен на 10
  3. ggplot draw с cases_deaths = "смерти" и min_n = 10

Как можно избежать шага 1, чтобы ggplot рисовался только один раз?

Ниже полностью воспроизводимый пример. 

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)

Я видел Как предотвратить многократное перерисовывание блестящего графика при взаимодействии с пользовательским интерфейсом? * сообщение 1045 *, но я не уверен, как эта логика c применяется здесь.

Ответы [ 2 ]

2 голосов
/ 19 марта 2020

Есть несколько вещей, которые вы можете сделать, чтобы улучшить:

  1. Не используйте renderui, но updatesliderInput, вместо этого, таким образом, вам не нужно будет постоянно создавать объекты
  2. Я также использовал пакет shinyjs с его функциями hide и show, поэтому вам не нужно создавать объекты
  3. Наконец, мы собираемся использовать reactiveValues для записи значения, которое необходимо отфильтровать 
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)
1 голос
/ 20 марта 2020

Спасибо @ pork-chop за отличный ответ! Мне пришлось внести несколько изменений в значения min_n_cases / min_n_deaths, чтобы они работали при переключении case_deaths. Слайд будет работать, если его переместить, но в противном случае сохранит старое значение. 

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)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...