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

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.

Related

Draw arrow on ggplot with dates as variable, by specifying co-ordinates rather than using the units of the x- and y-variables

I am attempting to plot the blood test results for a patient in a time series. I have managed to do this and included a reference range between two shaded y-intercepts. My problem is that the annotate() or geom_segment() calls want me to specify, in the units of my independent variable, which is, unhelpfully, a date (YYYY-MM-DD).
Is it possible to get R to ignore the units of the x- and y-axis and specify the arrow co-ordinates as if they were on a grid?
result <- runif(25, min = 2.0, max = 3.5)
start_date <- ymd("2021-08-16")
end_date <- ymd("2022-10-29")
date <- sample(seq(start_date, end_date, by = "days"), 25, replace = TRUE)
q <- data.table(numbers, date)
ggplot(q, aes(x = date, y = result)) +
geom_line() +
geom_point(aes(x = date, y = result), shape = 21, size = 3) +
scale_x_date(limits = c(min(q$date), max(q$date)),
breaks = date_breaks("1 month"),
labels = date_format("%b %Y")) +
ylab("Corrected calcium (mmol/L")+
xlab("Date of blood test") +
ylim(1,4)+
geom_ribbon(aes(ymin=2.1, ymax=2.6), fill="grey", alpha=0.2, colour="grey")+
geom_vline(xintercept=as.numeric(q$date[c(3, 2)]),
linetype=4, colour="black") +
theme(axis.text.x = element_text(angle = 45)) + theme_prism(base_size = 10) +
annotate("segment", x = 1, y = 2, xend = 3, yend = 4, arrow = arrow(length = unit(0.15, "cm")))
The error produced is Error: Invalid input: date_trans works with objects of class Date only.
I can confirm that:
> class(q$date)
[1] "Date"
I've just gone with test co-ordinates (1,2,3,4) for the annotate("segment"...), ideally I want to be able to get the arrow to point to a specific data point on the plot to indicate when the patient went on treatment.
Many thanks,
Sandro
You don't need to convert to points or coordinates. Just use the actual values from your data frame. I am just subsetting within annotate using a hard coded index (you can also automate this of course), but you will need to "remind" R that you are dealing with dates - thus the added lubridate::as_date call.
library(ggplot2)
library(lubridate)
result <- runif(25, min = 2.0, max = 3.5)
start_date <- ymd("2021-08-16")
end_date <- ymd("2022-10-29")
date <- sample(seq(start_date, end_date, by = "days"), 25, replace = TRUE)
q <- data.frame(result, date)
## I am arranging the data frame by date
q <- dplyr::arrange(q, date)
ggplot(q, aes(x = date, y = result)) +
geom_line() +
## for start use a random x and y so it starts whereever you want it to start
## for end, use the same row from your data frame, in this case row 20
annotate(geom = "segment",
x = as_date(q$date[2]), xend = as_date(q$date[20]),
y = min(q$result), yend = q$result[20],
arrow = arrow(),
size = 2, color = "red")

Arrows showing direction of path on every nth data point in R ggplot2 plot

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

how to prevent an overlapped segments in geom_segment

I'm trying to map different ranges (lines) into different regions in the plot (see below) using geom_segment but some of the ranges overlap and can't be shown at all.
This is a minimal example for a dataframes:
start = c(1, 5,8, 14)
end =c(3, 6,12, 16)
regions = c(1,2,3, 4)
regions = data_frame(regions, start, end)
from = c(1,2, 5.5, 13.5)
to = c(3,2.5,6, 15)
lines = data_frame(from, to)
I plotted the regions with geom_rect and then plot the ranges (lines) with geom_segment.
This is the plot:
plot_splice <- ggplot() +
scale_x_continuous(breaks = seq(1,16)) +
scale_y_continuous() +
geom_hline(yintercept = 1.6,
size = 20,
alpha = 0.1) +
geom_rect(
data = regions,
mapping = aes(
xmin = start,
xmax = end,
ymin = 1.5,
ymax = 1.8,
)) +
geom_segment(
data = lines,
x = (lines$from),
xend = (lines$to),
y = 1.48,
yend = 1.48,
colour = "red",
size = 3
) +
ylim(1.0, 2.2) +
xlab("") +
theme_minimal()
The first plot is the one generated with the code whereas the second one is the desired plot.
As you can see, the second line overlaps with the first one, so you can't see the second line at all.
How can I change the code to produce the second plot?
I'm trying to use ifelse statement but not sure what is test argument should be:
I want it to check for each range (line) if it is overlapped with any previous range (line) to change the y position by around .05, so it doesn't overlap.
lines <- lines %>%
dplyr::arrange(desc(from))
new_y$lines = ifelse(from[1] < to[0], 1.48, 1.3)
geom_segment(
data = lines,
x = (lines$from),
xend = (lines$to),
y = new_y,
yend = new_y,
colour = "red",
size = 3
)
Your geom_segment call isn't using any aesthetic mapping, which is how you normally get ggplot elements to change position based on a particular variable (or set of variables).
The stacking of the geom_segment based on the number of overlapping regions is best calculated ahead of the call to ggplot. This allows you to pass the x and y values into an aesthetic mapping:
# First ensure that the data feame is ordered by the start time
lines <- lines[order(lines$from),]
# Now iterate through each row, calculating how many previous rows have
# earlier starts but haven't yet finished when the current row starts.
# Multiply this number by a small negative offset and add the 1.48 baseline value
lines$offset <- 1.48 - 0.03 * sapply(seq(nrow(lines)), function(i) {
with(lines[seq(i),], length(which(from < from[i] & to > from[i])))
})
Now do the same plot but using aesthetic mapping inside geom_segment:
ggplot() +
scale_x_continuous(breaks = seq(1,16), name = "") +
scale_y_continuous(limits = c(1, 2.2), name = "") +
geom_hline(yintercept = 1.6,
size = 20,
alpha = 0.1) +
geom_rect(
data = regions,
mapping = aes(
xmin = start,
xmax = end,
ymin = 1.5,
ymax = 1.8,
)) +
geom_segment(
data = lines,
mapping = aes(
x = from,
xend = to,
y = offset,
yend = offset),
colour = "red",
size = 3
) +
theme_minimal()

Move chart labels of variables in opposite directions

I couldn't find out how to do this anywhere so I thought I would post the solution now that I've figured it out.
I created a simple chart with labels based on a data set in long format (see below for dat). There are two lines and the labels overlap. I would like to move the labels for the upper chart up and for the lower chart down.
library(dplyr)
library(ggplot2)
library(tidyr)
# sample data
dat <- data.frame(
x = seq(1, 10, length.out = 10),
y1 = seq(1, 5, length.out = 10),
y2 = seq(1, 6, length.out = 10))
# convert to long format
dat <- dat %>%
gather(var, value, -x)
# plot it
ggplot(data = dat, aes(x = x, y = value, color = var)) +
geom_line() +
geom_label(aes(label = value))
To move the labels in opposite directions, one can create a step function in nudge_y to multiply the upper line's labels by +1 times a nudge factor and the multiply the lower line's labels by -1 times the nudge factor:
# move labels in opposite directions
ggplot(data = dat, aes(x = x, y = value, color = var)) +
geom_line() +
geom_label(aes(label = value),
nudge_y = ifelse(dat$var == "y2", 1, -1) * 1)
This produces the following chart with adjusted labels.

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.

Resources