R ggplot2 facet chart with annotations varying among the facets

user_9159589 0
Viewed 51

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")
ggplot2 r
1 Answers

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)

user_82454060
Related