Question

此问题与我的previous one有关。这是一个小样本数据。我使用了data.table和data.frame来找到更快的解决方案。

test.dt <- data.table(strt=c(1,1,2,3,5,2), end=c(2,1,5,5,5,4), a1.2=c(1,2,3,4,5,6), 
                   a2.3=c(2,4,6,8,10,12), a3.4=c(3,1,2,4,5,1), a4.5=c(5,1,15,10,12,10),
                   a5.6=c(4,8,2,1,3,9))

test.dt[,rown:=as.numeric(row.names(test.dt))]

test.df <- data.frame(strt=c(1,1,2,3,5,2), end=c(2,1,5,5,5,4), a1.2=c(1,2,3,4,5,6), 
                   a2.3=c(2,4,6,8,10,12), a3.4=c(3,1,2,4,5,1), a4.5=c(5,1,15,10,12,10),
                   a5.6=c(4,8,2,1,3,9))

test.df$rown <- as.numeric(row.names(test.df))

    > test.df
  strt end a1.2 a2.3 a3.4 a4.5 a5.6 rown
1    1   2    1    2    3    5    4    1
2    1   1    2    4    1    1    8    2
3    2   5    3    6    2   15    2    3
4    3   5    4    8    4   10    1    4
5    5   5    5   10    5   12    3    5
6    2   4    6   12    1   10    9    6

我想使用开始和结束列值来确定列到子集的列范围（从 a1.2 到 a5.6 的列）并获得平均值。例如，在第一行中，由于strt = 1和end = 2，我需要得到 a1.2 和 a2.3 的平均值;在第三行中，我需要得到 a2.3 ， a3.4 ， a4.5 和 a5的均值0.6

输出应该是这样的矢量

> k
       1        2        3        4        5        6 
1.500000 2.000000 6.250000 5.000000 3.000000 7.666667

在这里，我试过了：

解决方案1 ：这会使用data.table并对其应用函数。

func.dt <- function(rown, x, y) {
      tmp  <- paste0("a", x, "." , x+1)
      tmp1 <- paste0("a", y, "." , y+1)
      rowMeans(test.dt[rown,get(tmp):get(tmp1), with=FALSE])
      }
    k <- test.dt[, func.dt(rown, strt, end), by=.(rown)]

解决方案2 ：这会使用data.frame并对其应用函数。

func.df <- function(rown, x, y) {
  rowMeans(test.df[rown,(x+2):(y+2), drop=FALSE])
  }
k1 <- mapply(func.df, test.df$rown, test.df$strt, test.df$end)

解决方案3 ：这会使用data.frame并循环播放。

    test.ave <- rep(NA, length(test1$strt))
for (i in 1 : length(test.df$strt)) {
    test.ave[i] <- rowMeans(test.df[i, as.numeric(test.df[i,1]+2):as.numeric(test.df[i,2]+2), drop=FALSE])
    }

基准测试表明解决方案2是最快的。

test replications elapsed relative user.self sys.self user.child sys.child
1 sol1          100    0.67    4.786      0.67        0         NA        NA
2 sol2          100    0.14    1.000      0.14        0         NA        NA
3 sol3          100    0.15    1.071      0.16        0         NA        NA

但是，这对我来说还不够好。鉴于我的数据大小，这些函数需要运行几天才能得到输出。我确信我没有充分利用data.table的力量，而且我也知道我的功能很糟糕（他们在没有传递的情况下引用全局环境中的数据集）。不幸的是，我不够深入，不知道如何解决这些问题并快速完成我的功能。我非常感谢任何有助于改进我的功能或指向替代解决方案的建议。

Answer 1

除非你能想出一种通过巧妙的子集方法来实现这一目标的方法，否则我认为你已经达到了R的速度障碍。你会想要使用像C ++这样的低级语言来解决这个问题。幸运的是，Rcpp包与C++中的R接口简单。免责声明：我一生中从未编写过一行C ++代码。此代码可能效率很低。

