R ggplot2 facet chart with annotations varying among the facets - r

Question

I am trying to construct a facet plot using ggplot2 with an annotation that varies from one facet to the next. The annotation is to be located using the plot area coordinates between 0 and 1, rather than the usual (x,y) coordinates, and is to be in the same location for every facet. The annotation is to be constructed using the y aesthetic and the paste0() function.
My reprex shows one case that works, but this case does not include the part that comes from the y aesthetic and the annotation does not vary among the facets. The reprex also shows a second case where the percentage change in the last (most recent) value for the y aesthetic is added to the annotation, and this does not work. It is this second case that I want to solve.
The reprex uses the ggpp package, but I have also tried using annotation_custom instead of ggpp. However I have not been able to get that to work either. Any help much appreciated.
Here is my reprex:
# Reprex for facets with placed annotation
library(ggplot2)
library(ggpp)
PC <- function(x) {y <- round(100*(x/lag(x)-1),1)}
df <- data.frame(tm=1:25,A=sample(1:100,25,replace=T),
B=sample(1:100,25,replace=T),C=sample(1:100,25,replace=T),
D=sample(1:100,25,replace=T))
df <- tidyr::pivot_longer(df,cols=2:5,names_to="City",values_to="Value")
# This works:
ggplot(df,aes(x=tm,y=Value))+
geom_line()+
scale_y_continuous(lim=c(-10,100))+
ggpp::geom_text_npc(aes(npcx = x, npcy = y, label=label),
data = data.frame(x = 0.05, y = 0.05,
label='% change in various cities'))+
facet_wrap(~City,scale="free_y")
# But this does not work:
ggplot(df,aes(x=tm,y=Value))+
geom_line()+
scale_y_continuous(lim=c(-10,100))+
ggpp::geom_text_npc(aes(npcx = x, npcy = y, label=label),
data = data.frame(x = 0.05, y = 0.05,
label=paste0("Last change in this city ",PC(y)[25],'%')))+
facet_wrap(~City,scale="free_y")

Answer 1

This solution below is a bit complicated, there are probably simpler ones, but it works.
1. Function PC()
Without loading package dplyr, your function PC is calling stats::lag, not dplyr::lag. And assigning to y without returning its value. The right version is
PC <- function(x) {round(100*(x/dplyr::lag(x) - 1), 1)}
2. The data
The plot is created with data = df but then, when plotting the labels the data set changes and the y value no longer comes from df.
The ggpp::geom_text_npc layer doesn't compute PC(y) correctly because its data argument only is self-referring to y. The data.frame is ill formed. This y is not the one in df.
A way to correct this is to first note that the labels to be plotted are 4, one per city and compute the last change value beforehand. This is very simple:
Value <- with(df, tapply(Value, City, \(y) PC(y)[length(y)]))
Value
# A B C D
# -24.1 -16.7 -91.3 46.9
The labels data then becomes
df_labels <- data.frame(
x = rep(0.05, length(Value)), y = rep(0.05, length(Value)),
City = names(Value),
label = paste0("Last change in this city ", Value, "%")
)
3. The plot
Full reproducible example, from top to bottom.
# Reprex for facets with placed annotation
suppressPackageStartupMessages({
library(ggplot2)
library(ggpp)
})
set.seed(2022)
PC <- function(x) {y <- round(100*(x/dplyr::lag(x) - 1), 1)}
df <- data.frame(tm=1:25,A=sample(1:100,25,replace=T),
B=sample(1:100,25,replace=T),
C=sample(1:100,25,replace=T),
D=sample(1:100,25,replace=T))
df <- tidyr::pivot_longer(df,cols=2:5,names_to="City",values_to="Value")
Value <- with(df, tapply(Value, City, \(y) PC(y)[length(y)]))
df_labels <- data.frame(
x = rep(0.05, length(Value)), y = rep(0.05, length(Value)),
City = names(Value),
label = paste0("Last change in this city ", Value, "%")
)
ggplot(df, aes(x = tm, y = Value)) +
geom_line() +
scale_y_continuous(lim = c(-10, 100)) +
ggpp::geom_text_npc(
data = df_labels,
mapping = aes(
npcx = x, npcy = y,
label = label
)
) +
facet_wrap(~ City, scale = "free_y")
Created on 2022-08-08 by the reprex package (v2.0.1)