根据输入更改传单地图而不重绘(多个多边形) [英] Changing Leaflet map according to input without redrawing (multiple polygons)
问题描述
无法解决我的 MULTIPLE 过滤器/多边形问题.目前我的代码可以工作，但速度很慢，我不使用 observe()、reactive() 和 LeafletProxy()，因为我偶然发现.
cannot fix my problem for MULTIPLE filters/polygons. Currently my code works, but very slow, I do not use observe(), reactive(), and LeafletProxy(), because I stumbled.
我显然检查了这个答案 根据输入更改传单地图而不重绘还有这个 在不重绘传单地图的情况下进行闪亮的 UI 调整 和传单教程使用带闪亮的传单
I obviously checked this answer Changing Leaflet map according to input without redrawing and this one Making Shiny UI Adjustments Without Redrawing Leaflet Maps and leaflet tutorial Using Leaflet with Shiny
在我的情况下，我有四个过滤器，但不太了解如何将它们组合在一起并快速制作地图.
In my case I have four filters and do not quite understand how to combine them together and make the map fast.
我的样本数据:
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 修复它，而无需每次都重新绘制地图.
Please help me to fix it with observe, reactive, and LeafletProxy and without redrawing map every time.
对我来说，拥有这些多个过滤器/多边形会使情况变得非常困难.
For me having these multiple filters/polygons make the situation really difficult.
非常感谢！
推荐答案
我想这符合您想要实现的目标.我更喜欢有单独的全局、ui 和服务器文件.我的示例项目文件是:
I guess this is in line with what you are trying to achieve. I prefer have separate global, ui and server files. My sample project file is:
"","国家","客户","频道","状态""1","克罗地亚","客户端 1","代理网络","启动""2","德国","客户 2","借记卡","已推出""3","意大利","客户 3","移动银行","规划""4","France","Client 4","M-banking","推出""5","斯洛文尼亚","客户 5","代理网络","已启动""6","Austria","Client 6","代理网络","启动""7","Hungary","Client 7","代理网络","Pilot"
"","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"
全球.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)
)
)
))
服务器.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)
})
})
让我知道...
这篇关于根据输入更改传单地图而不重绘(多个多边形)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
