r - 根据相邻元素有效地更改数据中的元素

Question

让我深入研究。想象一下，您有如下所示的数据:

 df <- data.frame(one = c(1, 1, NA, 13), 
                  two = c(2, NA,10, 14), 
                three = c(NA,NA,11, NA), 
                 four = c(4, 9, 12, NA))

这给了我们:

df
#   one two three four
# 1   1   2    NA    4
# 2   1  NA    NA    9
# 3  NA  10    11   12
# 4  13  14    NA   NA

每行分别是第 1、2、3 和 4 周的测量值。假设这些数字代表自上次测量发生以来的一些累积测量。例如，在第 1 行，“四”列中的“4”表示第 3 周和第 4 周的累积值。

现在，如果在前几周没有进行测量，我想通过将测量结果均匀分布到测量前的所有周来“平衡”这些数字(在这里可以随意更正我的术语)。例如，第 1 行应为

 1 2 2 2 

因为原始数据中的4代表的是2周(周“三”和“四”)的累计值，而4/2就是2。

最终的最终结果应如下所示:

df
#  one two three four
# 1   1   2    2    2
# 2   1   3    3    3
# 3   5   5   11   12
# 4  13  14   NA   NA

我在如何最好地解决这个问题上有点挣扎。一种候选解决方案是获取所有缺失值的索引，然后计算运行的长度(NA 出现多次)，并使用它以某种方式填充值。但是，我的真实数据很大，我认为这样的策略可能很耗时。有没有更简单有效的方法？

Answer 1

基本的 R 解决方案是首先确定需要替换的索引，然后确定这些索引的分组，最后使用 ave 分配分组值。功能:

clean <- function(x) {
  to.rep <- which(is.na(x) | c(FALSE, head(is.na(x), -1)))
  groups <- cumsum(c(TRUE, head(!is.na(x[to.rep]), -1)))
  x[to.rep] <- ave(x[to.rep], groups, FUN=function(y) {
    rep(tail(y, 1) / length(y), length(y))
  })
  return(x)
}
t(apply(df, 1, clean))
#      one two three four
# [1,]   1   2     2    2
# [2,]   1   3     3    3
# [3,]   5   5    11   12
# [4,]  13  14    NA   NA

如果效率很重要(您的问题暗示它很重要)，那么 Rcpp 解决方案可能是一个不错的选择:

library(Rcpp)
cppFunction(
"NumericVector cleanRcpp(NumericVector x) {
  const int n = x.size();
  NumericVector y(x);
  int consecNA = 0;
  for (int i=0; i < n; ++i) {
    if (R_IsNA(x[i])) {
      ++consecNA;
    } else if (consecNA > 0) {
      const double replacement = x[i] / (consecNA + 1);
      for (int j=i-consecNA; j <= i; ++j) {
        y[j] = replacement;
      }
      consecNA = 0;
    } else {
      consecNA = 0;
    }
  }
  return y;
}")
t(apply(df, 1, cleanRcpp))
#      one two three four
# [1,]   1   2     2    2
# [2,]   1   3     3    3
# [3,]   5   5    11   12
# [4,]  13  14    NA   NA

我们可以在更大的实例(10000 x 100 矩阵)上比较性能:

set.seed(144)
mat <- matrix(sample(c(1:3, NA), 1000000, replace=TRUE), nrow=10000)
all.equal(apply(mat, 1, clean), apply(mat, 1, cleanRcpp))
# [1] TRUE
system.time(apply(mat, 1, clean))
#    user  system elapsed 
#   4.918   0.035   4.992 
system.time(apply(mat, 1, cleanRcpp))
#    user  system elapsed 
#   0.093   0.016   0.120 

在这种情况下，与基本 R 实现相比，Rcpp 解决方案提供了大约 40 倍的加速。