awesome - Cambio del mapa del prospecto de acuerdo con la entrada sin redibujar

r leaflet weight

Question

Me pregunto cómo puedo cambiar Shiny y Leaflet para trazar puntos de acuerdo con el cambio en la entrada sin redibujar todo el mapa.

El código que estoy usando es:

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)

El conjunto de datos utilizado para el código está disponible en este enlace - Melbourne Urban Forest Data

Hay muchos puntos, por lo que no me gustaría volver a dibujar cada vez que se modifique la entrada. La entrada se basa en la columna "Precinto" en el conjunto de datos. Cualquier ayuda aquí es muy apreciada.

Answer 1

De acuerdo, ahí lo tienes: leafletProxy se usa para agregar capas a un mapa de folleto existente. El uso es como las adiciones normales de folletos, pero no necesita la parte de representación, ya que el mapa ya está representado en su documento.

La primera y más fácil parte es renderizar el mapa del folleto en un nivel básico, es decir, fichas, leyendas, dibujos estáticos, todo lo que quieras hacer solo una vez. Este es su punto de partida. A partir de ahí, la alteración del mapa solo se realiza mediante comandos directos en lugar de volver a representarlos.

Ahora se puede acceder a este mapa a través de su brillante ID de salida. En nuestro caso, teníamos leafletOutput("treedat") , así que si queremos abordar este mapa, usamos leafletProxy("treedat") . Usamos la misma sintaxis que en las modificaciones regulares de folleto. Por ejemplo, leafletProxy("treedat") %>% addMarkers(lat = 1, lng = 1) agrega un marcador al mapa existente sin volver a representarlo.

Por lo tanto, cada modificación del mapa puede / debe ocurrir desde dentro de una instrucción de observe y no desde adentro de renderLeaflet . Tenga en cuenta que cada comando es una adición al mapa original, por lo que tuve que usar clearMarkers en el siguiente ejemplo.

Código:

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)