基于连续行的值对值进行矢量化

Question

考虑以下（示例）zoo对象：

数据框在日期索引上按升序排序。 ma3 字段提供持续时间字段的3天移动平均值。 比较字段将持续时间值的值与相应的 ma3 值进行比较; （1）IF 持续时间＆gt; ma3 那么'上'，（2）如果持续时间＆lt; ma3 那么'低于'，（3）ELSE'EQUAL'。

consec_day 字段的值计算如下：如果比较值等于'，则从最早的日期开始，使用ma3值在上面'然后 consec_day 值的符号为正，如果比较值等于'BELOW'，则 consec_day 值的符号为负，如果比较值等于'EQUAL'，则 consec_day 值为零。要确定 consec_day 值的大小，请计算连续数（从最旧到最近），相同的比较值。

问题：

1. 可以对 consec_day 字段的计算进行矢量化吗？
2. 如果是这样，怎么样？

我当前的解决方案使用循环如下：

    z0 <- zoo(matrix(c(c(345, 432, 112, 332, 496, 414, 211), c(NA, NA, 296.33, 292, 313.33, 414, 373.67), c(NA, NA, 'BELOW', 'ABOVE', 'ABOVE', 'EQUAL', 'BELOW'), c(NA, NA, -1, 1, 2, 0, -1)), nrow = 7, ncol = 4), seq(as.Date('2013-07-31'), as.Date('2013-08-06'), by = "day"))
    colnames(z0) <- c("duration", "ma3", "comparison", "consec_day")
    require(xts)
    for (r in 1:nrow(z0)) {
      if (is.na(z0$comparison[r])) {next}
      if (z0$comparison[r] == 'EQUAL') {z0$consec_day[r] <- 0; next}
      if (is.na(z0$comparison[r - 1])) {z0$consec_day[r] <- ifelse(z0$comparison[r] == 'ABOVE', 1, ifelse(z0$comparison[r] == 'BELOW', -1, 0)); next}
      if ( (xts::coredata(df0)[r, 3] != xts::coredata(df0)[r - 1, 3]) & xts::coredata(df0)[r, 3] == 'ABOVE') {
        df0$consec_day[r] <- 1 
      } else {
      if ( (xts::coredata(df0)[r, 3] != xts::coredata(df0)[r - 1, 3]) & xts::coredata(df0)[r, 3] == 'BELOW') {
        df0$consec_day[r] <- -1 
      } else {ifelse((xts::coredata(df0)[r, 3] != xts::coredata(df0)[r - 1, 3]) & xts::coredata(df0)[r, 3] == 'ABOVE')), df0$consec_day[r] <- df0$consec_day[r - 1] + 1, df0$consec_day[r] <- df0$consec_day[r - 1] - 1}
    }

Answer 1

使用run length encoding（rle）

您需要传递原子矢量（并将NA值替换为'.NA'，因为rle并不能很好地处理它们。

comparison <- z0[,3]
compAtomic <- as.character(comparison)
compAtomic[is.na(compAtomic)] <- '.NA'

# define your changes
changes <- c('BELOW' =-1, 'EQUAL' = 0, 'ABOVE' = 1, '.NA' = NA )
# perform rle (and unclass the results)
rrl <- unclass(rle(compAtomic))
# a bit of `rep` and `sequence`
with(rrl, sequence(lengths) * rep(changes[values],lengths))
#  .NA   .NA BELOW ABOVE ABOVE EQUAL BELOW 
#   NA    NA    -1     1     2     0    -1