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

Question

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

使用Auto的示例。我做了计算每1000lbs平均马力前两个模型的年柱：

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）），这很难更新/好办法。有没有办法以简单的方式对不同滞后时间的多个变量执行这种滞后加权计算？

我有一种感觉，我想使用动物园:: rollaplyr基于我以前的问题和另一个问题，我发现（Mutate multiple/consecutive columns (with dplyr or base R)），但我有问题确定函数将是什么。为了保持这个例子，你能帮我弄清楚如何计算最后两个实例MPG,displacement和acceleration的平均值1000lbs 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 

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

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

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 

现在你只精确使用可用于滞后于汽车。如果我错过了商标，请告诉我，因为我很可能。