是否有可能优化（向量化）这两个函数以获得更好的性能

Question

在我尝试使用RI的首次尝试中，我猜这两个函数的性能不太好，如果能收到一些有关如何使它们更高效（矢量化）的提示，我将不胜感激。 这两个功能最后都带有“测试用例”。

第一个函数接受xts对象x和y的两个时间序列，并返回一个包含x比y高/低多少天的数据的序列。

require('xts')
require('quantmod')

countDaysBelowOrAbove <- function(x, y) {
    x <- try.xts(x, error=as.matrix)
    y <- try.xts(y, error=as.matrix)

    if(is.xts(x) && is.xts(y)) {
        xy <- cbind(x,y)
    } else {
        xy <- cbind( as.vector(x), as.vector(y) )
    }

    # Count NAs, ensure they're only at beginning of data, then remove.
    xNAs <- sum( is.na(x) )
    yNAs <- sum( is.na(y) )
    NAs <- max( xNAs, yNAs )
    if( NAs > 0 ) {
        if( any( is.na(xy[-(1:NAs),]) ) ) stop("Series contain non-leading NAs")
    }

    resultDaysLower <- x
    resultDaysHigher <- x
    resultDaysLower[!is.na(resultDaysLower)]<-0
    resultDaysHigher[!is.na(resultDaysHigher)]<-0

    series<-cbind(xy, resultDaysLower, resultDaysHigher)
    colnames(series) <- c(names(xy), "cumDaysLower", "cumDaysHigher")

    daysLower = 0
    daysHigher = 0

    for (i in 1:NROW(xy)) {
        if (!(is.na(series[,1][i]) | is.na(series[,2][i]))) {
            if (series[,1][i] >= series[,2][i]) {
                daysLower = 0
                daysHigher = daysHigher + 1
            }
            else {
                daysHigher = 0
                daysLower = daysLower + 1
            }
        }
        else {
            daysLower = 0
            daysHigher = 0
        }
        series$cumDaysLower[i] = daysLower
        series$cumDaysHigher[i] = daysHigher                
    }
    return(series)
}

getSymbols("SPY", from='2005-01-01')
SPYclose = Cl(SPY)

getSymbols("QQQQ", from='2005-01-01')
QQQQclose = Cl(QQQQ)

testData = countDaysBelowOrAbove(SPYclose, QQQQclose)

我希望对性能优化有所帮助的第二个功能如下。 该函数将xts对象系列和代表间隔长度的xts对象作为参数，以计算指定时间的最小系列。 该函数以指定的窗口返回计算的最小系列数，以指定的长度设置最小计算。

minimumWithVaryingLength<-function(series, lengths) {
    series <- try.xts(series, error=as.matrix)
    lengths <- try.xts(lengths, error=as.matrix)

    if(is.xts(series) && is.xts(lengths)) {
        serieslengths <- cbind(series,lengths)
    } else {
        serieslengths <- cbind( as.vector(series), as.vector(lengths) )
    }

    # Count NAs, ensure they're only at beginning of data, then remove.
    seriesNAs <- sum( is.na(series) )
    lengthsNAs <- sum( is.na(lengths) )
    NAs <- max( seriesNAs, lengthsNAs )
    if( NAs > 0 ) {
        if( any( is.na(serieslengths[-(1:NAs),]) ) ) stop("Series contain non-leading NAs")
    }

    result <- series
    result[!is.na(result)]<-0

    for (i in 1:NROW(serieslengths)) {  
        if (lengths[i] > 0) {
            result[i] <- runMin(series, n=lengths[i], cumulative=FALSE)[i]
        }
        else {
            result[i] <- 0
        }
    }

    return(result)
}

getSymbols("SPY", from='2005-01-01')
SPYclose = Cl(SPY)

getSymbols("QQQQ", from='2005-01-01')
QQQQclose = Cl(QQQQ)

numDaysBelow = countDaysBelowOrAbove(SPYclose, QQQQclose)
test = minimumWithVaryingLength(SPYclose, numDaysBelow)

