根据输入更改传单地图，无需重绘（多个多边形）

Question

根据输入更改传单地图，无需重绘（多个多边形）

无法解决 MULTIPLE 过滤器/多边形的问题。目前我的代码有效，但速度很慢，我不使用observe()、reactive() 和 LeafletProxy()，因为我偶然发现了。

我显然检查了这个答案根据输入更改传单地图而无需重绘和这个在不重绘传单地图和传单教程的情况下进行闪亮的 UI 调整使用带有闪亮的传单

就我而言，我有四个过滤器，但不太明白如何将它们组合在一起并使地图快速。

我的样本数据：

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

Run Code Online (Sandbox Code Playgroud)

此代码有效

# 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)

Run Code Online (Sandbox Code Playgroud)

请帮助我使用观察、反应和 LeafletProxy来修复它，而不是每次都重新绘制地图。

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

非常感谢！

Answer 1

Val*_*vić 6

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

“”、“国家”、“客户”、“渠道”、“状态”“1”、“克罗地亚”、“客户 1”、“代理网络”、“启动”“2”、“德国”、“客户 2” ","借记卡","推出""3","意大利","客户3","移动银行","规划""4","法国","客户4","移动银行" ,“启动”“5”,“斯洛文尼亚”,“客户端 5”,“代理网络”,“启动”“6”,“奥地利”,“客户端 6”,“代理网络”,“启动”“7”, “匈牙利”、“客户端 7”、“代理网络”、“飞行员”

全局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")

Run Code Online (Sandbox Code Playgroud)

用户界面

    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) 
                              )
                      )
    ))

Run Code Online (Sandbox Code Playgroud)

服务器

  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)
            })        
    })

Run Code Online (Sandbox Code Playgroud)

让我知道...

Answer 2

Jef*_*eff 5

您可以做几件事来设置代码，还有几件事需要清理。

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

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

Run Code Online (Sandbox Code Playgroud)

然后，您可以为每个多边形创建不同的输出，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)
}
)}

Run Code Online (Sandbox Code Playgroud)

然后在您的 UI 部分，您一个接一个地调用每个输出：

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

Run Code Online (Sandbox Code Playgroud)

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

# 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)

Run Code Online (Sandbox Code Playgroud)

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

归档时间：	8 年，2 月前
查看次数：	4980 次
最近记录：	5 年，4 月前