Issue using geom_link2 with after_stat when using Facet_wrap

Question

Library Dependencies:

library(ggplot2)
library(dplyr)
library(ggforce)

Create Data Frame


x <- c('27/12/2021' ,
       '03/01/2022' ,
       '10/01/2022' ,
       '17/01/2022' ,
       '24/01/2022' ,
       '31/01/2022' ,
       '07/02/2022' ,
       '14/02/2022' ,
       '21/02/2022' ,
       '28/02/2022' ,
       '07/03/2022' ,
       '14/03/2022' ,
       '21/03/2022' ,
       '28/03/2022' ,
       '04/04/2022' ,
       '11/04/2022' ,
       '18/04/2022' ,
       '25/04/2022' ,
       '02/05/2022' ,
        '09/05/2022'    ,
        '16/05/2022',
       '23/05/2022' ,
       '30/05/2022' ,
       '06/06/2022' ,
       '13/06/2022' ,
       '20/06/2022' ,
       '27/06/2022' ,
       '04/07/2022' ,
       '11/07/2022' ,
       '18/07/2022' ,
       '25/07/2022' ,
       '01/08/2022' ,
       '08/08/2022' ,
       '15/08/2022' ,
       '22/08/2022' ,
       '29/08/2022' ,
       '05/09/2022' ,
       '12/09/2022' ,
       '19/09/2022' ,
       '26/09/2022' ,
       '03/10/2022' ,
       '10/10/2022' ,
       '17/10/2022' ,
       '24/10/2022' ,
       '31/10/2022' ,
       '07/11/2022' ,
       '14/11/2022' ,
       '21/11/2022' ,
       '28/11/2022' ,
       '05/12/2022' ,
       '12/12/2022' ,
       '19/12/2022' ,
       '26/12/2022' ,
       '27/12/2021' ,
       '03/01/2022' ,
       '10/01/2022' ,
       '17/01/2022' ,
       '24/01/2022' ,
       '31/01/2022' ,
       '07/02/2022' ,
       '14/02/2022' ,
       '21/02/2022' ,
       '28/02/2022' ,
       '07/03/2022' ,
       '14/03/2022' ,
       '21/03/2022' ,
       '28/03/2022' ,
       '04/04/2022' ,
       '11/04/2022' ,
       '18/04/2022' ,
       '25/04/2022' ,
       '02/05/2022' ,
       '09/05/2022' ,
       '16/05/2022' ,
       '23/05/2022' ,
       '30/05/2022' ,
       '06/06/2022' ,
       '13/06/2022' ,
       '20/06/2022' ,
       '27/06/2022' ,
       '04/07/2022' ,
       '11/07/2022' ,
       '18/07/2022' ,
       '25/07/2022' ,
       '01/08/2022' ,
       '08/08/2022' ,
       '15/08/2022' ,
       '22/08/2022' ,
       '29/08/2022' ,
       '05/09/2022' ,
       '12/09/2022' ,
       '19/09/2022' ,
       '26/09/2022' ,
       '03/10/2022' ,
       '10/10/2022' ,
       '17/10/2022' ,
       '24/10/2022' ,
       '31/10/2022' ,
       '07/11/2022' ,
       '14/11/2022' ,
       '21/11/2022' ,
       '28/11/2022' ,
       '05/12/2022' ,
       '12/12/2022' ,
       '19/12/2022' ,
       '26/12/2022' 
)
y <- c(0.2268,
       0.1792,
       0.1626,
       0.1542,
       0.1629,
       0.1678,
       0.157,
       0.1897,
       0.1331,
       0.1461,
       0.1658,
       0.1776,
       0.1834,
       0.1429,
       0.1319,
       0.1516,
       0.1955,
       0.1491,
       0.1605,
       0.1486,
       0.1747,
       0.1713,
       0.181,
       0.1608,
       0.1868,
       0.1581,
       0.1565,
       0.1792,
       0.1944,
       0.15,
       0.1711,
       0.1703,
       0.1401,
       0.1734,
       0.183,
       0.1493,
       0.1898,
       0.1971,
       0.1733,
       0.159,
       0.1755,
       0.1491,
       0.1895,
       0.1664,
       0.163,
       0.1584,
       0.1689,
       0.1538,
       0.1623,
       0.1675,
       0.1731,
       0.1606,
       0.1884,
       0.1353,
       0.1686,
       0.1536,
       0.1826,
       0.1532,
       0.1562,
       0.1649,
       0.1666,
       0.1996,
       0.1783,
       0.1286,
       0.1754,
       0.1655,
       0.1558,
       0.2072,
       0.1878,
       0.1423,
       0.1946,
       0.1564,
       0.1668,
       0.1302,
       0.1769,
       0.1645,
       0.1644,
       0.1706,
       0.1523,
       0.1748,
       0.1421,
       0.1905,
       0.1803,
       0.1602,
       0.1612,
       0.1891,
       0.174,
       0.1532,
       0.1782,
       0.1496,
       0.1783,
       0.1739,
       0.1333,
       0.2017,
       0.165,
       0.1775,
       0.1663,
       0.1653,
       0.1837,
       0.1547,
       0.1636,
       0.1647,
       0.1879,
       0.1763,
       0.1933,
       0.1869
)

