Loops in Funktion benutzerdefinierte R zu transformieren Daten

Question

ich diesen Code verwenden, um eine Probe Datenrahmen von Ereignissen zu erstellen:

set.seed(100) 
mydf <-data.frame(time=(1:100), 
        status = sample(c('OK','UNKNOWN'),1000,replace=TRUE), 
        event = sample(1:10,1000,replace=TRUE) 
       ) 

Die Daten sieht wie folgt aus:

head(mydf) 
    time status event 
1 1  OK  1 
2 2  OK  2 
3 3 UNKNOWN  7 
4 4  OK  7 
5 5  OK  4 
6 6 UNKNOWN  2 

Ich möchte eine neue erstellen -Datensatz wie folgt aus:

StartTime EndTime SeqID Sequence 
1  1   3  1 {1,2,7}  
2  4   6  2 {7,4,2} 

Im Grunde möchte ich eine Spalte mit dem Namen Sequenz zu erzeugen, die eine Anordnung der Ereignisse ist, bu t Ich möchte neu beginnen, nachdem die Statusspalte gleich UNBEKANNT ist. Ich habe eine for-Schleife mit einer while-Schleife versucht, aber keinen Erfolg.

Answer 1

Hier ist eine data.table Lösung:

library(data.table); 
dt <- as.data.table(mydf); 
dt[,.(StartTime=time[1L],EndTime=time[length(time)],Sequence=list(event)),.(SeqID=cumsum(status=='UNKNOWN')+1L)]; 
##  SeqID StartTime EndTime Sequence 
## 1:  1   1  2  1,2 
## 2:  2   3  6 7,7,4,2 
## 3:  3   7  8  1,5 
## 4:  4   9  10  6,10 
## 5:  5  11  11  4 
## --- 
## 513: 513  90  92 7,3,5 
## 514: 514  93  93  2 
## 515: 515  94  95  8,10 
## 516: 516  96  99 3,2,3,1 
## 517: 517  100  100  7 

Ich glaube, Sie einen Fehler mit Ihrem erwarteten Ausgang gemacht haben. Wenn die Sequenz jedes Mal neu gestartet wird, wenn die Statusspalte gleich UNKNOWN ist, sollte das erste Array 1,2 und nicht 1,2,7 lauten.

---

Update: Wenn Sie die Reihenfolge wollen in der Reihe beginnen über nach der Statusspalte UNKNOWN erreicht, dann können Sie dies tun:

dt[,.(StartTime=time[1L],EndTime=time[length(time)],Sequence=list(event)),.(SeqID=c(0L,cumsum(status[-length(status)]=='UNKNOWN'))+1L)]; 
##  SeqID StartTime EndTime Sequence 
## 1:  1   1  3 1,2,7 
## 2:  2   4  7 7,4,2,1 
## 3:  3   8  9  5,6 
## 4:  4  10  11 10, 4 
## 5:  5  12  12  2 
## --- 
## 512: 512  89  90  2,7 
## 513: 513  91  93 3,5,2 
## 514: 514  94  94  8 
## 515: 515  95  96 10, 3 
## 516: 516  97  100 2,3,1,7 

Beachten Sie, dass Ihre erwartete Ausgabe ist immer noch falsch; Die zweite Gruppe sollte 7,4,2,1 anstatt 7,4,2 unter diesem Design sein. Edit: Eigentlich denke ich, das Problem ist vielleicht mit einer Diskrepanz in mydf; Ich erhalte diese mit Ihrer Probe Erstellungscode:

head(mydf,10L); 
## time status event 
## 1  1  OK  1 
## 2  2  OK  2 
## 3  3 UNKNOWN  7 
## 4  4  OK  7 
## 5  5  OK  4 
## 6  6  OK  2 
## 7  7 UNKNOWN  1 
## 8  8  OK  5 
## 9  9 UNKNOWN  6 
## 10 10  OK 10 

Bitte versuchen Sie Ihre Probe Erstellungscode läuft wieder mit dem Samen von 100. Wir sollten für mydf das gleiche Ergebnis bekommen.

---

Hier ist eine Lösung Basis R um by() gebaut:

