在R中将非NA值向左移动的最快方法[重复]

Question

我知道这里已经有很多答案可以将非 NA 值按行向左移动。但所有这些都将让我永远做到这一点。有没有最快的方法来执行这个任务？示例：

#from
X1 X2 X3 X4 X5 X6 X7
NA NA AB NA AD AE AF
NA NA NA AG NA AI AJ
NA AK AL AM NA AO AP
NA NA AQ NA AS AT NA
AV AW AX AY AZ NA BB

#to
X1 X2 X3 X4 X5 X6 X7
AB AD AE AF NA NA NA
AG AI AJ NA NA NA NA 
AK AL AM AO AP NA NA
AQ AS AT AU NA NA NA
AV AW AX AY AZ BB NA

使用apply 和/或for 循环需要很长时间。就上下文而言，我有一个包含 340K 行和 67 列的数据框，如果我运行以下命令，我将需要 18 多个小时才能完成这项工作：

    for (i in 1:nrow(df)) {
      Temp <- unlist(df[i,])
      ndf[i,] <- t(c(Temp[!is.na(Temp)],Temp[is.na(Temp)]))
    }

其他帖子中的其他建议解决方案似乎与此类似，所以我也预计需要很长时间。

我也试过以下代码：

ndf <- na_move(df) #from package: dedupewider

但它似乎没有完成最后 3 列的工作，如下所示：

#to
X1 X2 X3 X4 X5 X6 X7
AB NA NA NA AD AE AF
AG NA NA NA NA AI AJ
AK AL AM NA NA AO AP
AQ NA NA NA AS AT NA
AV AW AX AY AZ NA BB

希望有一个解决方案。非常感谢！

Answer 1

这是您的确切任务的Rcpp 实现：给定一个字符矩阵x，函数shift_na 返回一个排序矩阵y，这样

identical(y[i, ], x[i, order(is.na(x[i, ]))])

对于所有 i 来说是 TRUE。在我的机器上，它在大约 0.3 秒内对 340000×67 字符矩阵进行排序。见下文。

Rcpp::sourceCpp(code = '
#include <Rcpp.h>
using namespace Rcpp;

// [[Rcpp::export]]
void shift_na_in_place(CharacterMatrix x)
{
  int m = x.nrow();
  int n = x.ncol();
  for (int i = 0, k = 0, k0 = 0; i < m; ++i) {
    for (int j = 0; j < n; ++j) {
      if (x[k] != NA_STRING) {
        x[k0] = x[k];
        k0 += m;
      }
      k += m;
    }
    while (k0 < k) {
      x[k0] = NA_STRING;
      k0 += m;
    }
    k = (k % m) + 1;
    k0 = k;
  }
  if (x.attr("dimnames") != R_NilValue) {
    List dn = x.attr("dimnames");
    dn[1] = R_NilValue;
    if (dn.attr("names") != R_NilValue) {
      CharacterVector ndn = dn.attr("names");
      ndn[1] = "";
    }
  }
}

// [[Rcpp::export]]
CharacterMatrix shift_na(CharacterMatrix x)
{
  CharacterMatrix y = clone(x);
  shift_na_in_place(y);
  return y;
}
')

使用 6×6 矩阵测试正确性：

f <- function(d) {
  x <- sample(c(letters, NA), size = prod(d), replace = TRUE, prob = c(rep(1, 26), 13))
  dim(x) <- d
  x
}
set.seed(1L)
x <- f(c(6L, 6L))
x

     [,1] [,2] [,3] [,4] [,5] [,6]
[1,] NA   "z"  "d"  "p"  NA   "h" 
[2,] "p"  "o"  "p"  "t"  "e"  "m" 
[3,] "l"  "n"  "t"  "z"  NA   "i" 
[4,] "y"  NA   "i"  NA   "p"  NA  
[5,] NA   NA   "q"  "o"  "w"  "v" 
[6,] "y"  NA   "a"  NA   "c"  "d"

shift_na(x)

     [,1] [,2] [,3] [,4] [,5] [,6]
[1,] "z"  "d"  "p"  "h"  NA   NA  
[2,] "p"  "o"  "p"  "t"  "e"  "m" 
[3,] "l"  "n"  "t"  "z"  "i"  NA  
[4,] "y"  "i"  "p"  NA   NA   NA  
[5,] "q"  "o"  "w"  "v"  NA   NA  
[6,] "y"  "a"  "c"  "d"  NA   NA 

使用 340000×67 矩阵进行基准测试：

x <- f(c(340000L, 67L))
microbenchmark::microbenchmark(shift_na(x))

Unit: milliseconds
        expr      min       lq     mean   median       uq      max neval
 shift_na(x) 258.4182 263.9208 296.4804 287.7001 318.1688 366.1472   100

如果您无法为已排序的矩阵分配内存并且不需要保留未排序的矩阵，则可以使用 shift_na_in_place。

编辑：如果您从包含字符变量的数据框 data 开始，而不是字符矩阵，请执行以下操作：

x <- as.matrix(data)
shift_na_in_place(x)
newdata <- as.data.frame(x)