Erstelle Gruppen aus Vektor von 0,1 und NA

Question

Hintergrund:

Ich versuche, ein Korpus zu entfernen, wo der Sprecher identifiziert wird. Ich habe das Problem reduziert, einen bestimmten Sprecher aus dem Korpus in den folgenden Strom von 1,0 und NA (x) zu entfernen. 0 bedeutet, dass die Person spricht, 1 jemand anderes spricht, NA bedeutet, dass derjenige, der der letzte Sprecher war, immer noch spricht.

Hier ist ein visuelles Beispiel:

0 1 S0: Hello, how are you today? 
1 2 S1: I'm great thanks for asking! 
NA 3 I'm a little tired though! 
0 4 S0: I'm sorry to hear that. Are you ready for our discussion? 
1 5 S1: Yes, I have everything I need. 
NA 7 Let's begin. 

So aus diesem Rahmen, würde Ich mag 2,3,5 nehmen, und 7. Oder ,. Ich möchte, dass das Ergebnis 0,1,1,0,1,1 lautet.

Wie ziehe ich die Positionen jedes Laufs von 1 und NA bis zur Position vor der nächsten 0 in einem Vektor.

Hier ist ein Beispiel, und meine gewünschte Ausgabe:

Beispiel Eingabe:

x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0) 

Beispiel Ausgabe:

Dies sind die Positionen, die ich, weil sie, dass „Lautsprecher 1“ identifizieren wollen spricht (1 oder 1 gefolgt von NA bis zur nächsten 0)

Eine Alternative wäre ein Ausgang Füllung sein:

fill <- c(0,0,0,0,0,1,0,1,1,1,1,0,0,0,1,1,1,0) 

Wo die NA-Werte der vorherigen 1 oder 0 in den nächsten neuen Wert gefüllt.

Answer 1

s <- which(x==1); 
e <- c(which(x!=1),length(x)+1L); 
unlist(Map(seq,s,e[findInterval(s,e)+1L]-1L)); 
## [1] 6 8 9 10 11 15 16 17 

Jedes Auftreten eines 1 in dem Eingangsvektor ist der Start einer Folge von Positionsindizes für Lautsprecher 1. Wir dies mit which(x==1) in s erfassen.

Für jeden Startindex müssen wir die Länge seiner enthaltenden Sequenz finden. Die Länge wird durch das nächstliegende Vorkommnis einer 0 bestimmt (oder allgemeiner irgendeinen Nicht-NA-Wert außer 1, falls dies möglich war). Daher müssen wir zuerst berechnen, um diese Indizes zu erhalten. Da das letzte Vorkommen einer 1 kein Vorkommnis von 0 haben kann, müssen wir einen zusätzlichen virtuellen Index um eine Einheit über das Ende des Eingabevektors hinaus anhängen, weshalb wir c() aufrufen müssen, um length(x)+1L zu kombinieren. Wir speichern dies als e, was zeigt, dass dies (potentielle) Ende Indizes sind. Beachten Sie, dass dies exklusive Ende Indizes sind; sie sind nicht wirklich Teil der (potentiellen) vorhergehenden Sprecher-1-Sequenz.

Schließlich müssen wir die tatsächlichen Sequenzen generieren. Um dies zu tun, müssen wir einen Aufruf an seq() für jedes Element von s, auch mit der entsprechenden End-Index von e. Um den Endindex zu finden, können wir findInterval() verwenden, um den Index in e zu finden, dessen Elementwert (dh der Endindex in x) nur vor jedes Element von s fällt. (Der Grund, warum es ist nur vor ist, dass der verwendete Algorithmus von findInterval()v[i[j]] ≤ x[j] < v[i[j]+1] ist wie auf der doc Seite erklärt.) Wir haben dann ein etwas hinzufügen müssen den Index in e dessen Elementwert fällt nur nach jedem jeweiligen zu bekommen Element von s. Wir indexieren dann e damit und geben uns die Endindizes in x, die jedem entsprechenden Element von s folgen. Davon müssen wir eins abziehen, da die von uns erzeugte Sequenz das (exklusive) Endelement ausschließen muss. Der einfachste Weg, um die Anrufe an seq() zu machen, ist Map() die beiden Endpunkt Vektoren zu ihm, eine Liste von jeder Sequenz, die wir unlist() erhalten können, um die erforderliche Ausgabe zu erhalten.

