create directed arrow plots of two variables using ggplot2 in R

Question

I have two variables (V1,V2) measured on same subject (id) at two time points (timepoint). I want to have a scatterplot with arrow paths to show how values moved from T1 to T2 for the same subject.

In my example, some subjects do not have change in V1 nor V2, it would be ideal to show just as one dot for those sub (sub 1 for example), but I am OK with two dots for two visits, since they will be overlap. There are also sub with a decrease in either V1 or V2 (sub 2 for example), those sub were shown in red arrow above. The third group of subjects show an increase in either V1 or V2 (sub 6 and 7): these sub were in green.

However, what I really need is all arrows point from T1 to T2. That is I hope the green arrow change direction.

The dataset can be generated by:

datatest <- data.frame(timepoint =rep(seq(2,1),8), 
                   id = c(1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8),
                   V1= c( 30.29, 30.29, 21.60, 31.43, 20.75,20.75, 21.60, 30.03, 21.60, 31.30, 31.60, 21.72, 31.6, 20.02, 11.60, 20.16),
                   V2=c(40, 40, 30.78, 41.63, 40.41, 40.41,30.78, 40.97, 20.78, 40.84, 41.85, 41.85, 40.78, 31.79,20.78, 30.23))

which looks like this:

   timepoint id    V1    V2
1          2  1 30.29 40.00
2          1  1 30.29 40.00
3          2  2 21.60 30.78
4          1  2 31.43 41.63
5          2  3 20.75 40.41
6          1  3 20.75 40.41
7          2  4 21.60 30.78
8          1  4 30.03 40.97
9          2  5 21.60 20.78
10         1  5 31.30 40.84
11         2  6 31.60 41.85
12         1  6 21.72 41.85
13         2  7 31.60 40.78
14         1  7 20.02 31.79
15         2  8 11.60 20.78
16         1  8 20.16 30.23

To generate the (wrong) plot I currently have, please run the codes below:

library(ggplot2)
library(lemon)
ggplot(datatest, aes(V1,V2,color=as.factor(timepoint),group=id)) +ggtitle("V2 vs V1 from T1 to T2")+
  geom_pointline(linesize=1, size=2, distance=4, arrow = arrow(angle = 30, length = unit(0.1, "inches"), ends = "first", type = "open") )+
  scale_x_continuous(limits = c(0,33), breaks=seq(0,30,10), expand = c(0, 0)) +
  scale_y_continuous(limits = c(0,43), breaks=seq(0,44,10),expand = c(0, 0))+
  scale_color_manual(values=c("green","red"))+labs(color  = "Timepoint")

The plot currently looks like this:

Thank you!

Answer 1

Would this get you closer?

library(dplyr)
library(tidyr)
library(ggplot2)


data <- data.frame(timepoint =rep(seq(2,1),8), 
                       id = c(1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8),
                       V1= c( 30.29, 30.29, 21.60, 31.43, 20.75,20.75, 21.60, 30.03, 21.60, 31.30, 31.60, 21.72, 31.6, 20.02, 11.60, 20.16),
                       V2=c(40, 40, 30.78, 41.63, 40.41, 40.41,30.78, 40.97, 20.78, 40.84, 41.85, 41.85, 40.78, 31.79,20.78, 30.23))


data <- data %>%
  mutate(row_id = paste0("T", timepoint)) %>%
  pivot_wider(id_cols = id,
              names_from = row_id,
              values_from = c(V1, V2)) %>%
  mutate(colour = ifelse((V1_T1 > V1_T2) | (V2_T1 > V2_T2), "red", "green"))

ggplot(data = data) +
  geom_point(aes(x = V1_T1, y = V2_T1)) +
  geom_point(aes(x = V1_T2, y = V2_T2)) +
  geom_segment(aes(x = V1_T1, xend = V1_T2, y = V2_T1 , yend = V2_T2, colour = colour),
               arrow = arrow(length = unit(0.3,"cm"))) +
  scale_x_continuous(
    limits = c(0, 33),
    breaks = seq(0, 30, 10),
    expand = c(0, 0)
  ) +
  scale_y_continuous(
    limits = c(0, 43),
    breaks = seq(0, 44, 10),
    expand = c(0, 0)
  ) 

You can filter the object data to remove those lines where V1 and V2 do not change and not draw the lines with length zero.