Наиболее эффективный / векторизация при использовании предыдущего вычисленного значения (переходящий)
После этих разговоров:
Могу ли я векторизовать расчет, который зависит от предыдущих элементовsapply? tapply? ddply? Переменная dataframe, основанная на скользящем индексе предыдущих значений другой переменнойЯ хотел проверить более "реальный" пример из жизни. Недавно мне пришлось перенести код SAS в код R и код KDB в код R. Я попытался скомпилировать достаточно простой, но более сложный пример для оптимизации.
давайте построим тренировочный набор
buildDF <- function(N){
set.seed(123); dateTimes <- sort(as.POSIXct("2001-01-01 08:30:00") + floor(3600*runif(N)));
set.seed(124); f <- floor(1+3*runif(N));
set.seed(123); s <- floor(1+3*runif(N));
return(data.frame(dateTime=dateTimes, f=f, s=s));
}
Это то, что должно быть достигнуто
f1 <- function(DF){
#init
N <- nrow(DF);
DF$num[1] = 1;
for(i in 2:N){
if(DF$f[i] == 2){
DF$num[i] <- ifelse(DF$s[i-1] == DF$s[i],DF$num[i-1],1+DF$num[i-1]);
}else{ #meaning f in {1,3}
if(DF$f[i-1] != 2){
DF$num[i] = DF$num[i-1];
}else{
DF$num[i] = ifelse((DF$dateTime[i]-DF$dateTime[i-1])==0,DF$num[i-1],1+DF$num[i-1]);
}
}
}
return(DF)
}
Это отвратительно. Давайте немного векторизовать это:
f2 <- function(DF){
N <- nrow(DF);
DF$add <- 1; DF$ds <- c(NA,diff(DF$s)); DF$lf <- c(NA,DF$f[1:(N-1)]);
DF$dt <- c(NA,diff(DF$dateTime));
DF$add[DF$f == 2 & DF$ds == 0] <- 0;
DF$add[DF$f == 2 & DF$ds != 0] <- 1;
DF$add[DF$f != 2 & DF$lf != 2] <- 0;
DF$add[DF$f != 2 & DF$lf == 2 & DF$dt==0] <- 0;
DF$num <- cumsum(DF$add);
return(DF);
}
И используя самые полезныеТаблица данных:
f3 <- function(DT){
N <- nrow(DT);
DT[,add:=1]; DT[,ds:=c(NA,diff(s))]; DT[,lf:=c(NA,f[1:(N-1)])];
DT[,dt:=c(NA,diff(dateTime))];
DT[f == 2 & ds == 0, add:=0];
DT[f == 2 & ds != 0, add:=1];
DT[f != 2 & lf != 2, add:=0];
DT[f != 2 & lf == 2 & dt == 0, add:=0];
DT[,num:=cumsum(add)];
return(DT);
}
На 10K-фрейме данных:
library(rbenchmark);
library(data.table);
N <- 1e4;
DF <- buildDF(N)
DT <- as.data.table(DF);#we can contruct the data.table as a data.frame so it's ok we don't count for this time.
#make sure everybody is equal
DF1 <- f1(DF) ; DF2 <- f2(DF); DT3 <- f3(DT);
identical(DF1$num,DF2$num,DT3$num)
[1] TRUE
#let's benchmark
benchmark(f1(DF),f2(DF),f3(DT),columns=c("test", "replications", "elapsed",
+ "relative", "user.self", "sys.self"), order="relative",replications=1);
test replications elapsed relative user.self sys.self
2 f2(DF) 1 0.010 1.0 0.012 0.000
3 f3(DT) 1 0.012 1.2 0.012 0.000
1 f1(DF) 1 9.085 908.5 8.980 0.072
Хорошо, теперь на более приличных 5M строках data.frame
N <- 5e6;
DF <- buildDF(N)
DT <- as.data.table(DF);
benchmark(f2(DF),f3(DT),columns=c("test", "replications", "elapsed",
+ "relative", "user.self", "sys.self"), order="relative",replications=1);
test replications elapsed relative user.self sys.self
2 f3(DT) 1 2.843 1.000 2.092 0.624
1 f2(DF) 1 10.920 3.841 4.016 5.137
Мы получаем 5X с data.table.
Интересно, еслиRcpp или зоопарк ::: rollapply может получить много на этом. Я был бы счастлив с любым предложением