targt <- c(0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202,
            0.202
)
f <- c('W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W1',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2',
       'W2'
)
x <- as.Date(x, "%d/%m/%Y")
df <- data.frame(x,y,targt,f)
df <- df |>
  mutate(
    targt1 = 0.206
  ) |> 
  select(
    x,y,targt1,f
  )

Create ggplot using ggforces - geom_link2 (facet_wrap applied)

df |>
  ggplot(aes(x,
             y,
             targt1)) + 
geom_link2(
  aes(colour = after_stat(y<df$targt1))
) + 
facet_wrap(vars(f), scales = "free_y") +
  geom_hline(aes(yintercept = targt1),
                 color = "Green3",
                 size = 0.5,
                 linetype = "solid")

Create ggplot using ggforces - geom_link2 (facet_wrap not applied)

df |>
  ggplot(aes(x,
             y,
             targt1)) + 
geom_link2(
  aes(colour = after_stat(y<df$targt1))
) + 
  geom_hline(aes(yintercept = targt1),
                 color = "Green3",
                 size = 0.5,
                 linetype = "solid")

My code gives me this output with facet applied:

With facet_wrap commented into code, you can see the after_stat function y<targt1 field doesn't work correctly in the W1 panel; the issue seems to be around the first point. It works correctly with the point in W2 as you can see

and this without facet applied:

Comment out the facet_wrap section to see the difference, this is correct but without facets which are needed

The second is correct but obviously without the necessary facets. Why doesn't my after_stat calculation within geom_link2 work with facets?

I'm hoping for someone to show me where I am going wrong with my after_stat function/facet_wrap/geom_link2.

I'm not 100% sure where my issue is, but if the target is changed to 0.201 the code works fine as you can see below:

targt1 = 0.201

However as soon as the targt1 is change to anything over 0.202 the code falls down and the line is red rather than green under the target:

targt1 = 0.202

I based my initial code on the answer given here and it works in most cases but seems to fail in the circumstances I have displayed above:

How make line red when the value is below zero and green when above?

score 1 · Accepted Answer · answered Nov 29 '22 at 21:05

I'm reasonably sure that this is a bug in geom_link2() somewhere. Probably in ggforce:::GeomPathInterpolate$draw_panel() by my estimation (layer_data(last_plot()) seems to give correct data).

Anyhow, you just need the stat part of that layer to do the main interpolation. The geom part of the layer is exchangeable. That is exactly what we're doing below, by just chosing geom_path(..., stat = "link2").

# construction code same as question
# omitted for brevity
# df <- ...

df |>
  ggplot(aes(x, y)) + 
  geom_path(
    # We would only need to stage if `targt1` is not constant.
    # However, used here for good measure.
    aes(colour = stage(targt1, y < colour)),
    stat = "link2"
  ) + 
  facet_wrap(vars(f), scales = "free_y") +
  geom_hline(aes(yintercept = targt1),
             color = "Green3",
             linewidth = 0.5,
             linetype = "solid") +
  scale_colour_discrete()

^{Created on 2022-11-29 by the reprex package (v2.0.1)}

Agree that this is a bug. Tracked it down to `ggforce::interpolateDataFrame`. There we can see that the interpolation step messes up the `colour` column. — stefan, Nov 29 '22 at 21:26
Thanks for the swift response, this was a great solution. I had an idea that it was a bug rather than a syntax error but I wouldn't haven known that you can simply add a stat to the geom_path, this will no doubt come in useful for other plots in the future as well. I'd vote up but I only have 13 reputation currently! — JoeK, Nov 30 '22 at 17:47

Issue using geom_link2 with after_stat when using Facet_wrap

1 Answers1