R: Create map with point markers rotated by attribute value - r

I want to create a map using sf and ggplot2 libraries in R and show point markers rotated by attribute value. Is there maybe a more simple way than doing it like this using geom_segment() and vector calculation using sin() and cos()?
# load necessary libraries
library(ggplot2)
library(sf)
# load csv data
photo_positions <- readr::read_csv("photos_hamburg.csv") |>
sf::st_as_sf(coords=c('X', 'Y'))
# transform degrees to radians for orientation values
photo_positions[['orientation_rad']] = photo_positions[['orientation']] * pi / 180
# define the arrow length in decimal degrees
arrow_length <- 0.001
# test plot
ggplot(data = photo_positions) +
# extract coordinates
stat_sf_coordinates() +
# draw arrows with orientation from attribute
geom_segment(stat = "sf_coordinates", mapping = aes(geometry = geometry, x = after_stat(x), y = after_stat(y), xend = after_stat(x) + arrow_length * sin(photo_positions[['orientation_rad']]), yend = after_stat(y) + arrow_length * cos(photo_positions[['orientation_rad']])), arrow = arrow(), size = 2, color = "turquoise") +
# draw circle markers
geom_sf(stat = "sf_coordinates", mapping = aes(geometry = geometry, x = after_stat(x), y = after_stat(y)), size = 4, shape = 21, fill = "white") +
# axis labels
xlab("Longitude") + ylab("Latitude") +
#map title
ggtitle("Photos in Hamburg")
I tested it in QGIS. Here's the result.
And here's the CSV data used (imaginary photo spots including orientation):
X,Y,name,orientation
9.991293,53.55456,"Alster view 2",59
9.992967,53.550898,"Rathaus view 2",219
9.995563,53.556932,"Alster view 1",201
9.992591,53.551986,"Rathaus view 1",177
9.995724,53.552775,"Alster view 3",338
Any recommendations are highly appreciated!
EDIT: OK, it seems to be an appropriate solution. My only question is now: How do I add those arrows as a map legend with a horizontal arrow as example?

Related

Unable to color lines by group on a circular dendogram using R/ggraph

