R-优化递归应用程序，以在同一数据集上应用不同的功能

Question

我在矩阵的行的不同子集上应用多个功能。这是一些示例数据：

set.seed(1)
## The data is a simple matrix
dataset <- matrix(sample(1:25, 25), 5, 5)
#     [,1] [,2] [,3] [,4] [,5]
#[1,]    7   18    4   19    6
#[2,]    9   22    3   25   16
#[3,]   14   12   24    8    2
#[4,]   20   11   21   23   15
#[5,]    5    1   13   10   17
## The subsets is a list contain a list of matrices where the columns represent the rows of data
subsets <- list(list(matrix(seq(1:5), ncol = 1), matrix(c(c(1:3), c(2:4), c(3:5)), ncol = 3)))
#[[1]]
#[[1]][[1]]
#     [,1]
#[1,]    1
#[2,]    2
#[3,]    3
#[4,]    4
#[5,]    5
#
#[[1]][[2]]
#     [,1] [,2] [,3]
#[1,]    1    2    3
#[2,]    2    3    4
#[3,]    3    4    5
## The functions to apply successively (the first one outputs a matrix, the second a single numeric)
function_list <- list(var, sd)

在此示例中，subset列表的第一级仅包含一个元素，但可以包含更多元素。我想将第一个和第二个函数连续应用于子集中选择的每个行的矩阵。例如：

sd(var(dataset[c(1,2,3,4,5), ]))
#[1] 35.6238

或更具体地：

## The first function
(subset_out <- function_list[[1]](dataset[subsets[[1]][[1]][,1], ]))
#      [,1]   [,2]   [,3]   [,4]   [,5]
#[1,] 36.50   3.25  40.25  11.25  -4.25
#[2,]  3.25  63.70 -40.50  40.75 -12.70
#[3,] 40.25 -40.50  91.50 -37.25 -18.00
#[4,] 11.25  40.75 -37.25  58.50  23.25
#[5,] -4.25 -12.70 -18.00  23.25  45.70
## The second function
function_list[[2]](subset_out)
#[1] 35.6238

到目前为止，我的解决方案是使用lapply和apply在数据上调用功能，但似乎有点麻烦且慢：

## Apply consecutively both functions to one matrix within the subsets list
lapply.to.one.subset <- function(one_subset, function_list, dataset){
    ## Apply the first function
    subset_out <- apply(one_subset, 2, function(X, fun, dataset) fun(dataset[X, ]), function_list[[1]], dataset)
    ## Apply the second function
    subset_out <- apply(subset_out, 2, function_list[[2]])
    return(subset_out)
}
## apply to the whole subset
lapply(subsets, lapply, lapply.to.one.subset, function_list, dataset)
#[[1]]
#[[1]][[1]]
#[1] 35.6238
#[[1]][[2]]
#[1] 57.47624 55.63089 31.68247

在我的情况下，subset列表中还存在更多元素，以及function_list中的更多功能，其中包含lapply.to.one.subset功能中的更多条件语句(已删除以简化(。这使得大数据集的速度很慢。关于如何更快地达到相同结果的任何想法？

Answer 1

通过 parallel:parLapply并行化，例如so

library(parallel)
cl <- makeCluster(detectCores()-1)
clusterExport(
    cl,
    c("dataset", "subsets", "function_list", "lapply.to.one.subset")
)

由于您有一个嵌套列表，因此您需要选择是否并行化外部列表

# parallelize outer loop - subset[1-N]
parLapply(
    cl,
    subsets,
    function(i) {
        lapply(i, function(j) lapply.to.one.subset(j, function_list, dataset))
    }
) 

或内部嵌套列表

# parallelize inner loop - subset[[1]][1-N]
lapply(
    subsets,
    function(i) {
        parLapply(
            cl,
            i,
            function(j) { lapply.to.one.subset(j, function_list, dataset) }
        )
    }
)

关闭您的并行群集

stopCluster(cl)
rm(cl)

Answer 2

我没有检查速度，因为它会比并行解决方案慢，但是以下情况似乎确实有效。

library(dplyr)
lapply(subsets, lapply, function(lst) apply(lst, 2, 
                           function(Y) dataset[Y, , drop = FALSE] %>%
                              function_list[[1]]() %>% 
                                   function_list[[2]]()))