---

s <- which(!is.na(x)); 
rep(c(0,x[s]),diff(c(1L,s,length(x)+1L))); 
## [1] 0 0 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0 

Jedes Auftreten eines nicht-NA-Wert in dem Eingangsvektor ist der Start eines Segments, das in der Ausgabe, eine Wiederholung des Elementwert zu diesem Startindex werden müssen. Wir erfassen diese Indizes in s mit which(!is.na(x));.

Wir müssen dann jedes Startelement so oft wiederholen, bis das folgende Segment erreicht ist. Daher können wir rep() unter x[s] mit einem vektorisierten times-Argument aufrufen, dessen Werte aus diff() bestehen, das unter s aufgerufen wird. Um das letzte Segment zu behandeln, müssen wir einen Index um eine Einheit hinter dem Ende des Eingabevektors, length(x)+1L, anhängen. Um den möglichen Fall von NAs, die den Eingangsvektor führen, zu behandeln, müssen wir außerdem ein 0 bis x[s] und ein 1 bis diff() Argument vorgeben, das eine ausreichende Anzahl von Malen wiederholt, um die führenden NAs abzudecken, falls solche existieren.

---

Benchmarking (Position)

library(zoo); 
library(microbenchmark); 
library(stringi); 

marat <- function(x) { v <- na.locf(zoo(x)); index(v)[v==1]; }; 
rawr <- function(x) which(zoo::na.locf(c(0L, x))[-1L] == 1L); 
jota1 <- function(x) { stringx <- paste(x, collapse = ""); stringx <- gsub("NA", "N", stringx, fixed = TRUE); while(grepl("(?<=1)N", stringx, perl = TRUE)) stringx <- gsub("(?<=1)N", "1", stringx, perl = TRUE); unlist(gregexpr("1", stringx)); }; 
jota2 <- function(x) { stringx <- paste(x, collapse = ""); stringx <- gsub("NA", "N", stringx, fixed = TRUE); while(grepl("(?<=1)N", stringx, perl = TRUE)) stringx <- gsub("(?<=1)N", "1", stringx, perl = TRUE); newx <-unlist(strsplit(stringx, "")); which(newx == 1); }; 
jota3 <- function(x) {x[is.na(x)] <- "N"; stringx <- stri_flatten(x); ones <- stri_locate_all_regex(stringx, "1N*")[[1]]; unlist(lapply(seq_along(ones[, 1]), function(ii) seq.int(ones[ii, "start"], ones[ii, "end"]))); }; 
bgoldst <- function(x) { s <- which(x==1); e <- c(which(x!=1),length(x)+1L); unlist(Map(seq,s,e[findInterval(s,e)+1L]-1L)); }; 

---

## OP's test case 
x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0); 

ex <- marat(x); 
identical(ex,rawr(x)); 
## [1] TRUE 
identical(ex,jota1(x)); 
## [1] TRUE 
identical(ex,jota2(x)); 
## [1] TRUE 
identical(ex,jota3(x)); 
## [1] TRUE 
identical(ex,bgoldst(x)); 
## [1] TRUE 

microbenchmark(marat(x),rawr(x),jota1(x),jota2(x),jota3(x),bgoldst(x)); 
## Unit: microseconds 
##  expr  min  lq  mean median  uq  max neval 
## marat(x) 411.830 438.5580 503.24486 453.7400 489.2345 2299.915 100 
##  rawr(x) 115.466 143.0510 154.64822 153.5280 163.7920 276.692 100 
## jota1(x) 448.180 469.7770 484.47090 479.6125 491.1595 835.633 100 
## jota2(x) 440.911 464.4315 478.03050 472.1290 484.3170 661.579 100 
## jota3(x) 53.885 65.4315 74.34808 71.2050 76.9785 158.232 100 
## bgoldst(x) 34.212 44.2625 51.54556 48.5395 55.8095 139.843 100 

---

## scale test, high probability of NA 
set.seed(1L); 
N <- 1e5L; probNA <- 0.8; x <- sample(c(NA,T),N,T,c(probNA,1-probNA)); x[which(x)] <- rep(c(0,1),len=sum(x,na.rm=T)); 