I've created a circular dendogram using R and the ggraph package. I have my labels and nodes correctly colored by "group". However, I'm unsure how to color the lines by "colors" (my color column). Currently I can change the line color to a single color (e.g. "red"), though I can't color them dynamically by column "colors".
My code is based on code from the r-graph gallery website. As you can see from my datafiles, I've tried adding a "colors" column and then calling that in my ggraph call but that gives me the following error:
Error in `geom_edge_diagonal(colour = colors)`:
! Problem while setting up geom aesthetics.
ℹ Error occurred in the 1st layer.
Caused by error in `rep()`:
! attempt to replicate an object of type 'closure'
Here is my code:
library(ggraph)
library(igraph)
library(tidyverse)
library(RColorBrewer)
d1 = read.csv("~/data1.csv", sep=",")
d2 = read.csv("~/data2.csv", sep=",")
edges=rbind(d1, d2)
# create a vertices data.frame. One line per object of our hierarchy
vertices = data.frame(
name = unique(c(as.character(edges$from), as.character(edges$to))) ,
value = runif(78)
)
# Let's add a column with the group of each name. It will be useful later to color points
vertices$group = edges$from[ match( vertices$name, edges$to, edges$colors ) ]
#Let's add information concerning the label we are going to add: angle, horizontal adjustement and potential flip
#calculate the ANGLE of the labels
vertices$id=NA
myleaves=which(is.na( match(vertices$name, edges$from, edges$colors) ))
nleaves=length(myleaves)
vertices$id[ myleaves ] = seq(1:nleaves)
vertices$angle= 90 - 360 * vertices$id / nleaves
# calculate the alignment of labels: right or left
# If I am on the left part of the plot, my labels have currently an angle < -90
vertices$hjust<-ifelse( vertices$angle < -90, 1, 0)
# flip angle BY to make them readable
vertices$angle<-ifelse(vertices$angle < -90, vertices$angle+180, vertices$angle)
# Create a graph object
mygraph <- graph_from_data_frame( edges, vertices=vertices )
# Make the plot
ggraph(mygraph, layout = 'dendrogram', circular = TRUE) +
geom_edge_diagonal(colour=colors) +
scale_edge_colour_distiller(palette = "RdPu") +
geom_node_text(aes(x = x*1.12, y=y*1.12, filter = leaf, label=name, angle = angle, colour=group, hjust=hjust), size=6) +
geom_node_point(aes(filter = leaf, x = x*1.07, y=y*1.07, colour=group, alpha=.2, size=2)) +
scale_colour_manual(values= rep( brewer.pal(7,"Paired") , 30)) +
scale_size_continuous( range = c(0.1,17) ) +
theme_void() +
theme(
legend.position="none",
plot.margin=unit(c(0,0,0,0),"cm"),
) +
expand_limits(x = c(-1.3, 1.3), y = c(-1.3, 1.3))
Here are two minimal examples of the code used:
data1.csv
from,to,colors
origin,group1,color1
origin,group2,color1
origin,group3,color1
origin,group4,color2
origin,group5,color2
origin,group6,color3
origin,group7,color3
origin,group8,color4
origin,group9,color4
data2.csv
from,to,colors
group1,"test1",color1
group2,"test2",color1
group3,"test3",color1
group4,"test4",color2
group5,"test5",color2
group6,"test6",color3
group7,"test7",color3
group8,"test8",color4
group9,"test9",color4
I believe the following line is the one I need help with (inside my ggraph call):
geom_edge_diagonal(colour=colors) +
If it helps, my question is the same as asking how to color lines by group on the example code I used, taken from r-graph gallery.
Any help is appreciated.
The suggestion in my earlier comments, to use aes(), did solve for the error you had identified. You just realized you had yet another problem. We solve for that by changing from scale_edge_color_distiller to scale_edge_color_brewer as distiller is looking for a continuous variable.
Note, I've also set up so your data is reproducible. Consider using dput() in the future when you provide your data set to support question asked.
d1 <- tribble(
~from,~to,~colors,
"origin","group1","color1",
"origin","group2","color1",
"origin","group3","color1",
"origin","group4","color2",
"origin","group5","color2",
"origin","group6","color3",
"origin","group7","color3",
"origin","group8","color4",
"origin","group9","color4")
d2 <- tribble(
~from, ~to, ~colors,
"group1","test1","color1",
"group2","test2","color1",
"group3","test3","color1",
"group4","test4","color2",
"group5","test5","color2",
"group6","test6","color3",
"group7","test7","color3",
"group8","test8","color4",
"group9","test9","color4")
edges=rbind(d1, d2)
# create a vertices data.frame. One line per object of our hierarchy
vertices = data.frame(
name = unique(c(as.character(edges$from), as.character(edges$to))) ,
value = runif(19)
)
# Let's add a column with the group of each name. It will be useful later to color points
vertices$group = edges$from[ match( vertices$name, edges$to, edges$colors ) ]
#Let's add information concerning the label we are going to add: angle, horizontal adjustement and potential flip
#calculate the ANGLE of the labels
vertices$id=NA
myleaves=which(is.na( match(vertices$name, edges$from, edges$colors) ))
nleaves=length(myleaves)
vertices$id[ myleaves ] = seq(1:nleaves)
vertices$angle= 90 - 360 * vertices$id / nleaves
# calculate the alignment of labels: right or left
# If I am on the left part of the plot, my labels have currently an angle < -90
vertices$hjust<-ifelse( vertices$angle < -90, 1, 0)
# flip angle BY to make them readable
vertices$angle<-ifelse(vertices$angle < -90, vertices$angle+180, vertices$angle)
# Create a graph object
mygraph <- graph_from_data_frame( edges, vertices=vertices )
# Make the plot
ggraph(mygraph, layout = 'dendrogram', circular = TRUE) +
geom_edge_diagonal(aes(colour=colors)) +
#scale_edge_colour_distiller(palette = "RdPu") +
scale_edge_colour_brewer(palette = "RdPu") +
geom_node_text(aes(x = x*1.12, y=y*1.12, filter = leaf, label=name, angle = angle, colour=group, hjust=hjust), size=6) +
geom_node_point(aes(filter = leaf, x = x*1.07, y=y*1.07, colour=group, alpha=.2, size=2)) +
scale_colour_manual(values= rep( brewer.pal(7,"Paired") , 30)) +
scale_size_continuous( range = c(0.1,17) ) +
theme_void() +
theme(
legend.position="none",
plot.margin=unit(c(0,0,0,0),"cm"),
) +
expand_limits(x = c(-1.3, 1.3), y = c(-1.3, 1.3))

