Question

我正在使用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组合起来。

我需要删除一些“不可能的行动”，例如我不能事先购买新单位两次出售同一股票，所以我用上面的脚本删除那些不可能的行动。但是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循环是不可避免的吗？

Answer 1

看起来你正在做的就是检查最后一个动作。这根本不需要循环。您所要做的就是移动矢量并进行直线矢量比较。这是一个人为的例子。

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%。

Answer 2

我尝试使用矢量化做一些聪明的事情，但失败了，因为循环的先前迭代可以改变数据关系以便以后的迭代。因此，我无法将数据滞后一定数量，并且比较滞后于实际结果。

我能做的是尽量减少所涉及的复制操作。 R是按副本分配的，因此当您编写类似output.df <- output.df[-loop.del,]的语句时，您将复制已删除的每一行的整个数据结构。我没有更改（和复制）数据框，而是对逻辑矢量进行了更改。其他一些加速尝试包括使用逻辑和（&&）而不是按位和（&），使用%in%进行较少的比较，并最大限度地减少对output.df的访问。

为了比较两个函数，我略微修改了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()

Answer 3

这是一些更简单，更快速的代码。它不会遍历所有元素，而只会在匹配之间循环。它匹配前进而不是后退。

首先，修改您的cutrow.fx功能。删除最后一行的<<-output.df，然后只返回结果。然后你可以运行两个函数并比较结果。

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

加快“for-loop”以删除符合条件的行

更新01

3 个答案: