Transform angles from polar coordinates - r

I am in need of some help with angles.
Calculating bearings with the package fossil and the function fossil::earth.bear we obtain, according to the help,
"the bearing in degrees clockwise from True North between any two points on the globe".
I have a vector of angles obtained with this function, and I need to transform them so the origin (0º) is on the x axis (East) and the angles increment counterclockwise.
Basically I need a way to rotate 90º clockwise my angles (so the 0º will be on the x axis "facing East") and then calculate the angle in the opposite direction (counterclockwise).
Intuitively, I've tried adding 90º to my bearings (to rotate clockwise) and then substracting them from 360 (to calculate the angle in the "opposite direction").
However, it does not work and I highly suspect that there is a different thing to do for each quadrant, but I just can't figure it out.
Below a test with dummy data and polar histograms to prove that the solution is not working as the resulting vector bearings2is not equivalent to the starting vector bearings
# Generate vector with 100 random values between 0 and 360
set.seed(123)
bearing <- runif(100, 0,360)
# generate a histogram with values binned every 5º
breaks = seq(0, 360, by=5)
bearing.cut = cut(bearing, breaks, right=FALSE)
bearing.freq = as.data.frame(table(bearing.cut))
bearing.freq$bearing.cut <- seq(5,360, by = 5)
#plot with ggplot
library(ggplot2)
ggplot(bearing.freq, aes(x = bearing.cut, y = Freq)) +
coord_polar(theta = "x", start = 0 direction = 1) + #start 0 for north, direction 1 for cloclwise
geom_bar(stat = "identity") +
scale_x_continuous(breaks = seq(0, 360, 5))
This is the plot that this creates
Now I perform the mentioned operations in my bearing vector
bearing2 <- 360-(bearing-90)
# repeat the process to generate freq table and plot
breaks = seq(0, 360, by=5)
bearing.cut2 = cut(bearing2, breaks, right=FALSE)
bearing.freq2 = as.data.frame(table(bearing.cut2))
bearing.freq2$bearing.cut <- seq(5,360, by = 5)
#plot with ggplot
library(ggplot2)
ggplot(bearing.freq2, aes(x = bearing.cut2, y = Freq)) +
coord_polar(theta = "x", start = -pi/2, direction = -1) + # now start at E and counterclockwise
geom_bar(stat = "identity") +
scale_x_continuous(breaks = seq(0, 360, 5))
And this is the plot that this generates. Clearly, if my conversion was correct, these two plots should look the same... and they don't.
** I have edited as per Gregor's suggestion (and to set a seed so it is repeatable). Looks better but we lose all angles between 0º and 90º. Which reinforces my initial idea that there's a different operation to do for each quadrant, but still can't figure it out. Still, thanks for the tip!

