如何使用 Rcpp 避免在 r 中使用 for 循环

Question

我有一个xts格式的数据（data）看起来是这样的：

                              A
2008-01-14 09:29:59           10 
2008-01-14 09:29:59           0.1
2008-01-14 09:30:00           0.9
2008-01-14 09:30:00           0.1
2008-01-14 09:30:00           0.2
2008-01-14 09:30:00           0.4
2008-01-14 09:30:00           0.6
2008-01-14 09:30:00           0.7
2008-01-14 09:30:02           1.5
2008-01-14 09:30:06           0.1
2008-01-14 09:30:06           0.1
2008-01-14 09:30:07           0.9
2008-01-14 09:30:07           0.2
2008-01-14 09:30:10           0.4
2008-01-14 09:30:10           0.3
2008-01-14 09:30:25           1.5 

任何列或行元素中都没有模式。

数据由 POSIXct 类对象索引。我正在创建名为“1second”、“3second”的新列。对于“1秒”列，对于每一行，我想根据他们的xts时间对象在接下来的1秒内找到下一个观察值，并记录该行的“A”值。如果在接下来的几秒钟内没有观察到，则将 NA 放入该行的 data$1second 中。

同样，对于“3second”列，对于每一行，我想根据他们的 xts 时间对象在接下来的 3 秒内找到领先的观察。如果在接下来的 3 秒内有多行具有相同的时间戳，则仅使用最后一次观察。

如果在接下来的 3 秒内没有观察到，则将 NA 放入该行的 data$3second 中。 例如，我期望得到以下结果：

                              B    1second  3second
2008-01-14 09:29:59           10    0.7      1.5        
2008-01-14 09:29:59           0.1   0.7      1.5
2008-01-14 09:30:00           0.9   NA       1.5
2008-01-14 09:30:00           0.1   NA       1.5
2008-01-14 09:30:00           0.2   NA       1.5
2008-01-14 09:30:00           0.4   NA       1.5
2008-01-14 09:30:00           0.6   NA       1.5
2008-01-14 09:30:00           0.7   NA       1.5
2008-01-14 09:30:02           1.5   NA       NA
2008-01-14 09:30:06           0.1   0.2      0.2
2008-01-14 09:30:06           0.1   0.2      0.2
2008-01-14 09:30:07           0.9   NA       0.3
2008-01-14 09:30:07           0.2   NA       0.3
2008-01-14 09:30:10           0.4   NA       0.3
2008-01-14 09:30:10           0.3   NA       NA
2008-01-14 09:30:25           1.5   NA       NA

这是我当前的代码，它可以工作，但速度很慢。

TimeStmp is the POSIXct object.
      TimeHorizon<-c(1,3)
      for( j in 1:nrow(data)){
        a<-sapply(TimeHorizon,function(x) which(TimeStmp==TimeStmp[j] +x)) 
        for( k in 1:length(a)){
          if (length(a[[k]]>0)){
            data[j,k+1]<-(data$B)[last(a[[k]])]
          }
        }
      }

我想知道是否可以使用 Rcpp 来避免使用 for 循环。非常感谢您的帮助。

Answer 1

如果你想要一个 Rcpp 解决方案，你可以使用

#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
NumericVector name_me(List df, double nsec) {

  NumericVector TimeStmp = df["TimeStmp"];
  NumericVector B        = df["B"];
  int n = B.size();
  int i, j, k, ndup;
  double time;

  NumericVector res(n);

  for (i = 0; i < n; i++) {

    // get last for same second
    for (ndup = 0; (i+1) < n; i++, ndup++) {
      if (TimeStmp[i+1] != TimeStmp[i]) break;
    }

    // get last value within nsec
    time = TimeStmp[i] + nsec;
    for (j = i+1; j < n; j++) {
      if (TimeStmp[j] > time) break;
    }

    // fill all previous ones with same value
    res[i] = (j == (i+1)) ? NA_REAL : B[j-1];
    for (k = 1; k <= ndup; k++) res[i-k] = res[i];
  }

  return res;
}

然后，在获取此 .cpp 文件后，您只需调用

name_me(df, 1)
name_me(df, 3)

请注意，您的第 (n-2) 行有 3 秒的不一致。

Answer 2

对代码不太满意，但这可能是一种方法：

temp1 <- test[! duplicated(test$timestamp, fromLast = T), ]
for (i in c(0,rep(1,3))) {
  temp1$timestamp <- temp1$timestamp - i
  test <- merge(test, temp1, by = "timestamp", all.x = T)
}
colnames(test) <- c("timestamp", "B", "0second", "1second", "2second", "3second")
test$`3second` <- test[-1][cbind(1:nrow(test), max.col(!is.na(test[-1]), "last"))]
test$`3second`[shift(test$timestamp,1,type = "lead") - test$timestamp > 3 | is.na(shift(test$timestamp,1,type = "lead") - test$timestamp)] <- NA
test <- test[c("timestamp", "B", "1second", "3second")]
test
#              timestamp    B 1second 3second
# 1  2008-01-14 09:29:59  0.1     0.7     1.5
# 2  2008-01-14 09:29:59 10.0     0.7     1.5
# 3  2008-01-14 09:30:00  0.9      NA     1.5
# 4  2008-01-14 09:30:00  0.1      NA     1.5
# 5  2008-01-14 09:30:00  0.2      NA     1.5
# 6  2008-01-14 09:30:00  0.4      NA     1.5
# 7  2008-01-14 09:30:00  0.6      NA     1.5
# 8  2008-01-14 09:30:00  0.7      NA     1.5
# 9  2008-01-14 09:30:02  1.5      NA      NA
# 10 2008-01-14 09:30:06  0.1     0.2     0.2
# 11 2008-01-14 09:30:06  0.1     0.2     0.2
# 12 2008-01-14 09:30:07  0.9      NA     0.3
# 13 2008-01-14 09:30:07  0.2      NA     0.3
# 14 2008-01-14 09:30:10  0.3      NA     0.3
# 15 2008-01-14 09:30:10  0.4      NA      NA
# 16 2008-01-14 09:30:25  1.5      NA      NA

编辑：刚刚看到您想使用 Rcpp。那么请忽略这个答案。 :)

EDIT2：对我的代码的解释。如果解释不是最好的，请原谅： 不是在列上循环，而是首先获取每个时间戳的最后一个观察值（第 1 行）。然后将其“left_joins”到原始数据帧上。然后从时间戳中减去一秒，然后再次将其“left_joins”到原始数据帧上。这会重复 3 次以说明 1 秒、2 秒和 3 秒的延迟（第 2-5 行）。现在，它是一个在同一行中包含“正确”元素的数据框；这只是找到正确列的问题。正确的列是该行没有na 的最大列（第7 行）。我们仍然需要设置na 在接下来的三秒内没有后续观察的行（第 8 行）。完成后，我们可以删除不必要的列（第 9 行）并完成。