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:
and this without facet applied:
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:
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:
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?
CodePudding user response：
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)