программно создать фиктивный файл для каждого возможного значения переменной и передать их в формулу - PullRequest
Новая
       15

программно создать фиктивный файл для каждого возможного значения переменной и передать их в формулу

0 голосов
/ 22 мая 2018

Я нашел Данные о смещении в НХЛ и хотел бы оценить модель, в которой будут забиты голы, распределением Пуассона в зависимости от того, кто находится на льду для обеих команд.

Моя точка зрения заключается в том, что у нас уже есть хорошая идея о том, кто может набирать очки (голы и голевые передачи), но, может быть, кто-то действительно хорош в том, чтобы помочь своей команде набрать очки, не попав в таблицу рекордов (возможно, генерируя обороты?) или просто очень хорош в предотвращении подсчета очков другой командой.

Я могу создать набор данных, который выглядит как «данные» ниже.Обычно на льду по 5 игроков для каждой команды, но я ставлю только 2, чтобы сделать пример усваиваемым.

В принципе, у меня есть линия за смену, я знаю результат смены (goal_for),shift_duration и у меня есть список идентификаторов игроков, играющих за команду (for_players) и в составе команды противников (против_players).

Что я хотел бы сделать - это взять набор данных «data» и создать «model_data» с одной фиктивной переменной, указывающей, находится ли игрок на льду в течение данного смены.Затем я бы создал формулу для своей модели Пуассона, которая включала бы все манекены и передал бы ее модели.Я мог бы также бросить одного манекена за и одного манекена против, но я также могу позволить mgcv: gam сделать это для меня.

Я подозреваю, что это будет связано с некоторыми !!и quos (), но я не уверен, как это сделать. 

data <- tibble(
  shift_id = c(1, 2, 3, 4, 5, 6, 7, 8,9,10),
  shift_duration = c(12, 7, 30, 11, 14, 16, 19, 32,11,12),
  goal_for = c(1, 1, 0, 0, 1, 1, 0, 0,0,0),
  for_players = list(
    c("A", "B"),
    c("A", "C"),
    c("B", "C"),
    c("A", "C"),
    c("B", "C"),
    c("A", "B"),
    c("B", "C"),
    c("A", "B"),
    c("B", "C"),
    c("A", "B")
  ),
  against_players = list(
    c("X", "Z"),
    c("Y", "Z"),
    c("X", "Y"),
    c("X", "Y"),
    c("X", "Z"),
    c("Y", "Z"),
    c("X", "Y"),
    c("Y", "Z"),
    c("X", "Y"),
    c("Y", "Z")
  )
)


(black magic goes here)

model_data <- tibble(
  shift_id = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
  shift_duration = c(12, 7, 30, 11, 14, 16, 19, 32, 11, 12),
  goal_for = c(1, 1, 0, 0, 1, 1, 0, 0, 0, 0),
  for_player_A = c(1, 1, 0, 1, 0, 1, 0, 1, 0, 1),
  for_player_B = c(1, 0, 1, 0, 1, 1, 1, 1, 1, 1),
  for_player_C = c(0, 1, 1, 1, 1, 0, 1, 0, 1, 0),
  against_player_X = c(1, 0, 1, 1, 1, 0, 1, 0, 1, 0),
  against_player_Y = c(0, 1, 1, 1, 0, 1, 1, 1, 1, 1),
  against_player_Z = c(1, 1, 0, 0, 1, 1, 0, 1, 0, 1)
)



mod.gam <- mgcv::gam(
  data = model_data,
  formula =  goal_for ~ offset(log(shift_duration)) + for_player_A + for_player_B  + for_player_C +
    against_player_X + against_player_Y + against_player_Z,
  family = poisson(link = log)
)

data выглядит так: 

> data
# A tibble: 10 x 5
   shift_id shift_duration goal_for for_players against_players
      <dbl>          <dbl>    <dbl> <list>      <list>         
 1     1.00          12.0      1.00 <chr [2]>   <chr [2]>      
 2     2.00           7.00     1.00 <chr [2]>   <chr [2]>      
 3     3.00          30.0      0    <chr [2]>   <chr [2]>      
 4     4.00          11.0      0    <chr [2]>   <chr [2]>      
 5     5.00          14.0      1.00 <chr [2]>   <chr [2]>      
 6     6.00          16.0      1.00 <chr [2]>   <chr [2]>      
 7     7.00          19.0      0    <chr [2]>   <chr [2]>      
 8     8.00          32.0      0    <chr [2]>   <chr [2]>      
 9     9.00          11.0      0    <chr [2]>   <chr [2]>      
10    10.0           12.0      0    <chr [2]>   <chr [2]>

Данные модели выглядит так: 

> model_data
# A tibble: 10 x 9
   shift_id shift_duration goal_for for_player_A for_player_B for_player_C against_player_X against_player_Y against_player_Z
      <dbl>          <dbl>    <dbl>        <dbl>        <dbl>        <dbl>            <dbl>            <dbl>            <dbl>
 1     1.00          12.0      1.00         1.00         1.00         0                1.00             0                1.00
 2     2.00           7.00     1.00         1.00         0            1.00             0                1.00             1.00
 3     3.00          30.0      0            0            1.00         1.00             1.00             1.00             0   
 4     4.00          11.0      0            1.00         0            1.00             1.00             1.00             0   
 5     5.00          14.0      1.00         0            1.00         1.00             1.00             0                1.00
 6     6.00          16.0      1.00         1.00         1.00         0                0                1.00             1.00
 7     7.00          19.0      0            0            1.00         1.00             1.00             1.00             0   
 8     8.00          32.0      0            1.00         1.00         0                0                1.00             1.00
 9     9.00          11.0      0            0            1.00         1.00             1.00             1.00             0   
10    10.0           12.0      0            1.00         1.00         0                0                1.00             1.00

Результаты по модели: 

Family: poisson 
Link function: log 

Formula:
goal_for ~ offset(log(shift_duration)) + for_player_A + for_player_B + 
    for_player_C + against_player_X + against_player_Y + against_player_Z

Parametric coefficients:
                  Estimate Std. Error z value Pr(>|z|)
(Intercept)       -22.0296  4317.9341  -0.005    0.996
for_player_A        0.0000     0.0000      NA       NA
for_player_B       -2.3026     2.0000  -1.151    0.250
for_player_C       -0.1542     1.4142  -0.109    0.913
against_player_X    1.6094     1.4142   1.138    0.255
against_player_Y    0.0000     0.0000      NA       NA
against_player_Z   20.2378  4317.9339   0.005    0.996


Rank: 5/7
R-sq.(adj) =  0.353   Deviance explained = 73.6%
UBRE = 0.26435  Scale est. = 1         n = 10

1 Ответ

0 голосов
/ 22 мая 2018

Вы можете преобразовать ваш data фрейм данных в ваш model_data фрейм данных, используя функции из tidyr ... 

library(dplyr)
library(tidyr)

model_data <-
  data %>% 
  unnest(for_players, .drop = F) %>% 
  spread(for_players, for_players, sep = '_') %>% 
  unnest(against_players, .drop = F) %>% 
  spread(against_players, against_players, sep = '_') %>% 
  mutate_at(vars(-(1:3)), funs(as.numeric(!is.na(.))))
...