如何加快循环操作?

时间:2016-06-17 16:36:48

标签: r loops

有谁能建议如何加快这个循环?我编写了一个从data.frame对象中随机绘制的函数,直到达到数字阈值,然后使用来自r中名为Unmarked的程序中的函数估计随机选择生成的每个随机选择位置的鸟类种群大小。谢谢你!

编码:

06-17 10:53:08.577 D/Mono    ( 6303): GC_OLD_BRIDGE num-objects 1   num_hash_entries 1 sccs size 1 init 0.00ms df1 0.01ms sort 0.04ms dfs2 0.00ms setup-cb 0.00ms free-data 0.00ms links 0/0/0/0 dfs passes 0/0
06-17 10:53:08.578 D/Mono    ( 6303): GC_MINOR: (Nursery full) pause 3.49ms, total 3.75ms, bridge 0.00ms promoted 0K major 3248K los 251K
06-17 10:53:09.771 D/Mono    ( 6303): GC_OLD_BRIDGE num-objects 1 num_hash_entries 1 sccs size 1 init 0.00ms df1 0.01ms sort 0.04ms dfs2 0.00ms setup-cb 0.00ms free-data 0.00ms links 0/0/0/0 dfs passes 0/0
06-17 10:53:09.771 D/Mono    ( 6303): GC_MINOR: (Nursery full) pause 4.45ms, total 5.95ms, bridge 0.00ms promoted 0K major 3248K los 251K
06-17 10:53:10.954 D/Mono    ( 6303): GC_OLD_BRIDGE num-objects 1 num_hash_entries 1 sccs size 1 init 0.00ms df1 0.01ms sort 0.04ms dfs2 0.00ms setup-cb 0.00ms free-data 0.00ms links 0/0/0/0 dfs passes 0/0

1 个答案:

答案 0 :(得分:0)

由于我没有测量性能所需的所有数据,因此我只能用可以加速循环体来回答这个问题。

构建sampData的while循环实际上并不进行随机抽样,因为这应该是无需替换。由于您未跟踪已包含哪些示例,因此您正在使用替换进行采样

更好的想法是采用data[, 2]的随机排列(记住行索引!),获取它的累积总和,然后确定首先满足条件的位置(using which.max) 。然后从data获取具有相关索引的行(即从排列的开始,直到并包括累积区域足够的示例)。

sampleIndices <- sample.int(nrow(data))
cumulativeArea <- cumsum(sample(data[sampleIndices, 2]))
sampleLastIndex <- which.max(cumulativeArea >= areaWanted)
sampData <- data[sampleIndices[1:sampleLastIndex], ]

这部分可以通过抽取较少的指数(sample.int(nrow(data), howManyIndices))进行优化,但存在覆盖面积不足的风险。

(只需确保data包含多行。)

请注意您在结束前不要使用sampData[, 13]。实际上将它计算为sampData[, 12] * sampData[, 2]实际上更快,它也会按元素计算它。这个计算可以在嵌套循环之后完成。

嵌套循环现在只有一个输入向量(scale(sampData[, 10]))和一个输出向量(sampData[, 12])。我不确定这是否真的加速了事情,但使用sapply or one of its friends要短得多。

首先,在某处定义一个函数

calculate_column_12 <- function(grass1) {
    abund <- backTransform(linearComb(BEVIgrass, c(1, grass1), type="lambda"))
    return(abund@estimate)
}

然后用它来生成列:

sampData[, 12] <- sapply(scale(sampData[, 10]), calculate_column_12)

结果代码:

#Population Estimate Loops
data <- read.csv("C:/Users/Bryan/Desktop/CREP dissertation/ch.2CREPPopulationestimate/N-mixture data/FedCREP_updated2010abuffer200m_1.csv",header=TRUE)

calculate_column_12 <- function(grass1) {
    abund <- backTransform(linearComb(BEVIgrass, c(1, grass1), type="lambda"))
    return(abund@estimate)
}

#28000
sims       <- 100
areaWanted <- 28000

finalPop   <- matrix(nrow = 100, ncol = 1)
areaha     <- matrix(nrow = 100, ncol = 1)

for (i in 1:sims) {
    sampleIndices <- sample.int(nrow(data))
    cumulativeArea <- cumsum(sample(data[sampleIndices, 2]))
    sampleLastIndex <- which.max(cumulativeArea >= areaWanted)
    sampData <- data[sampleIndices[1:sampleLastIndex], ]

    sampData[, 12] <- sapply(scale(sampData[, 10]), calculate_column_12)
    sampData[, 13] <- sampData[, 12] * sampData[, 2]

    finalPop[i] <- sum(sampData[, 13])
    areaha[i]   <- sum(sampData[, 2])
}