Leaflet popup graphs don't correspond to map - r

I am trying to make a choropleth map as an html widget using the leaflet package. I don't want to deal with shiny for this. I have covid death time series data for each state. I would like to be able to click on states and have the corresponding time series graph to popup. I have gotten so close but my problem is that the graphs that popup when you click on a state do not correctly correspond to that state. For example, if you click on Ohio a West virginia map pops up.
Shapefile data: https://www.census.gov/cgi-bin/geo/shapefiles/index.php?year=2019&layergroup=States+%28and+equivalent%29
Covid data: https://data.cdc.gov/Case-Surveillance/United-States-COVID-19-Cases-and-Deaths-by-State-o/9mfq-cb36
library(tidyverse)
library(lubridate)
library(readr)
library(leaflet)
library(tigris)
library(rgdal)
library(leafpop)
states <- readOGR(dsn = "tl_2019_us_state", layer = "tl_2019_us_state")
covid_deaths<- read_csv("covid_deaths_usafacts.csv")
Clean_Deaths<- covid_deaths%>%
select(submission_date, state, tot_cases,new_case,tot_death,new_death)%>%
filter(new_death>=0)%>%
mutate(submission_date=as.Date(Clean_Deaths$submission_date, "%m/%d/%Y"))
my_list <- list()
loop<-for (i in unique(Clean_Deaths$state)) {
state<-Clean_Deaths%>% filter(state==i)
plot<-ggplot(state, aes(x = submission_date, y = new_death)) +
geom_line()+scale_x_date(date_breaks = "1 month",date_labels = "%b")+labs(title = i)
my_list[[i]] <- plot
}
m1 <- leaflet() %>%
addTiles() %>%
setView(lng = -120.5, lat = 44, zoom = 6)%>%
addPolygons(data = states,
fillColor = "red",
fillOpacity = 0.6,
color = "darkgrey",
weight = 1.5,
popup = popupGraph(my_list)
)
m1

I think you have abbreviations for state in Clean_Deaths$state (e.g., "NY") and you have full state names in states$NAME (e.g., "New York").
In your filter, you can convert from one to other. Your for loop can go through states$NAME which will match your data used in your map:
for (i in states$NAME) {
state<-Clean_Deaths%>% filter(state==state.abb[match(i, state.name)])
plot<-ggplot(state, aes(x = submission_date, y = new_death)) +
geom_line()+scale_x_date(date_breaks = "1 month",date_labels = "%b")+labs(title = i)
my_list[[i]] <- plot
}
Here is something comparable using lapply and simplified:
my_list <- lapply(states$NAME, function(i) {
Clean_Deaths %>%
filter(state == state.abb[match(i, state.name)]) %>%
ggplot(aes(x = submission_date, y = new_death)) +
geom_line() +
scale_x_date(date_breaks = "1 month",date_labels = "%b") +
labs(title = i)
})
As an aside, your mutate before this does not need the data frame referenced in the pipe:
mutate(submission_date=as.Date(submission_date, "%m/%d/%Y"))
Let me know if this addresses your problem.

Related

Merge and plot multiple isochrones

