I would like to ask is there a way how to set xend and yend from geom_segment arguments in leaflet`s addPolylines function?
insted of explaining I rather provide reproduceble example since it is mut easire to see rather than explain:
library(leaflet)
library(spdep)
library(ggplot2)
URL <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_DEU_1_sp.rds"
data <- readRDS(url(URL))
cns <- knearneigh(coordinates(data), k = 1, longlat = T)
scnsn <- knn2nb(cns, row.names = NULL, sym = T)
cns
scnsn
cS <- nb2listw(scnsn)
# Plotting results
plot(data)
plot(cS, coordinates(data), add = T)
# Plotting in ggplot
# Converting to data.frame
data_df <- data.frame(coordinates(data))
colnames(data_df) <- c("long", "lat")
n = length(attributes(cS$neighbours)$region.id)
DA = data.frame(
from = rep(1:n,sapply(cS$neighbours,length)),
to = unlist(cS$neighbours),
weight = unlist(cS$weights)
)
DA = cbind(DA, data_df[DA$from,], data_df[DA$to,])
colnames(DA)[4:7] = c("long","lat","long_to","lat_to")
ggplot(data, aes(x = long, y =lat))+
geom_polygon(aes(group = group), color = "black", fill = FALSE)+
geom_point(data = data_df, aes(x= long, y = lat), size = 1)+
geom_segment(data = DA, aes(xend = long_to, yend = lat_to), size=0.5, color = "red")
# Plotting in leaflet
leaflet() %>% addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=data, weight = 0.8, fill = F, color = "red") %>%
addPolylines(data=DA, lng = DA$long_to, lat = DA$lat_to, weight = 0.85)
It can be seen then result in leaflet are not right (Spatial Map is different) how ever plots in basic plot and ggplot are how things should look like,
Is there a way how to reproduce plots above in leaflet? Reading leaflet documentation did not help me
A possible workaround is to use the function addFlows() implemented in library(leaflet.minicharts).
leaflet() %>% addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=data, weight = 0.8, fill = F, color = "red") %>%
addFlows(lng0 = DA$long, lat0 = DA$lat,lng1 = DA$long_to, lat1 = DA$lat_to, dir = 1, maxThickness= 0.85)
Related
I have a choropleth map created using plotly::plot_geo. I would like to add labels on top of the map so that, for instance, over the location of Alabama on the map, it would say 'AL (68)', but for all states, as in the example below:
Can anyone tell me if there is a way to do this?
library(tidyverse)
library(plotly)
set.seed(1)
density <- sample(1:100, 50, replace = T)
g <- list(
scope = 'usa',
projection = list(type = 'albers usa'),
lakecolor = toRGB('white')
)
plot_geo() %>%
add_trace(
z = ~density, text = state.name, span = I(0),
locations = state.abb, locationmode = 'USA-states'
) %>%
layout(geo = g)
Using your example, this is possible with plotly::plot_ly()
set.seed(1)
density <- sample(1:100, 50, replace = T)
g <- list(
scope = 'usa',
projection = list(type = 'albers usa'),
lakecolor = toRGB('white')
)
plot_ly() %>%
layout(geo = g) %>%
add_trace(type = "choropleth", locationmode = 'USA-states',
locations = state.abb,
z = ~density, text = state.name,
color = ~density, autocolorscale = TRUE) %>%
add_trace(type = "scattergeo", locationmode = 'USA-states',
locations = state.abb, text = paste0(state.abb, "\n", density),
mode = "text",
textfont = list(color = rgb(0,0,0), size = 12))
Output is:
Still not sure how to do this with plotly::plot_geo(), but this solution does allow you to stay within the plotly family.
I don't think this is reasonably possible in R, at least for the time being. However, this is supported in python (see #r-beginners comment and https://plotly.com/python/text-and-annotations/).
I am showing a couple of examples of alternative approaches using ggplot and leaflet, but each presents considerable drawbacks if you are wedded to plotly. Mapbox appears to be another option, but I have never used it. Examples using all of these packages in the article that was already linked in the comments (https://plotly-r.com/maps.html).
Example dataset
library(sf)
set.seed(1)
nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
nc$density <- sample(1:100, nrow(nc), replace = T)
nc$lat <- st_coordinates(st_centroid(nc))[,"Y"]
nc$lon <- st_coordinates(st_centroid(nc))[,"X"]
Plot with ggplot (static)
library(ggplot2)
ggplot(nc) +
geom_sf(aes(fill = density)) +
geom_text(
aes(x = lon, y = lat),
label = paste0(nc$NAME, "\n", "(", nc$density, ")"),
check_overlap = TRUE) +
scale_fill_viridis_c() +
theme_void()
Plot with leaflet (interactive)
library(leaflet)
library(viridis)
pal <- colorNumeric(viridis_pal(option = "C")(2), domain = nc$density)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
setView(-80, 34.5, zoom = 6.2) %>%
addPolygons(
data = nc,
fillColor = ~pal(nc$density),
fillOpacity = 0.8,
weight = 0.2,
smoothFactor = 0.2,
popup = ~density) %>%
addLabelOnlyMarkers(
lng = nc$lon,
lat = nc$lat,
label = paste0(nc$NAME, "\n", "(", nc$density, ")"),
#label = "LABEL",
labelOptions = labelOptions(noHide = T, textOnly = TRUE)) %>%
addLegend(
pal = pal,
values = nc$density,
position = "bottomright",
title = "Density")
Using tmap in view-mode allows to reach nearly what you want (shapes are used via the urbnmapr package):
library(tidyverse)
library(tmap)
library(sf)
library(urbnmapr)
states <- get_urbn_map("states", sf = T) %>%
as.tibble() %>%
mutate(density = sample(1:100, 51, replace = T)) %>%
mutate(abbvAndDens = str_c(state_abbv, " (", density, ")")) %>%
st_as_sf()
tmap_mode("view")
tm_shape(states) +
tm_fill("density",
palette = "viridis",
style = "cont",
breaks = seq(0, 100, 20)) +
tm_borders(lwd = .5, col = "black") +
tm_text("abbvAndDens", size= .75, col = "black")
I am creating a map and then adding some cities on top of it, and I want to have multiple legend items.
So far I have this code:
library(tidyverse)
library(raster)
library(sf)
library(maptools)
#a location to add to the map
city <- tibble(y = c(47.7128),
x = c(74.0060))
city <- st_as_sf(city, coords = c("x", "y"), crs = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs +towgs84=0,0,0")
#world map to plot, along with a raster of distance from a point
data(wrld_simpl)
wrld_simpl_sf <- sf::st_as_sf(wrld_simpl)
r <- raster(wrld_simpl, res = 1)
wrld_r <- rasterize(wrld_simpl, r)
#
pt1 <- matrix(c(100,0), ncol = 2)
dist1 <- distanceFromPoints(r, pt1)
values(dist1)[values(dist1) > 5e6] <- NA
plot(dist1)
gplot_data <- function(x, maxpixels = 50000) {
x <- raster::sampleRegular(x, maxpixels, asRaster = TRUE)
coords <- raster::xyFromCell(x, seq_len(raster::ncell(x)))
## Extract values
dat <- utils::stack(as.data.frame(raster::getValues(x)))
names(dat) <- c('value', 'variable')
dat <- dplyr::as.tbl(data.frame(coords, dat))
if (!is.null(levels(x))) {
dat <- dplyr::left_join(dat, levels(x)[[1]],
by = c("value" = "ID"))
}
dat
}
gplot_dist1 <- gplot_data(dist1)
gplot_wrld_r <- gplot_data(wrld_r)
#plot data
ggplot() +
geom_sf(data = wrld_simpl_sf, fill = "grey20",
colour = "white", size = 0.2) +
geom_tile(data = gplot_dist1,
aes(x = x, y = y, fill = value)) +
scale_fill_gradient("Distance",
low = 'yellow', high = 'blue',
na.value = NA) +
geom_sf(data = city, fill = "red", color = "red", size = 3, shape = 21)
which returns:
This is all fine but now I just want to add the red point from geom_sf(data = city, fill = "red", color = "red", size = 3, shape = 21) to the legend with the caption "Cities".
You could use the scale_color_manual function. The way I understand (I found out about this today), it allows you to map colors to "levels" that then appear in the legend.
Changing your code to have the following does the trick.
geom_sf(data = city, fill = "red", aes(color = "Cities"), size = 3, shape = 21) +
scale_color_manual(values = c("Cities" = "red"))
This is the result
I am trying to create a new geom that will create a wind radii chart from hurricane data.
The data needed to run this came be generated from the following:
storm_observation <- data_frame(longitude = c(-89.6, -89.6, -89.6),
latitude = c(29.5, 29.5, 29.5),
wind_speed = c("34", "50", "64"),
ne = c(200, 120, 90),
nw = c(100, 75, 60),
se = c(200, 120, 90),
sw = c(150, 75, 60))
My code to create the new Geom is included below, but is throwing a strange error related to fontsize:
Error in check.length(gparname) : 'gpar' element 'fontsize' must not be length 0
I have attempted to include fontsize in the default_aes and gpar() functions, but it still resulted in the same error. Any help would be appreciated. NOTE: This requires tidyr, dplyr and geosphere packages.
GeomHurricane <- ggproto("GeomPolygon", Geom,
required_aes = c("x", "y", "r_ne", "r_se", "r_nw", "r_sw",
"fill", "colour"),
default_aes = aes(scale_radii = 0.8, alpha = 0.8, linetype = 1, size = 0.5),
draw_group = function(data, panel_scales, coord) {
## Create function for conditional mutation
mutate_cond <- function(.data, condition, ..., envir = parent.frame()) {
condition <- eval(substitute(condition), .data, envir)
.data[condition, ] <- .data[condition, ] %>% mutate(...)
.data
}
## Create df of bearings for later joining
bearingDF <- tibble::data_frame(bearing = c(360,1:90,90:180,180:270,270:360),
direction = rep(c("r_ne", "r_se", "r_sw", "r_nw"),
each = 91)) %>%
dplyr::bind_rows(tibble::data_frame(bearing = rep(0, 4),
direction = c("r_ne", "r_se", "r_sw", "r_nw")))
## Transform data in tidy format and combine with bearings
data <- data %>%
dplyr::select(x, y, r_ne, r_nw, r_se, r_sw, colour, fill,
PANEL, group, scale_radii, alpha, linetype,
size) %>%
tidyr::gather(direction, distance, -x, -y, -colour, -fill,
-PANEL, -group, -scale_radii, -alpha, -linetype,
-size) %>%
dplyr::mutate(distance = distance * 1852 * scale_radii) %>%
dplyr::left_join(bearingDF, by = "direction") %>%
mutate_cond(bearing == 0, distance = 0)
## Generate correct lat/lon for perimeter of polygons
data <- data %>%
dplyr::bind_cols(as.data.frame(geosphere::destPoint(as.matrix(data[,1:2]),
data$bearing,
data$distance))) %>%
dplyr::select(-x, -y) %>%
dplyr::rename(x = lon, y = lat)
## Coord transform and take first row
coords <- coord$transform(data, panel_scales)
first_row <- coords[1, , drop = FALSE]
grid::polygonGrob(
coords$x, coords$y,
default.units = "native",
gp = grid::gpar(
col = first_row$colour,
fill = scales::alpha(first_row$fill, first_row$alpha),
lwd = first_row$size * .pt,
lty = first_row$linetype
)
)
})
geom_hurricane <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity",
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) {
layer(geom = GeomHurricane, mapping = mapping, data = data, stat = stat,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...))}
Here is the code to create the map using the new geom:
get_map("Louisiana", zoom = 6, maptype = "toner-background", source = "stamen") %>%
ggmap(extent = "device") +
geom_hurricane(data = storm_observation,
aes(x = longitude, y = latitude,
r_ne = ne, r_se = se, r_nw = nw, r_sw = sw,
fill = wind_speed, color = wind_speed)) +
scale_color_manual(name = "Wind speed (kts)",
values = c("red", "orange", "yellow")) +
scale_fill_manual(name = "Wind speed (kts)",
values = c("red", "orange", "yellow"))
I figured it out. Had somehow forgotten to include draw_key = draw_key_polygon, once I added that back into the ggproto function everything worked.
Thanks!
Very much related to this question I am trying to plot some world regions, now using a Mercator projection, but keep getting into trouble when adding x and y limits:
ggplot(world, mapping = aes(x = long, y = lat, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_map(projection = "mercator", xlim = c(-125, -30), ylim = c(-60, 35))
Obviously not great. When I use coord_cartesian (as suggested here) to set the limits, I loose the Mercator projection:
ggplot(world, mapping = aes(x = long, y = lat, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_map(projection = "mercator") +
coord_cartesian(xlim = c(-125, -30), ylim = c(-60, 35))
When I use lims I get what I want for Latin America:
ggplot(world, mapping = aes(x = long, y = lat, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_map(projection = "mercator") +
lims(x = c(-125, -30), y = c(-60, 35))
Problem is, this approach does not always work, for example for Africa or Asia I start to get some crazy behaviour towards the plot border:
ggplot(world, mapping = aes(x = long, y = lat, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_map(projection = "mercator") +
lims(x = c(-20, 45), y = c(-50, 40))
# lims(x = c(40, 150), y = c(-10, 55))
A solution here could be to convert the lat/lon coordinates to "proper" web mercator coordinates (here I'm using epsg 3857, which is the "google" projection), and then plotting using those "new" coordinates.
Assuming that original coordinates are latlon wgs84 (epsg 4326), this can be achieved like this:
worldmerc <- SpatialPointsDataFrame(coords = data_frame(x = world$long, y = world$lat),
data = world, proj4string = CRS("+proj=longlat +datum=WGS84")) %>%
subset((lat < 90 & lat > -90)) %>% # needed because transform not defined at the poles !!!!
spTransform(CRS("+init=epsg:3857"))
worldmerc <- mutate(worldmerc#data, longmerc = coordinates(worldmerc)[,1], latmerc = coordinates(worldmerc)[,2])
Plotting the whole data gives you this (Note the use of coord_fixed to preserve aspect ratio !:
ggplot(worldmerc, mapping = aes(x = longmerc, y = latmerc, group = group)) +
geom_polygon(fill = "black", colour = "black") +coord_fixed()
Now, the problem is that to do subsetting you would now need to enter "map" coordinates instead than lat long, but also that can be tweaked:
#For South America
xlim = c(-125, -30)
ylim = c(-60, 35)
lims = SpatialPoints(coords = data_frame(x = xlim, y = ylim), proj4string = CRS("+proj=longlat +datum=WGS84"))%>%
spTransform(CRS("+init=epsg:3857"))
ggplot(worldmerc, mapping = aes(x = longmerc, y = latmerc, group = group)) +
geom_polygon(fill = "black", colour = "black")+
coord_fixed(xlim = coordinates(lims)[,1], ylim = coordinates(lims)[,2])
#for africa
xlim = c(-20,45)
ylim = c(-50,40)
lims = SpatialPoints(coords = data_frame(x = xlim, y = ylim), proj4string = CRS("+proj=longlat +datum=WGS84"))%>%
spTransform(CRS("+init=epsg:3857"))
ggplot(worldmerc, mapping = aes(x = longmerc, y = latmerc, group = group)) +
geom_polygon(fill = "black", colour = "black")+
coord_fixed(xlim = coordinates(lims)[,1], ylim = coordinates(lims)[,2])
As you can see, in both cases you get "correct" maps.
Now, last thing you may want to do is maybe have "lat/lon" coordinates on the axis. That's a bit of a hack but can be done like this:
library(magrittr)
xlim = c(-125, -30)
ylim = c(-60, 35)
# Get the coordinates of the limits in mercator projection
lims = SpatialPoints(coords = data_frame(x = xlim, y = ylim),
proj4string = CRS("+proj=longlat +datum=WGS84"))%>%
spTransform(CRS("+init=epsg:3857"))
# Create regular "grids" of latlon coordinates and find points
# within xlim/ylim - will be our labels
majgrid_wid_lat = 20
majgrid_wid_lon = 30
majbreaks_lon = data_frame(x=seq(-180, 180, majgrid_wid_lon)) %>%
filter(x >= xlim[1] & x <= xlim[2]) %>%
as.data.frame()
majbreaks_lat = data_frame(x=seq(-90, 90, majgrid_wid_lat)) %>%
filter(x >= ylim[1] & x <= ylim[2]) %>%
as.data.frame()
#Find corresponding mercator coordinates
mercbreaks_lat = SpatialPoints(coords = expand.grid(x = majbreaks_lon$x, y = majbreaks_lat$x), proj4string = CRS("+init=epsg:4326"))%>%
spTransform(CRS("+init=epsg:3857")) %>% coordinates() %>% extract(,2) %>% unique()
mercbreaks_lon = SpatialPoints(coords = expand.grid(x = majbreaks_lon$x, y = majbreaks_lat$x), proj4string = CRS("+init=epsg:4326"))%>%
spTransform(CRS("+init=epsg:3857")) %>% coordinates() %>% extract(,1) %>% unique()
# Plot using mercator coordinates, but latlon labels
ggplot(worldmerc, mapping = aes(x = longmerc, y = latmerc, group = group)) +
geom_polygon(fill = "black", colour = "black") +
coord_fixed(xlim = coordinates(lims)[,1], ylim = coordinates(lims)[,2])+
scale_x_continuous("lon", breaks = mercbreaks_lon, labels = signif(majbreaks_lon$x, 2)) +
scale_y_continuous("lat", breaks = mercbreaks_lat, labels = signif(majbreaks_lat$x,2))+theme_bw()
, which gives:
It's a bit convoluted and there could be better ways, but it does the trick, and could be easily transformed in a function.
HTH,
Lorenzo
I made this plot
With the following code.
library(XML)
library(ggplot2)
library(scales)
library(plyr)
library(maps)
unemp <-
readHTMLTable('http://www.bls.gov/web/laus/laumstrk.htm',
colClasses = c('character', 'character', 'numeric'))[[2]]
names(unemp) <- c('rank', 'region', 'rate')
unemp$region <- tolower(unemp$region)
us_state_map <- map_data('state')
map_data <- merge(unemp, us_state_map, by = 'region')
map_data <- arrange(map_data, order)
states <- data.frame(state.center, state.abb)
p1 <- ggplot(data = map_data, aes(x = long, y = lat, group = group))
p1 <- p1 + geom_polygon(aes(fill = cut_number(rate, 5)))
p1 <- p1 + geom_path(colour = 'gray', linestyle = 2)
p1 <- p1 + scale_fill_brewer('Unemployment Rate (Jan 2011)', palette = 'Set1')
p1 <- p1 + coord_map()
p1 <- p1 + geom_text(data = states, aes(x = x, y = y, label = state.abb, group = NULL), size = 2)
p1 <- p1 + theme_bw()
p1
Now I want to reproduce the same plot with leaflet R package.
library(leaflet)
leaflet(data = map_data) %>%
setView(lng = -77.0167, lat = 38.8833, zoom = 4) %>%
addTiles()
How can I annotate rate from map_data data.frame on the map with leaflet as geom_polygon did in ggplot2 version?
Maybe here's one way as a starting point:
mapStates = map("state", fill = TRUE, plot = FALSE)
rates <- cut_number(unemp$rate[match(sub("(.*?):.*", "\\1", mapStates$names), unemp$region)], 5)
leaflet(data = mapStates) %>% addTiles() %>%
addPolygons(fillColor = brewer_pal(palette = "Set1")(8)[as.numeric(rates)], stroke = FALSE) %>%
addLegend(colors = brewer_pal(palette = "Set1")(nlevels(rates)), labels = levels(rates), opacity = .2)
Add:
With regards to your other question:
library(raster)
pakistan.adm2.spdf <- getData("GADM", country = "Pakistan", level = 2)
rates <- cut_number(unemployment.df$unemployment[match(pakistan.adm2.spdf#data$NAME_2, unemployment.df$id)], 5)
leaflet(pakistan.adm2.spdf) %>% addTiles() %>%
addPolygons(fillColor = brewer_pal(palette = "PuRd")(nlevels(rates))[as.numeric(rates)], stroke = FALSE, fillOpacity = .6) %>%
addLegend(colors = brewer_pal(palette = "PuRd")(nlevels(rates)), labels = levels(rates), opacity = .6) %>%
setView(lng = 69.374268, lat = 30.028617, zoom = 5)