ex <- marat(x); 
identical(ex,rawr(x)); 
## [1] TRUE 
identical(ex,jota1(x)); 
## [1] TRUE 
identical(ex,jota2(x)); 
## [1] TRUE 
identical(ex,jota3(x)); 
## [1] TRUE 
identical(ex,bgoldst(x)); 
## [1] TRUE 

microbenchmark(marat(x),rawr(x),jota1(x),jota2(x),jota3(x),bgoldst(x)); 
## Unit: milliseconds 
##  expr  min  lq  mean median  uq  max neval 
## marat(x) 189.34479 196.70233 226.72926 233.39234 237.45738 293.95154 100 
##  rawr(x) 24.46984 27.46084 43.91167 29.92112 68.86464 79.53008 100 
## jota1(x) 154.91450 157.09231 161.73505 158.18326 160.42694 206.04889 100 
## jota2(x) 149.47561 151.68187 155.92497 152.93682 154.79668 201.13302 100 
## jota3(x) 82.30768 83.89149 87.35308 84.99141 86.95028 129.94730 100 
## bgoldst(x) 80.94261 82.94125 87.80780 84.02107 86.10844 130.56440 100 

---

## scale test, low probability of NA 
set.seed(1L); 
N <- 1e5L; probNA <- 0.2; x <- sample(c(NA,T),N,T,c(probNA,1-probNA)); x[which(x)] <- rep(c(0,1),len=sum(x,na.rm=T)); 

ex <- marat(x); 
identical(ex,rawr(x)); 
## [1] TRUE 
identical(ex,jota1(x)); 
## [1] TRUE 
identical(ex,jota2(x)); 
## [1] TRUE 
identical(ex,jota3(x)); 
## [1] TRUE 
identical(ex,bgoldst(x)); 
## [1] TRUE 

microbenchmark(marat(x),rawr(x),jota1(x),jota2(x),jota3(x),bgoldst(x)); 
## Unit: milliseconds 
##  expr  min  lq  mean median  uq  max neval 
## marat(x) 178.93359 189.56032 216.68963 226.01940 234.06610 294.6927 100 
##  rawr(x) 17.75869 20.39367 36.16953 24.44931 60.23612 79.5861 100 
## jota1(x) 100.10614 101.49238 104.11655 102.27712 103.84383 150.9420 100 
## jota2(x) 94.59927 96.04494 98.65276 97.20965 99.26645 137.0036 100 
## jota3(x) 193.15175 202.02810 216.68833 209.56654 227.94255 295.5672 100 
## bgoldst(x) 253.33013 266.34765 292.52171 292.18406 311.20518 387.3093 100 

---

Benchmarking (Fill)

library(microbenchmark); 

bgoldst <- function(x) { s <- which(!is.na(x)); rep(c(0,x[s]),diff(c(1L,s,length(x)+1L))); }; 
user31264 <- function(x) { x[is.na(x)]=2; x.rle=rle(x); val=x.rle$v; if (val[1]==2) val[1]=0; ind = (val==2); val[ind]=val[which(ind)-1]; rep(val,x.rle$l); }; 

---

## OP's test case 
x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0); 

ex <- bgoldst(x); 
identical(ex,user31264(x)); 
## [1] TRUE 

microbenchmark(bgoldst(x),user31264(x)); 
## Unit: microseconds 
##   expr min  lq  mean median  uq max neval 
## bgoldst(x) 10.264 11.548 14.39548 12.403 13.258 73.557 100 
## user31264(x) 31.646 32.930 35.74805 33.785 35.068 84.676 100 

---

## scale test, high probability of NA 
set.seed(1L); 
N <- 1e5L; probNA <- 0.8; x <- sample(c(NA,T),N,T,c(probNA,1-probNA)); x[which(x)] <- rep(c(0,1),len=sum(x,na.rm=T)); 

ex <- bgoldst(x); 
identical(ex,user31264(x)); 
## [1] TRUE 

microbenchmark(bgoldst(x),user31264(x)); 
## Unit: milliseconds 
##   expr  min  lq  mean median  uq  max neval 
## bgoldst(x) 10.94491 11.21860 12.50473 11.53015 12.28945 50.25899 100 
## user31264(x) 17.18649 18.35634 22.50400 18.91848 19.53708 65.02668 100 

