1

Rを使用していくつかの投資戦略をバックテストしています。以下のスクリプトがあります。

set.seed(1)
output.df <- data.frame(action=sample(c("initial_buy","sell","buy"),
          10000,replace=TRUE),stringsAsFactors=FALSE)
output.df[,"uid"] <- 1:nrow(output.df)

cutrow.fx <- function(output.df) {
  loop.del <- 2
  while (loop.del <= nrow(output.df)) {
    if ((output.df[loop.del,"action"]=="initial_buy" & 
            output.df[loop.del-1,"action"]=="initial_buy")|
          (output.df[loop.del,"action"]=="sell" & 
            output.df[loop.del-1,"action"]=="sell")|
          (output.df[loop.del,"action"]=="buy" & 
            output.df[loop.del-1,"action"]=="sell")|
          (output.df[loop.del,"action"]=="initial_buy" & 
            output.df[loop.del-1,"action"]=="buy")){
      output.df <- output.df[-loop.del,]
    } else {
      loop.del <- loop.del + 1
    }
  }
output.df<<-output.df
}

print(system.time(cutrow.fx(output.df=output.df)))

戦略は次のことを決定します。1）いつ株式の購入を開始するか。2）いつ株式に追加拠出を追加するか。3）すべての株式をいつ売却するか。過去10年間の株価のデータフレームがあります。株式を売買する日付を示す3つのスクリプトを作成し、3つの結果とorderそれらを組み合わせます。

「不可能なアクション」の一部を削除する必要があります。たとえば、事前に新しいユニットを購入しないと同じ株を2回販売できないため、上記のスクリプトを使用して、これらの不可能なアクションを削除しました。しかし、forループはちょっと遅いです。

それをスピードアップするための提案はありますか？

アップデート01

私はを次のように更新しcutrow.fxましたが失敗します：

cutrow.fx <- function(output.df) {
  output.df[,"action_pre"] <- "NIL"
  output.df[2:nrow(output.df),"action_pre"] <- output.df[1:(nrow(output.df)-1),"action"]                    
  while (any(output.df[,"action_pre"]=="initial_buy" & output.df[,"action"]=="initial_buy")|
           any(output.df[,"action_pre"]=="sell" & output.df[,"action"]=="sell")|
           any(output.df[,"action_pre"]=="sell" & output.df[,"action"]=="buy")|
           any(output.df[,"action_pre"]=="buy" & output.df[,"action"]=="initial_buy")) {
    output.df <- output.df[!(output.df[,"action_pre"]=="initial_buy" & output.df[,"action"]=="initial_buy"),]
    output.df <- output.df[!(output.df[,"action_pre"]=="sell" & output.df[,"action"]=="sell"),]
    output.df <- output.df[!(output.df[,"action_pre"]=="sell" & output.df[,"action"]=="buy"),]
    output.df <- output.df[!(output.df[,"action_pre"]=="buy" & output.df[,"action"]=="initial_buy"),]
    output.df[,"action_pre"] <- "NIL"
    output.df[2:nrow(output.df),"action_pre"] <- output.df[1:(nrow(output.df)-1),"action"]                    
  }        
  output.df[,"action_pre"] <- NULL
  output.df<<-output.df
}

私は、ジョンによって何らかの形でインスピレーションを得て（答えで彼が何を意味するのか正確にわからないので、どういうわけか使用しました）、ベクトル比較を使用しました。繰り返しには、whileループを使用します。しかし、出力は同じではありません。

ここでのforループは避けられませんか？

4

3 に答える 3

2

ベクトル化で何か賢いことをしようとしましたが、ループの前の反復が後の反復のデータ関係を変更する可能性があるため、失敗しました。そのため、データを設定された量だけ遅らせて、実際の結果と比較することはできませんでした。

私にできることは、関連するコピー操作を最小限に抑えることです。Rはコピーによる割り当てであるため、のようなステートメントを作成するとoutput.df <- output.df[-loop.del,]、削除される各行のデータ構造全体がコピーされます。データフレームを変更（およびコピー）する代わりに、論理ベクトルに変更を加えました。スピードアップのその他の試みには、ビット単位のand （）の代わりに論理and（）を使用すること、比較を少なくするために使用すること、およびへのアクセスを最小限に抑えることが含まれます。&&&%in%output.df

2つの機能を比較するために、元のデータフレームが上書きされないように、OPソリューションを少し変更しました。これにより速度が10倍向上するようですが、それでもかなりの時間（> 0.5秒）かかります。もっと速い解決策を見たいです。

OPのソリューション（戻り値がわずかに変更され、グローバル割り当てなし）

