Here's a result of shameless copy-paste from the SO thread I mentioned, and hence full credit goes to Henrik, and recursively to kohske.
df <- data.frame(Date = c(1981, 1982, 1983, 1984, 1985, 1986, 1987, 1988, 1989, 1990,
1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
2011, 2012, 2013, 2014, 2015, 2016, 2017),
Temp = c(-0.2, -0.1, -0.2, -0.7, -0.3, -0.4, -0.7, -0.8, -0.8, -0.2,
0.2, -0.4, 0.1, -0.1, 0.2, -0.1, 0.4, 0.5, 1.0, 0.2,
0.2, 0.2, 0.1, -0.6, 0.6, 0.6, 0.2, 0.2, 0.5, 0.2,
0.3, 0.3, 0.2, 0.4, 0.0, 0.6, 0.5))
df$grp <- "orig"
new_df <- do.call(what = "rbind",
args = sapply(X = 1:(nrow(x = df) -1),
FUN = function(i)
{
f <- lm(formula = (Date ~ Temp),
data = df[i:(i + 1),])
if (f$qr$rank < 2)
{
return(NULL)
}
r <- predict(object = f,
newdata = data.frame(Temp = 0))
if(df[i,]$Date < r & r < df[i+1,]$Date)
{
return(data.frame(Date = r,
Temp = 0))
} else
{
return(NULL)
}
}))
new_df$grp <- "new"
df_mod <- rbind(df, new_df)
library(ggplot2)
#> Registered S3 methods overwritten by 'ggplot2':
#> method from
#> [.quosures rlang
#> c.quosures rlang
#> print.quosures rlang
ggplot(data = df_mod,
mapping = aes(x = Date,
y = Temp)) +
geom_area(data = subset(x = df_mod,
subset = (Temp <= 0)),
fill = "red") +
geom_area(data = subset(x = df_mod,
subset = (Temp >= 0)),
fill = "blue") +
geom_smooth(se = FALSE,
colour = "green")
#> `geom_smooth()` using method = 'loess' and formula 'y ~ x'
Created on 2019-05-01 by the reprex package (v0.2.1)