Najszybszy sposób na usunięcie wszystkich duplikatów w R

Question

Chciałbym usunąć wszystkie elementy, które pojawiają się więcej niż jeden raz w wektorze. W szczególności obejmuje to wektory znakowe, liczbowe i całkowite. Obecnie używam duplicated() zarówno do przodu, jak i do tyłu (przy użyciu parametru fromLast).

Czy istnieje bardziej wydajne obliczeniowo (szybciej) sposób wykonania tego w R? Poniższe rozwiązanie jest dość proste, aby pisać/czytać, ale wydaje się nieskuteczne dwukrotne wykonanie podwójnego wyszukiwania. Być może metoda liczenia z wykorzystaniem dodatkowej struktury danych byłaby lepsza?

przykład:

d <- c(1,2,3,4,1,5,6,4,2,1) 
d[!(duplicated(d) | duplicated(d, fromLast=TRUE))] 
#[1] 3 5 6 

pokrewnych, tak stanowisk here i here.

Answer 1

Niektóre czasy:

set.seed(1001) 
d <- sample(1:100000, 100000, replace=T) 
d <- c(d, sample(d, 20000, replace=T)) # ensure many duplicates 
mb <- microbenchmark::microbenchmark(
    d[!(duplicated(d) | duplicated(d, fromLast=TRUE))], 
    setdiff(d, d[duplicated(d)]), 
    {tmp <- rle(sort(d)); tmp$values[tmp$lengths == 1]}, 
    as.integer(names(table(d)[table(d)==1])), 
    d[!(duplicated.default(d) | duplicated.default(d, fromLast=TRUE))], 
    d[!(d %in% d[duplicated(d)])], 
    { ud = unique(d); ud[tabulate(match(d, ud)) == 1L] }, 
    d[!(.Internal(duplicated(d, F, F, NA)) | .Internal(duplicated(d, F, T, NA)))] 
) 
summary(mb)[, c(1, 4)] # in milliseconds 
#                    expr  mean 
#1        d[!(duplicated(d) | duplicated(d, fromLast = TRUE))] 18.34692 
#2              setdiff(d, d[duplicated(d)]) 24.84984 
#3      {  tmp <- rle(sort(d))  tmp$values[tmp$lengths == 1] } 9.53831 
#4           as.integer(names(table(d)[table(d) == 1])) 255.76300 
#5    d[!(duplicated.default(d) | duplicated.default(d, fromLast = TRUE))] 18.35360 
#6              d[!(d %in% d[duplicated(d)])] 24.01009 
#7      {  ud = unique(d)  ud[tabulate(match(d, ud)) == 1L] } 32.10166 
#8 d[!(.Internal(duplicated(d, F, F, NA)) | .Internal(duplicated(d,  F, T, NA)))] 18.33475 

Biorąc pod uwagę komentarze zobaczmy, czy są one poprawne?

results <- list(d[!(duplicated(d) | duplicated(d, fromLast=TRUE))], 
     setdiff(d, d[duplicated(d)]), 
     {tmp <- rle(sort(d)); tmp$values[tmp$lengths == 1]}, 
     as.integer(names(table(d)[table(d)==1])), 
     d[!(duplicated.default(d) | duplicated.default(d, fromLast=TRUE))], 
     d[!(d %in% d[duplicated(d)])], 
     { ud = unique(d); ud[tabulate(match(d, ud)) == 1L] }, 
     d[!(.Internal(duplicated(d, F, F, NA)) | .Internal(duplicated(d, F, T, NA)))]) 
all(sapply(ls, all.equal, c(3, 5, 6))) 
# TRUE 

Answer 2

można użyć set operation:

d <- c(1,2,3,4,1,5,6,4,2,1) 
duplicates = d[duplicated(d)] 
setdiff(d, duplicates) 
[1] 3 5 6 

(nie pewien, czy to jest bardziej wydajny niż powyższym kodzie ale wydaje koncepcyjnie czystsze)

Answer 3

Można to zrobić z rle funkcji:

tmp <- rle(sort(d)) 
res <- tmp$values[tmp$lengths == 1] 

Chodzi o to, aby znaleźć liczbę takich samych wartości w wektorze.

Istnieje wiele alternatyw tutaj: Counting the number of elements with the values of x in a vector

Edit

Po pobycie w benchmarkach, @NBATrends Mam podejrzane. Teoretycznie liczenie przedmiotów z jednym przejściem musi być ~ 2x szybsze w porównaniu do oryginalnej logiki duplicated.

Próbowałem robić to z data.table:

library(data.table) 
dt <- data.table(d) 
res <- dt[, count:= .N, by = d][count == 1]$d 

A oto odniesienia na różne wielkości prób dla trzech rozwiązań (I zmniejszyły je szybko unikalne podejście):

Widać, że wraz ze wzrostem próbki data.table zaczyna przewyższać inne metody (2x).

Oto kod do reprodukcji:

set.seed(1001) 
N <- c(3, 4, 5, 6 ,7) 
n <- 10^N 
res <- lapply(n, function(x) { 
d <- sample(1:x/10, 5 * x, replace=T) 
d <- c(d, sample(d, x, replace=T)) # ensure many duplicates 
dt <- data.table(d) 
mb <- microbenchmark::microbenchmark(
    "duplicated(original)" = d[!(duplicated(d) | duplicated(d, fromLast=TRUE))], 
    "tabulate" = { ud = unique(d); ud[tabulate(match(d, ud)) == 1L] }, 
    "data.table" = dt[, count:= .N, by = d][count == 1]$d, 
    times = 1,unit = "ms") 
sm <- summary(mb)[, c(1, 4, 8)] 
sm$size = x 
return(sm) 

}) 

res <- do.call("rbind", res) 

require(ggplot2) 
##The values Year, Value, School_ID are 
##inherited by the geoms 
ggplot(res, aes(x = res$size, y = res$mean, colour=res$exp)) + 
geom_line() + scale_x_log10() + scale_y_log10() + 
geom_point()