library(Rcpp)

cppFunction('NumericVector MYrcpp(NumericMatrix x) {
  int nrow = x.nrow(), ncol = x.ncol();
  NumericVector out(nrow);

  for (int i = 0; i < nrow; i++) {
    double avg = 0;

    int start = x(i,0);
    int end = x(i,1);

    int N = end - start + 1;

    while(start<=end){

      avg += x(i, start + 1); 

      start = start + 1;

    }

    out[i] = avg/N;

  }
  return out;
}')

对于此代码，我将data.frame作为matrix传递（即testM <- as.matrix(test.df)）

让我们看看它是否有效......

 MYrcpp(testM)
[1] 1.500000 2.000000 6.250000 5.000000 3.000000 7.666667

它有多快？

Unit: microseconds
          expr      min        lq      mean   median       uq       max neval
          f2() 1543.099 1632.3025 2039.7350 1843.458 2246.951  4735.851   100
          f3() 1859.832 1993.0265 2642.8874 2168.012 2493.788 19619.882   100
          f4()  281.541  315.2680  364.2197  345.328  375.877  1089.994   100
 MYrcpp(testM)    3.422   10.0205   16.7708   19.552   21.507    56.700   100

f2()，f3()和f4()定义为

f2 <- function(){
  func.df <- function(rown, x, y) {
    rowMeans(test.df[rown,(x+2):(y+2), drop=FALSE])
  }
  k1 <- mapply(func.df, test.df$rown, test.df$strt, test.df$end)
}

f3 <- function(){
  test.ave <- rep(NA, length(test.df$strt))
  for (i in 1 : length(test.df$strt)) {
    test.ave[i] <- rowMeans(test.df[i,as.numeric(test.df[i,1]+2):as.numeric(test.df[i,2]+2), drop=FALSE])
  }
}

f4 <- function(){
  lapply(
    apply(test.df,1, function(x){
      x[(x[1]+2):(x[2]+2)]}),
    mean)
}

这比最快的增加了大约20倍。

注意，要实现上述代码，您需要一个C编译器R可以访问。对于Windows，请查看Rtools。有关Rcpp的更多信息，请阅读this

现在让我们看看它是如何扩展的。

N = 5e3
test.df <- data.frame(strt = 1, 
                 end = sample(5, N, replace = TRUE), 
                 a1.2 = sample(3, N, replace = TRUE), 
                 a2.3 = sample(7, N, replace = TRUE), 
                 a3.4 = sample(14, N, replace = TRUE),
                 a4.5 = sample(8, N, replace = TRUE),
                 a5.6 = sample(30, N, replace = TRUE))
test.df$rown <- as.numeric(row.names(test.df))


test.dt <- as.data.table(test.df)

microbenchmark(f4(), MYrcpp(testM))
Unit: microseconds
          expr       min         lq        mean     median          uq       max neval
          f4() 88647.256 108314.549 125451.4045 120736.073 133487.5295 259502.49   100
 MYrcpp(testM)   196.003    216.533    242.6732    235.107    261.0125    499.54   100

5e3行MYrcpp现在快了550倍。这部分是由于理查德在评论中讨论的f4()不能很好地扩展。 f4()实际上是通过在apply内调用lapply来调用嵌套for循环。有趣的是，C++代码也通过在for循环中使用while循环来调用嵌套循环。速度差异在很大程度上是由于C++代码已经被编译并且不需要被中断到机器在运行时可以理解的东西。

我不确定您的数据集有多大，但是当我在MYrcpp上data.frame行1e7时，data.frame行是MYr <- function(x){ nrow <- nrow(x) ncol <- ncol(x) out <- matrix(NA, nrow = 1, ncol = nrow) for(i in 1:nrow){ avg <- 0 start <- x[i,1] end <- x[i,2] N <- end - start + 1 while(start<=end){ avg <- avg + x[i, start + 2] start = start + 1 } out[i] <- avg/N } out }我最大的MYrcpp在我的笔记本电脑上分配，它在500毫秒内运行。

