Shiny leaflet map - filtering by years in different columns

leaflet

#1

First, I have a perfect solution here how to create a Shiny leaflet map and filters based on rows.

Now I want to show a very similar map, where filters are applied to columns. Stumbled a little bit.

I want to create a map of US adult smoking by year, highlighting % with different colors.

Data in .csv format is here

Shapefiles are here

Currently, my map looks like this

This is my code:

# Set directory
setwd("C:/DC/R/Shiny/US Adult Smoking by State")

# Upload packages
library(rgdal)
library(sp)
library(leaflet)
library(shinythemes)
library(shiny)

# Read dataset
smoking <- read.csv("US adult smoking by state1.csv", header = TRUE)

# Leaflet map
states <- readOGR(dsn = "C:/DC/R/Cool datasets/US smoking", layer = 
"cb_2016_us_state_500k", 
          encoding = "UTF-8", verbose = FALSE)

# Merge data
# require(sp)! For spatial dataframe!
smoking.df <- merge(states, smoking, by.x = "NAME", by.y = "state")
class(smoking.df)

# Create palette
pal <- colorBin("Reds", c(0, 30), na.color = "#808080",
        alpha = FALSE, reverse = FALSE)


# UI
ui <- shinyUI(fluidPage(theme = shinytheme("united"),
                titlePanel(HTML("<h1><center><font size=14> US Adult 
Smoking by State in 2015-2017</font></center></h1>")), 
                sidebarLayout(
                  sidebarPanel(
                    selectInput("stateInput", label = h3("State"),
                                choices = c("Choose state",
                                            "Alabama",
                                            "Alaska",
                                            "Arizona",
                                            "Arkansas",
                                            "California",
                                            "Colorado",
                                            "Connecticut",
                                            "Delaware",
                                            "Florida",
                                            "Georgia",
                                            "Hawaii",
                                            "Idaho",
                                            "Illinois",
                                            "Indiana",
                                            "Iowa",
                                            "Kansas",
                                            "Kentucky",
                                            "Louisiana",
                                            "Maine",
                                            "Maryland",
                                            "Massachusetts",
                                            "Michigan",
                                            "Minnesota",
                                            "Mississippi",
                                            "Missouri",
                                            "Montana",
                                            "Nebraska",
                                            "Nevada",
                                            "New Hampshire",
                                            "New Jersey",
                                            "New Mexico",
                                            "New York",
                                            "North Carolina",
                                            "North Dakota",
                                            "Ohio",
                                            "Oklahoma",
                                            "Oregon",
                                            "Pennsylvania",
                                            "Rhode Island",
                                            "South Carolina",
                                            "South Dakota",
                                            "Tennessee",
                                            "Texas",
                                            "Utah",
                                            "Vermont",
                                            "Virginia",
                                            "Washington",
                                            "West Virginia",
                                            "Wisconsin",
                                            "Wyoming"
                                            ),
                                selected = "Choose state"),
                    selectInput("stateInput", label = h3("State"),
                                choices = c("Choose year",
                                            "2015",
                                            "2016",
                                            "2017"),
                                selected = "Choose year")),
                  mainPanel(leafletOutput(outputId = 'map', height = 
 800) 
                      ))
                ))



 # SERVER
 server <- shinyServer(function(input, output) {
 output$map <- renderLeaflet({
 leaflet(smoking.df) %>% 
 addProviderTiles(providers$Stamen.TonerLite) %>% 
 setView(lng = -98.583, lat = 39.833, zoom = 4) #%>% 

 })
# observers

# selected state
selectedState <- reactive({
smoking.df[smoking.df$NAME == input$stateInput, ] 
})

observe({
state_popup <- paste0("<strong>State: </strong>", 
                  selectedState()$NAME, 
                  "<br><strong>% of smoking adults in 2015: </strong>",
                  selectedState()$adult_smoking_2015,
                  "<br><strong>% of smoking adults in 2016: </strong>",
                  selectedState()$adult_smoking_2016,
                  "<br><strong>% of smoking adults in 2017: </strong>",
                  selectedState()$adult_smoking_2017)

  leafletProxy("map", data = selectedState()) %>%
  clearShapes() %>%
  addPolygons(fillColor = "orange",
          popup = state_popup,
          color = "#BDBDC3",
          fillOpacity = 0.8,
          weight = 1)
 })

# selected year
selectedYear <- reactive({
smoking.df[smoking.df$adult_smoking_2015 == input$yearInput &
       smoking.df$adult_smoking_2016 == input$yearInput &
       smoking.df$adult_smoking_2017 == input$yearInput,] 
})

observe({
state_popup1 <- paste0("<strong>State: </strong>", 
                  selectedState()$NAME)

leafletProxy("map", data = selectedYear()) %>%
clearShapes() %>%
addPolygons(fillColor = ~pal(selectedYear()$yearInput),
          popup = state_popup1,
          color = "#BDBDC3",
          fillOpacity = 0.8,
          weight = 1)
 })


 })


# Run app! 
shinyApp(ui = ui, server = server)

So, my assumption that I am screwing up with inputYear, and also with the color palette in leaflet map. Years are in columns and it is a little bit difficult for me now to understand where is my mistake.

Super grateful for all hints. Hopefully, my question will also help other people.

My desirable outcome, which I created just in leaflet (without Shiny) below. I want to change year in a filter and receive the change on a map.


#2

It’s not clear what’s the desired output :question:

What do you want your state selection to achieve ? Just showing a popup on the selected state ? Or overlaying this state, in orange, and letting the others state still colored according to the selected year ?

Do you really need a state selection ?
As for the year input, the easiest solution would be to create a mapData column in your smoking.df, this mapData column being updated to the selected year inside an observe.

But first, a little clarification of the desired interaction would be usefull :slight_smile:


#3

I haven’t tried running your code yet, but you have your selectInput call for selecting the year with the same id as your selectInput for the state in your ui. You then call a non-existent input (input$yearInput) in your server code. This could be why the data would not be filtered as expected.


#4

I agree with RCura. The desired output is not clear enough, but i made a try and it is working. i don’t know if that is what you are trying to accomplish, but i think the shapefile is a bit heavy for the app.

Here is the code (both .csv & .shp were placed in the working directory) :

# Upload packages
library(rgdal)
library(sp)
library(leaflet)

library(shinythemes)
library(shiny)

# Read dataset
smoking <- read.csv("US adult smoking by state1.csv", header = TRUE)

# Leaflet map
states <- readOGR(dsn = ".", layer = 
                    "cb_2016_us_state_500k", 
                  encoding = "UTF-8", verbose = FALSE)

# Merge data
# require(sp)! For spatial dataframe!
smoking.df <- merge(states, smoking, by.x = "NAME", by.y = "state")


# UI
ui <- shinyUI(fluidPage(theme = shinytheme("united"),
                        titlePanel(HTML("<h1><center><font size=14> US Adult 
                                        Smoking by State in 2015-2017</font></center></h1>")), 
                        sidebarLayout(
                          sidebarPanel(
                            selectizeInput(
                              "stateInput", 'State', choices = "", multiple = FALSE,
                              options = list(
                                placeholder = 'Please select a state from below')
                            )
                            ,
                            selectInput("yearInput", label = h3("Year"),
                                        choices = c("2015",
                                                    "2016",
                                                    "2017"))),
                          mainPanel(leafletOutput(outputId = 'map', height = 
                                                    800) 
                          ))
                        ))


# SERVER
server <- shinyServer(function(input, output, session) {
 
  updateSelectizeInput(session, "stateInput", choices = smoking.df$NAME,
                       server = TRUE)
  # selected state
  selectedState <- reactive({
    smoking.df[smoking.df$NAME == input$stateInput, ] 
  })
  # selected year
  selectedYear <- reactive({switch(input$yearInput, 
                                   "2015"=smoking.df$adult_smoking_2015, 
                                   "2016"=smoking.df$adult_smoking_2016, 
                                   "2017"=smoking.df$adult_smoking_2017)
                          })
  pal2 <- colorNumeric(palette = "Greens", domain=NULL)
  
  output$map <- renderLeaflet({
    leaflet(smoking.df) %>% 
      addProviderTiles(providers$Stamen.TonerLite) %>% 
      setView(lng = -98.583, lat = 39.833, zoom = 4) %>%
      addPolygons(data = smoking.df ,fillColor = ~pal2(selectedYear()),
                                    popup = paste0("<strong>State: </strong>", 
                                                    selectedState()$NAME),
                                    color = "#BDBDC3",
                                    fillOpacity = 0.8,
                                    weight = 1)
    
  })
  
 observeEvent(input$stateInput, {
    state_popup <- paste0("<strong>State: </strong>", 
                          selectedState()$NAME, 
                          "<br><strong>% of smoking adults in 2015: </strong>",
                          selectedState()$adult_smoking_2015,
                          "<br><strong>% of smoking adults in 2016: </strong>",
                          selectedState()$adult_smoking_2016,
                          "<br><strong>% of smoking adults in 2017: </strong>",
                          selectedState()$adult_smoking_2017)
    
    leafletProxy("map", data = selectedState()) %>%
      clearGroup(c("st.ate")) %>%
      addPolygons(group ="st.ate",fillColor = "orange",
                  popup = state_popup,
                  color = "#BDBDC3",
                  fillOpacity = 0.8,
                  weight = 5)
  })
  
})

# Run app! 
shinyApp(ui = ui, server = server)

#5

Dear @RCura, thanks for your time and response. I need to pick states because I want to show them separately. I would prefer to show the state independently, just orange, while other states remain unselected and white.


#6

Dear @tbradley, thanks for your response. It is really helpful, I am pretty new to Shiny.


#7

Dear @veegpap, many thanks! Almost perfect! :slight_smile: I think geojson may be a solution for this, I used it in another map and it was much faster. I will try it.
Ideally, I would like to have a separate choice of state with orange highlight and separately map for the each year (as you created).
Again, many thanks.
P.S. One more slight problem - when I pick a year and state together, for all green states I have popup with the name of the selected state. But I think I may fix it.


#8

Sorry about that. Easy fix, replace output map in the server side with this :

output$map <- renderLeaflet({
    leaflet(smoking.df) %>% 
      addProviderTiles(providers$Stamen.TonerLite) %>% 
      setView(lng = -98.583, lat = 39.833, zoom = 4) %>%
      addPolygons(data = smoking.df ,fillColor = ~pal2(selectedYear()),
                                    popup = paste0("<strong>State: </strong>", 
                                                    smoking.df$NAME),
                                    color = "#BDBDC3",
                                    fillOpacity = 0.8,
                                    weight = 1)

#9

Dear @veegpap, many thanks again, I also fixed it :). Many thanks again, I will try to add geojson file today and let you know how it goes.


#10

@veegpap, so I just substituted shapefile with geojson one

library(geojsonio)

states <- geojson_read("gz_2010_us_040_00_500k.json",what = "sp")

It makes the map faster while switching between years. Instead of 5 sec - only 2. :slight_smile:

The only final problem - map still remains gray, and I faced this problem before.


#11

@Oleksiy, on my machine the app works like a charm and it’s way faster than the shapefile. I didn’t change anything except the substitute of the .shp.
R version 3.4.1 (2017-06-30) Platform: x86_64-pc-linux-gnu (64-bit) Running under: Ubuntu 16.04.3 LTS


#12

Very good to know. Many thanks again!