計算多列前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 

現在你只精確使用可用於滯後於汽車。如果我錯過了商標，請告訴我，因爲我很可能。