Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Changing Leaflet map according to input without redrawing

Tags:

r

leaflet

shiny

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.

like image 785
Arvind Suryanarayana Avatar asked May 25 '16 09:05

Arvind Suryanarayana


1 Answers

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)
like image 173
K. Rohde Avatar answered Nov 11 '22 02:11

K. Rohde