How to update shiny reactive only if threshold is crossed?

Question

In the code below, the leaflet addCircles get drawn twice after a change in zoom. I think this double plotting occurs because the reactive to create a dataframe always updates with a change in zoom. However, I only want the reactive dataframe (race.dots.all.r) to update when a zoom threshold is crossed. Any ideas?

EDIT: I removed even more code to simplify and made it reproducible by adding a dropbox link to the data.

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)

why is the plotted data dependent on zoom to begin with? Do you **specifically** intend to plot certain things only if user is zoomed in/out upto certain extent? — Shree, Oct 17 '18 at 16:12
@Shree: The first time the data is plotted, it doesn't need to be dependent on zoom. However, if the user zooms out I want fewer dots to display. This is to (a) make it plot faster, and (b) to change the visualization so that dots don't overlay each other. Related to (b) I plan to change the weight when zoomed out so that the circleMarkers also change. — dca, Oct 17 '18 at 16:46

score 0 · Answer 1 · answered Oct 17 '18 at 16:44

0

If I understand your requirement correctly then here's one way to do it. I have set the zoom threshold at 0 for this example just so that it is easy to demo. You can change it to 4 for your app.

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")
      }
    })
  }
)

answered Oct 17 '18 at 16:44

Shree

10,835
1
14
36

Thanks for the rapid response @Shree. However, I don't see how this would work with the other observeEvent's that need to addCircles depending on checkboxInput statuses (and the addCircleMarkers/addAwesomeMarkers needs to work at the same time). Any idea how that would work? – dca Oct 17 '18 at 16:50
Your code is too much to go through for me. It'd help if you can reduce it down to bare minimum that represents your problem. – Shree Oct 17 '18 at 17:39
I simplified the code in the original post and made it reproducible by loading the data from dropbox. Thanks! – dca Oct 17 '18 at 18:45
I just realized that it is not fully reproducible because the css file is not available. It is here, in case that helps: https://www.dropbox.com/s/s2uytt54su7h0p3/bootstrap.css?dl=1 – dca Oct 18 '18 at 01:37
I've made the problem less significant by adding `ignoreInit = TRUE` in the observeEvents that addCircles. The problem now is that the initial zoom level is to zoomed out. Maybe that's now a different question. – dca Oct 19 '18 at 00:05
I tried running your code but the map didn't even show up. Anyways, you need to get rid of all appearance related stuff as it doesn't matter. Get rid of css, fancy colors, fancy layout, icons, reduce the data to 2-3 schools etc. Server logic is the key. Nothing else matters. – Shree Oct 19 '18 at 23:02
Thanks again, @Shree. I removed much more this time. The app responds faster now, but the addCircles still blink off and then on again after a zoom. When I have multiple groups and many more circles, the update following a zoom can take 10+ seconds. – dca Oct 21 '18 at 23:21
One version of the more full-featured app, with delays, can be seen here: https://njed.shinyapps.io/race_seg_gap_map/ – dca Oct 21 '18 at 23:26

How to update shiny reactive only if threshold is crossed?

1 Answers1