all.different Funktion in R, wenden Sie es in einer Schleife an?

Question

Ich habe einen Vektor von Zahlen. So wie diese, mit nur wenigen eindeutigen Werten:

set.seed(2) 
a = rpois(1000, 0.3) 
head(a, 20) 
#### [1] 0 0 0 0 1 1 0 1 0 0 0 0 1 0 0 1 2 0 0 0 

Nun, was ich brauche, ist für jede Zahl zu finden, wenn sich die vorherige und das folgende Element sind alle unterschiedlich. Ich habe versucht, eine Funktion all.different oder alle verschieden in R zu finden, erfolglos, so habe ich es:

all.diff = function(num) NROW(unique(num))==NROW(num) 

Dann kam ich mit einem for Schleife wie auf den Punkt:

ConsecutiveDifferent = function(vector) { 
    output = numeric(NROW(vector)-2) 
    for (i in 2:(NROW(vector)-1)) { 
    trio <- c(vector[i-1], vector[i], vector[i+1]) 
    if (all.diff(trio)) output[i]<-1 
    } 
    return(output) 
} 
res = ConsecutiveDifferent(a) 
head(res, 20) 
#### [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 

Es tut der Job, aber da mein Vektor eine Länge von mehreren hundert Millionen hat, habe ich mich gefragt, ob es einen besseren Weg als eine Schleife gab.

Danke,

EDIT

Danke für so viele Lösungen bekommen! Ich konnte nicht entscheiden, wessen Antwort angenommen werden muss, also habe ich einen Mikrobenmark (Länge = 50000) gemacht und der Preis geht an Franck. Danke auch für die ausführliche Antwort.

Answer 1

rle. Dies ist ganz besonders auf den Fall des Trios:

w = with(rle(a), cumsum(lengths)[ 
    lengths == 1L & c(NA, values[-length(values)]) != c(values[-1], NA) 
]) 

res2 = c(NA, logical(length(a)-2), NA) 
res2[w] = TRUE 

identical(res, res2) # TRUE 

---

combn. ich tun könnte

a_shift = list(c(NA, a[-length(a)]), a, c(a[-1], NA)) 
n_distinct = rowSums(combn(a_shift, 2, FUN = function(x) x[[1]] != x[[2]])) 
res  = n_distinct == length(a_shift) 

Um zu untersuchen, ob es geklappt hat ...

head(cbind.data.frame(a, res), 20) 


    a res 
1 0 NA 
2 0 FALSE 
3 0 FALSE 
4 0 FALSE 
5 1 FALSE 
6 1 FALSE 
7 0 FALSE 
8 1 FALSE 
9 0 FALSE 
10 0 FALSE 
11 0 FALSE 
12 0 FALSE 
13 1 FALSE 
14 0 FALSE 
15 0 FALSE 
16 1 TRUE 
17 2 TRUE 
18 0 FALSE 
19 0 FALSE 
20 0 FALSE 

Dies kann zu suchen weiter nach vorn und hinten durch die Erweiterung a_shift erweitert werden, die leicht mit der shift Funktion getan werden können, von data.table:

library(data.table) 
n_back = 1 
n_fwd = 1 
a_shift = setDT(list(a))[, c(
    shift(V1, n_back:0, type="lag"), 
    list(shift(V1, n_fwd, type="lead")) 
)] 
a_shift[, r := .I] 

resDT = melt(a_shift, id = "r")[, .(res = 
    if (any(is.na(value))) NA else uniqueN(value) == n_fwd + n_back + 1L 
), by=r][, a := a] 

identical(res, resDT$res) # TRUE 

... die arkanen aussehen, aber das ist mehr mit meiner Codierung Stil zu tun, als das Paket.

Answer 2

Hässlich wie Sünde, aber es funktioniert.

set.seed(2) 
a <- rpois(1000, 0.3) 

a_shifted <- embed(a,3) 

indices <- 1 + which(apply(X = a_shifted, 
          FUN = function(num) {length(unique(num))==length(num)}, 
          MARGIN = 1)) 
print(a[indices]) 

Answer 3

Sie können die duplicated Funktion machen

adjacent_dif <- function(i,l){ 
    as.numeric(!any(duplicated(c(l[i-1], l[i], l[i+1])))) 
} 

sapply(2:length(a)-1, adjacent_dif, a) 

Answer 4

Die folgenden Schritte nicht eine Iterator-Funktion (anwenden wie Funktion) verwenden, und ich denke, dass es schneller sein wird

da = diff(a) 
lda = c(0,da) 
rda = c(da,0) 
sda = lda + rda 
res = lda != 0 & rda != 0 & sda != 0 

res enthält FALSE in der ersten und letzten Position, und es hat die gleiche Länge wie Vektor a.