如何使用r中的dplyr应用loess函数并按组获取预测？

Question

我有这个示例数据集：

data.1 <-read.csv(text = "
country,year,response
Austria,2010,34378
Austria,2011,38123
Austria,2012,37126
Austria,2013,42027
Austria,2014,43832
Austria,2015,56895
Austria,2016,49791
Austria,2017,64467
Austria,2018,67620
Austria,2019,69210
Croatia,2010,56456
Croatia,2011,58896
Croatia,2012,54109
Croatia,2013,47156
Croatia,2014,47104
Croatia,2015,88867
Croatia,2016,78614
Croatia,2017,85133
Croatia,2018,77090
Croatia,2019,78330
France,2010,50939
France,2011,41571
France,2012,37367
France,2013,42999
France,2014,75789
France,2015,122529
France,2016,136518
France,2017,141829
France,2018,153850
France,2019,163800
")

我想通过country调整一个loess函数，并在我提供的数据框中获得每年的预测值。loess平滑如下所示：

ggplot(data.1, aes(x=year, y=response, color=country)) +
  geom_point(size = 3, alpha=0.3) + 
  #geom_line(aes(x=year, y=area_harvested_ha/1000), size=0.5, alpha= 1) +
  geom_smooth(method = 'loess', span=0.75, na.rm = T, se=F, size = 2)

绘图：

​

​

这是我试图得到预测的代码：

data.1.with.pred <- data.1 %>% 
  group_by(country) %>% 
  arrange(country, year) %>% 
  mutate(pred.response = stats::predict(stats::loess(response ~ year, span = .75, data=.),
                         data.frame(year = seq(min(year), max(year), 1))))

我正在获取数据帧中的预测，但按country分组不起作用。

这是图：

ggplot(data.1.with.pred, aes(x=year, y=pred.response, color=country)) +
  geom_point(aes(x=year, y=response), size = 3, alpha=0.3) + 
  #geom_line(aes(x=year, y=area_harvested_ha/1000), size=0.5, alpha= 1) +
  geom_smooth(method = 'loess', span=0.75, na.rm = T, se=F, size = 2)

​

​

我遇到的问题是按country分组失败了。我从这里得到了这个答案：

https://stackoverflow.com/a/53400029/4880334

非常感谢你的建议。

Answer 1

如果您想要获得每个国家的黄土预测，您可能需要使用nest()ed数据框架。这将允许您设置一个包含特定于国家/地区数据的数据框的列，然后对这些单独的数据框运行loess()和predict()，然后运行unnest()将结果恢复为标准格式。

以下是一些代码，它们嵌套您的数据，对每个国家/地区运行分析，然后将其拉回常规数据框架：

library(tidyverse)

data.1.with.pred <- data.1 %>% 
  group_by(country) %>% 
  arrange(country, year) %>% 
  nest() %>%
  mutate(pred.response = purrr::map(data, function(x)stats::loess(response~year, span= 0.75, data = x) %>%
                             stats::predict(data.frame(year = seq(min(x$year), max(x$year), 1))))) %>%
  unnest(cols = c(data, pred.response))

data.1.with.pred %>%
  ggplot() +
  geom_point(aes(x = year, y = response, colour = country)) +
  geom_line(aes(x = year,y=pred.response, colour = country))

由此产生的数据帧具有每个国家的年度黄土预测，而不是所有国家的年度预测，图表看起来如下所示：

​

这就是你想要做的吗？

Answer 2

使用loess函数创建数据子集的模型，如下所示：

#use a loess model on a subset of the data (France)
    model <- loess(formula = response ~ year,data = subset(data.1,country == "France"))

#plot
    ggplot() +
      geom_point(data = data.1,
                 mapping = aes(x=year, y=response, color=country),size = 3, alpha=0.3) + 
      geom_line(aes(model$x,model$fitted)) +
      geom_smooth(method = 'loess', span=0.75, na.rm = T, se=F, size = 2)

拟合值为model$fitted格式

Answer 3

这里的问题是group_by不能很好地使用变异/预测功能。

在这个解决方案中，我拆分数据帧，计算每个预测，然后组合并绘制：

#split by country
sdata <-split(data.1, data.1$country)
#calculate the predicted values for each country
data.1.with.pred <- lapply(sdata, function(df){
   df$pred.response  <-stats::predict(stats::loess(response ~ year, span = .75, data=df))
   df
})

#merge back into 1 dataframe
data.1.with.pred <-dplyr::bind_rows(data.1.with.pred )

#data.1.with.pred[order(data.1.with.pred$year),]

ggplot(data.1.with.pred, aes(x=year, y=pred.response, color=country)) +
   geom_point(aes(x=year, y=response), size = 3, alpha=0.3) + 
   #geom_line(aes(x=year, y=area_harvested_ha/1000), size=0.5, alpha= 1) +
   geom_smooth(method = 'loess', span=0.75, na.rm = T, se=F, size = 2)

​

​