Question

我有来自比赛的数据，包括竞赛者的比赛时间，他们在比赛中的位置，独立变量x和raceid。我正在寻找一种方法来预测新赛事的结果。不只是胜利者，而是整个排名。这就是数据的样子：

df <- data.frame(                                      
competitor = c("A", "B", "C", "A", "B", "C", "D"),     
time = c(54.2, 48.3, 49.1, 105.2, 116.2, 112.5, 117.3),
position = c(3,1,2,1,3,2,4),                           
x = c(4, 6, 2, 3, 7, 5, 2),                            
race = c("race1", "race1", "race1",                    
"race2", "race2", "race2", "race2")                    
)                                                      

#>   competitor  time position x  race
#> 1          A  54.2        3 4 race1
#> 2          B  48.3        1 6 race1
#> 3          C  49.1        2 2 race1
#> 4          A 105.2        1 3 race2
#> 5          B 116.2        3 7 race2
#> 6          C 112.5        2 5 race2
#> 7          D 117.3        4 2 race2

我的一个想法是重组数据，使每个竞争对手与其他竞争对手“竞争”。然后，必须对数据进行重组，使其在第一场比赛中看起来像这样：

df_wide <- data.frame(                       
competitor = c("A", "B", "A", "C", "B", "C"),
opponent = c("B", "A", "C", "A", "C", "B"),  
time = c(54.2,48.3, 54.2, 49.1, 48.3, 49.1), 
x = c(3,1,3,2,1,2),                          
win = c(0,1,0,1,1,0),                        
race = c("race1"))                           

#>   competitor opponent time x win  race
#> 1          A        B 54.2 3   0 race1
#> 2          B        A 48.3 1   1 race1
#> 3          A        C 54.2 3   0 race1
#> 4          C        A 49.1 2   1 race1
#> 5          B        C 48.3 1   1 race1
#> 6          C        B 49.1 2   0 race1

然后我想我可以模拟A在新种族中赢得B的概率，从而预测位置。

有没有人知道这样重组数据的便捷方法？

Answer 1

好问题。

除非我过度复杂化，否则我认为所有这一切的关键是使用outer并<作为函数。例如，第一场比赛中的位置是：

pos <- c("A" = 3, "B" = 1, "C" = 2)

我们可以获得所有可能的赢/输比较矩阵，如下所示：

(res <- outer(pos, pos, `<`))
#>       A     B     C
#> A FALSE FALSE FALSE
#> B  TRUE FALSE  TRUE
#> C  TRUE FALSE FALSE

然后，我们可以使用gather和其他一些技巧将其转换为合适的数据框。但最终必须为每场比赛做好准备，然后整个事情重新组合并与原始数据框合并。所以我们需要定义一个完成工作的函数。这是：

library(tidyverse)
all_pairs <- function(df) {
  pmat <- outer(df$position, df$position, `<`)
  rownames(pmat) <- colnames(pmat) <- df$competitor
  as.data.frame(pmat) %>% 
    rownames_to_column(var = "competitor") %>% 
    gather(opponent, win, -competitor) %>% 
    mutate(win=as.integer(win)) %>% 
    filter(competitor != opponent)
}

让我们试试第一场比赛：

all_pairs(df[1:3,])
#>   competitor opponent win
#> 1          B        A   1
#> 2          C        A   1
#> 3          A        B   0
#> 4          C        B   0
#> 5          A        C   0
#> 6          B        C   1

我决定使用split和lapply。 bind_rows函数有一种很好的方法来恢复race变量。这是最后的答案：

left_join(df,
          bind_rows(lapply(split(df, factor(df$race)), all_pairs), .id = "race")) %>% 
  select(competitor, opponent, time, x, win, race)
#> Joining, by = c("competitor", "race")
#> # A tibble: 18 x 6
#>    competitor opponent  time     x   win race 
#>    <chr>      <chr>    <dbl> <dbl> <int> <chr>
#>  1 A          B         54.2    4.     0 race1
#>  2 A          C         54.2    4.     0 race1
#>  3 B          A         48.3    6.     1 race1
#>  4 B          C         48.3    6.     1 race1
#>  5 C          A         49.1    2.     1 race1
#>  6 C          B         49.1    2.     0 race1
#>  7 A          B        105.     3.     1 race2
#>  8 A          C        105.     3.     1 race2
#>  9 A          D        105.     3.     1 race2
#> 10 B          A        116.     7.     0 race2
#> 11 B          C        116.     7.     0 race2
#> 12 B          D        116.     7.     1 race2
#> 13 C          A        112.     5.     0 race2
#> 14 C          B        112.     5.     1 race2
#> 15 C          D        112.     5.     1 race2
#> 16 D          A        117.     2.     0 race2
#> 17 D          B        117.     2.     0 race2
#> 18 D          C        117.     2.     0 race2

重组比赛/比赛数据

1 个答案: