计算多列上前 n 个实例的加权平均值

Question

我正在尝试通过计算 2 列的前 n 个值来创建几个新列。

使用Auto 的示例。我制作了一个列来计算前两个车型年每 1000 磅的平均马力：

library(ISLR)
library(dplyr)    
LaggedAuto <- Auto %>% 
                  arrange(year) %>% 
                  group_by(name) %>% 
                  mutate(L2HPbyWT = 1000*((lag(horsepower)+lag(horsepower,2))/(lag(weight)+lag(weight,2))))

所以 80,81,82 卡罗拉的 (重量, HP) 分别为 (2265, 75), (2350, 75), (2245,70)。因此，Corolla '82 行上的新列将是 1000*(75+75)/(2265+2350) = 32.50。所以它或多或少是HP/Weight 的平均值，由Weight 加权。

在我自己的数据集中，我想要为大约 12 列执行此操作，滞后 5+。这意味着如果我继续使用当前的技术，我将为另外 11 个变量进行大量输入 (lag(,1) + lag(,2) + ... + lag(,5)) ，这使得我很难更新/调整。有没有办法以一种简单的方式对多个变量执行这种滞后加权计算，以获得不同的滞后？

根据我以前的问题和我发现的另一个问题 (Mutate multiple / consecutive columns (with dplyr or base R))，我有一种想使用 zoo::rollaplyr 的感觉，但我在确定功能是什么时遇到了问题。为了保持这个例子，你能帮我弄清楚如何计算MPG、displacement和acceleration的最后两个实例的平均值乘以1000磅weight吗？

Answer 1

首先，请注明数据来源，以便我们使用。我在library(ISLR) 下找到它。

所以，我讨厌 stats::lag 函数。从滞后函数添加滞后值是错误的。我会告诉你我的意思：

lag(Auto$horsepower[1:8], 1)
#[1] 130 165 150 150 140 198 220 215
#attr(,"tsp")
#[1] 0 7 1

lag(Auto$horsepower[1:8], 2)
#[1] 130 165 150 150 140 198 220 215
#attr(,"tsp")
#[1] -1  6  1

lag(Auto$horsepower[1:8], 1) + lag(Auto$horsepower[1:8], 2)
#[1] 260 330 300 300 280 396 440 430
#attr(,"tsp")
#[1] 0 7 1

这不起作用。它为您提供了正确子集数据的方法，但实际上并不可用。你真正想要的是这样的：

shift(Auto$horsepower[1:8], 1:2)
#     [,1] [,2]
#[1,]    0    0
#[2,]  130    0
#[3,]  165  130
#[4,]  150  165
#[5,]  150  150
#[6,]  140  150
#[7,]  198  140

rowSums(shift(Auto$horsepower[1:8], 1:2))
#[1]   0 130 295 315 300 290 338 418

这将是一个完美的矢量化函数，可以让领先者和滞后者的生活更轻松。 所以我写在下面：

  shift <- function(x, i = 1, NA2zero = TRUE, naming = NULL){
  Z <- ifelse(NA2zero, 0, NA)
  L <- sapply(i, function(i){ "if"(i > 0, 
                                     c(rep(Z, max(abs(i))), 
                                       x[-c((length(x)+1-i):length(x))]),
                                     "if"(i < 0, 
                                             c(x[-c(1:abs(i))], 
                                               rep(Z, max(abs(i))) ),
                                             x))
              })
  "if"(is.null(naming), 
       colnames(L) <- paste0(deparse(substitute(x)),".",i),
       colnames(L) <- paste0(naming,".",i))
  return(L)
}

现在您可以通过以下方式轻松地修复您的代码：

L2HPbyWT = 1000*((rowSums(shift(Auto$horsepower, i = 1:2)) / rowSums(shift(Auto$weight, i = 1:2))))

我什至添加了一个有趣的小命名功能：

head(shift(Auto$horsepower, 0:2, naming = "HP"),3)
     HP.0 HP.1 HP.2
[1,]  130    0    0
[2,]  165  130    0
[3,]  150  165  130

编辑：看来您毕竟不需要延迟功能！ 现在我可以深入探讨你的问题。我从来没有进入过 dplyr，所以这将是基础，所以请原谅我。看来您落后于不同年份的汽车。因此，如果我们看一下汽车： 昏暗（自动） #[1] 392 9 # 很大，很多行。

# split them into groups by type of car
eachAuto <- split(Auto, Auto$name)
table(sapply(eachAuto, nrow))
#  0   1   2   3   4   5 # lengths
#  3 245  34  12   7   3 # counts

现在我们看到有 0 行的 3 辆汽车（有些因子水平没有数据），只有 1 行的 245 辆汽车，3 行的 12 辆汽车，依此类推。

在这里使用名称列似乎是一个错误......除非我们限制我们可以使用的汽车？ 怎么样：

MAXLAG <- 2
Autos_subset <- eachAuto[sapply(eachAuto, nrow) > (MAXLAG-1)]
newAuto <- lapply(Autos_subset, function(x) {
  x$L2HPbyWT <- 1000*((rowSums(shift(x$horsepower, i = 1:MAXLAG)) / rowSums(shift(x$weight, i = 1:MAXLAG))))
  x
  })

length(newAuto) # 56 car names in the list 

现在您准确地只使用了可用于滞后的汽车。如果我错过了标记，请告诉我，因为我很可能是。