使用x‘speed’加速循环

Question

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

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

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

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

输出：sed和borewidth矢量

假设 (h/t Simon )：每一行的起点、终点是连续的，连续的，对于每个区域，从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))

蒂娅。

Answer 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开始。这允许我们在cut()上使用$finish，而不是单独处理每个间隔。一个不同之处是，您在间隙处编码左缺口，但我假设这不是有意为之。