Changing Leaflet map according to input without redrawing (multiple polygons)

Question

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.

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.

My sample data:

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

This code works

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

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.

Many thanks!

Answer 1

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

Answer 2

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$map variable 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 renderPlot and 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.

Answer 3

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 leafletjs code and then using the setShapeStyle function. 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)
})