thomasp85 / ggforce

Accelerating ggplot2
https://ggforce.data-imaginist.com
Other
916 stars 106 forks source link

Issue using geom_link2 with after_stat #288

Closed joekeane7 closed 1 year ago

joekeane7 commented 1 year ago

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:

https://stackoverflow.com/questions/66817508/how-make-line-red-when-the-value-is-below-zero-and-green-when-above/66817776

teunbrand commented 1 year ago

In case it is any help, I came across this issue on SO, and think it might be a bug that appears to be in the interpolateDataFrame() function.

joekeane7 commented 1 year ago

yes that was me, I posted on both forums as seemed relevant. The solution on https://stackoverflow.com/questions/74614700/issue-using-geom-link2-with-after-stat-when-using-facet-wrap was great thanks.

I guess it is still an issue with geom_link2 but I'm happy to close from my perspective.