13
votes

I'm wondering how I can change Shiny and Leaflet to plot points according to the change in input without redrawing the whole map.

The code i'm using is:

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

ui <- fluidPage(
  titlePanel("Melbourne Urban Tree Visualisation"),
  leafletOutput("treedat"),
  uiOutput("precinct")
   #Giving an input name and listing out types to choose in the Shiny app
  )

server <- function(input, output){

  #td <- read.csv("treedata.csv", header = TRUE)

  #pal <- colorNumeric(
  #palette = "RdYlGn",
  #domain = td$LifeExpectencyValue
  #)

  output$precinct <- renderUI({

    choices <- as.character(unique(td$Precinct))  
    choices <- c('All', choices)
    selectInput(inputId = "precinct", label = "Precinct", choices = choices, selected = "CBD")

  })


  output$treedat <- renderLeaflet({
    #if(is.null(td)) return()
    ## get the choice from teh drop-down box
    PRECINCT = input$precinct

    ## supbset the data based on the choice
    if(PRECINCT != 'All'){
      td2 <- td[td$Precinct == PRECINCT, ]
    }else{
      td2 <- td
    }
    ## plot the subsetted ata
    td2 <- leafletProxy(td2) %>% addTiles(
      urlTemplate = 'http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png',
      attribution='Map tiles by <a href="http://stamen.com">Stamen Design</a>, <a href="http://creativecommons.org/licenses/by/3.0">CC BY 3.0</a> &mdash; Map data &copy; <a href="http://www.openstreetmap.org/copyright">OpenStreetMap</a>') %>% 
      addCircleMarkers(radius= 5,
                       fillOpacity = 0.5, 
                       stroke = FALSE,
                       color=~pal(LifeExpectencyValue),
                       popup=paste("<b>", td$CommonName,"</b>", "<br>", 
                                   "<b>","Years Left:", "</b>", td$LifeExpectency, "<br>", 
                                   "<b>","Genus:","</b>", td$Genus)) %>% addLegend(pal = pal, 
                                                                      values = ~LifeExpectencyValue, 
                                                                      opacity = 1, 
                                                                      title = "Life Expectency")
    return(td2)
  })
}

shinyApp(ui = ui, server = server)

The dataset used for the code is available at this link - Melbourne Urban Forest Data

There are a lot of points so I wouldn't want to re-draw each time the input is changed. The input is based on the "Precinct" column in the dataset. Any help here is deeply appreciated.

1
Use leafletProxy. There is a documentation under this link.K. Rohde
Hi, I tried leafletProxy but could not get it to work. The app wouldn't run at all? Am i missing something?Arvind Suryanarayana
Sorry, I should have looked at this more closely. Yes, you're using it wrong. I need some time to come up with a code sample (sadly, you did not provide a working example) to illustrate how to use the command.K. Rohde
Sorry about that! Take your time. No hurry. Thanks for offering to help.Arvind Suryanarayana

1 Answers

22
votes

Okay, there you go: leafletProxy is used to add layers to an existing leaflet map. The usage ist just like normal leaflet additions, but you don't need the rendering part, since the map is already rendered in your document.

The first and easiest part is to render the leaflet map on a basic level, that is tiles, legend, static drawings, everything that you want to do just once. This is your starting point. From there on, altering the map is only done by direct commands instead of re-renderings.

This map can now be accessed via its shiny output id. In out case, we had leafletOutput("treedat"), so if we want to address this map, we use leafletProxy("treedat"). We use the same syntax as in regular leaflet modifications. E.g. leafletProxy("treedat") %>% addMarkers(lat = 1, lng = 1) adds a marker to the existing map without re-rendering it.

Thus, every modification to the map can / has to happen from inside some observe statement and not from inside the renderLeaflet. Note that every command is an addition to the original map, which is why I had to use clearMarkers in the example below.

Code:

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

ui <- fluidPage(
  titlePanel("Melbourne Urban Tree Visualisation"),
  leafletOutput("treedat"),
  uiOutput("precinct")
   #Giving an input name and listing out types to choose in the Shiny app
  )

server <- function(input, output){

  td <- data.frame(
    LifeExpectencyValue = sample(20:100, 10), 
    Precinct = c(rep("CBD", 3), rep("ABC", 4), rep("XYZ", 3)),
    CommonName = sapply(1:10, function(x){paste(sample(LETTERS, 10, replace = TRUE), collapse = "")}),
    Genus = rep(c("m","f"), each = 5),
    lat = seq(5, 50, 5),
    lng = seq(2, 65, 7)
  )

  pal <- colorNumeric(palette = "RdYlGn", domain = td$LifeExpectencyValue)

  output$precinct <- renderUI({

    choices <- as.character(unique(td$Precinct))  
    choices <- c('All', choices)
    selectInput(inputId = "precinct", label = "Precinct", choices = choices, selected = "CBD")

  })


  output$treedat <- renderLeaflet({

    leaflet() %>% 
      addTiles(
        urlTemplate = 'http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png',
        attribution='Map tiles by <a href="http://stamen.com">Stamen Design</a>, <a href="http://creativecommons.org/licenses/by/3.0">CC BY 3.0</a> &mdash; Map data &copy; <a href="http://www.openstreetmap.org/copyright">OpenStreetMap</a>'
      ) %>%
      addLegend(pal = pal, values = td$LifeExpectencyValue, opacity = 1, title = "Life Expectency")

  })

  observeEvent(input$precinct, {

    #if(is.null(td)) return()
    ## get the choice from teh drop-down box
    PRECINCT = input$precinct

    ## supbset the data based on the choice
    if(PRECINCT != 'All'){
      td2 <- td[td$Precinct == PRECINCT, ]
    }else{
      td2 <- td
    }
    ## plot the subsetted ata
    leafletProxy("treedat") %>%
      clearMarkers() %>%
      addCircleMarkers(lat = td2$lat, lng = td2$lng,
        radius= 5, fillOpacity = 0.5, stroke = FALSE, color=pal(td2$LifeExpectencyValue),
        popup = paste("<b>", td2$CommonName,"</b>", "<br>", 
          "<b>","Years Left:", "</b>", td2$LifeExpectency, "<br>", 
          "<b>","Genus:","</b>", td2$Genus))
  })
}

shinyApp(ui = ui, server = server)