rshinyr-leaflet
Shiny leaflet map - filtering data by columns, not rows
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(ggthemes)
library(rgdal)
library(sp)
library(leaflet)
library(shinythemes)
# 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.
My desirable outcome, which I created just in leaflet below. I want to change year in a filter and receive the change on a map.
Solution
Preliminary solution (not mine, from other smart people). Plus the shapefile was substituted with geojson one.
# Upload packages
library(rgdal)
library(sp)
library(leaflet)
library(geojsonio)
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)
states <- geojson_read("gz_2010_us_040_00_500k.json",what = "sp")
# 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("Choose year", "2015", #
Choose year was added!
"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 = "Reds", 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>",
smoking.df$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)
Current outputs:
Current problems:
Map is still slow with geojson, 2 seconds for changing years, it is redrawing.
Gray color is on a map without any picks. Any ideas?
Will keep you posted, will try to add one more filter.
- Turn dataframe with frequency into a frequency table for chi-square test
- Print result of a function in R
- dplyr is turning dates to doubles when mutating dataframe
- How to require user authentication in R Shiny before users see any part of the app using shinyauthr?
- Determine foreground / background colour in bslib app with dark/light mode
- R quanteda kwic not matching negative look behind pattern
- make ggplot legend correspond to geom type
- Preserve xy coordinates while using terra::extract with vector data
- Grepl with logical operator AND across multiple alphanumeric columns
- Newey-West error for multiple linear regressions
- Looping over variables in ggplot
- data.frame rows to a list
- Calculate svymean for variable within user-defined function called by mutate(), across(), with variable name as function parameter
- Dual axis graph, keep original scale
- creating a Instrument variable formula form formula object
- Create a straight edge between nodes if there is another node branching from the midpoint of the edge in DiagrammeR?
- Compose long character string in R across multiple lines but without functions or line breaks
- Using R Quarto to create PDF documents, how can I center code chunk output and add a background color?
- Create a gif from a series of Leaflet maps in R
- How to reduce vertical margin between rows in ggplot legend
- Importing a scatter plot from PDF into R
- How to remove background of images with the magick package?
- saveGIF() returns empty GIF
- Writing multiple images using Magick on R
- How to repair obscured blocks in a QR code image
- Join multiple rasters at specific locations, when the number of rasters is variable
- Creating animation (.gif) in R using .png files
- Forest plot images cut off on all sides
- R - select last 2 columns
- Why is step_cut from R's recipes package complaining about a factor in my data frame?