R: Hide geom_segment() if a certain condition is true?

I use geom_segment() from ggplot2 package in R, where the data attribute is a vector with two elements. The segment is an arrow. I want to hide the segment if one of the elements of the data vector equals 0. Is there a way to only plot the segment if a certain condition is true?
If an example is needed to understand what I mean, please let me know. My current use case is quite complex and requires some preparation to be shown here.
EDIT: Here's my reduced but working example, taken from this post and extended a little bit. I want the arrows not to show up when exposure_time is 0.
# load necessary libraries
library(ggplot2)
library(sf)
# load csv data
photo_positions <- readr::read_csv("photos_hamburg2.csv") |>
sf::st_as_sf(coords=c('X', 'Y'))
# transform degrees to radians for orientation values
photo_positions[['orientation_rad']] = photo_positions[['orientation']] * pi / 180
# define a length_factor
length_factor <- .2
# test plot
ggplot(data = photo_positions) +
# extract coordinates
stat_sf_coordinates() +
# draw arrows with orientation and length from attributes
geom_segment(
stat = "sf_coordinates",
mapping = aes(
geometry = geometry,
x = after_stat(x),
y = after_stat(y),
xend = after_stat(x) + photo_positions[['exposure_time']] * length_factor * sin(photo_positions[['orientation_rad']]),
yend = after_stat(y) + photo_positions[['exposure_time']] * length_factor * cos(photo_positions[['orientation_rad']])
),
arrow = arrow(),
size = 2,
color = "turquoise"
) +
# draw circle markers
geom_sf(stat = "sf_coordinates", mapping = aes(geometry = geometry, x = after_stat(x), y = after_stat(y)), size = 4, shape = 21, fill = "white") +
# axis labels
xlab("Longitude") + ylab("Latitude") +
#map title
ggtitle("Photos in Hamburg")
Not very realistic, but hopefully showing what I want to achieve. In my real use case I work with wind speeds and wind directions for different locations, but it was too complicated to reduce it to a suitable example.
CSV data used:
X,Y,name,orientation,exposure_time
9.991293,53.55456,"Alster view 2",59,0.004
9.992967,53.550898,"Rathaus view 2",219,0.008
9.995563,53.556932,"Alster view 1",201,0
9.992591,53.551986,"Rathaus view 1",177,0
9.995724,53.552775,"Alster view 3",338,0.016
Screenshot of the result (including arrows to be hidden)
Here's the solution with photo_positions <- photo_positions[photo_positions$'exposure_time' > 0,] from Jon Spring's comment included, based on the same CSV data as provided with the question.
# load necessary libraries
library(ggplot2)
library(sf)
# load csv data
photo_positions <- readr::read_csv("photos_hamburg2.csv") |>
sf::st_as_sf(coords=c('X', 'Y'))
# remove rows with zero values for exposure time data
photo_positions <- photo_positions[photo_positions$'exposure_time' > 0,]
# transform degrees to radians for orientation values
photo_positions[['orientation_rad']] = photo_positions[['orientation']] * pi / 180
# define a length_factor
length_factor <- .2
# test plot
ggplot(data = photo_positions) +
# extract coordinates
stat_sf_coordinates() +
# draw arrows with orientation and length from attributes
geom_segment(
stat = "sf_coordinates",
mapping = aes(
geometry = geometry,
x = after_stat(x),
y = after_stat(y),
xend = after_stat(x) + photo_positions[['exposure_time']] * length_factor * sin(photo_positions[['orientation_rad']]),
yend = after_stat(y) + photo_positions[['exposure_time']] * length_factor * cos(photo_positions[['orientation_rad']])
),
arrow = arrow(),
size = 2,
color = "turquoise"
) +
# draw circle markers
geom_sf(stat = "sf_coordinates", mapping = aes(geometry = geometry, x = after_stat(x), y = after_stat(y)), size = 4, shape = 21, fill = "white") +
# axis labels
xlab("Longitude") + ylab("Latitude") +
#map title
ggtitle("Photos in Hamburg")

