在大型数据帧上使用 rle()

Question

我正在尝试查找一个 ID 具有任何分数的连续运行的数量，按日期排序。我遇到了一个使用 apply() 的简单方法，它似乎有效，但是，它只给出了每个运行的长度，而不是与之相关的分数或 ID。

数据框由以下内容组成：

DATE         ID     SCORE
2021-04-05   12690   67
2021-04-05   12278   47
2021-04-05   12153   64
---
2021-03-26   12690   88
2021-03-26   12278   47
---
2021-03-20   12690   67
+ 120,000 more rows

日期格式为 YYYY-MM-DD

基于上面的示例 df，我希望它 return 类似于以下内容：

12690   67    1
12690   88    1
12690   67    1
12278   47    2
12153   64    1

即对于 ID 12690，分数 67 出现一次，然后 88 一次，然后 67 一次，依此类推

如果我强制它一次只使用一个 ID，我可以让它工作，但这似乎不是很有效。最好的方法是什么？ TIA

Answer 1

这是对提供的数据起作用的尝试。如果它不适用于您的真实数据，post 稍微复杂一点的示例数据集，我们可以再试一次。

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
dat <- tibble::tribble(
  ~DATE,         ~ID,     ~SCORE,
"2021-04-05", 12690,   67,
"2021-04-05",   12278,   47,
"2021-04-05", 12153,   64,
"2021-03-26",   12690,   88,
"2021-03-26", 12278,   47,
"2021-03-20",   12690,   67) %>% 
  mutate(DATE = lubridate::ymd(DATE))


tmp <- dat %>% 
  arrange(ID, DATE) %>% 
  group_by(ID) %>% 
  mutate(eq = SCORE == lead(SCORE), 
         eq = case_when(is.na(eq) ~ FALSE, 
                     TRUE ~ eq), 
         eq = case_when(!eq ~ SCORE == lag(SCORE), 
                        TRUE ~ eq), 
         eq = case_when(is.na(eq) ~ FALSE, 
                        TRUE ~ eq)) 

tmps <- tmp %>% split(tmp$eq)
tmps[[2]] <- tmps[[2]] %>% 
  group_by(ID, SCORE) %>% 
  summarise(n = sum(eq))
#> `summarise()` has grouped output by 'ID'. You can override using the `.groups`
#> argument.
tmps[[1]] <- tmps[[1]] %>%
  select(ID, SCORE) %>% 
  mutate(n=1)

bind_rows(tmps)
#> # A tibble: 5 × 3
#> # Groups:   ID [3]
#>      ID SCORE     n
#>   <dbl> <dbl> <dbl>
#> 1 12153    64     1
#> 2 12690    67     1
#> 3 12690    88     1
#> 4 12690    67     1
#> 5 12278    47     2

^{由 reprex package (v2.0.1)}

创建于 2022-04-13

这里有一个替代方案，可以将相同 ID 的相同号码的不同运行分开。

library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
dat <- tibble::tribble(
  ~DATE,         ~ID,     ~SCORE,
  "2021-04-05", 12690,   67,
  "2021-04-05",   12278,   47,
  "2021-04-05", 12153,   64,
  "2021-03-26",   12690,   88,
  "2021-03-26", 12278,   47,
  "2021-03-20",   12690,   67) %>% 
  mutate(DATE = lubridate::ymd(DATE))

tmp <- dat %>% 
  arrange(ID, DATE) %>% 
  group_by(ID) %>% 
  mutate(obs = 1:n()) %>% 
  ungroup %>% 
  mutate(new_grp = as.numeric(SCORE != lag(SCORE) | ID != lag(ID) | obs != lag(obs) + 1), 
         new_grp = ifelse(is.na(new_grp), 1, new_grp), 
         group = cumsum(new_grp)) %>% 
  group_by(ID, SCORE, group) %>% 
  summarise(n = n()) %>% 
  ungroup %>% 
  select(-group)
#> `summarise()` has grouped output by 'ID', 'SCORE'. You can override using the
#> `.groups` argument.

tmp
#> # A tibble: 5 × 3
#>      ID SCORE     n
#>   <dbl> <dbl> <int>
#> 1 12153    64     1
#> 2 12278    47     2
#> 3 12690    67     1
#> 4 12690    67     1
#> 5 12690    88     1

^{由 reprex package (v2.0.1)}

于 2022-04-14 创建

在大型数据帧上使用 rle()

using rle() on a large dataframe

r

run-length-encoding