根据输入更改传单地图而无需重绘(多个多边形) [英] Changing Leaflet map according to input without redrawing (multiple polygons)
问题描述
无法解决多个过滤器/多边形的问题. 目前，我的代码可以运行，但是速度很慢，因为我迷迷糊糊，所以我不使用 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调整而无需重绘传单地图 和传单指南将传单与Shiny配合使用
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"，法国"，客户4"，移动银行"，启动" "5"，斯洛文尼亚"，客户端5"，代理网络"，启动" "6"，奥地利"，客户端6"，代理网络"，启动" "7"，匈牙利"，客户端7"，代理网络"，飞行员"
"","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)
})
})
让我知道...
这篇关于根据输入更改传单地图而无需重绘(多个多边形)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
