Question

我想知道如何更改Shiny和Leaflet以根据输入的变化绘制点而不重绘整个地图。

我正在使用的代码是：

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)

此链接提供了用于代码的数据集 - Melbourne Urban Forest Data

有很多要点，所以每次输入更改时我都不想重新绘制。输入基于数据集中的“Precinct”列。非常感谢任何帮助。

Answer 1

好的，你去了：leafletProxy用于向现有的传单地图添加图层。用法就像普通的传单添加一样，但您不需要渲染部分，因为地图已经在文档中呈现。

第一个也是最简单的部分是在基本级别上渲染传单地图，即图块，图例，静态图纸，以及您想要只执行一次的所有内容。这是你的出发点。从那以后，改变地图只能通过直接命令而不是重新渲染来完成。

现在可以通过其闪亮的输出ID访问此地图。在以后的情况下，我们有leafletOutput("treedat")，因此如果我们想要解决此地图，我们会使用leafletProxy("treedat")。我们使用与常规传单修改相同的语法。例如。 leafletProxy("treedat") %>% addMarkers(lat = 1, lng = 1)会在不重新渲染现有地图的情况下为现有地图添加标记。

因此，对映射的每次修改都可以/必须从某个observe语句内部发生，而不是从renderLeaflet内部发生。请注意，每个命令都是对原始地图的补充，这就是我必须在下面的示例中使用clearMarkers的原因。

代码：

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)

根据输入更改传单地图而不重绘

1 个答案: