根据输入更改 Leaflet 地图而不重绘（多个多边形）

Question

无法解决我的 MULTIPLE filters/polygons 问题。目前我的代码可以工作，但速度很慢，我没有使用 observe()、reactive() 和 LeafletProxy()，因为我迷路了。

我显然检查了这个答案而这一张无需重新绘制传单地图即可进行闪亮 UI 调整和传单教程 Using Leaflet with Shiny

在我的例子中，我有四个过滤器，但不太了解如何将它们组合在一起并快速制作地图。

我的示例数据：

Country Client  Channel Status
Country 1   Client 1    Agent network   Launched
Country 2   Client 2    Debit cards Launched
Country 3   Client 3    M-banking   Planning
Country 4   Client 4    M-banking   Launched
Country 5   Client 5    Agent network   Launched
Country 6   Client 6    Agent network   Launched
Country 7   Client 7    Agent network   Pilot

此代码有效

# Packages
library(shiny)
library(shinythemes)
library(leaflet)
library(rgdal)

# Set working directory
setwd("C: /My Shiny apps")

# Read csv, which was created specifically for this app
projects <- read.csv("sample data10.csv", header = TRUE) 

# Read a shapefile
countries <- readOGR(".","ne_50m_admin_0_countries")

# Merge data
projects.df <- merge(countries, projects, by.x = "name", by.y = "Country")
class(projects.df)


# Shiny code

# UI

ui <- fluidPage(theme = shinytheme("united"),
            titlePanel("Map sample)"), 
            sidebarLayout(
              sidebarPanel(
                selectInput("countryInput", "Country",
                            choices = c("Choose country", "Country 1",
                                        "Country 2",
                                        "Country 3",
                                        "Country 4",
                                        "Country 5",
                                        "Country 6", 
                                        "Country 7"),
                            selected = "Choose country"),
                selectInput("clientInput", " Client",
                            choices = c("Choose Client", "Client 1",
                                        "Client 2",
                                        "Client 3",
                                        "Client 4",
                                        "Client 5",
                                        "Client 6"),
                            selected = "Choose Client"),
                selectInput("channeInput", "Channel",
                            choices = c("Choose Channel", "Agent network", 
"M-banking", "Debit cards"),
                            selected = "Choose Channel"),
                selectInput("statusInput", "Status",
                            choices = c("Choose status", "Launched", 
"Pilot", "Planning"),
                            selected = "Choose status")
              ),

              mainPanel(leafletOutput(outputId = 'map', height = 800) 
              )
            )
)

server <- function(input, output) {

output$map <- renderLeaflet({

pal1 <- colorFactor(
  palette = "Red",
  domain = input$countryInput)

pal2 <- colorFactor(
  palette = "Yellow",
  domain = input$clientInput)

pal3 <- colorFactor(
  palette = "Green",
  domain = input$channelInput)

pal4 <- colorFactor(
  palette = "Blue",
  domain = input$statusInput)

# Create a pop-up
state_popup <- paste0("<strong>Country: </strong>", 
                      projects.df$name, 
                      "<br><strong> Client: </strong>", 
                      projects.df$ Client,
                      "<br><strong> Channel: </strong>", 
                      projects.df$Channel
                      "<br><strong>Status: </strong>", 
                      projects.df$Status)

# Create a map

projects.map <- projects.df %>%
  leaflet() %>%
  addTiles("Stamen.Watercolor") %>% 
  setView(11.0670977,0.912484, zoom = 4) %>% 
  addPolygons(fillColor = ~pal1(projects.df$name), 
              popup = state_popup,
              color = "#BDBDC3",
              fillOpacity = 1,
              weight = 1) %>%
  addPolygons(fillColor = ~pal2(projects.df$Client), 
              popup = state_popup,
              color = "#BDBDC3",
              opacity = 1,
              weight = 1) %>%
  addPolygons(fillColor = ~pal3(projects.df$Channel), 
              popup = state_popup,
              color = "#BDBDC3",
              opacity = 1,
              weight = 1) %>%
  addPolygons(fillColor = ~pal4(projects.df$Status), 
              popup = state_popup,
              color = "#BDBDC3",
              opacity = 1,
              weight = 1)
})

}

shinyApp(ui = ui, server = server)

