将lapply调用的输出写入单个表

Question

我在我的数据集中使用lapply作为

dt <- read.table(text ="Year         Premium     Silver     Budget
Jan2016      112354      36745      456563       
Feb2016      1233445     234322     4533345
Mar2016      13456544    346755     34564422", header = TRUE)

library(forecast)
library(data.table)
dt <- data.table(dt)
res <- lapply(c("Premium", "Silver", "Budget"), function(x) {
  count <- dt[, get(x)]
  tickets <-
    ts(count, frequency = 12,start = c(2016, 1),end = c(2018, 6)
    )
  pi = auto.arima(tickets)
  forecast(pi, h = 12)
})

我的输出是

[[1]]
         Point forecast    Lo80       Hi80       Lo85      Hi85
Apr 2019      2.4078098  -1.725018  6.540638  -3.912805  8.728425
May 2019      0.2415010  -4.561637  5.044639  -7.104264  7.587266
Jun 2019      0.3093233  -5.426247  6.044894  -8.462474  9.081121
Jul 2019      2.2816647  -4.124944  8.688274  -7.516398 12.079728 

[[2]]
         Point forecast    Lo80         Hi80       Lo85      Hi85
Apr 2019      12.4078098  -11.725018  16.540638  -13.912805  8.728425
May 2019      10.2415010  -14.561637  15.044639  -17.104264  7.587266
Jun 2019      10.3093233  -15.426247  16.044894  -18.462474  9.081121
Jul 2019      12.2816647  -14.124944  18.688274  -17.516398 12.079728 

[[3]]
         Point forecast    Lo80        Hi80         Lo85        Hi85
Apr 2019      32.4078098  -31.725018  36.540638  -33.912805  38.728425
May 2019      30.2415010  -34.561637  35.044639  -37.104264  37.587266
Jun 2019      30.3093233  -35.426247  36.044894  -38.462474  39.081121
Jul 2019      32.2816647  -34.124944  38.688274  -37.516398  42.079728 

我想把这个数据写成一个表格

Month_year     Premium         Silver        Budget
Apr 2019      2.4078098       12.4078098    32.4078098 
May 2019      0.2415010       10.2415010    30.2415010
Jun 2019      0.3093233       10.3093233    30.3093233 
Jul 2019      2.2816647       12.2816647    32.2816647

我一直在使用下面的内容，以获得单个类别的预期结果。

df <- data.frame(res)
      newdf<- df %>% rownames_to_column("month_year")
      newq <- data.frame(newdf$month_year,newdf$Point.Forecast)

现在我正在使用lapply进行多个类别，我不知道如何获得它。

Answer 1

我们设置'res'的名称，列名为'dt'（'Year'列除外），循环遍历'res'的名称，在提取第一列后将其转换为data.table（可以完成通过提取mean或转换为data.frame，然后得到第一列），并将Reduce与单个数据by合并在'Month_Year'上

names(res) <- names(dt)[-1]
lst1 <- lapply(names(res), function(x) setnames(setDT(as.data.frame(res[[x]])[1], 
            keep.rownames = TRUE), c("Month_Year", x))[]) 
Reduce(function(...) merge(..., by = "Month_Year"), lst1)

---

或者如果我们需要使用tidyverse

library(tidyverse)
imap(res, ~ .x %>% 
               as.data.frame %>% 
               select(!! .y := `Point Forecast`) %>% 
               rownames_to_column("Month_year")) %>% 
               reduce(inner_join, by = "Month_year")