Frage Wie kann dieser Algorithmus verbessert werden?


R Version 2.11.1 32-Bit unter Windows 7

Ich erhalte die Daten train.txt wie folgt:

USER_A USER_B ACTION
1        7      0
1        8      1
2        6      2
2        7      1
3        8      2

Und ich behandle die Daten als folgenden Algorithmus:

train_data=read.table("train.txt",header=T)
result=matrix(0,length(unique(train_data$USER_B)),2)
result[,1]=unique(train_data$USER_B)
for(i in 1:dim(result)[1])
{
    temp=train_data[train_data$USER_B%in%result[i,1],]
    result[i,2]=sum(temp[,3])/dim(temp)[1]
}

Das Ergebnis ist die Punktzahl aller USER_B in train_data. Die Punktzahl ist definiert als:

Bewertung von USER_B = (die Summe aller Aktionen von USER_B) / (die empfohlenen Zeiten von USER_B)

aber die train_data ist sehr groß, es kann drei Tage dauern, um dieses Programm zu beenden, also komme ich hierher, um um Hilfe zu bitten, könnte dieser Algorithmus verbessert werden?


5
2018-04-13 06:33


Ursprung


Antworten:


Wenn Sie Ihr Beispiel ausführen, ist Ihr gewünschtes Ergebnis die Berechnung der mittleren ACTION für jedes einzelne USER_B:

     [,1] [,2]
[1,]    7  0.5
[2,]    8  1.0
[3,]    6  2.0

Sie können dies mit einer Codezeile unter Verwendung der ddply() Funktion im Paket plyr

library(plyr)
ddply(train_data[, -1], .(USER_B), numcolwise(mean))

  USER_B ACTION
1      6    2.0
2      7    0.5
3      8    1.0

Alternativ die Funktion tapply in der Basis R macht das gleiche:

tapply(train_data$ACTION, train_data$USER_B, mean)

Abhängig von der Größe Ihrer Tabelle können Sie eine Verbesserung der Ausführungszeit von 20x oder höher erzielen. Hier ist der system.time Test für einen data.frame mit einer Million Einträgen. Ihr Algorithmus benötigt 116 Sekunden, ddply () benötigt 5,4 Sekunden und tapply braucht 1,2 Sekunden:

train_data <- data.frame(
        USER_A = 1:1e6,
        USER_B = sample(1:1e3, size=1e6, replace=TRUE),
        ACTION = sample (1:100, size=1e6, replace=TRUE))

yourfunction <- function(){
    result <- matrix(0,length(unique(train_data$USER_B)),2)
    result[,1] <- unique(train_data$USER_B);
    for(i in 1:dim(result)[1]){     
        temp=train_data[train_data$USER_B%in%result[i,1],]
        result[i,2]=sum(temp[,3])/dim(temp)[1]
    }
    result
}

system.time(XX <- yourfunction())
   user  system elapsed 
 116.29   14.04  134.33 

system.time(YY <- ddply(train_data[, -1], .(USER_B), numcolwise(mean)))
   user  system elapsed 
   5.43    1.60    7.19 

system.time(ZZ <- tapply(train_data$ACTION, train_data$USER_B, mean))
   user  system elapsed 
   1.17    0.06    1.25 

6
2018-04-13 07:27



Zusätzlich zu den Ansätzen, die von @Andrie, der split() dann lapply() Ansatz ist noch schneller:

> system.time(ZZ <- tapply(train_data$ACTION, train_data$USER_B, mean))
   user  system elapsed 
  1.025   0.011   1.062 
> system.time(WW <- unlist(lapply(split(train_data$ACTION, 
+                                       f = train_data$USER_B), 
+                          mean)))
   user  system elapsed 
  0.465   0.007   0.483

sapply() ist genauso schnell für dieses Problem:

> system.time(SS <- sapply(split(train_data$ACTION, f = train_data$USER_B), 
+                          mean))
   user  system elapsed 
  0.469   0.001   0.474

5
2018-04-13 08:18



@gavin hat die hohe Leistungsfähigkeit bereits unter Beweis gestellt, wenn eine Kombination von split und lapply.

Das Paket data.table bietet eine weitere spürbare Leistungssteigerung von ~ 75%

library(data.table)
system.time({
      VV <- as.data.table(train_data)[, list(ACTION=mean(ACTION)), by=USER_B]
    })

user  system elapsed 
0.15    0.02    0.17 

system.time(WW <- unlist(lapply(split(train_data$ACTION, f = train_data$USER_B),mean)))

user  system elapsed 
0.61    0.02    0.63 

all(WW==VV$ACTION)
[1] TRUE

Das data.table Paket ist verfügbar bei CRAN und hat Website auf Schmiede


4
2018-05-05 08:38



Sie können es versuchen tapply:

train_data <- read.table("train.txt",header=T);
result <- tapply(train_data$ACTION,train_data$USER_B,function(x) sum(x)/length(x)); 

Sie können verwenden mean Anstatt von function.., aber ich habe kürzlich gelesen, dass diese letzte Lösung schneller ist (wenn Sie keine haben NAs usw.).

Ich habe nicht getestet, aber ich glaube, das sollte schneller sein. Wenn du noch eine schnellere Lösung willst, schau mal rein Rcpp und inline Pakete...


0
2018-04-13 07:05