请帮我用 observe、reactive 和 LeafletProxy 解决这个问题，不要每次都重绘地图。

对我来说，有这些 多个 filters/polygons 让情况变得非常困难。

非常感谢！

Answer 1

您可以做一些事情来设置您的代码，还有一些事情需要清理。

首先，确保您的 output$map 变量是您的最小可行地图——它应该加载底图、设置 lat/lon、设置缩放，仅此而已。所以它可能看起来像：

output$map <- renderLeaflet({
leaflet('map') %>%
  addTiles("Stamen.Watercolor") %>% 
  setView(11.0670977,0.912484, zoom = 4)
})

然后您可以使用 renderPlot 为每个多边形创建不同的输出并将其包装在条件语句中：

output$country_one <- renderPlot({
if("Country 1" %in% input$"countryInput") {
 leafletProxy('map') %>%
 addPolygons(data = projects.df, fillColor = ~pal1(projects.df$name), 
              popup = paste0("<strong>Country: </strong>", 
                      projects.df$name, 
                      "<br><strong> Client: </strong>", 
                      projects.df$ Client,
                      "<br><strong> Channel: </strong>", 
                      projects.df$Channel
                      "<br><strong>Status: </strong>", 
                      projects.df$Status),
              color = "#BDBDC3",
              fillOpacity = 1,
              weight = 1)
}
)}

然后在你的 UI 部分，你依次调用每个输出：

leafletProxy('map')
plotOutput('country_one')

清理调色板后（域必须是数字），您的代码可能如下所示：

# Packages
library(shiny)
library(shinythemes)
library(leaflet)
library(rgdal)

# Set working directory
setwd("C: /My Shiny apps")

# Read csv, which was created specifically for this app
projects <- read.csv("sample data10.csv", header = TRUE) 

# Read a shapefile
countries <- readOGR(".","ne_50m_admin_0_countries")

# Merge data
projects.df <- merge(countries, projects, by.x = "name", by.y = "Country")
class(projects.df)

# Shiny code

# UI

ui <- fluidPage(theme = shinytheme("united"),
            titlePanel("Map sample"), 
            sidebarLayout(
              sidebarPanel(
                selectInput("countryInput", "Country",
                            choices = c("Choose country", "Country 1","Country 2","Country 3","Country 4","Country 5","Country 6", "Country 7"),
                            selected = "Choose country"),
                selectInput("clientInput", " Client",
                            choices = c("Choose Client", "Client 1","Client 2","Client 3","Client 4","Client 5","Client 6"),
                            selected = "Choose Client"),
                selectInput("channeInput", "Channel",
                            choices = c("Choose Channel", "Agent network", "M-banking", "Debit cards"),
                            selected = "Choose Channel"),
                selectInput("statusInput", "Status",
                            choices = c("Choose status", "Launched", "Pilot", "Planning"),
                            selected = "Choose status")
              ),

              mainPanel(
                leafletOutput('map'), 
                plotOutput('country_output'),
                plotOutput('client_output'),
                plotOutput('channel_output'),
                plotOutput('status_output')
              )
            )
)

