ggplot2 adding dynamic arrow annotations pointing at specific data points that remain proportional to the scale of the overall plot

Question

I would like to create a template that would allow me to create a line graph of stock prices with the ability to add arrows pointing at specific dates. The annotation function on ggplot2 does not allow for resizing with the scale of the plot. Is there any workaround?

For example, in this plot with only 6 dates the arrows are sized properly with the chart:

prices<-c(3,5,28,17,62,10)
prices2<-prices-1
prices3<-prices-11
dates<-seq.Date(from=as.Date("2018-1-1"),to=as.Date("2018-1-6"),"days")

ggplot()+
geom_line(aes(dates,prices))+
annotate(
"segment",
x=dates,
xend=dates,
y=prices3,
yend=prices2,
color="blue",
arrow=arrow(length=unit(0.5,"cm")
            ))

However when I increase the period to 15 dates the arrows do not scale proportionally and look like this:

Answer 1

I am not sure exactly what you mean by proportional, is it essentially same proportional length to the first figure? If so, since the length of the arrow is controlled by prices2 and prices3 you can just figure out how much space they take proportionally on the first figure and then compute for the second. Combine with npc for arrow head and it should roughly give you what you want. The arrowhead itself isn't perfect because of the x-axis but I think it's closer than what you had before.

So using your data:

# original data
prices<-c(3,5,28,17,62,10)
dates<-seq.Date(from=as.Date("2018-1-1"),to=as.Date("2018-1-6"),"days")

# original plot (with 0.05 npc)
ggplot()+
    geom_line(aes(dates,prices))+
    annotate(
        "segment",
        x=dates,
        xend=dates,
        y=prices-11,
        yend=prices-1,
        color="blue",
        arrow=arrow(length=unit(0.05,"npc")
        ))

# new data
prices2<-c(prices,c(20,250,30,60,40))
dates2 <- seq.Date(from=as.Date("2018-1-1"),to=as.Date("2018-1-11"),"days")

# compute length of arrow
p1 <- abs(min(prices)-11)+max(prices)
fs1<-function(x) { (abs(min(prices2)-x)+max(prices2))*11/p1-x }
y1<-uniroot(fs2,lower=0,upper=100)$root

p2 <- abs(min(prices)-1)+max(prices)
fs2<-function(x) { (abs(min(prices2)-x)+max(prices2))*1/p2-x }
y2<-uniroot(fs1,lower=0,upper=100)$root

# new plot
ggplot()+
geom_line(aes(dates2,prices2))+
annotate(
    "segment",
    x=dates2,
    xend=dates2,
    y=prices2-y1,
    yend=prices2-y2,
    color="blue",
    arrow=arrow(length=unit(0.05,"npc")
    ))