6

それらの会話に続いて：

  1. 以前の要素に依存する計算をベクトル化できますか
  2. sapply？タップライ？ddply？別の変数の以前の値のローリングインデックスに基づくデータフレーム変数

もっと「現実の」ケーススタディをテストしたかったのです。最近、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);
}

そして、最も有用なdata.tableを使用します：

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

data.tableで5倍になります。

Rcppまたはzoo:::rollapplyがこれで多くを得ることができるかどうか疑問に思います。 私はどんな提案にも満足します

4

2 に答える 2

6

シンプルなインラインRcppバージョン：

library(Rcpp)
library(inline)

f4cxx <- cxxfunction(signature(input="data.frame"), plugin="Rcpp", body='
  Rcpp::DataFrame df(input);
  const int N = df.nrows();  

  Rcpp::NumericVector f = df["f"];
  Rcpp::NumericVector s = df["s"];
  Rcpp::NumericVector d = df["dateTime"]; // As far as we need only comparation
  Rcpp::NumericVector num(N);             // it is safe to convert Datetime to Numeric (faster) 

  num[0] = 1;
  for(int i=1; i<N; i++){
    bool cond1 = (f[i]==2) && (s[i]!=s[i-1]);
    bool cond2 = (f[i]!=2) && (f[i-1]==2) && (d[i]!=d[i-1]);
    num[i] = (cond1 || cond2)?1+num[i-1]:num[i-1];    
  }

  df["num"] = num;
  return df;                                // Returns list
  //return (Rcpp::as<Rcpp::DataFrame>(df)); // Returns data.frame (slower)
  ')

チェックアウト：

N<-1e4; df<-buildDF(N)
identical(f1(df)$num, f4cxx(df)$num)

[1] TRUE

ベンチマーク：

N<-1e5; df<-buildDF(N); dt<-as.data.table(df)
benchmark(f2(df), f2j(df), f3(dt), f4cxx(df),
          columns=c("test", "replications", "elapsed", "relative", "user.self", "sys.self"),
          order="relative", replications=1);

       test replications elapsed relative user.self sys.self
4 f4cxx(df)            1   0.001        1     0.000        0
2   f2j(df)            1   0.037       37     0.040        0
3    f3(dt)            1   0.058       58     0.056        0
1    f2(df)            1   0.078       78     0.076        0
于 2012-12-31T01:53:25.507 に答える
3

Rcpp（またはDirkに頭を悩ませたい場合は、「プレーンな古いC API」）を使用して最初の関数をC / C ++に変換するのが、おそらく最速です。data.tableソリューションはおそらくすぐ近くにあります。

f2これは、多くのdata.frameサブセット化（非常に遅い）を回避するため、関数よりもはるかに高速なベースRソリューションです。これは、ベースRコードを高速にするために何をすべきか、または避けるべきかを示していますが、コードの明瞭さ/可読性がいくらか犠牲になっています。

f2j <- function(DF){
  N <- nrow(DF)
  f2  <- DF$f == 2
  ds0 <- diff(DF$s) == 0
  lf2 <- f2[-N]
  f2  <- f2[-1]
  dt3 <- diff(DF$dateTime) == 0
  cond <- logical(N)
  cond[-1] <- (f2 & ds0) | (!f2 & !lf2) | (!f2 & lf2 & dt3)
  DF$num <- cumsum(!cond)
  DF
}
于 2012-12-30T23:55:57.790 に答える