server <- function(input, output) {

pal1 <- colorFactor(palette = "Blues", domain = c(0, 100))
pal2 <- colorFactor(palette = "Blues", domain = c(0, 100))
pal3 <- colorFactor(palette = "Blues", domain = c(0, 100))
pal4 <- colorFactor(palette = "Blues", domain = c(0, 100))

output$map <- renderLeaflet({
    leaflet('map') %>%
      addTiles("Stamen.Watercolor") %>% 
      setView(11.0670977,0.912484, zoom = 4)
})

output$country_output <- renderPlot({
  if("Country 1" %in% input$"countryInput") { # sample conditional statement
    leafletProxy('map') %>% # initalize the map
      clearGroup("polys") %>% # clear any previous polygons
      addPolygons(fillColor = ~pal1(projects.df$name), 
                  popup = paste0("<strong>Country: </strong>",projects.df$name,"<br><strong> Client: </strong>",projects.df$ Client,"<br><strong> Channel: </strong>",projects.df$Channel,"<br><strong>Status: </strong>", projects.df$Status), 
                  color = "#BDBDC3", fillOpacity = 1, weight = 1, group = "polys")
  }
})

output$client_output <- renderPlot({
  leafletProxy('map') %>% # initalize the map
    clearGroup("polys") %>% # clear any previous polygons
    addPolygons(fillColor = ~pal2(projects.df$Client), 
                popup = paste0("<strong>Country: </strong>",projects.df$name,"<br><strong> Client: </strong>",projects.df$ Client,"<br><strong> Channel: </strong>",projects.df$Channel,"<br><strong>Status: </strong>", projects.df$Status), 
                color = "#BDBDC3", fillOpacity = 1, weight = 1, group = "polys")
})  

output$channel_output <- renderPlot({
  leafletProxy('map') %>% # initalize the map
    clearGroup("polys") %>% # clear any previous polygons
    addPolygons(fillColor = ~pal3(projects.df$Channel), 
                popup = paste0("<strong>Country: </strong>",projects.df$name,"<br><strong> Client: </strong>",projects.df$ Client,"<br><strong> Channel: </strong>",projects.df$Channel,"<br><strong>Status: </strong>", projects.df$Status), 
                color = "#BDBDC3", fillOpacity = 1, weight = 1, group = "polys")
})    

output$status_output <- renderPlot({
  leafletProxy('map') %>% # initalize the map
    clearGroup("polys") %>% # clear any previous polygons
    addPolygons(fillColor = ~pal4(projects.df$Status), 
                popup = paste0("<strong>Country: </strong>",projects.df$name,"<br><strong> Client: </strong>",projects.df$ Client,"<br><strong> Channel: </strong>",projects.df$Channel,"<br><strong>Status: </strong>", projects.df$Status), 
                color = "#BDBDC3", fillOpacity = 1, weight = 1, group = "polys")
})      

}

shinyApp(ui = ui, server = server)

我无法对此进行测试，因为我没有您的地理空间数据。因此，如果您遇到错误，可能值得检查此代码以及您的数据源。

Answer 2

我想这与您要实现的目标一致。我更喜欢有单独的全局文件、ui 和服务器文件。我的示例项目文件是：

"","Country","Client","Channel","Status" "1","Croatia","Client 1","Agent network","Launched" "2","Germany","Client 2","Debit cards","Launched" "3","Italy","Client 3","M-banking","Planning" "4","France","Client 4","M-banking","Launched" "5","Slovenia","Client 5","Agent network","Launched" "6","Austria","Client 6","Agent network","Launched" "7","Hungary","Client 7","Agent network","Pilot"

global.R

    library(shiny)
    library(shinythemes)
    library(leaflet)
    library(rgdal)

    # Set working directory

    # Read csv, which was created specifically for this app
    projects <- read.csv("sample data10.csv", header = TRUE) 

    # Read a shapefile
    countries <- readOGR(".","ne_50m_admin_0_countries")

    # Merge data
    projects.df <- merge(countries, projects, by.x = "name", by.y = "Country")

ui.R

    library(shiny)
    library(shinythemes)
    library(leaflet)
    library(rgdal)

    shinyUI(fluidPage(theme = shinytheme("united"),
                      titlePanel("Map sample"), 
                      sidebarLayout(
                              sidebarPanel(
                                      selectInput("countryInput", "Country",
                                                  choices = c("Choose country", "Croatia",
                                                              "Germany",
                                                              "Italy",
                                                              "France",
                                                              "Slovenia",
                                                              "Austria", 
                                                              "Hungary"),
                                                  selected = "Choose country"),
                                      selectInput("clientInput", " Client",
                                                  choices = c("Choose Client", "Client 1",
                                                              "Client 2",
                                                              "Client 3",
                                                              "Client 4",
                                                              "Client 5",
                                                              "Client 6"),
                                                  selected = "Choose Client"),
                                      selectInput("channeInput", "Channel",
                                                  choices = c("Choose Channel", "Agent network", 
                                                              "M-banking", "Debit cards"),
                                                  selected = "Choose Channel"),
                                      selectInput("statusInput", "Status",
                                                  choices = c("Choose status", "Launched", 
                                                              "Pilot", "Planning"),
                                                  selected = "Choose status")
                              ),

                              mainPanel(leafletOutput(outputId = 'map', height = 800) 
                              )
                      )
    ))

