使用 x`apply` 来加速循环答案

【问题标题】：Use of x`apply` to speed up loops使用 x`apply` 来加速循环
【发布时间】：2012-01-02 13:14:02
【问题描述】：

这是一个更集中的问题，基于我在Vectorize/Speed up Code with Nested For Loops 提出的另一个问题

基本上，我想加快这段代码的执行速度。我正在考虑使用apply 系列函数之一。 apply 函数必须使用/执行以下操作：

输入：循环区域 1 到 10；向量 sed 和 borewidth 预先分配的维度填充了 NA

流程：在sed和borewidth的每一个中填充数据，以内部for循环中实现的方式实现

输出：sed 和 borewidth 向量

假设（h/t Simon Urbanek）：每行的开始点和结束点是连续的、连续的，并且对于每个区域，从 0 开始。

代码如下：

for (region in 1:10) {             
    # subset standRef and sample by region code
    standRef.region <- standRef[which(standRef$region == region),]
    sample.region <- sample[which(sample$region == region),]

    for (i in 1:nrow(sample.region))
    {
        # create a dataframe - locations - that includes: 
        # 1) those indices of standRef.region in which the value of the location column is greater than the value of the ith row of the begin column of sample.region
        # 2) those indices of standRef.region in which the value of the location column is less than the value of the ith row of the finish column of sample.region
        locations <- standRef.region[which((standRef.region$location > sample.region$begin[i]) & (standRef.region$location < sample.region$finish[i])),]
        sed[end_tracker:(end_tracker + nrow(locations))] <- sample.region$sed[i]   
        borewidth[end_tracker:(end_tracker + nrow(locations))] <- sample.region$borewidth[i]

        # update end_tracker to the number of locations rows for this iteration
        end_tracker <- end_tracker + nrow(locations)                
    }
    cat("Finished region", region,"\n")            
}

borewidth 和sed 的样本数据。编辑：更正dput中的格式错误

structure(list(region = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L), 
begin = c(0L, 2253252L, 7091077L, 9120205L, 0L, 135094L, 
941813L, 5901391L, 6061324L), finish = c(2253252L, 7091077L, 
9120205L, 17463033L, 135094L, 941813L, 5901391L, 6061324L, 
7092402L), sed = c(3.31830840984048, 1.38014704208403, 6.13049140975458, 
2.10349875097134, 0.48170587509345, 0.13058713509175, 9.13509713513509, 
6.13047153058701, 3.81734081501503), borewidth = c(3L, 5L, 
2L, 1L, 1L, 1L, 2L, 4L, 4L)), .Names = c("region", "begin", 
"finish", "sed", "borewidth"), class = "data.frame", row.names = c(NA, 
-9L))

TIA。

【问题讨论】：

split 和 lapply 将有助于外循环。如果可能，您可能还想考虑merge-ing 2 个数据帧以在没有显式循环的情况下执行此操作。
一些（虚拟）数据会让我们更容易为您提供帮助。
@Thierry，一些示例数据。参考数据 - standRef - 以dput 格式在stackoverflow.com/questions/8691966/… 中提供。谢谢
@James 我尝试使用sapply，将上面的代码放入函数foo1 并从vecOfData <- sapply(vecOfData, function(x) foo1(1:10)) 调用它，其中vecOfData <- c(sed, borewidth)。然而，这似乎只是遍历sed 和borewidth 中的每个元素——超过一百万次迭代！ -- 而不是将每个向量视为一个元素。我如何在上面的上下文中使用split？谢谢。
请给我们代码来生成可以通过简单的复制粘贴工作的数据集。 structure() 只生成一个 data.frame。那是sed还是borewidth？而且我们没有示例 data.frame（可能与 sample() 函数混淆）。

标签： r

【解决方案1】：

根据您发布的数据（包括另一个问题）做出一些额外的假设，这是您可以做到的一种方法：

index <- unlist(lapply (unique(standRef$region), function(reg) {
   reg.filter <- which(standRef$region == reg)
   samp.filter <- which(sample$region == reg)
   samp.filter[cut(standRef$location[reg.filter],c(0L,sample$finish[samp.filter]),labels=F)]
}))
sed <- sample$sed[index]
borewidth <- sample$borewidth[index]

额外的假设是您的样本是连续的、连续的（您的所有示例都是）并且从 0 开始。这允许我们在 $finish 上使用 cut() 而不是单独处理每个间隔。一个区别是您在休息时编码留下空白，但我假设这不是故意的。

【讨论】：

这是否替换了我上面的所有代码，或者它是否适合它的特定部分？很抱歉对此有点密集：我从未听说过您正在使用的许多功能。谢谢。回复：假设：连续——应该是；顺序：是的；从给定区域的 0 开始：是的。
它替换了你所有的代码。 unique(standRef$region) 为您提供所有区域，因此该函数以reg 在所有区域上运行。对于每个区域，它将区域的location 拆分为finish 使用cut() 给出的片段。这为您提供了区域 within 的索引，因此诀窍是通过将其插入到samp.filter[..] 中映射回完整大小的sample，从而为您提供sample 中的索引。由于保留了顺序，您只需连接结果（通过unlist），即可为您提供从sample 中的每一行到standRef 中的行的完整映射。
在我的数据集上测试了代码。两个观察结果：它有效，而且速度很快，非常快。谢谢！！！关于如何加快stackoverflow.com/questions/8691966/… 的其余代码的任何提示？这部分的炽热速度与其他部分不一致。再次感谢！
在另一个问题中，您可能只想创建一个文件而不是循环遍历所有文件 - read.table 通常相当慢。但即使你不这样做，你也可以用一个 lapply: lapply(data_files, function(file) { ...; sample$sed[index] }) 替换所有外部代码 - 这是一个错位循环的典型示例。
如何 - 在 function(file) 内 - 我 1) 更新 sediment.df 和其他数据帧？ 2) 返回sediment.df 和其他数据框？是否再次需要unlist？谢谢。