Эффективный способ поиска повторяющихся строк строк, удаления и подсчета

У меня есть набор данных с повторяющимися строками. Я хочу удалить последовательные повторы и подсчитать их, но только если они последовательны. Я ищу эффективный способ сделать это. Невозможно представить, как в dplyr или data.table.

MWE

dat <- data.frame(
    x = c(6, 2, 3, 3, 3, 1, 1, 6, 5, 5, 6, 6, 5, 4),
    y = c(7, 5, 7, 7, 7, 5, 5, 7, 1, 2, 7, 7, 1, 7),
    z = c(rep(LETTERS[1:2], each=7))
)

##        x     y     z
## 1      6     7     A
## 2      2     5     A
## 3      3     7     A
## 4      3     7     A
## 5      3     7     A
## 6      1     5     A
## 7      1     5     A
## 8      6     7     B
## 9      5     1     B
## 10     5     2     B
## 11     6     7     B
## 12     6     7     B
## 13     5     1     B
## 14     4     7     B

Желаемый выход

       x     y     z   n
1      6     7     A   1
2      2     5     A   1
3      3     7     A   3
4      1     5     A   2
5      6     7     B   1
6      5     1     B   1
7      5     2     B   1
8      6     7     B   2
9      5     1     B   1 
10     4     7     B   1

Ответ 1

С data.table:

library(data.table)
setDT(dat)

dat[, c(.SD[1L], .N), by=.(g = rleidv(dat))][, g := NULL]

    x y z N
 1: 6 7 A 1
 2: 2 5 A 1
 3: 3 7 A 3
 4: 1 5 A 2
 5: 6 7 B 1
 6: 5 1 B 1
 7: 5 2 B 1
 8: 6 7 B 2
 9: 5 1 B 1
10: 4 7 B 1

Ответ 2

Как и в случае с Рикки, здесь другое базовое решение:

with(rle(do.call(paste, dat)), cbind(dat[ cumsum(lengths), ], lengths))

В случае, если paste не вырезает его для классов столбцов, вы можете сделать

ud     = unique(dat)
ud$r   = seq_len(nrow(ud))
dat$r0 = seq_len(nrow(dat))
newdat = merge(dat, ud)

with(rle(newdat[order(newdat$r0), ]$r), cbind(dat[cumsum(lengths), ], lengths))

... хотя я предполагаю, что там есть лучший способ.

Ответ 3

С dplyr вы можете взять data.table::rleid для создания столбца идентификатора запуска, а затем использовать n для подсчета строк и unique, чтобы вырезать повторы:

dat %>% group_by(run = data.table::rleid(x, y, z)) %>%  mutate(n = n()) %>% 
    distinct() %>% ungroup() %>% select(-run)

Вы можете заменить rleid только базой R, если хотите, но это не так красиво:

dat %>% group_by(run = rep(seq_along(rle(paste(x, y, z))$len), 
                           times = rle(paste(x, y, z))$len)) %>%  
    mutate(n = n()) %>% distinct() %>% ungroup() %>% select(-run)

В любом случае, вы получите:

Source: local data frame [10 x 4]

       x     y      z     n
   (dbl) (dbl) (fctr) (int)
1      6     7      A     1
2      2     5      A     1
3      3     7      A     3
4      1     5      A     2
5      6     7      B     1
6      5     1      B     1
7      5     2      B     1
8      6     7      B     2
9      5     1      B     1
10     4     7      B     1

Изменить

В комментарии @Frank вы также можете использовать summarise для вставки n и свернуть вместо mutate и unique, если вы group_by все переменные, которые хотите сохранить до run, как summarise свертывает последнюю группу. Одно из преимуществ этого подхода заключается в том, что вам не нужно ungroup избавляться от run, поскольку summarise делает для вас:

dat %>% group_by(x, y, z, run = data.table::rleid(x, y, z)) %>% 
    summarise(n = n()) %>% select(-run)

Ответ 4

Базовое решение ниже

idx <- rle(with(dat, paste(x, y, z)))
d <- cbind(do.call(rbind, strsplit(idx$values, " ")), idx$lengths)
as.data.frame(d)  

   V1 V2 V3 V4
1   6  7  A  1
2   2  5  A  1
3   3  7  A  3
4   1  5  A  2
5   6  7  B  1
6   5  1  B  1
7   5  2  B  1
8   6  7  B  2
9   5  1  B  1
10  4  7  B  1

Ответ 5

Если у вас большой набор данных, вы можете использовать аналогичную идею для решения Frank data.table, но не используйте .SD следующим образом:

dat[, g := rleidv(dat)][, N := .N, keyby = g
   ][J(unique(g)), mult = "first"
   ][, g := NULL
   ][]

Это менее читаемо, и это оказывается медленнее. Решение Frank быстрее и удобочитаемо.

# benchmark on 14 million rows
dat <- data.frame(
    x = rep(c(6, 2, 3, 3, 3, 1, 1, 6, 5, 5, 6, 6, 5, 4), 1e6),
    y = rep(c(7, 5, 7, 7, 7, 5, 5, 7, 1, 2, 7, 7, 1, 7), 1e6),
    z = rep(c(rep(LETTERS[1:2], each=7)), 1e6)
)

setDT(dat)
d1 <- copy(dat)
d2 <- copy(dat)

С R 3.2.4 и data.table 1.9.7 (на компьютере Фрэнка):

system.time(d1[, c(.SD[1L], .N), by=.(g = rleidv(d1))][, g := NULL])
#    user  system elapsed 
#    0.42    0.10    0.52 
system.time(d2[, g := rleidv(d2)][, N := .N, keyby = g][J(unique(g)), mult = "first"][, g := NULL][])
#    user  system elapsed 
#    2.48    0.25    2.74

Ответ 6

Не сильно отличается от других ответов, но (1) с упорядоченными данными и (2) ищет последовательные прогоны, кажется хорошим кандидатом, просто OR ing x[-1L] != x[-length(x)] по столбцам вместо paste ing или другие сложные операции. Я думаю, это как-то эквивалентно data.table::rleid.

ans = logical(nrow(dat) - 1L)
for(j in seq_along(dat)) ans[dat[[j]][-1L] != dat[[j]][-nrow(dat)]] = TRUE    
ans = c(TRUE, ans)
#or, the two-pass, `c(TRUE, Reduce("|", lapply(dat, function(x) x[-1L] != x[-length(x)])))`

cbind(dat[ans, ], n = tabulate(cumsum(ans)))
#   x y z n
#1  6 7 A 1
#2  2 5 A 1
#3  3 7 A 3
#6  1 5 A 2
#8  6 7 B 1
#9  5 1 B 1
#10 5 2 B 1
#11 6 7 B 2
#13 5 1 B 1
#14 4 7 B 1

Ответ 7

Другая попытка базы с использованием ave, только потому, что:

dat$grp <- ave(
  seq_len(nrow(dat)),
  dat[c("x","y","z")],
  FUN=function(x) cumsum(c(1,diff(x))!=1)
)

dat$count <- ave(dat$grp, dat, FUN=length)

dat[!duplicated(dat[1:4]),]


#   x y z grp count
#1  6 7 A   0     1
#2  2 5 A   0     1
#3  3 7 A   0     3
#6  1 5 A   0     2
#8  6 7 B   0     1
#9  5 1 B   0     1
#10 5 2 B   0     1
#11 6 7 B   1     2
#13 5 1 B   1     1
#14 4 7 B   0     1

И попытка конверсии data.table:

d1[, .(sq=.I, grp=cumsum(c(1, diff(.I)) != 1)), by=list(x,y,z)][(sq), .N, by=list(x,y,z,grp)]