仅当超过阈值时如何更新闪亮的反应？

Question

在下面的代码中，小册子 addCircles 在缩放更改后被绘制了两次。我认为这种双重绘图的发生是因为创建数据框的反应总是随着缩放的变化而更新。但是，我只希望在超过缩放阈值时更新反应数据框（race.dots.all.r）。有任何想法吗？

编辑：我删除了更多代码以简化并通过向数据添加 Dropbox 链接使其可重现。

library(shiny)
library(leaflet)
library(dplyr)

load(url("https://www.dropbox.com/s/umhqvoqvbhlkrc6/shiny_app_seg_gap_stackoverflow.RData?dl=1"))

ui <- shinyUI(fluidPage(
  leafletOutput("map"),
  checkboxInput("togglewhite",  "White", value = TRUE)
                            ))


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

  per.person <- eventReactive(input$map_zoom,{

    new_zoom <- 12
    if (!is.null(input$map_zoom)) {
      new_zoom <- input$map_zoom}

    if ( new_zoom < 13 ) {
      per.person <- "1000"
    } else {
      per.person <- "250"
    }

    return(per.person)

  })

  race.dots.all.r <- eventReactive(per.person(),{
    race.dots.all <- race.dots.all[[per.person()]]
    return(race.dots.all)
  })


  values <- reactiveValues(school = NULL)

  output$map <- renderLeaflet({

    leaflet(options = leafletOptions(preferCanvas = TRUE)) %>% 
      addProviderTiles("CartoDB") %>%
      setView(lat=40.73771, lng=-74.18958, zoom = 8)
  })


  observeEvent(c(input$togglewhite, race.dots.all.r()), {

    proxy <- leafletProxy('map')
    proxy %>% clearGroup(group = "White")
    if (input$togglewhite){
      race.dots.all.selected.race <- dplyr::filter( race.dots.all.r(), group == "White")
      proxy %>% addCircles(group = race.dots.all.selected.race$group, 
                           race.dots.all.selected.race$lng, 
                           race.dots.all.selected.race$lat)
    }
  },ignoreInit = TRUE)

}) # close server

shinyApp(ui, server)

Answer 1

如果我正确理解您的要求，那么这是一种方法。为了便于演示，我将本示例的缩放阈值设置为 0。您可以为您的应用将其更改为 4。

library(shiny)
library(leaflet)

shinyApp(
  ui = fluidPage(
    leafletOutput("map")
  ),
  server = function(input, output, session) {
    output$map <- renderLeaflet({
      leaflet() %>%
        addTiles()
    })

    map_proxy <- leafletProxy("map")

    observeEvent(input$map_zoom, {
      if(input$map_zoom > 0) {
        map_proxy %>%
          addCircleMarkers(lng = 74.0060, lat = 40.7128,
                           group = "high_zoom_in", radius = 50, color = "red")
      } else {
        map_proxy %>%
          clearGroup("high_zoom_in")
      }
    })
  }
)