R-从值中计算滚动平均值与多列中的列匹配

Question

测试数据

library(data.table)
data<-data.table(
Date= c("2018-01-01", "2018-01-02", "2018-01-03", "2018-01-04", "2018-01-05", "2018-01-06"),
Winner= c("A","D","B","A","C","A"),
Loser=c("B","C","A","C","B","C"),
wpointp=c("52","58","51","61","59","55"),
lpointp=c("48","42","49","39","41","45"))

我有一个数据表，其中列出了游戏的赢家和输家，以及他们在比赛中赢得的分数百分比。我想要一个额外的列来计算过去比赛中获胜者的历史分数百分比（“wpoint.av”），无论他们之前是赢家还是输家。

我知道我可以使用以下代码使用 zoo 和 rollapply 来获得获胜者出现在获胜者列中的所有出现的滚动平均值，但我无法让它也计算任何时候获胜者也出现在失败者专栏：

data$wpointp<-as.numeric(data$wpointp)
data$lpointp<-as.numeric(data$lpointp)
data[,wpointp.av. := lag(rollapply(wpointp,mean,width=10000,align="right",partial=TRUE, fill=NA)),by="Winner"]

因此，“wpointp.av”在第 4 行返回 52 而不是在第 1 行平均 wpointp 和在第 3 行平均 lpointp 后返回 50.5 - 对应于 A 的两场比赛。这是我可以用 rollapply 做的事情，还是我需要找到一个单独的函数？

谢谢

Answer 1

我的理解是，问题是要求为每一行找到较早的行，该行的赢家是赢家还是输家。然后从这些行中取 wpointp 为赢家的行和 lpointp 为输家的行并平均所有这些数字。

1) sqldf 我们首先将 wpointp 和 lpointp 设为数值，然后使用指示的 on 条件将结果左连接到自身，并使用 avg 生成显示的平均值。

library(data.table)
library(sqldf)

data2 <- copy(data)
data2[, c("wpointp", "lpointp") := .(as.numeric(wpointp), as.numeric(lpointp))]

sqldf("select a.*, 
 avg((a.Winner = b.Winner)*b.wpointp + (a.Winner = b.Loser)*b.lpointp) 'wpoint.av',
 from data2 a
 left join data2 b
 on b.Date < a.Date and ((a.Winner = b.Winner) or (a.Winner = b.Loser))
 group by a.rowid")

给予：

        Date Winner Loser wpointp lpointp wpoint.av
1 2018-01-01      A     B      52      48        NA
2 2018-01-02      D     C      58      42        NA
3 2018-01-03      B     A      51      49      48.0
4 2018-01-04      A     C      61      39      50.5
5 2018-01-05      C     B      59      41      40.5
6 2018-01-06      A     C      55      45      54.0

2) 这仅使用 data.table。虽然我从初始版本开始添加了一些加速，但它可能会很慢。

Mean <- function(i) {
  w <- data2$Winner[i]
  data2[1:.N < i & (Winner == w | Loser == w),
     mean((Winner == w) * wpointp + (Loser == w) * lpointp)]
}
data2 <- copy(data)
data2[, c("wpointp", "lpointp") := .(as.numeric(wpointp), as.numeric(lpointp))]

data2[, wpoint.av := sapply(.I, Mean)]
data2

给予：

         Date Winner Loser wpointp lpointp wpoint.av
1: 2018-01-01      A     B      52      48       NaN
2: 2018-01-02      D     C      58      42       NaN
3: 2018-01-03      B     A      51      49      48.0
4: 2018-01-04      A     C      61      39      50.5
5: 2018-01-05      C     B      59      41      40.5
6: 2018-01-06      A     C      55      45      54.0

3) dplyr/tidyr 将指示的列转换为数字，转换为长格式，使用 cummean 计算滚动平均值，提取获胜者行并将它们连接回原始数据。

library(data.table)
library(dplyr)
library(tidyr)

data %>%
 mutate(wpointp = as.numeric(wpointp), lpointp = as.numeric(lpointp)) %>%
 pivot_longer(Winner:Loser) %>%
 group_by(value) %>%
 mutate(pointp.av = 
   lag(cummean((name=="Winner") * wpointp + (name=="Loser") * lpointp))) %>%
 ungroup %>%
 filter(name == "Winner") %>%
 select(Date, pointp.av) %>%
 right_join(data, by = "Date") %>%
 select(Date, Winner, Loser, wpointp, lpointp, pointp.av)

给予：

# A tibble: 6 x 6
  Date       Winner Loser wpointp lpointp pointp.av
  <chr>      <chr>  <chr> <chr>   <chr>       <dbl>
1 2018-01-01 A      B     52      48           NA  
2 2018-01-02 D      C     58      42           NA  
3 2018-01-03 B      A     51      49           48  
4 2018-01-04 A      C     61      39           50.5
5 2018-01-05 C      B     59      41           40.5
6 2018-01-06 A      C     55      45           54  

4) 这仅使用基数 R。首先使用 reshape 转换为长格式并按日期顺序对其进行排序。他们定义了一个 cumMean 函数并由 Winner 应用。最后提取出获胜者行。

varying <- list(c("Winner", "Loser"), c("wpointp", "lpointp"))
long <- reshape(data, dir = "long", varying = varying)
long <- long[order(long$Date), ]
cumMean <- function(x) c(NA, head(cumsum(x), -1)) / (seq_along(x) - 1)
long2 <- transform(long, av = ave(as.numeric(wpointp), Winner, FUN = cumMean))
subset(long2, time == 1)

给予：

         Date time Winner wpointp id   av
1: 2018-01-01    1      A      52  1   NA
2: 2018-01-02    1      D      58  2   NA
3: 2018-01-03    1      B      51  3 48.0
4: 2018-01-04    1      A      61  4 50.5
5: 2018-01-05    1      C      59  5 40.5
6: 2018-01-06    1      A      55  6 54.0