Plotting Curved Lines on Polar Charts

I am trying to create a graph that plots points, labels, and lines that connect the points given a start and end position. Then transform it into a polar chart. I can plot the points, labels, and lines, but my issue is when I transform my chart into polar. I have used both geom_curve and geom_segment.
In using geom_curve I get an error because geom_curve is not implemented for non-linear coordinates. Therefore the furthest I can get is this:
In using geom_segment I get it closer to my desired effect, but it draws the lines along the cirlce's circumfrence, which makes sense given how I pass through the coordinates. Here is a photo:
I essentially need a geom_curve for polar coordinates, but I have been unable to find one. I would like the lines on the inside of the circle and curved, there will be some overlap but anyway suggestions it look nice with spacing or something would be welcomed.
Data:
k<-18
ct<-12
q<-6
x_vector1<-seq(1,k,1)
x_vector2<-seq(1,3,1)
x_vector3<-seq(k-2,k,1)
x_vector<-c(x_vector1,x_vector2,x_vector3)
n<-9 ## sets first level radius
radius1<-rep(n,k)
b<-13 ## sets second level radius
radius2<-rep(b,q)
radius<-c(radius1,radius2)
name<-c('Alice','Bob','Charlie','D','E','F','G','H','I','J','K','L',
'M','N','O','Peter','Quin','Roger','Alice2','Bob2','Charlie2',
'Peter2','Quin2','Roger2')
dframe<-data.frame(x_vector,radius,name)
dframe$label_radius<-dframe$radius+1
from<-c('Alice2','Bob','Charlie','D','E','Alice2','Charlie2','Charlie',
'I','J','K','L','M','N','O','Peter','Quin','Alice')
to<-c('Alice','Alice','Alice','Alice','Alice','Bob',
'Bob','Bob','Bob','Charlie','Charlie','Peter',
'Peter','Quin','Quin','Quin','Roger','Roger')
amt<-c(3,8,8,8,6,2,2,4,2,4,8,1,10,5,9,5,2,1)
linethick<-c(0.34,0.91,0.91,0.91,0.68,0.23,0.23,0.45,0.23,0.45,
0.91,0.11,1.14,0.57,1.02,0.57,0.23,0.11)
to_x<-c(1,1,1,1,1,2,2,2,2,3,3,16,16,17,17,17,18,18)
to_rad<-c(9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9)
from_x<-c(1,2,3,4,5,1,3,3,9,10,11,12,13,14,15,16,17,1)
from_rad<-c(13,9,9,9,9,13,13,9,9,9,9,9,9,9,9,9,9,9)
stats<-data.frame(from,to,amt,linethick,to_x,to_rad,from_x,from_rad)
p<-ggplot()+
geom_point(data=dframe,aes(x=x_vector,y=radius),size=3,shape=19)+
geom_text(data=dframe,aes(x=x_vector,y=label_radius,label=name))+
geom_segment(data=stats,aes(x=from_x,y=from_rad,xend=to_x,yend=to_rad, color=to), ## I need arrows starting at TO and going to FROM. ##
arrow=arrow(angle=15,ends='first',length=unit(0.03,'npc'), type='closed'))+
## transform into polar coordinates coord_polar(theta='x',start=0,direction=-1)
## sets up the scale to display from 0 to 7 scale_y_continuous(limits=c(0,14))+
## Used to 'push' the points so all 'k' show up. expand_limits(x=0) p
As others have commented, you can mimic the desired positions produced by coord_polar() by calculating them yourself, in Cartesian coordinates. I.e.:
x = radius * cos(theta)
y = radius * sin(theta)
# where theta is the angle in radians
Manipulate the 2 data frames:
dframe2 <- dframe %>%
mutate(x_vector = as.integer(factor(x_vector))) %>%
mutate(theta = x_vector / n_distinct(x_vector) * 2 * pi + pi / 2) %>%
mutate(x = radius * cos(theta),
y = radius * sin(theta),
y.label = label_radius * sin(theta),
name = as.character(name))
stats2 <- stats %>%
select(from, to, amt, linethick) %>%
mutate_at(vars(from, to), as.character) %>%
left_join(dframe2 %>% select(name, x, y),
by = c("from" = "name")) %>%
rename(x.start = x, y.start = y) %>%
left_join(dframe2 %>% select(name, x, y),
by = c("to" = "name")) %>%
rename(x.end = x, y.end = y)
Plot using geom_curve():
# standardize plot range in all directions
plot.range <- max(abs(c(dframe2$x, dframe2$y, dframe2$y.label))) * 1.1
p <- dframe2 %>%
ggplot(aes(x = x, y = y)) +
geom_point() +
geom_text(aes(y = y.label, label = name)) +
# use 2 geom_curve() layers with different curvatures, such that all segments align
# inwards inside the circle
geom_curve(data = stats2 %>% filter(x.start > 0),
aes(x = x.start, y = y.start,
xend = x.end, yend = y.end,
color = to),
curvature = -0.3,
arrow = arrow(angle=15, ends='first',
length=unit(0.03,'npc'),
type='closed')) +
geom_curve(data = stats2 %>% filter(x.start <= 0),
aes(x = x.start, y = y.start,
xend = x.end, yend = y.end,
color = to),
curvature = 0.3,
arrow = arrow(angle=15, ends='first',
length=unit(0.03,'npc'),
type='closed')) +
expand_limits(x = c(-plot.range, plot.range),
y = c(-plot.range, plot.range)) +
coord_equal() +
theme_void()
p
If you want polar grid lines, these can be mimicked as well using geom_spoke() and ggfortify package's geom_circle():
library(ggforce)
p +
geom_spoke(data = data.frame(x = 0,
y = 0,
angle = pi * seq(from = 0,
to = 2,
length.out = 9), # number of spokes + 1
radius = plot.range),
aes(x = x, y = y, angle = angle, radius = radius),
inherit.aes = FALSE,
color = "grey") +
geom_circle(data = data.frame(x0 = 0,
y0 = 0,
r = seq(from = 0,
to = plot.range,
length.out = 4)), # number of concentric circles + 1
aes(x0 = x0, y0 = y0, r = r),
inherit.aes = FALSE,
color = "grey", fill = NA)
(Note: If you really want these pseudo-grid lines, plot them before the other geom layers.)
Do yo have to do everything in ggplot2?
If not, then one option would be to create the plot with the points (potentially using ggplot2, or just straight grid graphics, maybe even base graphics), then push to the appropriate viewport and use xsplines to add curves between the points (see this answer: Is there a way to make nice "flow maps" or "line area" graphs in R? for a basic example of using xspline).
If you insist on doing everything using ggplot2 then you will probably need to create your own geom function that plots the curves in the polar coordinate plot.

