Блог

Данные Испытаний

 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» возвращал 52 в строке 4, он должен возвращать 50,5 после усреднения wpointp в строке 1 и lpointp в строке 3, что соответствует двум играм А. Это то, что я могу сделать с помощью rollapply, или мне нужно найти отдельную функцию?

Спасибо

Я понимаю, что вопрос заключается в том, чтобы для каждой строки найти более ранние строки, в которых победитель этой строки является либо победителем, либо проигравшим. Затем из этих строк возьмите 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) При этом используются только данные.таблица. Это может быть медленно, хотя я добавил несколько ускорений с начальной версии.

 Mean <- function(i) {
  w <- data2$Winner[i]
  data2[1:.N < i amp; (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. Сначала преобразуйте в длинную форму с помощью изменения формы и отсортируйте ее в порядке дат. Они определяют функцию Кумма и применяют ее Победителем. В конце извлеките строки-победители.

 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