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")
Related
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.
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))
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.
I'm trying to color Arizona, Utah, and Idaho by different colors. Ideally I'd use a color gradient to color them by a variable I choose. But I can't seem to find any other information on the web about doing this.
This is the code I have so far:
library(ggplot2)
ggplot(data = azutid) +
geom_polygon(aes(x = long, y = lat, group = group), fill = "green", color = "black") +
coord_fixed(1.3) +
guides(fill = FALSE)
I imported the map and regions from the basic "maps" package. Thanks!
It can be done easily through the use of leaflet package. Although you will have to download the census data from
https://www.census.gov/geo/maps-data/data/cbf/cbf_state.html
You can also add costum popups and highlight on hover labels to the map.
library(leaflet)
library(spdplyr)
library(rgdal)
states <- readOGR(dsn = "./cb_2016_us_state_20m/cb_2016_us_state_20m.shp",
layer = "cb_2016_us_state_20m", verbose = FALSE)
group1 <- c("AZ","UT","ID")
newobj <- states %>%
filter(as.character(STUSPS) %in% group1)
m <- leaflet(newobj) %>%
setView(-96, 37.8, 4) %>% addProviderTiles("CartoDB.Positron")
pal = colorQuantile("YlOrRd", domain = newobj$value, n=7)
m %>% addPolygons(fillColor = "orange",
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7)
I want to draw a map of Australia and represent each city as a dot.
Then highlight the cities with a high population (>1M)
library(sp)
library(maps)
data(canada.cities)
head(canada.cities)
I have checked the sp package where this can be done for Canada and some other countries. But Australia details are not there. Is there a special way to get the data for a country we like (name of cities, long, lat, pop)?
Now you have the data using world.cities, you can plot them a few ways
library(maps)
df <- world.cities[world.cities$country.etc == "Australia",]
Basic plot of points
plot(df[, c("long", "lat")])
on a ggmap
library(ggmap)
myMap <- get_map(location = "Australia", zoom = 4)
ggmap(myMap) +
geom_point(data = df[, c("long","lat", "pop")], aes(x=long, y = lat, colour = pop > 1000000))
On a leaflet map
library(leaflet)
## define a palette for hte colour
pal <- colorNumeric(palette = "YlOrRd",
domain = df$pop)
leaflet(data = df) %>%
addTiles() %>%
addCircleMarkers(lat = ~lat, lng = ~long, popup = ~name,
color = ~pal(pop), stroke = FALSE, fillOpacity = 0.6) %>%
addLegend(position = "bottomleft", pal = pal, values = ~pop)