Changing Leaflet map according to input without redrawing (multiple polygons)
cannot fix my problem for MULTIPLE filters/polygons. Currently my code works, but very slow, I do not use observe(), reactive(), and LeafletProxy(), becau
-
Following this issue you can also create the map once and then recolor the polygons as you like.
This involves some javascript code, including the
leafletjscode and then using thesetShapeStylefunction. Note that both the javascript and the setShapeStyle function are shown in the issue above.# in ui ui <- fluidPage(leafletjs, ...) # in server observe({ leafletProxy("map") %>% setShapeStyle(layerId = ~LayerIDs, fillColor=input$color) })讨论(0) -
There are a couple things you can do to set up your code, and a few things that need to be cleaned up.
First, make sure your
output$mapvariable is your minimum viable map -- it should load the basemap, set the lat/lon, set the zoom, and that's about it. So it might look like:output$map <- renderLeaflet({ leaflet('map') %>% addTiles("Stamen.Watercolor") %>% setView(11.0670977,0.912484, zoom = 4) })Then you can create a different output for each of your polygons using
renderPlotand wrap it in a conditional statement: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) } )}Then in your UI section, you call each output one after another:
leafletProxy('map') plotOutput('country_one')After cleaning up your palettes (domain must be numeric), your code might look like this:
# 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)I can't test this because I don't have your geospatial data. So if you are encountering errors, it might be worth checking this code as well as your data source.
讨论(0) -
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:
"","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) }) })Let me know...
讨论(0)
加载中...
- 热议问题