Генерация переменной для подсчета последовательных записей

Question

Допустим, у меня есть следующий набор данных

df <- read.table(text="UTCDate  UTCTime   White   Black
    2018.01.01 03:49:40 JL  XN
    2018.01.01 03:52:01  XN JL
    2018.01.01 03:54:16 JL  XN
    2018.01.01 03:55:58  XN JL
    2018.01.01 03:57:59 JL  XN
    2018.01.01 04:00:27  XN JL
    2018.01.01 04:01:48 JL  XN
    2018.01.01 04:03:43  XN JL
    2018.01.01 04:06:12 JL  XN
    2018.01.01 09:21:16 JL  OC
    2018.01.01 09:22:28  OC JL
    2018.01.01 09:24:16 JL  OC
    2018.01.01 09:24:58  OC JL", header=T)

Я пытаюсь создать столбец, который отслеживает «последовательные игры», в которых последовательная игра определяется, скажем, как любая запись, которая находится менее чем в 10 минутах от предыдущей записи. Здесь последовательная игра определяется с точки зрения какого-либо игрока (например, JL), поэтому строки с 1 по 9 будут читаться (1: 9) в столбце consec_games, а строки с 10 по 13 будут (1: 4).

Столбец «последовательные игры» должен применяться только к одному игроку (например, JL). Так что это будет JL_consecutive_games. Это большой набор данных, в котором несколько игроков могут одновременно играть с другими. Поэтому столбец последовательных игр должен применяться только к некоторому заранее указанному игроку (в данном случае, JL).

Я видел такие ответы: Последовательный подсчет по группам , которые используют функцию задержки, но я не уверен, как применить задержку к этому набору данных.

Answer 1

А как насчет удобства data.table Функция:

consecutive_plays <- function(df, player, date_var = "UTCDate", time_var = "UTCTime", white_var = "White", black_var = "Black", diff_time = 10, unit_time = "mins") {

  require(data.table)

  setDT(df)[, `:=` (TimeDimension = as.POSIXct(paste(get(date_var), get(time_var)), format = "%Y.%m.%d %H:%M:%S"), 
                    Player_Present = get(white_var) == player | get(black_var) == player)][
                      , time_diff := as.numeric(difftime(TimeDimension, shift(TimeDimension), units = unit_time) >= diff_time), by = .(Player_Present)][
                        is.na(time_diff), time_diff := 0][
                          get(white_var) == player | get(black_var) == player, paste0(player, "_consecutive_games") := seq_len(.N), by = .(Player_Present, cumsum(time_diff))][
                            , c("TimeDimension", "time_diff", "Player_Present") := NULL
                            ]

}

То, что вы можете вызвать для любого желаемого игрока:

df <- consecutive_plays(df, player = "JL")

И получить вывод с соответствующим столбцом:

       UTCDate  UTCTime White Black JL_consecutive_games
 1: 2018.01.01 03:49:40    JL    XN                    1
 2: 2018.01.01 03:52:01    XN    JL                    2
 3: 2018.01.01 03:54:16    JL    XN                    3
 4: 2018.01.01 03:55:58    XN    JL                    4
 5: 2018.01.01 03:57:59    JL    XN                    5
 6: 2018.01.01 04:00:27    XN    JL                    6
 7: 2018.01.01 04:01:48    JL    XN                    7
 8: 2018.01.01 04:03:43    XN    JL                    8
 9: 2018.01.01 04:06:12    JL    XN                    9
10: 2018.01.01 09:21:16    JL    OC                    1
11: 2018.01.01 09:22:28    OC    JL                    2
12: 2018.01.01 09:24:16    JL    OC                    3
13: 2018.01.01 09:24:58    OC    JL                    4

Если игрока нет ни в одной из игр, строки будут установлены на NA:

df <- consecutive_plays(df, player = "XN")

       UTCDate  UTCTime White Black JL_consecutive_games XN_consecutive_games
 1: 2018.01.01 03:49:40    JL    XN                    1                    1
 2: 2018.01.01 03:52:01    XN    JL                    2                    2
 3: 2018.01.01 03:54:16    JL    XN                    3                    3
 4: 2018.01.01 03:55:58    XN    JL                    4                    4
 5: 2018.01.01 03:57:59    JL    XN                    5                    5
 6: 2018.01.01 04:00:27    XN    JL                    6                    6
 7: 2018.01.01 04:01:48    JL    XN                    7                    7
 8: 2018.01.01 04:03:43    XN    JL                    8                    8
 9: 2018.01.01 04:06:12    JL    XN                    9                    9
10: 2018.01.01 09:21:16    JL    OC                    1                   NA
11: 2018.01.01 09:22:28    OC    JL                    2                   NA
12: 2018.01.01 09:24:16    JL    OC                    3                   NA
13: 2018.01.01 09:24:58    OC    JL                    4                   NA

Неважно, сколько у вас игроков. Вы можете легко быстро получить столбцы для всех них:

players <- unique(c(as.character(df$White), as.character(df$Black)))

for (player in players) { df <- consecutive_plays(df, player = player) }

Выход:

       UTCDate  UTCTime White Black JL_consecutive_games XN_consecutive_games OC_consecutive_games
 1: 2018.01.01 03:49:40    JL    XN                    1                    1                   NA
 2: 2018.01.01 03:52:01    XN    JL                    2                    2                   NA
 3: 2018.01.01 03:54:16    JL    XN                    3                    3                   NA
 4: 2018.01.01 03:55:58    XN    JL                    4                    4                   NA
 5: 2018.01.01 03:57:59    JL    XN                    5                    5                   NA
 6: 2018.01.01 04:00:27    XN    JL                    6                    6                   NA
 7: 2018.01.01 04:01:48    JL    XN                    7                    7                   NA
 8: 2018.01.01 04:03:43    XN    JL                    8                    8                   NA
 9: 2018.01.01 04:06:12    JL    XN                    9                    9                   NA
10: 2018.01.01 09:21:16    JL    OC                    1                   NA                    1
11: 2018.01.01 09:22:28    OC    JL                    2                   NA                    2
12: 2018.01.01 09:24:16    JL    OC                    3                   NA                    3
13: 2018.01.01 09:24:58    OC    JL                    4                   NA                    4

В конце концов, вы также можете настроить другие параметры, например, если вы хотите изменить diff_time на более чем 10 минут, или если вы хотите изменить unit_time на hours, days или weeks и т. д.

Answer 2

Вот решение с использованием Tidyverse, которое дает вам результат для всех игроков:

library(tidyverse)
library(magrittr)
library(lubridate)

df %<>%           
  gather("color", "player", 3:4) %>%
  unite(datetime, 1:2) %>%
  arrange(datetime) %>%
  mutate(name = player)

df$datetime %<>% parse_datetime("%Y.%m.%d_%H:%M:%S")

nested <- df %>%
           mutate(cond = difftime(df$datetime, lag(df$datetime)) < 600) %>% 
           group_by(player) %>%
           nest()

get_cons <- function(df) {
  df$consecutive_games[1] <- 1
  for(i in 2:nrow(df)) {
    if(df$cond[i] == T) {
      df$consecutive_games[i] <- df$consecutive_games[i - 1] + 1
    }
    df$cond[i] <- 1
  }
  df %>%
    select(- cond)
}

options(tibble.print_max = Inf) # to show entire tibble

map_df(nested$data, get_cons)

# A tibble: 26 x 4
   datetime            color name  consecutive_games
   <dttm>              <chr> <chr>             <dbl>
 1 2018-01-01 03:49:40 White JL                    1
 2 2018-01-01 03:52:01 Black JL                    2
 3 2018-01-01 03:54:16 White JL                    3
 4 2018-01-01 03:55:58 Black JL                    4
 5 2018-01-01 03:57:59 White JL                    5
 6 2018-01-01 04:00:27 Black JL                    6
 7 2018-01-01 04:01:48 White JL                    7
 8 2018-01-01 04:03:43 Black JL                    8
 9 2018-01-01 04:06:12 White JL                    9
10 2018-01-01 09:21:16 White JL                    1
11 2018-01-01 09:22:28 Black JL                    2
12 2018-01-01 09:24:16 White JL                    3
13 2018-01-01 09:24:58 Black JL                    4
14 2018-01-01 03:49:40 Black XN                    1
15 2018-01-01 03:52:01 White XN                    2
16 2018-01-01 03:54:16 Black XN                    3
17 2018-01-01 03:55:58 White XN                    4
18 2018-01-01 03:57:59 Black XN                    5
19 2018-01-01 04:00:27 White XN                    6
20 2018-01-01 04:01:48 Black XN                    7
21 2018-01-01 04:03:43 White XN                    8
22 2018-01-01 04:06:12 Black XN                    9
23 2018-01-01 09:21:16 Black OC                    1
24 2018-01-01 09:22:28 White OC                    2
25 2018-01-01 09:24:16 Black OC                    3
26 2018-01-01 09:24:58 White OC                    4

А если вы предпочитаете его в широком формате:

map_df(nested$data, get_cons) %>%
  rownames_to_column(var = "id") %>%
  mutate_at(vars(id), funs(stringi::stri_pad_left(., width = 2, pad = "0"))) %>%
  spread(name, consecutive_games)

# A tibble: 26 x 6
   id  datetime            color    JL    OC    XN
   <chr> <dttm>              <chr> <dbl> <dbl> <dbl>
 1 01    2018-01-01 03:49:40 White     1    NA    NA
 2 02    2018-01-01 03:52:01 Black     2    NA    NA
 3 03    2018-01-01 03:54:16 White     3    NA    NA
 4 04    2018-01-01 03:55:58 Black     4    NA    NA
 5 05    2018-01-01 03:57:59 White     5    NA    NA
 6 06    2018-01-01 04:00:27 Black     6    NA    NA
 7 07    2018-01-01 04:01:48 White     7    NA    NA
 8 08    2018-01-01 04:03:43 Black     8    NA    NA
 9 09    2018-01-01 04:06:12 White     9    NA    NA
10 10    2018-01-01 09:21:16 White     1    NA    NA
11 11    2018-01-01 09:22:28 Black     2    NA    NA
12 12    2018-01-01 09:24:16 White     3    NA    NA
13 13    2018-01-01 09:24:58 Black     4    NA    NA
14 14    2018-01-01 03:49:40 Black    NA    NA     1
15 15    2018-01-01 03:52:01 White    NA    NA     2
16 16    2018-01-01 03:54:16 Black    NA    NA     3
17 17    2018-01-01 03:55:58 White    NA    NA     4
18 18    2018-01-01 03:57:59 Black    NA    NA     5
19 19    2018-01-01 04:00:27 White    NA    NA     6
20 20    2018-01-01 04:01:48 Black    NA    NA     7
21 21    2018-01-01 04:03:43 White    NA    NA     8
22 22    2018-01-01 04:06:12 Black    NA    NA     9
23 23    2018-01-01 09:21:16 Black    NA     1    NA
24 24    2018-01-01 09:22:28 White    NA     2    NA
25 25    2018-01-01 09:24:16 Black    NA     3    NA
26 26    2018-01-01 09:24:58 White    NA     4    NA

Answer 3

Только в базе R.
Сначала создайте объект данных / времени с двумя отдельными столбцами UTCDate и UTCTime. Затем используйте трюк cumsum, чтобы получить группы. Наконец, ave применяет функцию (seq_along) к каждому из векторов, определенных как d.

UTC <- paste(df$UTCDate, df$UTCTime)
UTC <- as.POSIXct(UTC, format = "%Y.%m.%d %H:%M:%S")

d <- c(0, difftime(UTC[-1], UTC[-length(UTC)], units = "mins"))
d <- cumsum(d > 10)

ave(seq_len(nrow(df)), d, FUN = seq_along)
#[1] 1 2 3 4 5 6 7 8 9 1 2 3 4

df$Games <- ave(seq_len(nrow(df)), d, FUN = seq_along)

rm(UTC, d)    # Tidy up