---

## scale test, low probability of NA 
set.seed(1L); 
N <- 1e5L; probNA <- 0.2; x <- sample(c(NA,T),N,T,c(probNA,1-probNA)); x[which(x)] <- rep(c(0,1),len=sum(x,na.rm=T)); 

ex <- bgoldst(x); 
identical(ex,user31264(x)); 
## [1] TRUE 

microbenchmark(bgoldst(x),user31264(x)); 
## Unit: milliseconds 
##   expr  min  lq  mean median  uq  max neval 
## bgoldst(x) 5.24815 6.351279 7.723068 6.635454 6.923264 45.04077 100 
## user31264(x) 11.79423 13.063710 22.367334 13.986584 14.908603 55.45453 100 

Answer 2

Einfügen der Sequenz in eine Zeichenkette und eine while-Schleife verwenden, die (mit grep) prüft, ob es irgendwelche NA voran s durch 1 s und ersetzt (mit gsub) solchen Fällen mit einem 1 wird es tun:

# substitute NA for "N" for later ease of processing and locating 1s by position 
x[is.na(x)] <- "N" 
# Collapse vector into a string 
stringx <- paste(x, collapse = "") 

while(grepl("(?<=1)N", stringx, perl = TRUE)) { 
    stringx <- gsub("(?<=1)N", "1", stringx, perl = TRUE) 
} 

Dann können Sie gregexpr verwenden, um die Indizes von 1s zu erhalten.

unlist(gregexpr("1", stringx)) 
#[1] 6 8 9 10 11 15 16 17 

Oder Sie können die Zeichenfolge aufgeteilt und die Indizes von 1 s in dem resultierenden Vektor zu finden suchen durch:

newx <-unlist(strsplit(stringx, "")) 
#[1] "N" "N" "N" "N" "0" "1" "0" "1" "1" "1" "1" "0" "N" "N" "1" "1" "1" "0" 

which(newx == "1") 
#[1] 6 8 9 10 11 15 16 17 

---

---

stri_flatten vom stringi Paket anstelle von paste und stri_locate_all_fixed statt gregexpr oder eine Zeichenfolge Teilung Route kann ein bisschen mehr Leistung, wenn es eine größere Vecto ist r Sie verarbeiten. Wenn der Vektor nicht groß ist, werden keine Leistungssteigerungen erzielt.

library(stringi) 
x[is.na(x)] <- "N" 
stringx <- stri_flatten(x) 

while(grepl("(?<=1)N", stringx, perl = TRUE)) { 
    stringx <- gsub("(?<=1)N", "1", stringx, perl = TRUE) 
} 

stri_locate_all_fixed(stringx, "1")[[1]][,"start"] 

---

Die folgende Vorgehensweise ist recht unkompliziert und relativ gut ab (basierend auf bgoldst ausgezeichneten Benchmarking Beispiel) auf kleine und großen Proben (sehr gut auf bgoldst hohen Wahrscheinlichkeit von NA Beispiel)

x[is.na(x)] <- "N" 
stringx <- stri_flatten(x) 

ones <- stri_locate_all_regex(stringx, "1N*")[[1]] 

#[[1]] 
# 
#  start end 
#[1,]  6 6 
#[2,]  8 11 
#[3,] 15 17 

unlist(lapply(seq_along(ones[, 1]), 
    function(ii) seq.int(ones[ii, "start"], ones[ii, "end"]))) 
#[1] 6 8 9 10 11 15 16 17 

Answer 3

Sie können von na.locf aus dem zoo Paket machen:

library(zoo) 
x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0) 

v <- na.locf(zoo(x)) 
index(v)[v==1] 
#[1] 6 8 9 10 11 15 16 17 

Answer 4

x <- c(NA,NA,NA,NA,0,1,0,1,NA,NA,NA,0,NA,NA,1,NA,NA,0) 
x[is.na(x)]=2 
x.rle=rle(x) 
val=x.rle$v 
if (val[1]==2) val[1]=0 
ind = (val==2) 
val[ind]=val[which(ind)-1] 
rep(val,x.rle$l) 

Ausgang:

[1] 0 0 0 0 0 1 0 1 1 1 1 0 0 0 1 1 1 0