r - 不使用apply函数对data.table的每一行进行操作的方法

Question

我在下面写了一个简单的函数:
mcs <- function(v) { ifelse(sum((diff(sort(v)) > 6) > 0), NA, sd(v)) }
它应该取一个向量，对其进行排序，然后检查每个连续差异中是否存在大于 6 的差异。如果差值大于 6，则返回 NA，否则返回标准差。

我想在数据表的所有行上应用此函数(仅选择某些列)，然后将每一行的返回值作为新列条目附加到数据表中。

例如，给定一个像这样的数据表

> dat <- data.table(A=c(1,2,3,4,5), B=c(2,3,4,10,6), C=c(3,4,10,6,8),   
D=c(3,3,3,3,3))  
> dat  
   A  B  C D  
1: 1  2  3 3  
2: 2  3  4 3  
3: 3  4 10 3  
4: 4 10  6 3  
5: 5  6  8 3  

我想生成下面的输出。 (我在每行的第 2、3 和 4 列上应用了函数。)

> dat
   A  B  C D        sd
1: 1  2  3 3 0.5773503
2: 2  3  4 3 0.5773503
3: 3  4 10 3 3.7859389
4: 4 10  6 3 3.5118846
5: 5  6  8 3 2.5166115

我了解到可以使用以下方法对数据表进行按行操作:

> dat[, sd:=apply(.SD, 1, mcs), .SDcols=(c(2,3,4))]

这种方法有效，只是它太慢了。我必须对几个大型数据表执行此操作，并且我编写了一个脚本来执行此操作。但是，它仅适用于较小的数据表。对于包含约 300,000 行的表，它会在几秒钟内完成，但是当我尝试使用具有约 8 亿行的表执行此操作时，我的程序没有完成。我试过等了两个小时，我认为 R 中断了或者是因为控制台卡住了。我试过多次运行脚本，它总是正确完成前几个较小的表(我让程序将表写入文件进行检查)，但是当它到达大数据表时，它永远不会完成。我在计算集群上运行它，所以我绝对不认为这是硬件限制。可能代码很差。

我假设瓶颈是应用中完成的循环，但我不知道如何使它更快。我对 R 很陌生，所以我不确定如何优化我的代码。我在互联网上看到了很多关于矢量化的帖子，我在想，如果我可以同时将我的函数应用于每一行，它会快得多，但我不知道如何做到这一点。请帮忙。

编辑
抱歉，我在复制我的 mcs 时出错了功能。我已经更新了。

编辑 2
对于那些感兴趣的人，我最终将 table 分成两半，然后分别对每一半进行操作，这对我有用。

Answer 1

如果您真的需要速度，一如既往最好使用 Rcpp 转向 C++，这为我们提供了一个速度超过 100 倍的解决方案。

数据

我确实制作了一些不同的示例数据来测试它有 1000 行而不是 5 行:

set.seed(123)
dat <- data.table(A = rnorm(1e3, sd=4), B = rnorm(1e3, sd=4), C = rnorm(1e3, sd=4),
                  D = rnorm(1e3, sd=4), E = rnorm(1e3, sd=4))

解决方案

我使用以下 C++ 代码来做与您的函数相同的事情，但现在循环是在 C++ 中完成的，而不是通过 apply 来完成的，这样可以节省大量时间:

#include <Rcpp.h>

using namespace Rcpp;

// [[Rcpp::export]]
NumericVector mcs2(DataFrame x) {
    int n = x.nrows();
    int m = x.size();
    NumericMatrix mat(n, m);
    for ( int j = 0; j < m; ++j ) {
        mat(_, j) = NumericVector(x[j]);
    }
    NumericVector result(n);
    for ( int i = 0; i < n; ++i ) {
        NumericVector tmp = mat(i, _);
        std::sort(tmp.begin(), tmp.end());
        bool do_sd = true;
        for ( int j = 1; j < m; ++j ) {
            if ( tmp[j] - tmp[j-1] > 6.0 ) {
                result[i] = NA_REAL;
                do_sd = false;
                break;
            }
        }
        if ( do_sd ) {
            result[i] = sd(tmp);
        }
        do_sd = true;
    }
    return result;
}

我们可以确保它返回相同的值:

all.equal(apply(dat[, 2:4], 1, mcs1), mcs2(dat[,2:4]))

[1] TRUE

现在让我们进行基准测试:

benchmark(mcs1 = dat[, sd:=apply(.SD, 1, mcs1), .SDcols=(c(2,3,4))],
          mcs2 = dat[, sd:=mcs2(.SD), .SDcols=(c(2,3,4))],
          order = 'relative',
          columns = c('test', 'elapsed', 'relative', 'user.self'))


  test elapsed relative user.self
2 mcs2    0.19    1.000     0.183
1 mcs1   21.34  112.316    20.044

如何编译这段代码

作为通过 Rcpp 使用 C++ 代码的介绍，我建议使用 this chapter Hadley Wickham 的 Advanced R。如果您打算进一步使用 Rcpp，我强烈建议您也阅读官方文档和小插曲，但 Wickham 的书可能更适合初学者使用作为起点。出于您的目的，您只需要启动并运行 Rcpp 即可编译上面的代码。

要使此代码对您有用，如果您还没有 Rcpp 包，则需要它。您可以通过运行获取包

install.packages(Rcpp)

来自 R。注意你还需要一个编译器；如果您使用的是基于 Debian 的 Linux 系统，例如 Ubuntu，您可以运行

sudo apt install r-base-dev

从终端。如果您使用的是 Mac 或 Windows，请查看 here有关进行此设置的一些说明，或在上面链接的 Wickham 章节中。

安装 Rcpp 后，将上面的 C++ 代码保存到文件中。假设我们的示例文件名为“SOanswer.cpp”。然后你可以制作它的 mcs2()通过将以下两行放在 R 脚本中，可以从 R 获得函数:

library(Rcpp)
sourceCpp("SOanswer.cpp") # assuming the file is in your working directory

就是这样!现在你的 R 脚本可以调用 mcs2()并且跑得更快。如果你想了解更多关于 Rcpp 的信息，除了上面的 Wickham 章节，我会查看引用手册和可用的小插图 here , this page来自 RStudio(它也有大量链接，其中一些链接到这里)，您还可以在 Rcpp gallery 周围找到一些非常有用的东西。 .