How to draw directional spider network in geom_segment/ggplot2 in R?

I am trying to work out to draw so-called spider network or desire line which illustrates movement of things (person, vehicle, etc.) between specific zones by direction.
This is the data frame that I am using:
df <- data.frame(O=c(1,2,4,4,4,6,6,6,7,7,7,9,9,9,9,10,10,10,11,12,12,12,32,86,108,128,128,157,157,157,157,157),
D=c(2,1,6,7,32,4,7,157,4,6,157,10,11,12,157,9,12,157,9,9,10,157,4,128,128,86,108,6,7,9,10,12),
trip=c(971,971,416,621,330,416,620,1134,621,620,625,675,675,378,439,675,724,472,675,378,724,563,330,610,405,610,405,1134,625,439,472,563),
lon.x=c(697746.6,696929.6,696748.8,696748.8,696748.8,694906.4,694906.4,694906.4,696769.4,696769.4,696769.4,698802.2,698802.2,698802.2,698802.2,698900.5,698900.5,698900.5,699686.7,696822.0,696822.0,696822.0,698250.7,702314.7,700907.1,702839.5,702839.5,694518.9,694518.9,694518.9,694518.9,694518.9),
lat.x=c(9312405,9311051,9308338,9308338,9308338,9307087,9307087,9307087,9305947,9305947,9305947,9304338,9304338,9304338,9304338,9302314,9302314,9302314,9306300,9303080,9303080,9303080,9309423,9320738,9321302,9322619,9322619,9301921,9301921,9301921,9301921,9301921),
lon.y=c(696929.6,697746.6,694906.4,696769.4,698250.7,696748.8,696769.4,694518.9,696748.8,694906.4,694518.9,698900.5,699686.7,696822.0,694518.9,698802.2,696822.0,694518.9,698802.2,698802.2,698900.5,694518.9,696748.8,702839.5,702839.5,702314.7,700907.1,694906.4,696769.4,698802.2,698900.5,696822.0),
lat.y=c(9311051,9312405,9307087,9305947,9309423,9308338,9305947,9301921,9308338,9307087,9301921,9302314,9306300,9303080,9301921,9304338,9303080,9301921,9304338,9304338,9302314,9301921,9308338,9322619,9322619,9320738,9321302,9307087,9305947,9304338,9302314,9303080))
df contains following fields:
O: origin of trips
D: destination of trips
trip: number of trips between O and D
lon.x: longitude of origin zone
lat.x: lattitude of origin zone
lon.y: longitude of destination zone
lat.y: lattitude of destination zone
Currently I can draw following figure by the script here using geom_segment in ggplot2 package:
library(ggplot2)
ggplot() +
geom_segment(data = df, aes(x = lon.x, y = lat.x, xend = lon.y, yend = lat.y, size = trip),
color = "blue", alpha = 0.5, show.legend = TRUE,
position = position_dodge2(width = 100)) +
scale_size_continuous(range = c(0, 5), breaks = c(300, 600, 900, 1200),
limits = c(100, 1200), name = "Person trips/day (over 100 trips)") +
theme(legend.key = element_rect(colour = "transparent", fill = alpha("black", 0))) +
guides(size = guide_legend(override.aes = list(alpha = 1.0))) +
geom_point(data = df, aes(x = lon.x, y = lat.x), pch = 16, size = 2.4)
The issue is that each line from O to D and from D to O are overlapped. I would prefer to plot the segments which are dodged based on the center line to properly visualize total number of trips and to see the balance of trips between zone pairs.
An example of desired result is shown below.
Dotted center line is not necessarily displayed (I just put it to show what the balance is). It is also preferable to change color by direction, for instance, red in clockwise and blue in anti-clockwise direction. Arrows are not necessary if direction can be shown in color.
I found some examples to solve the issue, however I cannot reach desirable result at this moment.
Calculation of offset for coordinates
It is not so easy to set offset for each direction in this example as I have around 80 zones which results in 6,400 pairs of zones.
Offset geom_segment in ggplot
position_dodge2 function
It says that I can set margin between segments in width using variable, however if I use trip in it, it returns error. Also, it is not clear how much should I set the value for appropriate offset to make segments follow center lines.
https://ggplot2.tidyverse.org/reference/position_dodge.html
geom_curve and arrow
It is also possible to draw lines with curve so that above issue could be solved. However curved segments are messy to observe the movements in one figure. Arrows are also a bit difficult to see the direction as the shape of arrows are not sharp though I change its style.
color=variable and position=dodge
I also tried to spread/gather the df to get new variable direction and to delete OD-pairs in opposite direction so that I thought I can easily dodge segments using color=direction and position=dodge in ggplot2, however it did not work well (segments are still overlapped). Small example is shown below.
O D trip direction lon.x lat.x lon.y lat.y
1 2 971 clock 697746.6 9312405 696929.6 9311051
2 1 300 anticlock 696929.6 9311051 697746.6 9312405
4 6 416 clock 696748.8 9308338 694906.4 9307087
4 7 621 anticlock 694906.4 9307087 696748.8 9308338
I highly appreciate your idea to obtain well-designed figure.
Please also see the following figure to get actual usage of spider network.
You could use trig functions to calculate an offset value, then plug this into the ggplot() call. Below is an example using your dataset above. I'm not exactly sure what you mean by clockwise, so I put in a simple dummy variable.
# make a dummy "clockwise" variable for now
df$clockwise = df$O > df$D
# angle from coordinates of stations
df$angle = atan((df$lat.y - df$lat.x)/(df$lon.y - df$lon.x))
# offsets from cos/sin of orthogonal angle
# scale the distance of the offsets by the trip size so wider bars offset more
# offset them one way if the trip is clockwise, the other way if not clockwise
df$xoffset = cos(df$angle - pi/2) * df$trip/5 * (2 * df$clockwise - 1)
df$yoffset = sin(df$angle - pi/2) * df$trip/5 * (2 * df$clockwise - 1)
ggplot() +
geom_segment(data = df, aes(x = lon.x + xoffset, y = lat.x + yoffset, xend = lon.y + xoffset, yend = lat.y + yoffset, size = trip, color = clockwise),
alpha = 0.5, show.legend = TRUE) +
scale_size_continuous(range = c(0, 5), breaks = c(300, 600, 900, 1200),
limits = c(100, 1200), name = "Person trips/day (over 100 trips)") +
theme(legend.key = element_rect(colour = "transparent", fill = alpha("black", 0))) +
guides(size = guide_legend(override.aes = list(alpha = 1.0))) +
geom_point(data = df, aes(x = lon.x, y = lat.x), pch = 16, size = 2.4) +
coord_fixed()