Ok I think I figured it out but not really sure why it works. I'll just leave it here to mark the question as answered.
The solution is that, for the first quadrant (angles between 0º and 90º, we need to calculate the complementray angle so we need 90-bearing . For the rest of the quadrants, we do what Gregor suggested(360-(bearing-90)).
Below the complete code to a reproducible example
library(ggplot2)
set.seed(123)
# 0º at North and clockwise
bearing <- runif(100, 0,360)
#create histogram
breaks = seq(0, 360, by=5) # half-integer sequence
bearing.cut = cut(bearing, breaks, right=FALSE)
bearing.freq = as.data.frame(table(bearing.cut))
bearing.freq$bearing.cut <- seq(5,360, by = 5)
#plot
p1 <- ggplot(bearing.freq, aes(x = bearing.cut, y = Freq)) +
coord_polar(theta = "x", start =0, direction = 1) +
geom_bar(stat = "identity") +
scale_x_continuous(breaks = seq(0, 360, 5))
# transform to 0º at E and counterclockwise
bearing2 <- ifelse(bearing <=90, (90-bearing), (360 - (bearing - 90)))
#create histogram
bearing.cut2 = cut(bearing2, breaks, right=FALSE)
bearing.freq2 = as.data.frame(table(bearing.cut2))
bearing.freq2$bearing.cut <- seq(5,360, by = 5)
# plot
p2 <- ggplot(bearing.freq2, aes(x = bearing.cut, y = Freq)) +
coord_polar(theta = "x", start = -pi/2, direction = -1) +
geom_bar(stat = "identity") +
scale_x_continuous(breaks = seq(0, 360, 5))
require(gridExtra)
grid.arrange(p1, p2, ncol=2)

Related

geom_density_2d_filled and gganimate: cumulative 2D density estimate animation over time?

This is a follow-up question of sorts to ggplot2 stat_density_2d: how to fix polygon errors at the dataset bounding box edges?
I am trying to animate a 2D density estimate ggplot2::geom_density_2d_filled over time so that each frame adds data to what was presented before. So far I have the gganimate animation working for the 2D density estimate so that each point in time (the dataframe column monthly) is individual, but I have no idea how to proceed from here.
Is it possible to use gganimate to cumulatively animate geom_density_2d_filled? Or could this be achieved by manipulating the source dataframe somehow?
Please see my code below:
library(dplyr)
library(sf)
library(geofi)
library(ggplot2)
library(gganimate)
# Finland municipalities
muns <- geofi::get_municipalities(year = 2022)
# Create sample points
points <- sf::st_sample(muns, 240) %>% as.data.frame()
points[c("x", "y")] <- sf::st_coordinates(points$geometry)
monthly <- seq(as.Date("2020/1/1"), by = "month", length.out = 24) %>%
rep(., each = 10)
points$monthly <- monthly
p <- ggplot() +
geom_density_2d_filled(data = points,
aes(x = x, y = y, alpha = after_stat(level))) +
geom_sf(data = muns,
fill = NA,
color = "black") +
coord_sf(default_crs = sf::st_crs(3067)) +
geom_point(data = points,
aes(x = x, y = y),
alpha = 0.1) +
scale_alpha_manual(values = c(0, rep(0.75, 13)),
guide = "none") +
# gganimate specific
transition_states(monthly,
transition_length = 1,
state_length = 40) +
labs(title = "Month: {closest_state}") +
ease_aes("linear")
animate(p, renderer = gganimate::gifski_renderer())
gganimate::anim_save(filename = "so.gif", path = "anim")
The resulting animation is seen below. Could this be portrayed cumulatively?
To get cumulative figures the easiest way is to repeat each month's data in future months.
Using the tidyverse, add the following statement before you define p...
points <- points %>%
mutate(monthly = map(monthly, ~seq(., max(monthly), by = "month"))) %>%
unnest(monthly)
Note that a cumulative density will not necessarily increase over time - if you want an animation that steadily increases you might want to add contour_var = "count" to your geom_density... term.

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")

Specifying geom_segment(...x and xend) Values Using Datetime Data

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.

Plotting a geom_arc() over a geom_point() plot

I am trying to plot a 90 degree arc from the x axis to the y axis as part of a geom_point() plot I already have with the aim of creating two parts to the graph, inside the arc and outside.
This is the data I have:
set.seed(1)
vector1 <- sample(1:500,250, replace = T)
vector2 <- replicate(250,min(sample(200,2,replace=TRUE)))
so.df <- data.frame(vector1, vector2)
so.df
ggplot(data = so.df, aes(x=vector2, y=vector1)) + geom_point()
I would like the arc to go from 100 on the y-axis to 100 on the x-axis with a radius of 10.
If I can clarify anything further please ask.
Thanks.
You can make the necessary coordinates using a little bit of geometry and then add it on in an additional geom_line:
set.seed(1)
vector1 <- sample(1:500,250, replace = T)
vector2 <- replicate(250,min(sample(200,2,replace=TRUE)))
so.df <- data.frame(vector1, vector2)
so.df
arc_data <- data.frame(
x = 0:100
) %>%
mutate(y = sqrt(100^2 - x^2))
ggplot(data = so.df, aes(x=vector2, y=vector1)) + geom_point() +
geom_line(aes(x, y), data = arc_data, col = "red")
That being said, I'm not sure how something with radius 10 reaches 100 on both axes?

Use gganimate to display calculation of tweened data

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)

Resources