R中非线性关系的外推（ggplot2）答案

【问题标题】：Extrapolation of non-linear relationships in R (ggplot2)R中非线性关系的外推（ggplot2）
【发布时间】：2017-06-14 12:39:54
【问题描述】：

假设这个数据集（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)

如何将这种绘制的黄土关系外推到 2040、2060、2080、2100 年。使用具有不同斜率的三种不同场景来获得 50% 的 y 值（百分比）？

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。我同意。那么我该如何反映不同的指数增长方案呢？
如果这是指数增长，您应该使用参数模型。
所以通过将我的模型更改为lm(Percent ~ time + I(Time^2) 应该可以吗？，
这不是指数增长模型。

标签： r plot ggplot2 exponential extrapolation

【解决方案1】：

这应该可行：

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)

【讨论】：

感谢您的解决方案。我认为解决这个问题还有很长的路要走。如果我想尝试不同的场景？如何将模型从“黄土”模型更改为不同斜率的指数增长模型，以在不同的目标日期达到目标？
检查一下这个指数模型拟合，我们可以对ggplot使用类似的扩展：stackoverflow.com/questions/41881329/…

【解决方案2】：

一位同事提供了这个解决方案：感谢 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)

【讨论】：