What I like to do
I like to plot isochrones from multiple locations on a map so I can visually find the travel time from an arbitrary town to the closest location. It should look like a kernel density 2D plot:
library(purrr)
library(ggmap)
locations <- tibble::tribble(
~city, ~lon, ~lat,
"Hamburg", 9.992246, 53.550354,
"Berlin", 13.408163, 52.518527,
"Rostock", 12.140776, 54.088581
)
data <- map2_dfr(locations$lon, locations$lat, ~ data.frame(lon = rnorm(10000, .x, 0.8),
lat = rnorm(10000, .y, 0.7)))
ger <- c(left = min(locations$lon) - 1, bottom = min(locations$lat) - 1,
right = max(locations$lon) + 1, top = max(locations$lat) + 1)
get_stamenmap(ger, zoom = 7, maptype = "toner-lite") %>%
ggmap() +
stat_density_2d(data = data, aes(x= lon, y = lat, fill = ..level.., alpha = ..level..),
geom = "polygon") +
scale_fill_distiller(palette = "Blues", direction = 1, guide = FALSE) +
scale_alpha_continuous(range = c(0.1,0.3), guide = FALSE)
What I tried
You can easily get isochrones via osrm and plot them with leaflet. However, these isochrones are independent from each other. When I plot them they overlap each other.
library(osrm)
library(leaflet)
library(purrr)
library(ggmap)
locations <- tibble::tribble(
~city, ~lon, ~lat,
"Hamburg", 9.992246, 53.550354,
"Berlin", 13.408163, 52.518527,
"Rostock", 12.140776, 54.088581
)
isochrone <- map2(locations$lon, locations$lat,
~ osrmIsochrone(loc = c(.x, .y),
breaks = seq(0, 120, 30))) %>%
do.call(what = rbind)
isochrone#data$drive_times <- factor(paste(isochrone#data$min, "bis",
isochrone#data$max, "Minuten"))
factpal <- colorFactor("Blues", isochrone#data$drive_times, reverse = TRUE)
leaflet() %>%
setView(mean(locations$lon), mean(locations$lat), zoom = 7) %>%
addProviderTiles("Stamen.TonerLite") %>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",
fillColor = ~factpal(isochrone#data$drive_times),
weight = 0.5, fillOpacity = 0.6,
data = isochrone, popup = isochrone#data$drive_times,
group = "Drive Time") %>%
addLegend("bottomright", pal = factpal, values = isochrone#data$drive_time,
title = "Fahrtzeit")
How can I merge these isochrone so that they don't overlap?
Really cool question. What you want to do is merge the shapes by ID, so all the 0-30 minute areas are one shape, all the 30-60 minute areas are another, and so on. There are ways to do this with other spatial packages, but it seems well-suited to sf, which uses dplyr-style functions.
After you create isochrone, you can convert it to a sf object, make the same type of distance label, group by ID, and call summarise. The default when you summarize sf objects is just a spatial union, so you don't need to supply a function there.
library(sf)
library(dplyr)
iso_sf <- st_as_sf(isochrone)
iso_union <- iso_sf %>%
mutate(label = paste(min, max, sep = "-")) %>%
group_by(id, label) %>%
summarise()
I didn't have leaflet handy, so here's just the default print method:
plot(iso_union["label"], pal = RColorBrewer::brewer.pal(4, "Blues"))
I'm not sure what's up with the areas that have abrupt vertical edges, but those are in your plot as well.
I had a hard time using the map2 method you used because it does both a union as well as, I think, another set theory like function to create specific intervals. Instead, I would recommend creating a raster layer of the layers you create and apply one opacity to that one raster, like the ggmap example does. There's an excellent blog post that I stole alot of code from here (along with from user:camille).
It uses a different API that requires mapbox but it is free. Another limitation is that it won't return isocrones that are the size you like but I recreated it in another location where three points are closer together to prove the method.
I also didn't bother vectorizing the process of creating the isocrone web request so I leave that to someone smarter.
# First be sure to get your mapbox token
library(fasterize)
library(sf)
library(mapboxapi)
library(leaflet)
#mapboxapi::mb_access_token("Go get the token and put it here",
# install = TRUE, overwrite = TRUE)
isos1 <- mb_isochrone(
location = c("-149.883234, 61.185765"),
profile = "driving",
time = c(5,10,15),
)
isos2 <- mb_isochrone(
location = c("-149.928200, 61.191227"),
profile = "driving",
time = c(5,10,15),
)
isos3 <- mb_isochrone(
location = c("-149.939484, 61.160192"),
profile = "driving",
time = c(5,10,15),
)
library(sf)
library(dplyr)
isocrones <- rbind(isos1,isos2,isos3)
iso_sf <- st_as_sf(isocrones)
iso_union <- iso_sf %>%
group_by(time) %>%
summarise()
isos_proj <- st_transform(iso_sf, 32615)
template <- raster(isos_proj, resolution = 100)
iso_surface <- fasterize(isos_proj, template, field = "time", fun = "min")
pal <- colorNumeric("viridis", isos_proj$time, na.color = "transparent")
leaflet() %>%
addTiles() %>%
addRasterImage(iso_surface, colors = pal, opacity = 0.5) %>%
addLegend(values = isos_proj$time, pal = pal,
title = "Minutes of Travel") %>%
addMarkers(lat = c(61.185765, 61.191227, 61.160192), lng = c(-149.883234, -149.928200, -149.939484))

Difficulty in customising cartogram output in R Studio

I am able to produce a cartogram using cartogram::cartogram_cont() But then have difficulty in customising the styling.
I have used broom::tidy() and dplyr::left_join() to fortify the cartogram, but I think perhaps the tidy stage has interfered with the plotOrder. If possible, I will include the output cartograms.
I'm attempting to replicate this type of output, but within my locality. Plesae note that the dataset used for the weighting in cartogram_cont() is not particularly significant, just a proof of concept at this stage:
[R Graph Gallery][1]
[1]: https://www.r-graph-gallery.com/331-basic-cartogram/
Shapefile from: [Lle Shapefile Location][2]
[2]: http://lle.gov.wales/catalogue/item/LocalAuthorities/?lang=en
library(dplyr)
library(leaflet)
library(maptools)
library(cartogram)
library(devtools)
install_github("HanOostdijk/odataR" , build_vignettes = T)
library(odataR)
library(tidyr)
library(rgdal)
library(htmltools)
#Read in shapefile and transform shape
#dsn = folder name, layer = filename but drop the .shp
shapefile <- readOGR(dsn = "Wales Shapefile",
layer = "localauthoritiesPolygon") %>%
#Transform coordinate referencing system
spTransform(CRS("+init=epsg:4326"))
#Next step is to join an interesting dataset to the shapefile using dplyr, then pass this to the cartoram package to render.
#Gone for the teacher sickness dataset from Stats Wales. Noticed it's only up to 2017, wonder if they've stopped collecting.
teacher_sickness_data <- odataR_query('http://open.statswales.gov.wales/dataset/schw0001')
#Check values for join.
categories <- unique(teacher_sickness_data$Area_ItemName_ENG)
categories_shp <- shapefile#data$name_en
categories
categories_shp
#Teacher data has "All Welsh local authorities". Not contained in shapefile so remove.
UA_sickness_data <- teacher_sickness_data[-c(2, 4:6, 8, 9, 11:13, 15:17)] %>%
filter(Area_ItemName_ENG != "All Welsh local authorities")
#Perform join to shapefile
shapefile_1 <- shapefile %>%
merge(UA_sickness_data, by.x = "name_en", by.y = "Area_ItemName_ENG",
duplicateGeoms = TRUE)
#Shiny App will allow choice of inputs to achieve one row per polygon. However, for testing
#functionality with cartograph functions, perform test filtering.
data_filtered <- UA_sickness_data %>%
filter(Year_ItemName_ENG == 2017) %>%
filter(Type_ItemName_ENG == "Full-time") %>%
filter(Variable_ItemName_ENG == "Total days of sick leave")
test_merge <- shapefile %>%
merge(data_filtered, by.x = "name_en", by.y = "Area_ItemName_ENG")
nc_pal <- colorNumeric(palette = "Reds",
domain = log(test_merge#data$Data))
m <-test_merge %>%
leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addPolygons(weight = 1,
color = ~nc_pal(log(Data)),
label = ~name_en,
highlight = highlightOptions(weight = 3,
color = "crimson",
bringToFront = TRUE),
popup = ~ paste0(Variable_ItemName_ENG, "<br/>",
"<b/>",
Data))
m
wales_cart <- cartogram_cont(test_merge, "Data", itermax=5)
plot(wales_cart)
[![Wales_Cartogram][3]][3]
[3]: https://i.stack.imgur.com/2tsMC.png
library(tidyverse)
library(ggmap)
library(broom)
library(rgeos) #used for gBuffer
#Buffer allows to tidy cartogram based on factor of choice.
wales_cart_buffered <- gBuffer(wales_cart, byid=TRUE, width=0)
#tidy cartogram in order to pass to ggplot
spdf_fortified_wales <- tidy(wales_cart_buffered, region = "name_en")
#Now perform a join based on english UA names
spdf_fortified_wales_joined <- spdf_fortified_wales %>%
left_join(. , wales_cart#data, by=c("id"="name_en"))
ggplot() +
geom_polygon(data = spdf_fortified_wales_joined, aes(fill = Data, x = long, y = lat, group = "name_en") , size=0, alpha=0.9) +
coord_map() +
theme_void()
[![incorrect_ggplot][4]][4]
[4]: https://i.stack.imgur.com/as0Z4.png
ggplot() +
geom_polygon(data = spdf_fortified_wales_joined, aes(fill = Data, x = long, y = lat, group = "name_en") , size=0, alpha=0.9) +
coord_map() +
theme_void()
Success Criteria: Polygons are rendered correctly distorted and colour scale reflects weighting variable.

how can I stop ggploty() adding lines between map points?

I'm using plotly package to convert my ggmap into HTML. However, after I apply ggplotly(), there are lines produced between map points. My df looks like:
df <- data.frame("Name" = c("A", "A", "A", "B","B"),
"lat" = c(42.04614, 40.14664, 37.63910, 29.73602, 33.97907),
"lng" = c(-88.03842, -82.98982, -122.41923, -95.58586, -84.21856))
And my code is:
map <- get_map(location = 'united states', zoom = 4, source = "google", color = "bw")
p <- ggmap(map)
p <- p + geom_point(data = df, aes(x=lng, y=lat, group = Name, colour = Name))
plotly <- ggplotly(p)
With out ggplotly(), my map is:
And after apply ggplotly(), my map turns to be :
How can I stop that? Any help would be appreciated!
If you are open to other libraraies.
Here is an approach using leaflet.
Leaflet is an interactive approach to looking at maps, you can also add popups to the map which are accessed by clicking on the circles.
library(leaflet)
library(RColorBrewer)
mapper1 <- leaflet(df) %>%
addTiles() %>%
setView(lng=-95.7129, lat=37.0902, zoom=4)
pal = colorFactor(c("red","blue"), domain = df$Name)
color_incident = pal(df$Name)
mpop <- mapper1 %>% addCircles(data = df, lat=~lat, lng= ~lng, color=color_incident) %>% addLegend(pal=pal, values=~df$Name, title="Names")

Plotting small multiples with a for loop in R

I'm trying to plot a map small multiples grid that shows hurricanes/tropical storms that have intersected with Florida since 1900. I used some spatial queries to subset the database of all Atlantic storms for this project.
I'm now plotting a line shapefile of my limited number of hurricane tracks on top of polygons of the state of Florida, some contiguous states, a few major cities in Florida and, of course, Lake Okeechobee. Here's the simple code:
library(maptools)
library(gdata)
library(RColorBrewer)
setwd("~/hurricanes")
# read shapefiles
florida <- readShapePoly("florida.shp")
south <- readShapePoly("south.shp")
hurricanes <- readShapeLines("hurricanes-florida.shp")
cities <- readShapePoints("cities.shp")
lakes <- readShapePoly("lakes.shp")
# miami, orlando and tallahassee (in FL)
cities <- subset(cities, ST == "FL")
# don't need ALL the 'canes
hurricanes1900 <- subset(hurricanes, Season >= 1900)
mycolors <- brewer.pal(5, "YlOrRd")
pdf(file = "hurricanemaps.pdf", ,width=8,height=20)
par(mfrow=c(15,5), mar=c(1,1,1,1))
for(i in 1:nrow(hurricanes1900))
{
plot(south, col="#e6e6e6", border = "#999999")
plot(florida, col="#999999", border = "#999999", add = TRUE)
plot(lakes, col="#ffffff", border = "#999999", add = TRUE)
plot(cities, pch=10, cex=.1,col="#000000", bg="#e38d2c", lwd=1, add = TRUE)
plot(hurricanes1900[i,], col = mycolors[cut(hurricanes$MAX_Wind_W, breaks = 5)],
lwd=3, add = TRUE); title(hurricanes1900$Title[i])
}
dev.off()
Three big issues I'm encountering:
1) The loop is giving me a map of each storm. I would prefer to have the code produce a Florida/South map in the grid for each year (even on those years without storms) and all the storms for that year, preferably with labels.
2) I would like to set the colors for wind speed among ALL the storms, not just those in each particular row of the loop. That way strong storms (like Andrew in 1992) show as darker even when they are the only storm of the year. Perhaps I can solve this my recoding a categorical (H1, H2, etc) variable that can be styled accordingly.
3) Assuming I can figure out No. 1, I'm having trouble getting labels to render on each storm path. The maptools documentation isn't great.
Anyway, here's the output so far (the title is a concatenation of two fields in the shapefile):
The real issue is No. 1. Thanks in advance for your help.
Given there is no reproducible data, I collected some data for this demonstration. Please provide a minimal reproducible data for SO users from next time. That will help you receive more help.
What you want to achieve can be done with ggplot2. If you want to draw a map for each year, you can use facet_wrap(). If you want to add colors based on wind, you can do that in aes() when you draw paths. If you want to add hurricanes' names, you can use the ggrepel package, which allows you to provide annotations with an ease. Note that, if you want to draw smooth paths, you further need data process.
library(stringi)
library(tibble)
library(raster)
library(ggplot2)
library(ggthemes)
library(ggrepel)
library(RColorBrewer)
library(data.table)
# Get some data. Credit to hmbrmstr for a few lines in the following code.
mylist <- c("http://weather.unisys.com/hurricane/atlantic/2007H/BARRY/track.dat",
"http://weather.unisys.com/hurricane/atlantic/2007H/TEN/track.dat",
"http://weather.unisys.com/hurricane/atlantic/2006H/ERNESTO/track.dat",
"http://weather.unisys.com/hurricane/atlantic/2006H/ALBERTO/track.dat")
temp <- rbindlist(
lapply(mylist, function(x){
foo <- readLines(x)
foo <- read.table(textConnection(gsub("TROPICAL ", "TROPICAL_",
foo[3:length(foo)])),
header=TRUE, stringsAsFactors=FALSE)
year <- stri_extract_first(str = x, regex = "[0-9]+")
name <- stri_extract_first(str = x, regex = "[A-Z]{2,}")
cbind(foo, year, name)
}
))
### Add a fake row for 2017
temp <- temp %>%
add_row(ADV = NA, LAT = NA, LON = NA, TIME = NA, WIND = NA,
PR = NA, STAT = NA, year = 2017, name = NA)
### Prepare a map
usa <- getData('GADM', country = "usa", level = 1)
mymap <- subset(usa, NAME_1 %in% c("Florida", "Arkansas", "Louisiana",
"Alabama", "Georgia", "Tennessee",
"Mississippi",
"North Carolina", "South Carolina"))
mymap <- fortify(mymap)
# Create a data.table for labeling hurricanes later.
label <- temp[, .SD[1], by = name][complete.cases(name)]
g <- ggplot() +
geom_map(data = mymap, map = mymap,
aes(x = long, y = lat, group = group, map_id = id),
color = "black", size = 0.2, fill = "white") +
geom_path(data = temp, aes(x = LON, y = LAT, group = name, color = WIND), size = 1) +
scale_color_gradientn(colours = rev(brewer.pal(5, "Spectral")), name = "Wind (mph)") +
facet_wrap(~ year) +
coord_map() +
theme_map() +
geom_text_repel(data = label,
aes(x = LON, y = LAT, label = name),
size = 2,
force = 1,
max.iter = 2e3,
nudge_x = 1,
nudge_y = -1) +
theme(legend.position = "right")

How to map an Indian state with districts in r?

I want to plot different states of India with respective districts in R software. I have tried using GADM, level 2 data to get the coordinates.
I have followed this thread Mapping just one State of India and writing its name inside the state boundary. However, I am unable to subset the data for any state and use it for mapping.
What I've tried:
map <- fortify(Karnataka)
map$id <- as.integer(map$id)
dat <- data.frame(id = 216:242, district = Karnataka)
map_df <- inner_join(map, dat, by = "id")
centers <- data.frame(gCentroid(Karnataka, byid = TRUE))
centers$state <- dat$district
I could map a state with its district borders by using following commands.
India <- getData("GADM", country = "India", level = 2)
Karnataka <- subset(India, NAME_1 == "Karnataka")
map <- fortify(Karnataka);
map$id <- as.integer(map$id);
dat <- data.frame(id = 216:242, district = Karnataka#data$NAME_2);
map_df <- inner_join(map, dat, by = "id");
centers <- data.frame(gCentroid(Karnataka, byid = TRUE));
centers$state <- dat$district;
ggplot() +
geom_map(data = map_df, map = map_df,
aes(map_id = id, x = long, y = lat, group = group),
color = "#ffffff", fill = "#bbbbbb", size = 0.25) +
geom_text(data = centers, aes(label = state, x = x, y = y), size = 2) +
coord_map() + labs(x = "", y = "", title = "Districts of Karnataka")
You can do this beautifully and easily with Google Maps in R. Within ggmap there are a lot of options. The examples below are very basic but it's fully customizable by setting the options however you like them.
map <- qmap('Karnataka', zoom = 7, maptype = 'hybrid')
map
library(ggmap)
qmap('Karnataka')

Resources