将非NA值左移到R的最快方法

问题描述

我知道这里已经有很多答案可以将非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

希望为这个问题找到解决方案。非常感谢！

推荐答案

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

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

对于所有i是TRUE。在我的机器上，它在大约0.3秒内对一个340000 x 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 x 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)