在此先感谢您的帮助。

亲切的问候，萨摩。

Answer 1

对于第一个函数，您要寻找序列x小于/高于y的累积周期数。 为此，您可以使用从cummax构建的这个方便的函数CumCount() 。 首先是一些样本数据：

set.seed(1)
x <- sample(1:5,20,T)
y <- sample(1:5,20,T)

CumCount <- function(x) {
  z <- cumsum(x)
  z - cummax(z*(!x))
}

CumLow = CumCount(x<y)
CumHigh = CumCount(x>y)

对于第二次计算，您尝试查找x < y期间每个时段内的累积最小 x值。 为此， rle函数非常有用（“游程长度编码”）。

# runs equals the length of each phase (x < y or x > y)
runs <- rle(CumLow > 0)$lengths
# starts is the number of periods prior to each phase...
starts <- c(0,cumsum(runs)[-length(runs)]) 
#... which we use to build "blocks", a list of indices of each phase.
blocks <- mapply( function(x,y) x+y, starts, lapply(runs,seq))
# now apply the cummin function within each block:
# (remember to mask it by CumLow > 0 -- 
#   we only want to do this within the x<y phase)
BlockCumMin <- unlist(sapply(blocks, function(blk) cummin(x[blk]))) * (CumLow > 0)

现在，我们将所有内容放在一起：

  > cbind(x,y, CumLow, CumHigh, BlockCumMin)

      x y CumLow CumHigh BlockCumMin
 [1,] 3 4      1       0           3
 [2,] 4 2      0       1           0
 [3,] 2 2      0       0           0
 [4,] 2 5      1       0           2
 [5,] 4 4      0       0           0
 [6,] 2 2      0       0           0
 [7,] 4 1      0       1           0
 [8,] 1 3      1       0           1
 [9,] 2 5      2       0           1
[10,] 1 3      3       0           1
[11,] 2 5      4       0           1
[12,] 1 4      5       0           1
[13,] 4 2      0       1           0
[14,] 5 3      0       2           0
[15,] 4 1      0       3           0
[16,] 4 1      0       4           0
[17,] 3 4      1       0           3
[18,] 3 1      0       1           0
[19,] 5 3      0       2           0
[20,] 4 4      0       0           0

请注意，此问题与此问题有关

更新。 对于其中你有一个更一般的情况series载体， lengths向量（长度相同的series ），并且要产生一种叫做结果BlockMins其中BlockMins[i]是的最小lengths[i]的块series结束在位置i ，您可以执行以下操作。 由于长度是任意的，因此不再是累积的最小值。 对于每个i您都必须采用在位置i处结束的series的length[i]元素中的最小值：

set.seed(1)
series <- sample(1:5,20,T)
lengths <- sample(3:5,20,T)
BlockMins <- sapply(seq_along(lengths), 
                    function(i) min( series[ i : max(1, (i - lengths[i]+1)) ]) )
> cbind(series, lengths, BlockMins)
      series lengths BlockMins
 [1,]      1       5         1
 [2,]      1       4         1
 [3,]      3       3         1
 [4,]      4       4         1
 [5,]      5       3         3
 [6,]      1       4         1
 [7,]      1       5         1
 [8,]      4       3         1
 [9,]      2       5         1
[10,]      2       4         1
[11,]      1       5         1
[12,]      2       5         1
[13,]      2       3         1
[14,]      2       4         1
[15,]      4       5         1
[16,]      3       5         2
[17,]      5       3         3
[18,]      1       4         1
[19,]      5       3         1
[20,]      3       3         1

Answer 2

无需处理时间序列设备，如果您有两个向量x和y，并且想“返回一个包含x比y高/低多少天的数据的序列”，只需对其进行比较：

# Make up some data
x <- seq(100)
y <- x[sample(x)]
# Compare
x.greater <- sum(x>y)
x.lesser <- sum(x<y)

这样做的关键是当您对一个逻辑向量求和时，例如（x> y），R将TRUE强制为1，将FALSE强制为0。