更新：R等价于C ++代码

MYr

MYrcpp和MYr在很多方面都很相似。让我讨论一些差异

MYrcpp的第一行与NumericVector MYrcpp(NumericMatrix x)不同。换句话说，MYrcpp的第一行，NumericVector，意味着我们正在定义一个名为x的函数，该函数返回类NumericMatrix的输出并接受输入{{ 1}}类int nrow = x.row()。
在C ++中，您必须在引入变量时定义变量的类，即nrow是一个名为int的变量，其类为x.nrow()（即整数），并且分配为nrow()即x的行数。（IGNORE如果你不知所措，x(0,1)是类NumericVector实例的方法。就像在Python中一样，你通过将它附加到实例来调用方法.R等价物是S3和S4方法）
当您在C ++中进行子集时，您使用（）而不是像R中的[]那样，索引从零开始（就像在Python中一样）。例如，C ++中的x[1,2]相当于R

++

j++是一个运算符，表示递增1，即j + 1与+=相同。 a += b是一个运算符，表示添加到一起并分配，即a = a + b与var move = function() { var element = document.getElementById('mover'); var pos = element.offsetLeft; if (pos != 0) { setTimeout(function() { element.style.left = pos + 150 + 'px'; }, 1000); } }相同

Answer 2

我很好奇我可以在不诉诸编写自定义C或C ++代码的情况下做到这一点。我能想到的最好的是下面的。请注意，使用mean.default将提供更高的精度，因为它会对数据进行第二次传递以进行纠错。

f_jmu <- compiler::cmpfun({function(m) {
  # remove start/end columns from 'm' matrix
  ma <- m[,-(1:2)]
  # column index for each row in 'ma' matrix
  cm <- col(ma)
  # logical index of whether we need the column for each row
  i <- cm >= m[,1L] & cm <= m[,2L]
  # multiply the input matrix by the index matrix and sum it
  # divide by the sum of the index matrix to get the mean
  rowSums(i*ma) / rowSums(i)
}})

Rcpp功能仍然更快（不足为奇），但上面的功能相当接近。以下是我的笔记本电脑上使用i7-4600U和12GB内存进行5000万次观察的示例。

set.seed(21)
N <- 5e7
test.df <- data.frame(strt = 1L, 
                 end = sample(5, N, replace = TRUE), 
                 a1.2 = sample(3, N, replace = TRUE), 
                 a2.3 = sample(7, N, replace = TRUE), 
                 a3.4 = sample(14, N, replace = TRUE),
                 a4.5 = sample(8, N, replace = TRUE),
                 a5.6 = sample(30, N, replace = TRUE))
test.df$strt <- pmax(1L, test.df$end - sample(3, N, replace = TRUE) + 1L)
test.m <- as.matrix(test.df)

另请注意，我注意确保test.m是整数矩阵。这有助于减少内存占用，这有助于加快速度。

R> system.time(st1 <- MYrcpp(test.m))
   user  system elapsed 
  0.900   0.216   1.112 
R> system.time(st2 <- f_jmu(test.m))
   user  system elapsed 
  6.804   0.756   7.560 
R> identical(st1, st2)
[1] TRUE

Answer 3

我的解决方案是基准测试中的第一个

library(microbenchmark)
microbenchmark(
  lapply(
    apply(test.df,1, function(x){
        x[(x[1]+2):(x[2]+2)]}),
    mean),
  test.dt[, func.dt(rown, strt, end), by=.(rown)]
)

      min        lq      mean   median       uq      max neval
  138.654  175.7355  254.6245  201.074  244.810 3702.443   100
 4243.641 4747.5195 5576.3399 5252.567 6247.201 8520.286   100

它似乎快了25倍，但这是一个小数据集。我确信有一种比我所做的更好的方法。

R提高功能的表现

3 个答案:

更新：R等价于C ++代码