R - 按数据框中的组识别一系列行元素答案

【问题标题】：R - Identify a sequence of row elements by groups in a dataframeR - 按数据框中的组识别一系列行元素
【发布时间】：2017-04-29 02:14:19
【问题描述】：

考虑以下示例数据框：

> df
   id name time
1   1    b   10
2   1    b   12
3   1    a    0
4   2    a    5
5   2    b   11
6   2    a    9
7   2    b    7
8   1    a   15
9   2    b    1
10  1    a    3

df = structure(list(id = c(1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 2L, 1L), 
    name = c("b", "b", "a", "a", "b", "a", "b", "a", "b", "a"
    ), time = c(10L, 12L, 0L, 5L, 11L, 9L, 7L, 15L, 1L, 3L)), .Names = c("id", 
"name", "time"), row.names = c(NA, -10L), class = "data.frame")

我需要识别和记录所有序列seq <- c("a","b")，其中“a”基于“时间”列在“b”之前，对于每个 id。 “a”和“b”之间不允许有其他名称。实际序列长度至少为 5。样本数据的预期结果是

有一个类似的问题Finding rows in R dataframe where a column value follows a sequence。但是，我不清楚在我的情况下如何处理“id”列。是否可以使用“dplyr”解决问题？

【问题讨论】：

目前还不清楚你是如何达到你想要的结果的。

标签： r dataframe dplyr

【解决方案1】：

library(dplyr); library(tidyr)

# sort data frame by id and time
df %>% arrange(id, time) %>% group_by(id) %>% 

       # get logical vector indicating rows of a followed by b and mark each pair as unique
       # by cumsum
       mutate(ab = name == "a" & lead(name) == "b", g = cumsum(ab)) %>% 

       # subset rows where conditions are met
       filter(ab | lag(ab)) %>% 

       # reshape your data frame to wide format
       select(-ab) %>% spread(name, time)


#Source: local data frame [3 x 4]
#Groups: id [2]

#     id     g     a     b
#* <int> <int> <int> <int>
#1     1     1     3    10
#2     2     1     5     7
#3     2     2     9    11

如果序列的长度大于两个，那么您将需要检查多个滞后，其中一种选择是使用 data.table 组合中的 shift 函数（它接受一个向量作为滞后/领先步骤）用Reduce，说我们是否需要检查模式abb：

library(dplyr); library(tidyr); library(data.table)
pattern = c("a", "b", "b")
len_pattern = length(pattern)

df %>% arrange(id, time) %>% group_by(id) %>% 

       # same logic as before but use Reduce function to check multiple lags condition
       mutate(ab = Reduce("&", Map("==", shift(name, n = 0:(len_pattern - 1), type = "lead"), pattern)), 
              g = cumsum(ab)) %>% 

       # use reduce or to subset sequence rows having the same length as the pattern
       filter(Reduce("|", shift(ab, n = 0:(len_pattern - 1), type = "lag"))) %>% 

       # make unique names
       group_by(g, add = TRUE) %>% mutate(name = paste(name, 1:n(), sep = "_")) %>% 

       # pivoting the table to wide format
       select(-ab) %>% spread(name, time) 

#Source: local data frame [1 x 5]
#Groups: id, g [1]

#     id     g   a_1   b_2   b_3
#* <int> <int> <int> <int> <int>
#1     1     1     3    10    12

【讨论】：

我本来打算发这个的，但它或多或少是一样的：df %>% arrange(id, time) %>% group_by(id) %>% filter(ifelse(name == 'b', lag(name) == 'a', lead(name) == 'b')) %>% ungroup() %>% mutate(i = rep(seq(n()/2), each = 2)) %>% spread(name, time) %>% select(a, b)
@alistaire 我认为您仍然可以将其发布为答案，对于如何为每对创建唯一 id 是一种不同的方法。
太棒了！正是我想要的！很容易扩展更长的序列，例如“abaab”或“abccd”。你能建议如何处理在执行之前长度未知的序列吗？ IE。我不知道序列是“ab”还是“aabbb”...
在使用类似的“名称”序列时，这种方法会出现问题。假设 > df = data.frame(id=c(1,1,1,2,2,2),name=c("a","a","a","a","a"," a"),time=c(0,2,4,1,3,5)) 并且我们正在寻找 ("a","a")，结果数据帧不正确。与 ("a","a","a") 相同
在这种情况下，您可能需要重新考虑您需要什么。对于 c("a", "a") 实例。对于 id == 1，结果将是 (0, 2) 或 (0, 2), (2, 4)？

【解决方案2】：

您可以将filter 中的ifelse 与lag 和lead 一起使用，然后将tidyr::spread 重塑为宽：

library(tidyverse)

df %>% arrange(id, time) %>% group_by(id) %>% 
    filter(ifelse(name == 'b',    # if name is b...
                  lag(name) == 'a',    # is the previous name a?
                  lead(name) == 'b')) %>%    # else if name is not b, is next name b?
    ungroup() %>% mutate(i = rep(seq(n() / 2), each = 2)) %>%    # create indices to spread by
    spread(name, time) %>% select(a, b)    # spread to wide and clean up

## # A tibble: 3 × 2
##       a     b
## * <int> <int>
## 1     3    10
## 2     5     7
## 3     9    11

根据下面的评论，这是一个使用gregexpr 查找匹配模式的第一个索引的版本，虽然更复杂，但更容易扩展到更长的模式，例如"aabb"：

df %>% group_by(pattern = 'aabb', id) %>%    # add pattern as column, group
    arrange(time) %>%
    # collapse each group to a string for name and a list column for time
    summarise(name = paste(name, collapse = ''), time = list(time)) %>% 
    # group and add list-column of start indices for each match
    rowwise() %>% mutate(i = gregexpr(pattern, name)) %>% 
    unnest(i, .drop = FALSE) %>%    # expand, keeping other list columns
    filter(i != -1) %>%    # chop out rows with no match from gregexpr
    rowwise() %>%    # regroup
    # subset with sequence from index through pattern length 
    mutate(time = list(time[i + 0:(nchar(pattern) - 1)]), 
           pattern = strsplit(pattern, '')) %>%    # expand pattern to list column
    rownames_to_column('match') %>%    # add rownames as match index column
    unnest(pattern, time) %>%    # expand matches in parallel
    # paste sequence onto each letter (important for spreading if repeated letters)
    group_by(match) %>% mutate(pattern = paste0(pattern, seq(n()))) %>% 
    spread(pattern, time)    # spread to wide form

## Source: local data frame [1 x 8]
## Groups: match [1]
## 
##   match    id  name     i    a1    a2    b3    b4
## * <chr> <int> <chr> <int> <int> <int> <int> <int>
## 1     1     1 aabba     1     0     3    10    12

请注意，如果模式没有按字母顺序排列，则结果列将不会按其索引排序。但是，由于保留了索引，因此您可以使用 select(1:4, parse_number(names(.)[-1:-4]) + 4) 之类的内容进行排序。

【讨论】：

很好的解决方案！如何扩展它以用于像“abaaaab”这样的较长序列？
您可以进行多次延迟，但此时将组粘贴在一起并使用gregexpr 可能更有意义。

【解决方案3】：

这有点令人费解，但是滚动连接怎么样？

library(data.table)
setorder(setDT(df), id, time)

df[ name == "b" ][
    df[, if(name == "a") .(time = last(time)), by=.(id, name, r = rleid(id,name))],
    on = .(id, time),
    roll = -Inf,
    nomatch = 0,
    .(a = i.time, b = x.time)
]

   a  b
1: 3 10
2: 5  7
3: 9 11

【讨论】：