r - 快速放大闪亮会使人失去控制

Question

我想制作一个情节，您可以在其中使用键盘箭头上下放大和缩小。这就是我所做的。它工作得很好，但仍然存在一个主要问题。

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

ui <- fluidPage(
    tags$script(
        '$(document).on("keyup", function(e) {
    if(e.keyCode == 38){
    Shiny.onInputChange("up", Math.random());
    }
    if(e.keyCode == 40){
    Shiny.onInputChange("down", Math.random());
    }
    });'
    ),
    uiOutput("whole_page")
)

server <- function (input, output, session) {
    min <- 0
    max <- 1000000
    view_size <- reactiveVal(max - min)
    view_center <- reactiveVal(mean(c(max, min)))
    position <- reactiveVal(c(min, max))
    
    observeEvent(c(view_size(), view_center()), {
        from <- (view_center() - (view_size() / 2))
        to <- (view_center() + (view_size() / 2))
        c(from, to) %>% position()
    })
    
    output$whole_page <- renderUI({
        fluidPage(
            sliderInput("slider", "range:", min = min, max= max, value = position(), step = 1),
            plotOutput("plot")
        )
    })

    output$plot <- renderPlot({
        ggplot(data = tibble(pos = position())) +
            geom_point(aes(x = pos, y = 0))
    })
    
    observeEvent(input$slider, {
        input$slider %>% position()
    })
    
    observeEvent(position(), {
        position() %>%
            mean() %>%
            view_center()
        position() %>%
            diff() %>%
            view_size()
    })
    
    observeEvent(input$up, {
        (view_size() / 2) %>%
            view_size()
    })
    
    observeEvent(input$down, {
        (view_size() * 2) %>%
            view_size()
    })
}

shinyApp(ui, server)

剩下的问题是，当你快速点击上箭头几次时，它会使应用程序崩溃，它开始不断地从一个缩放级别切换到另一个缩放级别，你必须重新启动应用程序。

有人可以帮我解决这个问题并允许快速缩放吗？

注意：这是我在这个论坛上的第一篇文章，因为我通常在之前提出的问题中找到我的问题的答案。这个论坛真的是代码相关问题的金矿。

标签： rggplot2shiny

Answer 1

您可以使用debounce过滤过快的输入更改：

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

ui <- fluidPage(
  tags$script(
    '$(document).on("keyup", function(e) {
    if(e.keyCode == 38){
    Shiny.onInputChange("up", Math.random());
    }
    if(e.keyCode == 40){
    Shiny.onInputChange("down", Math.random());
    }
    });'
  ),
  uiOutput("whole_page")
)

server <- function (input, output, session) {
  min <- 0
  max <- 1000000
  view_size <- reactiveVal(max - min)
  view_center <- reactiveVal(mean(c(max, min)))
  position <- reactiveVal(c(min, max))
  
  observeEvent(c(view_size(), view_center()), {
    from <- (view_center() - (view_size() / 2))
    to <- (view_center() + (view_size() / 2))
    c(from, to) %>% position()
  })
  
  output$whole_page <- renderUI({
    fluidPage(
      sliderInput("slider", "range:", min = min, max= max, value = position(), step = 1),
      plotOutput("plot")
    )
  })
  
  output$plot <- renderPlot({
    ggplot(data = tibble(pos = position())) +
      geom_point(aes(x = pos, y = 0))
  })
  
  observeEvent(input$slider, {
    input$slider %>% position()
  })
  
  observeEvent(position(), {
    position() %>%
      mean() %>%
      view_center()
    position() %>%
      diff() %>%
      view_size()
  })
  
  up_d <- debounce(reactive({input$up}),500)
  down_d <- debounce(reactive({input$down}),500)
  
  observeEvent(up_d(), {
    (view_size() / 2) %>%
      view_size()
  })
  
  observeEvent(down_d(), {
    (view_size() * 2) %>%
      view_size()
  })
}

shinyApp(ui, server)