with(list(SeqID=c(0L,cumsum(mydf$status[-nrow(mydf)]=='UNKNOWN'))+1L), 
    do.call(rbind,by(cbind(mydf,SeqID),SeqID,function(x) 
     data.frame(
      SeqID=x$SeqID[1L], 
      StartTime=x$time[1L], 
      EndTime=x$time[length(x$time)], 
      Sequence=I(list(x$event)) 
     ) 
    )) 
); 
##  SeqID StartTime EndTime  Sequence 
## 1  1   1  3  1, 2, 7 
## 2  2   4  7 7, 4, 2, 1 
## 3  3   8  9   5, 6 
## 4  4  10  11  10, 4 
## 5  5  12  12   2 
## 
## ... snip ... 
## 
## 512 512  89  90   2, 7 
## 513 513  91  93  3, 5, 2 
## 514 514  94  94   8 
## 515 515  95  96  10, 3 
## 516 516  97  100 2, 3, 1, 7 

---

Benchmarking

library(data.table); 
library(microbenchmark); 

bgoldst1 <- function(dt) dt[,.(StartTime=time[1L],EndTime=time[length(time)],Sequence=list(event)),.(SeqID=c(0L,cumsum(status[-length(status)]=='UNKNOWN'))+1L)]; 
bgoldst2 <- function(mydf) with(list(SeqID=c(0L,cumsum(mydf$status[-nrow(mydf)]=='UNKNOWN'))+1L),do.call(rbind,by(cbind(mydf,SeqID),SeqID,function(x) data.frame(SeqID=x$SeqID[1L],StartTime=x$time[1L],EndTime=x$time[length(x$time)],Sequence=I(list(x$event)))))); 
lebatsnok <- function(mydf) { mydfs <- split(mydf, head(cumsum(c("", mydf$status) == "UNKNOWN"), -1)); res <- lapply(mydfs, function(x) data.frame(StartTime = x$time[1], EndTime = tail(x$time,1), SeqID = NA, Sequence = paste(x$event, collapse=","))); res <- do.call(rbind, res); res$SeqID <- seq_len(NROW(res)); res; }; 

---

set.seed(100L); 
mydf <- data.frame(time=1:100,status=sample(c('OK','UNKNOWN'),1000L,T),event=sample(1:10,1000L,T),stringsAsFactors=F); 
dt <- as.data.table(mydf); 

ex <- as.data.frame(bgoldst1(dt)); o <- names(ex); 
all.equal(ex,bgoldst2(mydf)[o],check.attributes=F); 
## [1] TRUE 
all.equal(transform(ex,Sequence=factor(sapply(Sequence,paste,collapse=','))),lebatsnok(mydf)[o],check.attributes=F); 
## [1] TRUE 

microbenchmark(bgoldst1(dt),bgoldst2(mydf),lebatsnok(mydf)); 
## Unit: milliseconds 
##    expr  min   lq  mean  median   uq  max neval 
##  bgoldst1(dt) 1.363785 1.671909 1.896345 1.839763 2.041828 3.900621 100 
## bgoldst2(mydf) 217.960902 234.978058 244.491406 243.867674 251.392438 298.083774 100 
## lebatsnok(mydf) 254.961413 273.434086 284.439844 283.864322 291.889867 337.319627 100 

Answer 2

Eine Basis R-Lösung (beruht auf stringsAsFactorsFALSE sein, so mydf neu definiert):

set.seed(100) 
mydf <-data.frame(time=(1:100), 
        status = sample(c('OK','UNKNOWN'),1000,replace=TRUE), 
        event = sample(1:10,1000,replace=TRUE), stringsAsFactors=FALSE 
) 

mydfs <- split(mydf, head(cumsum(c("", mydf$status) == "UNKNOWN"), -1)) 
res <- lapply(mydfs, function(x) 
      data.frame(StartTime = x$time[1], 
        EndTime = tail(x$time,1), 
        SeqID = NA, 
        Sequence = paste(x$event, collapse=","))) 
res <- do.call(rbind, res) 
res$SeqID <- seq_len(NROW(res)) 
head(res) 
# StartTime EndTime SeqID Sequence 
# 0   1  3  1 1,2,7 
# 1   4  7  2 7,4,2,1 
# 2   8  9  3  5,6 
# 3  10  11  4  10,4 
# 4  12  12  5  2 
# 5  13  15  6 10,1,8