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

Question

I have a xts format data (data) looks like this:

                              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 

There is no pattern in any column or row element.

The data is indexed by a POSIXct class object. I am creating new columns called '1second', '3second'. For column '1second', for each row, I want to find the next observation within the next 1 second according to their xts time object and record the 'A' value of the row. If no observation within the next seconds, put NA in data$1second in that row.

Similarly, for column "3second", for each row, I want to find the leading observation within the next 3 second according to their xts time object. If there are multiple rows with the same time stamp within the next 3 seconds, then use the last observation only.

If no observation within the next 3 seconds, put NA in data$3second in that row. For example, I expect the following results:

                              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

Here is my current code, it works, but very slow.

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]])]
          }
        }
      }

I am wondering if it is possible to use the Rcpp to avoid using the for loop. Thank you so much for the help.

Answer 1

Not all too happy with the code, but it might be one approach:

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

EDIT: Just saw that you want to use Rcpp. Well then just ignore this answer. :)

EDIT2: Explanation to my code. Excuse me if the explanation is not the best: Instead of looping over the column, one first gets the last observation for each timestamp (line 1). Then one "left_joins" this onto the original dataframe. Afterwards one subtracts one second from the timestamp and "left_joins" it onto the original dataframe again. This is repeated 3 times to account for 1 second, 2 second, and 3 second delays (lines 2-5). Now, it's a dataframe that contains the "correct" element in the same row; it's only a question of finding the correct column. The correct column is the largest one that does not have na for that row (line 7). We still need to set na the rows which don't have a follow-up observation in the next three seconds (line 8). After doing that we can remove the unnecessary columns (line 9) and it's done.

Answer 2

If you want an Rcpp solution you can use

#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;
}

Then, after sourcing this .cpp file, you just need to call

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

Note that there is an inconstitency in your (n-2)th row for 3 second.