Extrapolation of non-linear relationships in R (ggplot2)

Question

Assuming this dataset (df):

Year<- c(1900, 1920,1940,1960,1980,2000, 2016) 
Percent<-(0, 2, 4, 8, 10, 15, 18) 
df<-cbind (Year, Percent)
df<-as.data.frame (df)

How would it be possible to extrapolate this plotted loess relationship to the years 2040, 2060, 2080, 2100. Using three different scenarios with different slopes to get to a y value (Percent) of 50%?

ggplot(data=df, aes(x=Year, y=Percent)) +
  geom_smooth(method="loess", color="#bdc9e1") +
  geom_point(color="#2b8cbe", size=0.5) + theme_bw() + 
  scale_y_continuous (limits=c(0,60), "Percent of Area") +   
  scale_x_continuous (limits=c(1900,2100), "Year") + 
  geom_hline(aes(yintercept=50)) + geom_vline(xintercept = 2016)

@Ronald. I agree. so how then would I reflect different exponential growth alternatives? — I Del Toro, Jan 29 '17 at 11:34
If this is exponential growth you should use a parametric model. — Roland, Jan 29 '17 at 12:28
so by changing my model to `lm(Percent ~ time + I(Time^2)` should work?, — I Del Toro, Jan 29 '17 at 12:29

score 2 · Answer 1 · answered Jan 29 '17 at 07:39

This should work:

library(ggplot2)
p <- ggplot(data=df, aes(x=Year, y=Percent)) +
  geom_smooth(method="loess", color="#bdc9e1") +
  geom_point(color="#2b8cbe", size=0.5) + theme_bw() + 
  scale_y_continuous (limits=c(0,60), "Percent of Area") +   
  scale_x_continuous (limits=c(1900,2100), "Year") + 
  geom_hline(aes(yintercept=50)) + geom_vline(xintercept = 2016)
p
model <- loess(Percent~Year,df, control=loess.control(surface="direct"))
newdf <- data.frame(Year=seq(2017,2100,1))
predictions <- predict(model, newdata=seq(2017,2100,1), se=TRUE)
newdf$fit <- predictions$fit
newdf$upper <- predictions$fit + qt(0.975,predictions$df)*predictions$se
newdf$lower <- predictions$fit - qt(0.975,predictions$df)*predictions$se
head(newdf)
#  Year      fit    upper     lower
#1 2017 18.42822 32.18557 4.6708718
#2 2018 18.67072 33.36952 3.9719107 
#3 2019 18.91375 34.63008 3.1974295
#4 2020 19.15729 35.96444 2.3501436
#5 2021 19.40129 37.37006 1.4325124
#6 2022 19.64571 38.84471 0.4467122
p + 
  geom_ribbon(data=newdf, aes(x=Year, y=fit, ymax=upper, ymin=lower), fill="grey90") +
  geom_line(data=newdf, aes(x=Year, y=fit), color='steelblue', lwd=1.2, lty=2)

Thank you for your solution. I think it goes a long way addressing the issue. If I wanted to try different scenarios? How would I change the model from a "loess" model to an exponential growth model of different slopes to reach the goal by different target dates? — I Del Toro, Jan 29 '17 at 11:53
check this out for an exponential model fitting and we can use similar extensions for `ggplot`: http://stackoverflow.com/questions/41881329/use-nlsfit-within-geom-smooth-to-add-exponential-line-to-plot/41881894#41881894 — Sandipan Dey, Jan 29 '17 at 15:58

score 1 · Accepted Answer · answered Jan 31 '17 at 21:44

A colleague from work offered this solution: Thanks ADAM!

loess_mod <- loess(Perc_area~Estab_Yr, data = marine_sub, control=loess.control(surface="direct"))

prd <- data.frame(Estab_Yr = seq(2017, 2100, by = 1))

loess_df <- data.frame(Estab_Yr = prd, Perc_area = predict(loess_mod, newdata = prd))

#Then, we can use geom_line and geom_point, but we need to tweak the scale on the y-axis to allow for where the predictions in 2017 start (just above 60):

ggplot(data=marine_sub, aes(x=Estab_Yr, y=Perc_area)) +
  geom_smooth(method="loess", color="#bdc9e1") +
  geom_point(color="#2b8cbe", size=0.5) + theme_bw() + 
  scale_y_continuous (limits=c(0,100), "Percent of Protected Area") +   
  scale_x_continuous (limits=c(1900,2100), "Year Protected") + 
  geom_hline(aes(yintercept=50)) + geom_vline(xintercept = 2017) +
  geom_line(data= loess_df, color = "orange", size = 1) +
  geom_point(data = loess_df, aes(x = Estab_Yr, y = Perc_area), size=.25)

Extrapolation of non-linear relationships in R (ggplot2)

2 Answers2