How to create a leaflet choropleth map of US counties - r

With the code below I get my dataframe with US county data
library(raster)
library(leaflet)
library(tidyverse)
# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)
### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
stringsAsFactors = FALSE)
My object is to crate an interactive leaflet choropleth map of Avg_yield so first I fortify my USA polygon data
library(rgeos)
library(maptools)
library(ggplot2)
states.shp.f <- fortify(USA, region = "NAME_2")
Then I subset my dataset and merge it with the fortified:
mydata2<-mydata[,c("COUNTY_NAME","Avg_yield")]
colnames(mydata2)[1]<-"id"
## merge shape file with data
merge.shp.coef <- merge(states.shp.f, mydata2, by = "id")
but now I have a dataset with every county name many times and also some counties have different values of Avg_yield. Whats the proper way to process those data in order to use the leaflet code like:
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(data = USA, stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(mydata$Avg_yield),
popup = paste("Region: ", USA$NAME_2, "<br>",
"Avg_yield: ", mydata$Avg_yield, "<br>")) %>%
addLegend(position = "bottomleft", pal = mypal, values = mydata$Avg_yield,
title = "Avg_yield",
opacity = 1)

The propoer way to do this is to transform your polygon object into a sf object
with st_as_sf()
Here you have a working example :
(I did used some other data for the polygon, I thought yours too precise and require a lot of resources, plus I made it work with shiny)
library(leaflet)
library(tidyverse)
library(ggplot2)
library(sf)
library(shiny)
USA <- st_read(dsn = '[your path]/cb_2018_us_county_500k.shp')
### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
stringsAsFactors = FALSE)
states_sf <- st_as_sf(USA)
mydata2<-mydata[,c("COUNTY_NAME","Avg_yield")]
colnames(mydata2)[1]<-"NAME"
## merge shape file with data
states_sf_coef <- left_join(states_sf, mydata2, by = "NAME")
ui <- fluidPage(
leafletOutput("map", height = "100vh")
)
server <- function(input, output, session) {
bins <- c(0, 5, 10, 15, 20, 25, 30, 35, 40)
mypal <- colorBin("YlOrRd", domain = states_sf_coef$Avg_yield, bins = bins)
#Sortie map
output$map <- renderLeaflet({
leaflet()%>%
addProviderTiles("OpenStreetMap.Mapnik")%>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(
data = states_sf_coef,
fillColor = ~mypal(states_sf_coef$Avg_yield),
stroke = FALSE,
smoothFactor = 0.2,
fillOpacity = 0.3,
popup = paste("Region: ", states_sf_coef$NAME_2, "<br>",
"Avg_yield: ", states_sf_coef$Avg_yield, "<br>"))%>%
addLegend(position = "bottomleft",
pal = mypal,
values = states_sf_coef$Avg_yield,
title = "Avg_yield",
opacity = 1)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

Related

Data mismatch between dataset and value in the leaflet map

I'm trying to create a choropleth map in county level using leaflet R package and I actually do it. But when I check my data file and the hover text of any county I find that the values are not correct. For example check the Conejos county. Any explanation? Or a better way to process tha data and create this map without the mismatches?
Code:
library(raster)
library(leaflet)
library(tidyverse)
# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)
### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
stringsAsFactors = FALSE) %>%
dplyr::select(COUNTY_NAME, Avg_yield)
### Check counties that exist in USA, but not in mydata
### Create a dummy data frame and bind it with mydata
mydata <- data.frame(COUNTY_NAME = setdiff(USA$NAME_2, mydata$COUNTY_NAME),
Avg_yield = NA,
stringsAsFactors = FALSE) %>%
bind_rows(mydata)
### Create a color palette
mypal <- colorNumeric(palette = "viridis", domain = mydata$Avg_yield)
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(data = USA, stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(mydata$Avg_yield),
popup = paste("Region: ", USA$NAME_2, "<br>",
"Avg_yield: ", mydata$Avg_yield, "<br>")) %>%
addLegend(position = "bottomleft", pal = mypal, values = mydata$Avg_yield,
title = "Avg_yield",
opacity = 1)

Rshiny : displaying chart when clicking on a polygon

I'm a Rshiny newbie very eager to learn but right now I'm facing an issue I cannot overcome alone and I would greatly appreciate if someone could help me out ! :)
My problem is (I guess) quite simple:
I have created a map with my polygons and I've managed to display some basic informations when I click on them (have a look on here) but I have no idea how to add a barplot (for example) below my map for each polygon I click.
Could someone help me on how doing that please ? (after hours and hours of attempts my eyesballs are really about to pop out of their sockets !!!)
Many thanks in advance !
Romain
My code:
library(shiny)
library(leaflet)
library(dplyr)
library(magrittr)
library(devtools)
library(RColorBrewer)
library(rgdal)
library(sp)
communes <- readOGR("G:/Ateliers/Projet/communes.shp")
commmunes#data
nom_commune INSEE Variable_1 Variable_2 Variable_3 area_sqkm
1 AUZEVILLE-TOLOSANE 31035 289 8.727212 9.336384 6.979758
2 CASTANET-TOLOSAN 31113 85 4.384877 8.891650 8.460724
3 LABEGE 31254 288 5.047406 2.031651 7.663404
4 PECHBUSQUE 31411 443 6.577743 8.120896 3.099422
5 RAMONVILLE-SAINT-AGNE 31446 95 2.601305 8.909278 6.236784
>
ui <- fluidPage(
leafletOutput("mymap"))
#### SERVEUR R #####
bins <- c(3,3.5,6,6.5,7,7.5,8,8.5)
pal <- colorBin("YlOrRd", domain = communes$area_sqkm, bins = bins)
labels <- sprintf(
"<strong>%s</strong><br/>%g km2",
communes$nom_commun, communes$area_sqkm
) %>% lapply(htmltools::HTML)
server <- function(input, output, session) {
output$mymap<-renderLeaflet(
leaflet(communes) %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE)
) %>%
setView(1.50, 43.54, zoom = 12) %>%
addTiles() %>%
addPolygons(fillColor = ~pal(area_sqkm),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(pal = pal, values = ~area_sqkm, opacity = 0.7, title = NULL,
position = "bottomright")
)
}
shinyApp(ui = ui, server=server)
The data I would like to display in my barplots are the variable 1,2 and 3 :
data <- read.csv("G:/Ateliers/Projet/communes.csv", sep=";")
data
nom_commune INSEE Variable_1 Variable_2 Variable_3 area_sqkm
1 AUZEVILLE-TOLOSANE 31035 289 8.727212 9.336384 6.979758
2 CASTANET-TOLOSAN 31113 85 4.384877 8.891650 8.460724
3 LABEGE 31254 288 5.047406 2.031651 7.663404
4 PECHBUSQUE 31411 443 6.577743 8.120896 3.099422
5 RAMONVILLE-SAINT-AGNE 31446 95 2.601305 8.909278 6.236784
>
Here is an example shiny app with other data, since I do not have access to your shape data for the map. I believe this might do what you need it to do and can be adapted for your needs.
I would create a reactiveVal to store the id of the polygon region that is clicked on (this variable stores input$mymap_shape_click$id). You data used in addPolygons should have an id to reference.
In your plot (or in a separate reactive expression), you can filter the data based on the reactiveVal containing the id.
library(shiny)
library(leaflet)
library(rgdal)
library(sf)
library(ggplot2)
library(tidyverse)
arcgis_data = st_read("http://data.phl.opendata.arcgis.com/datasets/bc2b2e8e356742568e43b0128c344d03_0.geojson")
arcgis_data$id <- 1:nrow(arcgis_data) ## Add an 'id' value to each shape
plot_data <- read.table(text =
"id nom_commune INSEE Variable_1 Variable_2 Variable_3 area_sqkm
1 AUZEVILLE-TOLOSANE 31035 289 8.727212 9.336384 6.979758
2 CASTANET-TOLOSAN 31113 85 4.384877 8.891650 8.460724
3 LABEGE 31254 288 5.047406 2.031651 7.663404
4 PECHBUSQUE 31411 443 6.577743 8.120896 3.099422
5 RAMONVILLE-SAINT-AGNE 31446 95 2.601305 8.909278 6.236784", header = T, stringsAsFactors = F
)
ui <- fluidPage(
leafletOutput(outputId = "mymap"),
plotOutput(outputId = "myplot")
)
server <- function(input, output){
## use reactive value to store the id from observing the shape click
rv <- reactiveVal()
output$mymap <- renderLeaflet({
leaflet() %>%
addPolygons(data = arcgis_data %>% slice(1:5), layerId = ~id) %>%
addProviderTiles("CartoDB.Positron")
})
observeEvent(input$mymap_shape_click, {
rv(input$mymap_shape_click$id)
})
## you can now plot your plot based on the id of region selected
output$myplot <- renderPlot({
plot_data %>%
filter(id == rv()) %>%
pivot_longer(cols = starts_with("Variable"), names_to = "Variable", values_to = "Value") %>%
ggplot(aes(x = Variable, y = Value)) +
geom_col()
})
}
shinyApp(ui, server)
Edit: For your uploaded data, you don't need to add a separate id for communes. Instead, you could match by name (nom_commune). You can use that in your layerId instead. This looks like it should work. I did take out some of the additional label information as this appeared to be missing from the .shp file I downloaded.
library(shiny)
library(leaflet)
library(rgdal)
library(sf)
library(ggplot2)
library(tidyverse)
communes <- readOGR("communes_ok.shp")
ui <- fluidPage(
leafletOutput(outputId = "mymap"),
plotOutput(outputId = "myplot")
)
server <- function(input, output){
## use reactive values to store the id from observing the shape click
rv <- reactiveVal()
output$mymap<-renderLeaflet(
leaflet(communes) %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE)) %>%
setView(1.50, 43.54, zoom = 12) %>%
addTiles() %>%
addPolygons(fillColor = "blue",
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.3,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
layerId = ~nm_cmmn)
)
observeEvent(input$mymap_shape_click, {
rv(input$mymap_shape_click$id)
})
## you can now 'output' your generated data however you want
output$myplot <- renderPlot({
if (is.null(rv())) return (NULL)
plot_data %>%
filter(nom_commune == rv()) %>%
pivot_longer(cols = starts_with("Variable"), names_to = "Variable", values_to = "Value") %>%
ggplot(aes(x = Variable, y = Value)) +
geom_col()
})
}
shinyApp(ui, server)

