Использование x`apply` для ускорения циклов

Question

Это более сфокусированный вопрос, основанный на другом вопросе, который я открыл в Векторизация / Ускорение кода с помощью вложенных циклов

По сути, я хочу ускорить выполнение этого кода,Я думал об использовании одной из функций семейства apply.Функция apply должна была бы использовать / выполнять следующее:

Input : цикл по областям с 1 по 10;векторы sed и borewidth с предварительно выделенными измерениями, заполненными NA *

Процесс : заполнить данные в каждом из sed и borewidth способом, реализованным во внутреннем forцикл

Выход : sed и borewidth векторы

Допущения (ч / т Саймон Урбанек): начало, конец точкикаждая строка является смежной, последовательной и для каждой области начинается с 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.

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 вместо обработки каждого интервала отдельно.Единственное отличие состоит в том, что вы кодируете пропуски в перерывах, но я предполагаю, что это не было преднамеренным.