是否可以更新传单中的多边形填充以获得闪亮而无需重新创建地图对象

Question

在传单中,我通常会创建一个地图:

server.R

shinyServer(function(input, output, session) {
url <- "custommapboxurl"
attrib <- "Maps by http://www.mapbox.com/Mapbox"

...
     map_out <- reactive({

        map <- leaflet()%>%
        addTiles(urlTemplate = url, attribution = HTML(attrib))%>%
        addPolygons(data = sub_shape,
                    fill = TRUE,
                    fillColor = colors$color,
                    fillOpacity = .8,
                    stroke = TRUE,
                    weight = 3,
                    color = "white",
                    dashArray = c(5,5),
                    popup = pops
        )
    })

    output$myMap <- renderLeaflet({
            map_out()
    })
...
})

sub_shape上面是我的shapefile(在本例中是美国的邮政编码),颜色$ color是与每个形状对应的颜色的动态矢量.您可以使用以下链接重新创建:http://www.nws.noaa.gov/geodata/catalog/national/html/province.htm,colors <- data.frame(color = colorRampPalette(c("white","blue"))(13))

ui.R

shinyUI(
    ...
    leafletOutput('myMap', width = "100%" , height = "100%")
    ...
)

这给出了:

我想要做的是根据用户的输入更改颜色矢量.例如,他们可能会选择一个不同的变量来为每个邮政编码着色,生成一个新的渐变.

Shiny允许我们这样做,就好像我根据输入小部件更改颜色向量,反应函数刷新,并基于新向量重新创建地图.问题是,对于大型shapefile对象,此刷新需要很长时间.

有没有办法直接更改当前渲染的形状的颜色,而无需重新创建整个图层？似乎color参数被锁定在leaflet()函数中.还有其他办法吗？

Answer 1

为了说明@Yihui Xie 的评论，这里是一个leafletProxy基于selectInput.

library(shiny)
library(leaflet)
library(sp)
library(raster)

## Spatial Polygon ##########
Sr1 = Polygon(cbind(c(2,4,4,1,2),c(2,3,5,4,2)))
Sr2 = Polygon(cbind(c(5,4,2,5),c(2,3,2,2)))
Sr3 = Polygon(cbind(c(4,4,5,10,4),c(5,3,2,5,5)))
Sr4 = Polygon(cbind(c(5,6,6,5,5),c(4,4,3,3,4)), hole = TRUE)
Srs1 = Polygons(list(Sr1), "s1")
Srs2 = Polygons(list(Sr2), "s2")
Srs3 = Polygons(list(Sr3, Sr4), "s3/4")
SpP = SpatialPolygons(list(Srs1,Srs2,Srs3), 1:3)
SpPDF <- SpatialPolygonsDataFrame(SpP, data = data.frame(x=1:length(SpP)), match.ID = F)
Extent = extent(SpPDF)

## UI ##########
ui <- fluidPage(
  selectInput("col", label = "Select a color", choices = c("Blues", "viridis", "magma")),
  leafletOutput("map")
)

## SERVER ##########
server <- function(input, output) {
  output$map <- renderLeaflet({
    leaflet()  %>% 
      addTiles() %>% 
      fitBounds(lng1 = Extent[1],lat1 = Extent[3], lng2 = Extent[2], lat2 = Extent[4])
  })

  observe({
    req(input$col)
    pal = colorFactor(input$col, domain = factor(SpPDF$x))
    leafletProxy("map") %>%
      addPolygons(data = SpPDF, color = ~pal(factor(SpPDF$x)))
  })
}

shinyApp(ui, server)