Making a Shiny leaflet map reactive (multiple filters)

1,019 views
Skip to first unread message

Oleksiy

unread,
Sep 14, 2017, 3:15:53 PM9/14/17
to shinyapps.io Users

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!

Joshua Spiewak

unread,
Sep 14, 2017, 3:21:37 PM9/14/17
to shinyapps.io Users
Try posting on the shiny-discuss group for general Shiny questions. This group focuses on hosting Shiny applications on shinyapps.io.
Reply all
Reply to author
Forward
0 new messages