Beschleunigung der Anwendung einer Funktion auf eindeutige Werte in R

Question

Ich hatte gehofft, jemand könnte helfen, ich versuche, eine Anwendungsfunktion zu beschleunigen, und ich habe ein paar Tricks versucht, aber es ist immer noch sehr langsam und ich fragte mich, ob Jeder hatte noch mehr Vorschläge.

Ich habe Daten wie folgt:

myData= data.frame(ident=c(3,3,4,4,4,4,4,4,4,4,4,7,7,7,7,7,7,7), 
group=c(7,7,7,7,7,7,7,7,7,7,7,8,8,8,8,8,8,8), 
significant=c(1,1,0,0,0,0,0,0,0,0,0,1,1,0,1,0,0,0), 
year=c(2003,2002,2001,2008,2010,2007,2007,2008,2006,2012,2008, 
2012,2006,2001,2014,2012,2004,2007), 
month=c(1,1,9,12,3,2,4,3,9,5,12,8,11,3,1,6,3,1), 
subReport=c(0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0), 
prevReport=c(1,1,0,1,1,1,0,1,1,1,0,1,1,1,1,1,1,1)) 

und ich möchte mit einem Datenrahmen wie dies am Ende:

results=data.frame(ident=c(3,4,7), 
significant=c(1,0,1), 
prevReports=c(2,6,7), 
subReport=c(0,1,0), 
group=c(7,7,8)) 

Um dies zu tun, ich den Code unten geschrieben und es zu tun schnell i habe versucht, in Datentabellen umzuwandeln und rbindlist anstelle von rbind zu verwenden, was ich in einigen Threads vorgeschlagen habe. Ich habe auch versucht, ParLapply, aber ich finde immer noch, dass der Prozess ziemlich langsam ist, (Ich mache das auf etwa 250.000 Datenpunkte).

dt<-data.table(myData) 

results<-NULL 

ApplyModel <- function (id,data) { 

dtTemp<-dt[dt$ident== id,] 

if(nrow(dtTemp)>=1){ 

prevReport = if(sum(dtTemp$prevReport)>=1) sum(dtTemp$prevReport) else 0 

subsequentReport = if(sum(dtTemp$subReport)>=1) 1 else 0 

significant = as.numeric(head(dtTemp$sig,1)) 

group = head(dtTemp$group,1) 

id= as.numeric(head(dtTemp$id,1)) 

output<-cbind(id, significant ,prevReport,subsequentReport ,group) 

output<-output[!duplicated(output[,1]),] 
print(output) 
results <- rbindlist(list(as.list(output))) 

} 
} 


results<-lapply(unique(dt$ident), ApplyModel) 
results<-as.data.frame(do.call(rbind, results)) 

Alle Vorschläge, wie dies beschleunigt werden könnte, wären sehr willkommen! Ich denke, dass es mit der Teilmenge zu tun ist, möchte ich die Funktion auf eine Teilmenge basierend auf einem eindeutigen Wert anwenden, aber ich denke, dass lapply ist wirklich mehr für die Anwendung einer Funktion auf jeden Wert, so Subsetting besiegt das Objekt etwas ...

Answer 1

Hier erzeugt der Code einen Fehler:

results<-lapply(unique(dt$ident), ApplyModel) Error in dt$ident : object of type 'closure' is not subsettable

Es erscheint mir, dass Sie für tapply suchen statt lapply. Mit tapply könnte man etwa die oben in viel prägnanter Weise ausdrücken:

results2 <- data.frame(significant = tapply(myData$significant, myData$ident, function(x) return(x[1])), 
         prevreports = tapply(myData$prevReport, myData$ident, sum), 
         subReports = tapply(myData$subReport, myData$ident, function(x) as.numeric(any(x==1))), 
         group = tapply(myData$group, myData$ident, function(x) return(x[1]))) 

über die gleiche Arbeit tun sollten, aber viel besser lesbar sein. Jetzt sollte das wirklich schnell sein, außer für riesige Datensätze. In den meisten Fällen sollte es schneller sein zu warten, bis R den Auftrag abgeschlossen hat, als mehr Zeit für die Programmierung aufzuwenden. Eine Möglichkeit, dies noch schneller zu machen, wäre die Nutzung der Leistung des data.table-Pakets, aber es genügt nicht, es aufzurufen. Sie müssen lernen, es ist sehr spezielle Syntax. Bitte überprüfe vorher, dass der Code auf diese Weise wirklich zu langsam ist. Wenn es wirklich zu langsam ist, überprüfen Sie dies:

library(data.table) 

first <- function(x) x[1] 
myAny <- function(x) as.numeric(any(x==1)) 
myData <- data.table(myData) 

myData[, .(significant=first(significant), 
      prevReports=sum(prevReport), 
      subReports=myAny(subReport), 
      group=first(group)), ident] 

Answer 2

Sie dplyr verwenden:

require(dplyr) 

new <- myData %>% group_by(ident) %>% 
summarise(first(significant),sum(prevReport),(n_distinct(subReport)-1), first(group)) %>% 
data.frame()