Это продолжение этого потока. Как и здесь, мне нужно определить идентификатор типа длины серии для столбца группы (игнорируя NA) с дополнительным столбцом seq_break, указывающим, что последовательность должна быть завершена, пока seq_break = TRUE. Однако решение, представленное в этом разделе, начинает новую последовательность в строке, где seq_break = TRUE, хотя на самом деле оно должно быть включено как последнее событие предыдущей последовательности. Примеры данных прилагаются ниже. Разницу можно увидеть в строке 46 - предыдущее решение запускало бы элемент последовательности 13 здесь, а мне нужно, чтобы он был включен в последовательность 12.

df <- structure(list(group = c(NA, NA, "home", "home", "home", "home", 
"home", "home", "away", NA, NA, "home", "home", "home", NA, NA, 
NA, "home", "away", "away", NA, "away", "away", "away", "home", 
"away", "away", "away", NA, "home", "home", NA, NA, "away", NA, 
NA, "home", NA, NA, "home", "home", "home", "home", "home", "home", 
"home", "away", "away", NA, NA), seq_break = c(FALSE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, 
FALSE, FALSE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE, TRUE, 
FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, 
FALSE, TRUE, TRUE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE, FALSE, 
FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, 
TRUE), expected_output = c(NA, NA, 1, 1, 1, 1, 1, 1, 2, NA, NA, 
3, 3, 3, NA, NA, NA, 4, 5, 5, NA, 6, 6, 6, 7, 8, 8, 8, NA, 9, 
9, NA, NA, 10, NA, NA, 11, NA, NA, 12, 12, 12, 12, 12, 12, 12, 
13, 13, NA, NA)), .Names = c("group", "seq_break", "expected_output"
), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-50L))

Есть идеи, как этого добиться с помощью tidyverse? Я не могу понять, как здесь можно заменить cumsum ...

0
jakes 21 Сен 2018 в 22:27

2 ответа

Лучший ответ

Мы можем создать новый столбец для вызова seq_break2 и добавить его в конвейер следующим образом. Это дает тот же результат, что и ваш ожидаемый результат.

library(tidyverse)
library(data.table)

df2 <- df %>% 
  select(-expected_output) %>%
  rowid_to_column() 

df3 <- df2 %>%
  mutate(seq_break2 = ifelse(seq_break & !is.na(group), FALSE, seq_break)) %>%
  mutate(ID = rleid(group, seq_break2)) %>%
  group_by(group, seq_break2, ID) %>%
  filter(!(is.na(group) & seq_break2 & row_number() > 1)) %>%
  ungroup() %>%
  mutate(ID2 = cumsum(seq_break2)) %>%
  drop_na(group) %>%
  mutate(expected_output = rleid(group, ID2)) %>%
  select(rowid, expected_output) %>%
  left_join(df2, ., by = "rowid") %>%
  select(-rowid)
0
www 21 Сен 2018 в 19:50

Использование rleid и shift из data.table ...

library(data.table)
setDT(df)

# make groups
df[, v := rleid(group, shift(cumsum(seq_break)))]

# drop if group is NA
df[is.na(group), v := NA]

# renumber the others
df[!is.na(group), v := .GRP, by=v]

# check
stopifnot( df[, all.equal(v, expected_output)] )

Столбец seq_break на самом деле не имеет отношения к этому примеру, поэтому я не уверен, правильно ли я его использую:

df[, v2 := rleid(group)][is.na(group), v2 := NA][!is.na(group), v2 := .GRP, by=v2]

# check
stopifnot( df[, all.equal(v2, expected_output)] )

Поскольку OP хочет ответ стиха, вот один перевод (все еще с использованием rleid):

library(dplyr)
res = df  %>% mutate(
  v2 = data.table::rleid(group) %>% replace(is.na(group), NA),
  v2 = match(v2, na.omit(unique(v2)))
) 

# check
stopifnot( with(res, all.equal(v2, expected_output)) )
1
Frank 21 Сен 2018 в 20:32