cutrow.fx <- function(output.df) {
  loop.del <- 2
  while (loop.del <= nrow(output.df)) {
    if ((output.df[loop.del,"action"]=="initial_buy" & 
            output.df[loop.del-1,"action"]=="initial_buy")|
          (output.df[loop.del,"action"]=="sell" & 
            output.df[loop.del-1,"action"]=="sell")|
          (output.df[loop.del,"action"]=="buy" & 
            output.df[loop.del-1,"action"]=="sell")|
          (output.df[loop.del,"action"]=="initial_buy" & 
            output.df[loop.del-1,"action"]=="buy")){
      output.df <- output.df[-loop.del,]
    } else {
      loop.del <- loop.del + 1
    }
  }
return(output.df)
}
ans1 <- cutrow.fx(output.df)

私の解決策

cutrow.fx2 <- function(output.df) {
    ##edge case if output.df has too few rows
    if (nrow(output.df) < 2) return(output.df)
    ##logical vector of indices of rows to keep
    idx <- c(TRUE,logical(nrow(output.df)-1))
    ##keeps track of the previous row
    prev.row <- 1
    prev.act <- output.df[prev.row,"action"]
    for (current.row in seq_len(nrow(output.df))[-1]) {
        ##access output.df only once per iteration
        current.act <- output.df[current.row,"action"]
        ##checks to see if current row is bad
        ##if so, continue to next row and leave previous row as is
        if ( (prev.act %in% c("initial_buy","buy")) && 
             (current.act == "initial_buy") ) {
            next
        } else if ( (prev.act == "sell") &&
            (current.act %in% c("buy","sell")) ) {
            next
        }
        ##if current row is good, mark it in idx and update previous row
        idx[current.row] <- TRUE
        prev.row <- current.row
        prev.act <- current.act
    }
    return(output.df[idx,])
}
ans2 <- cutrow.fx2(output.df)

答えが同じであることを確認します

identical(ans1,ans2)
## [1] TRUE

#benchmarking
require(microbenchmark)
mb <- microbenchmark(
  ans1=cutrow.fx(output.df)
  ,ans2=cutrow.fx2(output.df),times=50)
print(mb)
# Unit: milliseconds
  # expr       min        lq    median         uq        max
# 1 ans1 9630.1671 9743.1102 9967.6442 10264.7000 12396.5822
# 2 ans2  481.8821  491.6699  500.6126   544.4222   645.9658

plot(mb)
require(ggplot2)
ggplot2::qplot(y=time, data=mb, colour=expr) + ggplot2::scale_y_log10()
于 2013-01-05T20:21:16.940 に答える
2

最後のアクションをチェックしているだけのようです。これにはループはまったく必要ありません。ベクトルをシフトし、直接ベクトル比較を行うだけです。これは人為的な例です。

x <- sample(1:11)
buysell <- sample(c('buy', 'sell'), 11, replace = TRUE)

だから、私は11個のサンプル、x、そしてそれらを買ったか売ったかを持っています。最後のサンプルを売買したかどうかを示すブール値を作成したいと思います。

bought <- c(NA, buysell[1:10])
which( bought == 'buy' )

x 変数と buysell 変数を調べると、結果が前のアイテムで購入が行われた x アイテムのインデックスであることがわかります。

また、彼の機能をチェックアウトすることもできます%in%。

于 2013-01-04T17:03:32.187 に答える
1

これは、もう少し単純ではるかに高速なコードです。すべての要素をループするのではなく、一致間でのみループします。後方ではなく前方に一致します。

まず、cutrow.fx関数を変更します。<<-output.df最後の行の を削除し、単純に結果を返します。次に、2 つの関数を実行して、結果を比較できます。

cutrow.fx1 <- function(d) {
  len <- length(d[,1])
  o <- logical(len)
  f <- function(a) {
    switch(a,
           initial_buy=c('buy', 'sell'), 
           buy=c('buy', 'sell'),
           sell='initial_buy'
           )
  }
  cur <- 1
  o[cur] <- TRUE
  while (cur < len) {
    nxt <- match(f(d[cur,1]), d[(cur+1):len,1])
    if (all(is.na(nxt))) {
      break
    } else {
      cur <- cur + min(nxt, na.rm=TRUE);
      o[cur] <- TRUE
    }
  }
  d[o,]
}

結果が正しいことを示す：

identical(cutrow.fx1(output.df), cutrow.fx(output.df))
## [1] TRUE

そして、それはかなり高速です。matchこれは、行を破棄するために反復するのではなく、保持する次の行を見つけるために使用する、問題の部分的なベクトル化によるものです。

print(system.time(cutrow.fx(output.df)))
##   user  system elapsed 
##  5.688   0.000   5.720 

print(system.time(cutrow.fx1(output.df)))
##   user  system elapsed 
##  1.050   0.000   1.056
于 2013-01-05T23:59:59.297 に答える