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)
Related
I draw a map in which points are represented as polygons. The points are found close to a southern state border. The code is:
library(leaflet)
library(sf)
long <- c( 4.676119175, 4.53172103 , 4.939782877, 5.074127987, 5.072757119)
lat <- c(51.477299959, 51.589766239, 51.624436295, 51.520707997, 51.631483055)
labs <- c("A", "B", "C", "D", "E")
colors <- rainbow(length(labs))
df <- data.frame(ID = labs, X = long, Y = lat)
points <- st_geometry(st_as_sf(df, coords = c("X", "Y")))
points0 <- st_set_crs(points, 4326)
area <- rnaturalearth::ne_countries(country = c('netherlands'), scale = 'large', returnclass = 'sf')
polys <- points %>% st_union() %>% st_voronoi() %>% st_cast() %>% st_set_crs(., 4326)
polys <- polys[unlist(st_intersects(points0, polys))] %>% st_intersection(y = area)
leaflet() %>%
addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
addPolygons (data = polys,
fillColor = colors,
fillOpacity = 1,
weight = 0.5,
color = "black") %>%
addCircleMarkers(lng = long,
lat = lat,
label = labs,
color = "black",
radius = 5,
weight = 1,
fill = TRUE,
fillColor = colors,
fillOpacity = 1)
The results looks like this:
The problem is that the polygons get stretched out to the north way to much. This may be solved by setting a bounding box, but I would prefer to solve this by setting a maximum size (or radius) for the polygons. How exactly can I set the maximum radius?
I suggest adding another call of sf::st_intersection() with an object of buffered points.
You have two alternatives:
intersect with a buffer of a single lab - number C seems a good candidate, as it is placed in the middle
intersect with pairwise buffers of each lab; purrr:map2() will be your friend here for pairwise intersection
I find the results of a single intersection more visually pleasing, but this may be not the most important factor so make your own choice...
As a comment: my natural earth is a bit buggy at the moment, so I am using GISCO by Eurostat as a source of map of the Netherlands instead; in a high resolution because I really dig the tiny exclaves of Belgium...
library(leaflet)
library(rnaturalearth)
library(sf)
long <- c( 4.676119175, 4.53172103 , 4.939782877, 5.074127987, 5.072757119)
lat <- c(51.477299959, 51.589766239, 51.624436295, 51.520707997, 51.631483055)
labs <- c("A", "B", "C", "D", "E")
colors <- rainbow(length(labs))
points <- data.frame(ID = labs, X = long, Y = lat) %>%
st_as_sf(coords = c("X", "Y"), crs = 4326) %>%
mutate(ID = ordered(ID))
area <- giscoR::gisco_get_countries(country = "NL", resolution = "01") # my Natural Earth is buggy at the momemt
# intersection with a single buffer around C
polys <- points %>%
st_union() %>%
st_voronoi() %>%
st_cast() %>%
st_set_crs(., 4326) %>%
st_intersection(area) %>%
st_intersection(st_buffer(dplyr::filter(points, ID == "C"), units::as_units(30000, "m"))) %>%
st_as_sf() %>%
st_join(points) # add back labs id's
palette <- colorFactor(palette = colors,
domain = polys$ID)
leaflet(data = polys) %>%
addProviderTiles("Esri.WorldGrayCanvas") %>%
addPolygons(fillColor = ~palette(ID),
stroke = F) %>%
addCircleMarkers(data = points,
fillColor = ~palette(ID),
stroke = F,
fillOpacity = 1)
# intersection with pairwise buffers
polys <- points %>%
st_union() %>%
st_voronoi() %>%
st_cast() %>%
st_set_crs(., 4326) %>%
st_intersection(area) %>%
purrr::map2(st_geometry(st_buffer(points, units::as_units(30000, "m"))), st_intersection) %>%
st_as_sfc(crs = 4326) %>%
st_as_sf() %>%
st_join(points) # add back labs id's
mapview::mapview(polys)
I am making a voronoi map in R using the packages leaflet and sf as follows:
library(leaflet)
library(sf)
library(rnaturalearth)
library(rnaturalearthdata)
long <- c(4.35556 , 5.83745, 4.63683 , 6.06389, 6.41111, 5.639722)
lat <- c(52.00667, 53.09456, 52.38084 , 52.475 , 52.15917, 53.440278)
labs <- c("Delft" , "Grouw" , "Haarlem", "Hattem", "Lochem", "Hollum" )
colors <- c("red" , "orange", "yellow" , "green" , "blue" , "purple" )
df <- data.frame(ID = labs, X = long, Y = lat)
points <- st_geometry(st_as_sf(df, coords = c("X", "Y")))
points <- st_union(points)
NL <- ne_countries(country = c('netherlands'), scale = 'medium', returnclass = 'sf')
polys <- points %>%
st_voronoi() %>%
st_cast() %>%
st_set_crs(., 4326) %>%
st_intersection(y = NL)
leaflet() %>%
addProviderTiles(providers$OpenStreetMap.Mapnik) %>%
addPolygons (data = polys,
fillColor = colors,
fillOpacity = 1,
weight = 0.5,
color = "black") %>%
addCircleMarkers(lng = long,
lat = lat,
label = labs,
color = "black",
radius = 5,
weight = 1,
fill = TRUE,
fillColor = colors,
fillOpacity = 1)
In the resulting map the colors of the dots are correct, but the colors of the polygons are not correct. I guess something has changed in order of the locations in 'polys', but I am puzzled about this. Any suggestions how to solve this?
st_voronoi() indeed appears not to keep the order of input points in the resulting polygons. You may use st_intersects() to find out which polygon belongs to which point and reorder polys accordingly.
First store a copy of points before applying st_union() and set them the same CRS as polys will have, so thatst_intersects() works later on. I.e., insert this before the points <- st_union(points) line:
points0 <- st_set_crs(points, 4326)
Then, after creating polys, reorder them like this:
polys <- polys[unlist(st_intersects(points0, polys))]
If some point is located outside the area of Netherlands (as provided by ne_countries()) the matching of points to polygons has to be done before intersecting of polys and NL. So in the original code the polys <- points... will be replaced with:
polys <- points %>%
st_voronoi() %>%
st_cast() %>%
st_set_crs(., 4326)
polys <- polys[unlist(st_intersects(points0, polys))]
polys <- st_intersection(polys, NL)
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'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")
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)