Missing polygons while using Leaflet in R

I'm trying to reproduce a code to display polygons in a map in another computer, however, in one computer the polygons are not shown. Does someone had this kind of problem while sharing code?
You can download the shapefile from here: http://www.conabio.gob.mx/informacion/metadata/gis/muni_2012gw.xml?_xsl=/db/metadata/xsl/fgdc_html.xsl&_indent=no
library(rgdal)
library(rgeos)
library(leaflet)
Mex <- readOGR(dsn="C:/DISCO D", layer="Muni_2012gw")
Mex_sub <- Mex[Mex$CVE_ENT=="01",]
bins <- quantile(Mex_sub#data$OID_1, c(0,.125,.25, .5, .75,.875, 1))
pal <- colorBin("YlOrRd", domain = Mex_sub#data$OID_1, bins = (bins),
na.color = "grey40", reverse = FALSE)
centr <- gCentroid(Mex_sub)#coords
leaflet(Mex_sub, options = leafletOptions(minZoom = 4, maxZoom = 15)) %>%
addTiles() %>%
setView(centr[1], centr[2], zoom = 8) %>%
addPolygons(data=Mex_sub, weight = 1,fill = ~OID_1, fillColor = ~pal(OID_1),
opacity=1, fillOpacity = 0.5, color=grey(0.5))

Merge csv and json file in Leaflet map - strange mistake

Folks, I have no idea what a heck is going on. I did enough leaflet maps before and never had such problem. Shocked a little bit.
Doing very simple stuff.
Cannot match .csv and .json file by a state...
# US Adult Obesity 2016
library(rgdal)
library(sp)
library(leaflet)
library(geojsonio)
library(RColorBrewer)
library(dplyr)
# Set working directory
setwd("C:/~/App US Adult Obesity")
# Read csv
obesity <- read.csv("US Adult Obesity.csv", header = TRUE)
# Read geojson file
states <- geojson_read("gz_2010_us_040_00_500k.json", what = "sp")
View(states)
# Match data
obesity.map.2016 <- merge(states, obesity, by.x = "NAME", by.y = "State")
class(obesity.map.2016)
View(obesity.map.2016)
# Create a palette
obesity$Year.2016 <- as.numeric(as.character(obesity$Year.2016))
pal <- colorBin("Reds", c(22, 38), na.color = "#808080")
#, alpha = FALSE, reverse = FALSE)
# Create a popup
state_popup <- paste0("<strong>State: </strong>",
obesity$state,
"<br><strong>% of adult obesity in 2016: </strong>",
obesity$Year.2016)
# Create a map
leaflet(obesity.map.2016) %>%
addProviderTiles(providers$Stamen.TonerLite) %>%
setView(lng = -98.583, lat = 39.833, zoom = 4) %>%
addPolygons(color = "#444444", weight = 1,
# opacity = 0.5,
fillOpacity = 0.7,
fillColor = ~pal(obesity$Year.2016),
popup = state_popup) %>%
addLegend("bottomright", pal = pal, values = ~obesity$Year.2016,
opacity = 1,
title = "US Adult Obesity in 2016 by State")
As a result, I have Minnesota data in California. View shows that it does not match, I have 50 states + DC.
I cannot believe that I forgot how to do it.
Any hints about my stupid mistake?
Resolved personally. It looks like I screwed up with values, using them not from df, but from csv.
# US Adult Obesity 2016
library(rgdal)
library(sp)
library(leaflet)
library(geojsonio)
# Set working directory
setwd("C:/~US Adult Obesity")
# Read csv, which was created specifically
obesity <- read.csv("US Adult Obesity.csv", header = TRUE)
# Read geojson file
states <- geojson_read("gz_2010_us_040_00_500k.json", what = "sp")
# View(states)
# Shape file - cb_2016_us_state_500k.shp
# states <- readOGR(dsn = "C:/DC/IFC/My Shiny apps/App US Adult Obesity",
# layer = "cb_2016_us_state_500k",
# encoding = "UTF-8", verbose = FALSE)
# Match data
obesity.map.2016 <- merge(states, obesity, by = "NAME")
class(obesity.map.2016)
View(obesity.map.2016)
# Create a palette
obesity.map.2016$Year.2016 <- as.numeric(as.character(obesity.map.2016
$Year.2016))
pal <- colorBin("Reds", c(22, 38), na.color = "#808080")
#, alpha = FALSE, reverse = FALSE)
# Create a popup
state_popup <- paste0("<strong>State: </strong>",
obesity.map.2016$NAME,
"<br><strong>% of adult obesity in 2016: </strong>",
obesity.map.2016$Year.2016)
# Create a map
leaflet(obesity.map.2016) %>%
addProviderTiles(providers$Stamen.TonerLite) %>%
setView(lng = -98.583, lat = 39.833, zoom = 4) %>%
addPolygons(color = "#444444", weight = 1,
# opacity = 0.5,
fillOpacity = 0.7,
fillColor = ~pal(obesity.map.2016$Year.2016),
popup = state_popup) %>%
addLegend("bottomright", pal = pal, values = ~obesity.map.2016$Year.2016,
opacity = 1,
title = "US Adult Obesity in 2016 by State (%)")

Shiny: how to plot several parameters on the same leaflet map?

I'm new to shiny. I want to make a shiny app that shows the spatial distribution of different parameters. I used meuse dataset from sp package.
Here is the code I used
library(sp)
library(rgdal)
library(ggmap)
library(leaflet)
library(dplyr)
library(shiny)
ui <- fluidPage(
mainPanel(
titlePanel("Copper (ppm)"),
leafletOutput("copper"),
titlePanel("Lead (ppm)"),
leafletOutput("lead"),
titlePanel("Zinc (ppm)"),
leafletOutput("zinc")
)
)
server <- function(input,output){
output$copper <- renderLeaflet({
data(meuse)
coordinates(meuse) <- 1:2
proj4string(meuse) <- CRS("+init=epsg:28992")
meuse <- spTransform(meuse, CRS("+proj=longlat +datum=WGS84"))
meuse_df <- as.data.frame(meuse)
leaflet(meuse_df) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~copper/10,
stroke = FALSE,
fillOpacity = 0.4,
group = "meuse_df",
popup = ~as.character(copper)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap",
"Esri.WorldImagery"),
overlayGroups = "meuse_df")
})
output$lead <- renderLeaflet({
leaflet(meuse_df) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~lead/50,
stroke = FALSE,
fillOpacity = 0.4,
group = "meuse_df",
popup = ~as.character(lead)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap",
"Esri.WorldImagery"),
overlayGroups = "meuse_df")
})
output$zinc <- renderLeaflet({
leaflet(meuse_df) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~zinc/100,
stroke = FALSE,
fillOpacity = 0.4,
group = "meuse_df",
popup = ~as.character(zinc)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap",
"Esri.WorldImagery"),
overlayGroups = "meuse_df")
})
}
shinyApp(ui = ui, server = server)
and here is the result I got
I wonder if there is a way to plot all parameters (copper, lead and zinc) on one map. Any suggestions would be appreciated.
UPDATE
Thanks to #Symbolix's answer and suggestion of using checkBoxGroupInput. Instead, I used addCircleMarkers three times so I can plot all the metals on one map and I can switch them on and off
ui <- fluidPage(
mainPanel(
titlePanel("All metals (ppm)"),
leafletOutput("metals")
)
)
server <- function(input,output){
output$metals <- renderLeaflet({
data(meuse)
coordinates(meuse) <- 1:2
proj4string(meuse) <- CRS("+init=epsg:28992")
meuse <- spTransform(meuse, CRS("+proj=longlat +datum=WGS84"))
meuse_df <- as.data.frame(meuse)
leaflet(meuse_df) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~copper/10,
color ="red",
stroke = FALSE,
fillOpacity = 0.4,
group = "copper",
popup = ~as.character(copper)) %>%
addCircleMarkers(~x,
~y,
radius = ~lead/50,
color ="gren",
stroke = FALSE,
fillOpacity = 0.4,
group = "lead",
popup = ~as.character(lead)) %>%
addCircleMarkers(~x,
~y,
radius = ~zinc/100,
color ="blue",
stroke = FALSE,
fillOpacity = 0.4,
group = "zinc",
popup = ~as.character(zinc)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap",
"Esri.WorldImagery"),
overlayGroups = c("copper",
"lead",
"zinc"))
})
}
shinyApp(ui = ui, server = server)
Melt your data so that your metals are in one column and you're good to go.
Here I use library(reshape2) to do the melt.
library(sp)
library(rgdal)
library(ggmap)
library(leaflet)
library(dplyr)
library(shiny)
library(reshape2)
ui <- fluidPage(
mainPanel(
titlePanel("Metals"),
leafletOutput("all_metals")
)
)
server <- function(input,output){
output$all_metals <- renderLeaflet({
data(meuse)
coordinates(meuse) <- 1:2
proj4string(meuse) <- CRS("+init=epsg:28992")
meuse <- spTransform(meuse, CRS("+proj=longlat +datum=WGS84"))
meuse_df <- as.data.frame(meuse)
## melt df so 'metals' are in one column
## using 'reshape2' library
meuse_melt <- melt(meuse_df, measure.vars = c("copper","lead","zinc"), variable.name = "metal")
## specify factor levels for colours
meuse_melt$metal <- factor(sample.int(5L, nrow(meuse_melt), TRUE))
factpal <- colorFactor(topo.colors(5), meuse_melt$metal)
## now you just need one output
leaflet(meuse_melt) %>%
addProviderTiles("OpenStreetMap", group = "OpenStreetMap") %>%
addProviderTiles("Esri.WorldImagery", group = "Esri.WorldImagery") %>%
addCircleMarkers(~x,
~y,
radius = ~value/100,
stroke = FALSE,
fillOpacity = 0.4,
group = "meuse_melt",
popup = ~metal,
color= ~factpal(metal)) %>%
addLayersControl(position = "bottomleft",
baseGroups = c("OpenStreetMap", "Esri.WorldImagery"), overlayGroups = "meuse_melt")
})
}
shinyApp(ui = ui, server = server)
To save you lines of code you could use mapview which provides multi-layer maps out of the box. If you only want certain attributes you can simply supply their names (or column numbers) to the 'zcol' argument. Alternatively, you can use 'burst = TRUE' to display all layers/columns present in the attribute table.
library(mapview)
library(sp)
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
mapview(meuse, zcol = c("copper", "lead", "zinc"))
## all layers
mapview(meuse, burst = TRUE)
mapview can be used with renderLeaflet.

Resources