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.
Related
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")
I want to use ggplot2 to create a path with arrows in a plot. However, I have a lot of data points and so I only want the arrow on every nth datapoint. I adapted this answer for every nth label to put an observation point every nth data point, but if I try to use this with path I get straight lines between these points. I just want the arrow head.
The MWE below shows my attempt to get the two paths working together (I do want the full path as a line), and what worked for points (that I want to be directional arrows). In my real data set the arrows will point in different directions (so I can't just use a static arrow head as the observation symbol). I am also working with other filtering within the plots, and so creating new data frames that only keep some points is not a convenient solution.
MWE
library(tidyverse)
library(tidyr)
library(dplyr)
x <- seq(from = -100, to = 100, by = 0.01)
y <- x^3 - 2 * x + x
df<- data.frame(x,y)
df$t<- seq(1:nrow(df))
ggplot(data = df, aes(x = x, y = y)) +
geom_path(size = 0.1, aes(colour = t)) +
geom_path(aes(colour = t),data = . %>% filter(row_number() %% 2000 == 0), arrow = arrow(type = 'open', angle = 30, length = unit(0.1, "inches")))
ggplot(data = df, aes(x = x, y = y)) +
geom_path(size = 0.1, aes(colour = t)) +
geom_point(aes(colour = t),data = . %>% filter(row_number() %% 2000 == 0))
You can try to add a grouping variable.
ggplot(data = df, aes(x = x, y = y)) +
geom_path(aes(colour = t, group =factor(gr)),data = . %>% filter(row_number() %% 2000 == 0) %>%
mutate(gr = gl(n()/2, 2)),
arrow = arrow(type = 'open', angle = 30, length = unit(0.1, "inches")))
I am trying to make a wind vector plot, and the closest I have come is using ggplot2 and the tutorials here: https://theoceancode.netlify.app/post/wind_vectors/
and here: http://jason-doug-climate.blogspot.com/2014/08/weather-station-at-worldfish-hq-goes.html
First I'm going to specify some example data that has the same structure as I'm working with...some code is redundant for the example here but I'm leaving it in for continuity with what I'm working with.
library(tidyverse)
dat <- tibble(Date = seq(as.POSIXct('2018-08-01 00:00:00'),
as.POSIXct('2018-08-12 00:00:00'), "hour"),
WSMPS = rnorm(265,3,1),
WDir = rnorm(265,180,75),
month = 8,
year = rep(2018))
vec_dat <- dat %>%
rename(ws=WSMPS, wd= WDir) %>%
filter(year==2018, month==8) %>% # redundant for example data
mutate(hour = as.numeric(substr(Date,12,13)),
bin = cut.POSIXt(Date,
breaks = NROW(unique(Date))/4),
u = (1 * ws) * sin((wd * pi / 180.0)), # convert to cartesian coordinate vectors
v = (1 * ws) * cos((wd * pi / 180.0))) %>%
group_by(bin) %>% # bin the data into 4hr increments
summarise(u=mean(u),
v=mean(v)) %>%
mutate(bin = as.POSIXct(bin),
date = as.Date(substr(bin, 1,10)),
time = chron::as.times(substr(bin, 12,19)))
The closest I have come is using the code below
wind_scale <- 1 # this is a scaling factor not used at the moment so set to 1
y_axis <- seq(-5, 5, 5)
ggplot(data = vec_dat, aes(x = bin, y = y_axis)) +
# Here we create the wind vectors as a series of segments with arrow tips
geom_segment(aes(x = date, xend = date + u*wind_scale, y = 0, yend = v*wind_scale),
arrow = arrow(length = unit(0.15, 'cm')), size = 0.5, alpha = 0.7)
This creates a plot that looks good except that I would like to split the vectors into their respective bins (4 hour increments denoted by vec_dat$bin) instead of having all the vectors for a given day originate from the same point on the x axis. I've tried switching vec_dat$date for vec$dat$bin but then the math within geom_segment() no longer works and the plot originates from the bins but the vectors are all perfectly vertical as below:
ggplot(data = vec_dat, aes(x = bin, y = y_axis)) +
# Here we create the wind vectors as a series of segments with arrow tips
geom_segment(aes(x = bin, xend = bin + u*wind_scale, y = 0, yend = v*wind_scale),
arrow = arrow(length = unit(0.15, 'cm')), size = 0.5, alpha = 0.7)
UPDATE
This appears to be a math problem. When I calculate the xend argument using bin instead of date the result is that the xend value is not scaled correctly as below:
test <- vec_dat[1:12,]
test$bin+test$u
test$date+test$u
So what is required is to use data as class Date within the xend formula...however this throws an error:
ggplot(data = vec_dat, aes(x = bin, y = y_axis)) +
# Here we create the wind vectors as a series of segments with arrow tips
geom_segment(aes(x = bin, xend = date + u*wind_scale, y = 0, yend = v*wind_scale),
arrow = arrow(length = unit(0.15, 'cm')), size = 0.5, alpha = 0.7)
Error: Invalid input: time_trans works with objects of class POSIXct only
So if anyone can help with this error or with a workaround I'd appreciate it.
I think you are looking for something like this:
wind_scale <- 86400 # (seconds in a day)
y_axis <- seq(-5, 5, 5)
ggplot(data = vec_dat, aes(x = bin, y = y_axis)) +
geom_segment(aes(xend = bin + u * wind_scale, y = 0, yend = v),
arrow = arrow(length = unit(0.15, 'cm')),
size = 0.5, alpha = 0.7) +
coord_fixed(ratio = wind_scale) # Preserves correct angle for wind vector
For what it's worth, I don't think having this many arrows on a single plot makes for a great visualization because there is a lot of clashing and overlap of arrows that makes it hard to read. Vertical faceting by day might make this easier to interpret.
I would like to use gganimate to:
Graph two separate curved lines with geom_path
Call a function that performs a calculation with the data from those lines and returns a single coordinate (x, y)
Plot that coordinate as a geom_point
Move the lines around, with the geom_point updating as the lines move
This is simple if the movement is such that the single (x, y) coordinate moves linearly (just calculate it at each stage ahead of time and then animate it, it will move linearly from each stage to the next), but if it's not I'm not sure what to do. If I call a function within aes(), which seems like the natural solution, it seems to calculate it once at the beginning and then not update it as the lines move.
Here is an example.
library(tidyverse)
library(gganimate)
# A function to find the x and y coordinate of the minimum y value of either set
min_of_both <- function(x1, y1, x2, y2) {
cm <- bind_rows(tibble(x = x1, y = y1),
tibble(x = x2, y = y2))
return(list(x = cm[which(cm$y == min(cm$y)),]$x,
y = min(cm$y)))
}
# Create two parabola paths, curve A which moves downwards from t = 1 to t = 2
curveA <- tibble(xA = -50:50/10, yA = 5+(-50:50/10)^2, t = 1) %>%
bind_rows(tibble(xA = -50:50/10, yA = -10 + (-50:50/10)^2, t = 2))
# And curve B which is static in both time 1 and 2
curveB <- tibble(xB = -50:50/10, yB = 1 + (-30:70/10)^2)
data <- curveB %>%
bind_rows(curveB) %>%
bind_cols(curveA)
# Plot Curve A
p <- ggplot(data, aes(x = xA, y = yA)) +
geom_path(color = 'red') +
# And Curve B
geom_path(aes(x=xB,y=yB), color = 'blue')+
# Then plot a single point that uses both curves as input
# Note I also get problems if trying to run the function through data= instead of mapping=
# or if I define two separate functions, one for x and one for y, so as to avoid $
geom_point(aes(
x = min_of_both(xA,yA,xB,yB)$x,
y = min_of_both(xA,yA,xB,yB)$y),
size = 3,
color = 'black') +
theme_minimal()+
transition_states(t)+
ease_aes('sine-in-out')
animate(p)
This results in (not sure if the animation will play on StackOverflow but the parabola does indeed move):
The black dot is intended to mark the lowest y-coordinate on either parabola at each moment, but instead it marks the lowest y-coordinate on either parabola at any point in the animation (at the end).
Any tips appreciated.
After a lot of head-scratching I think I've understood your point and have found one solution. The best way forward might be to manually tween the paths and calculate the min values using your function whilst grouping by .frame before plotting:
# Same curve setup, but labelling points for grouping later
curveA <- tibble(xA = -50:50/10,
yA = 5+(-50:50/10)^2,
point = 1:101,
t = 1) %>%
bind_rows(tibble(xA = -50:50/10,
yA = -10 + (-50:50/10)^2,
point = 1:101,
t = 2))
curveB <- tibble(xB = -50:50/10,
yB = 1 + (-30:70/10)^2,
point = 1:101,
t = 1)
A_frames <- curveA %>%
tween_along(ease = 'sine-in-out', 100, along = t, id = point) %>%
filter(.phase == "transition") %>%
select(xA, yA, point, .frame) %>%
arrange(.frame, point) # arrange by point needed to keep in order
B_frames <- curveB %>%
bind_rows(curveB %>% mutate(t = 2)) %>%
tween_along(ease = 'sine-in-out', 100, along = t, id = point) %>%
filter(.phase == "transition") %>%
select(xB, yB, point, .frame) %>%
arrange(.frame, point)
data <- A_frames %>%
left_join(B_frames, by = c(".frame", "point")) %>%
group_by(.frame) %>%
mutate(xmin = min_of_both(xA,yA,xB,yB)$x,
ymin = min_of_both(xA,yA,xB,yB)$y)
# Plot Curve A
p <- ggplot(data, aes(x = xA, y = yA)) +
geom_path(color = 'red') +
# And Curve B
geom_path(aes(x=xB,y=yB), color = 'blue')+
# Then plot a single point that uses both curves as input
# Note I also get problems if trying to run the function through data= instead of mapping=
# or if I define two separate functions, one for x and one for y, so as to avoid $
geom_point(aes(xmin, ymin),
size = 3,
color = 'black') +
theme_minimal()+
transition_states(.frame)+
ease_aes('sine-in-out')
animate(p, fps = 24)
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"))