Plot points outside grid as arrows pointing to data with ggplot2 in R

I am generating maps with world-scale data, and then zooming in to certain regions. On the zoomed-in view, I would like to show that there are other data points outside the bounding box, by putting arrowheads that point from the center of the box to where the data point is in the outside world.
Note: I do not need it to be a "great circle" path, just XY vectors in Mercator projection, because I imagine this will be useful for "normal" plots as well.
As an example, here is the world map showing the extent of the data:
And here is the zoomed in view, with magenta arrows manually added to show what I would like to generate.
Below is the code and data I am using to generate these two basic plots. What I need is a way to generate the arrowheads.
require(ggplot2)
te = structure(list(lat = c(33.7399, 32.8571, 50.2214, 36.96263, 33.5835,
33.54557, 47.76147, 48, 59.40289, 35.93411, 32.87962, 38.3241,
50.03844, 37.44, 50.07774, 50.26668, 36.5944), lng = c(-118.37608,
-117.25746, -5.3865, -122.00809, -117.86159, -117.79805, -124.45055,
-126, -146.35157, -122.931472, -117.25285, -123.07331, -5.26339,
25.4, -5.709894, -3.86828, -121.96201)), .Names = c("lat", "lng"
), class = "data.frame", row.names = c(NA, -17L))
all_states = map_data("world")
# world version:
wp = ggplot() +
geom_polygon(data = all_states, aes(x = long, y = lat, group = group), colour = "gray",
fill = "gray") +
coord_cartesian(ylim = c(0, 80), xlim = c(-155, 45)) +
geom_point(data = te, aes(x = lng, y = lat), color = "blue", size = 5,alpha = 0.6)
print(wp)
#states plot
sp = ggplot() +
geom_polygon(data = all_states, aes(x = long, y = lat, group = group), colour = "gray", fill = "gray") +
coord_cartesian(ylim = c(30, 52), xlim = c(-128, -114)) +
geom_point(data = te, aes(x = lng, y = lat), color = "blue", size = 5, alpha = 0.6)
print(sp)
This solution uses sp and rgeos packages to manipulate spatial data, the main crux being intersecting lines and a box polygon to get the edge points for arrows. Then if you draw arrows with geom_segment and zero width, the line is invisible and only the arrow head remains.
This function computes the line-box intersections:
boxint <- function(xlim, ylim, xp, yp){
## build box as SpatialPolygons
box = cbind(xlim[c(1,2,2,1,1)],
ylim[c(1,1,2,2,1)])
box <- sp::SpatialPolygons(list(sp::Polygons(list(sp::Polygon(box)),ID=1)))
## get centre of box
x0=mean(xlim)
y0=mean(ylim)
## construct line segments to points
sl = sp::SpatialLines(
lapply(1:length(xp),
function(i){
sp::Lines(list(sp::Line(cbind(c(x0,xp[i]),c(y0,yp[i])))),ID=i)
}
)
)
## intersect lines segments with boxes to make points
pts = rgeos::gIntersection(sl, as(box, "SpatialLines"))
as.data.frame(sp::coordinates(pts), row.names=1:length(xp))
}
And this returns the geom with arrows:
wherelse <- function(xlim, ylim, points){
## get points outside bounding box
outsides = points[!(
points$lng>=xlim[1] &
points$lng <= xlim[2] &
points$lat >= ylim[1] &
points$lat <= ylim[2]),]
npts = nrow(outsides)
## get centre point of box
x = rep(mean(xlim),npts)
y = rep(mean(ylim),npts)
## compute box-point intersections
pts = boxint(xlim, ylim, outsides$lng, outsides$lat)
pts$x0=x
pts$y0=y
## create arrow segments as invisible lines with visible arrowheads
ggplot2::geom_segment(data=pts, aes(x=x0,y=y0,xend=x,yend=y),
lwd=0, arrow=grid::arrow(length=unit(0.5,"cm"),
type="closed"),col="magenta")
}
So your example, the basic plot is:
sp = ggplot() +
geom_polygon(
data=all_states,
aes(x=long, y=lat, group = group),colour="gray",fill="gray" ) +
coord_cartesian(ylim=c(30, 52), xlim=c(-128,-114)) +
geom_point(data=te,aes(x=lng,y=lat),color="blue",size=5,alpha=0.6)
and then add the arrows with:
sp + wherelse(c(-128,-114), c(30,52), te)
Not sure if there's an option to draw arrows exactly like you want them though!
Here is my attempt. This is the closest I got. I used gcIntermediate() for calculating the shortest distance between the center point of your US map and the data points which stay outside of the bbox. Hence, the arrow positions may not be something you want. My hope is that somebody else would deliver a better solution based on this attempt.
I first arranged your df (i.e., te) with the center point in the US zoomed map. I then chose data points which are not in the bbox of the US map. Then, add two columns to indicate the center point of the US map. Rename two columns and calculate the shortest distance with gcIntermediate.
library(dplyr)
library(ggplot2)
library(geosphere)
filter(te, !between(lng, -128, -114) | !between(lat, 30, 52)) %>%
mutate(start_long = (-128 - 114) / 2,
start_lat = (30 + 52) / 2) %>%
rename(end_lat = lat, end_long = lng) %>%
do(fortify(as(gcIntermediate(.[,c("start_long", "start_lat")],
.[,c("end_long", "end_lat")],
100,
breakAtDateLine = FALSE,
addStartEnd = TRUE,
sp = TRUE), "SpatialLinesDataFrame"))) -> foo
foo contains 100 data points to draw respective line. I chose data points which stay close to the bbox boundary. I was specifically looking for two data points for each line so that I could use geom_segment() later. I admit that I played with the filter condition a bit. In the end, I did not subset data using lat in this case.
filter(foo, between(long, -128, -126.5) | between(long, -115.5, -114)) %>%
group_by(group) %>%
slice(c(1,n())) -> mydf
In the next step, I rearranged the data frame based on this link
mutate(mydf, end_long = lag(long), end_lat = lag(lat)) %>%
slice(n()) -> mydf2
Finally I drew the map with arrows. I hope this will provide some kind of base for you. I also hope that other SO users will provide better solutions.
ggplot() +
geom_polygon(data = all_states, aes(x = long, y = lat, group = group),
colour = "gray", fill = "gray" ) +
coord_cartesian(ylim = c(30, 52), xlim = c(-128,-114)) +
geom_point(data = te, aes(x = lng,y = lat), color = "blue", size = 5,alpha = 0.6) +
geom_segment(data = mydf2, aes(x = end_long, xend = long,
y = end_lat, yend = lat, group = group),
arrow = arrow(length = unit(0.2, "cm"), ends = "last"))

Resources