server.R

  shinyServer(function(input, output) {
            output$map <- renderLeaflet({
                    leaflet(projects.df) %>% 
                            addProviderTiles(providers$Stamen.Watercolor) %>% 
                            setView(11.0670977,0.912484, zoom = 4) #%>% 

            })
            # observers
            # selected country
            selectedCountry <- reactive({
                   projects.df[projects.df$name == input$countryInput, ] 
            })
            observe({
                    state_popup <- paste0("<strong>Country: </strong>", 
                                          selectedCountry()$name, 
                                          "<br><strong> Client: </strong>", 
                                          selectedCountry()$Client,
                                          "<br><strong> Channel: </strong>", 
                                          selectedCountry()$Channel,
                                          "<br><strong>Status: </strong>", 
                                          selectedCountry()$Status)

                    leafletProxy("map", data = selectedCountry()) %>%
                            clearShapes() %>%
                            addPolygons(fillColor =  "red",
                                        popup = state_popup,
                                        color = "#BDBDC3",
                                        fillOpacity = 1,
                                        weight = 1)
            })
            # selected clients
            selectedClient <- reactive({
                    tmp <- projects.df[!is.na(projects.df$Client), ] 
                    tmp[tmp$Client == input$clientInput, ]
            })
            observe({
                    state_popup <- paste0("<strong>Country: </strong>",
                                          selectedClient()$name,
                                          "<br><strong> Client: </strong>",
                                          selectedClient()$Client,
                                          "<br><strong> Channel: </strong>",
                                          selectedClient()$Channel,
                                          "<br><strong>Status: </strong>",
                                          selectedClient()$Status)

                    leafletProxy("map", data = selectedClient()) %>%
                            clearShapes() %>%
                            addPolygons(fillColor =  "yellow",
                                        popup = state_popup,
                                        color = "#BDBDC3",
                                        fillOpacity = 1,
                                        weight = 1)
            })
            # selected channel
            selectedChannel <- reactive({
                    tmp <- projects.df[!is.na(projects.df$Channel), ] 
                    tmp[tmp$Channel == input$channeInput, ]
            })
            observe({
                    state_popup <- paste0("<strong>Country: </strong>",
                                          selectedChannel()$name,
                                          "<br><strong> Client: </strong>",
                                          selectedChannel()$Client,
                                          "<br><strong> Channel: </strong>",
                                          selectedChannel()$Channel,
                                          "<br><strong>Status: </strong>",
                                          selectedChannel()$Status)

                    leafletProxy("map", data = selectedChannel()) %>%
                            clearShapes() %>%
                            addPolygons(fillColor =  "green",
                                        popup = state_popup,
                                        color = "#BDBDC3",
                                        fillOpacity = 1,
                                        weight = 1)
            })
            # selected status
            selectedStatus <- reactive({
                    tmp <- projects.df[!is.na(projects.df$Status), ] 
                    tmp[tmp$Status == input$statusInput, ]
            })
            observe({
                    state_popup <- paste0("<strong>Country: </strong>",
                                          selectedStatus()$name,
                                          "<br><strong> Client: </strong>",
                                          selectedStatus()$Client,
                                          "<br><strong> Channel: </strong>",
                                          selectedStatus()$Channel,
                                          "<br><strong>Status: </strong>",
                                          selectedStatus()$Status)

                    leafletProxy("map", data = selectedStatus()) %>%
                            clearShapes() %>%
                            addPolygons(fillColor =  "blue",
                                        popup = state_popup,
                                        color = "#BDBDC3",
                                        fillOpacity = 1,
                                        weight = 1)
            })        
    })

让我知道...

Answer 3

按照this issue，您还可以创建一次地图，然后根据需要为多边形重新着色。

这里涉及到一些javascript代码，包括leafletjs代码，然后使用setShapeStyle函数。请注意，javascript 和 setShapeStyle 函数都显示在上面的问题中。

# in ui
ui <- fluidPage(leafletjs, ...)

# in server
observe({
  leafletProxy("map") %>%
    setShapeStyle(layerId = ~LayerIDs, fillColor=input$color)
})

根据输入更改 Leaflet 地图而不重绘（多个多边形）

Changing Leaflet map according to input without redrawing (multiple polygons)

r

polygons

leaflet

shiny