Question

无法修复MULTIPLE过滤器/多边形的问题。目前我的代码工作，但非常慢，我不使用 observe（），reactive（）和LeafletProxy（），因为我绊倒了。

我显然检查了这个答案Changing Leaflet map according to input without redrawing 这一篇Making Shiny UI Adjustments Without Redrawing Leaflet Maps 和传单教程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)

请帮我修复观察，反应和LeafletProxy ，而不是每次都重绘地图。

对于我来说，拥有这些多个过滤器/多边形会让情况变得非常困难。

非常感谢！

Answer 1

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

＆＃34;＆＃34;＆＃34;国家＆＃34;＆＃34;客户＆＃34;＆＃34;信道＆＃34;＆＃34;状态＆＃34; ＆＃34; 1＆＃34;，＆＃34;克罗地亚＆＃34;，＆＃34;客户1＆＃34;，＆＃34;代理商网络＆＃34;，＆＃34;推出＆＃34; ＆＃34; 2＆＃34;，＆＃34;德国＆＃34;，＆＃34;客户2＆＃34;，＆＃34;借记卡＆＃34;，＆＃34;发布＆＃34; ＆＃34; 3＆＃34;，＆＃34;意大利＆＃34;，＆＃34;客户3＆＃34;，＆＃34; M-banking＆＃34;，＆＃34;规划＆＃34; ＆＃34; 4＆＃34;，＆＃34;法国＆＃34;，＆＃34;客户4＆＃34;，＆＃34; M-banking＆＃34;，＆＃34;推出＆＃34; ＆＃34; 5＆＃34;，＆＃34;斯洛文尼亚＆＃34;，＆＃34;客户5＆＃34;，＆＃34;代理商网络＆＃34;，＆＃34;推出＆＃34; ＆＃34; 6＆＃34;，＆＃34;奥地利＆＃34;，＆＃34;客户6＆＃34;，＆＃34;代理网络＆＃34;，＆＃34;推出＆＃34; ＆＃34; 7＆＃34;，＆＃34;匈牙利＆＃34;，＆＃34;客户7＆＃34;，＆＃34;代理商网络＆＃34;，＆＃34; Pilot＆＃34;

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 2

您可以采取一些措施来设置代码，还有一些事情需要清理。

首先，确保您的output$map变量是您的最小可行地图 - 它应该加载底图，设置纬度/经度，设置缩放，以及它是关于它的。所以它可能看起来像：

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 3

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

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

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

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

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

3 个答案: