Векторизация R-loop для лучшей производительности

Question

У меня возникли проблемы с поиском векторизации Представление для определенного цикла в R. Моя цель - повысить производительность цикла, поскольку его нужно запускать тысячи раз в алгоритм.

Я хочу найти позицию самого низкого значения в определенной секции массива, определяемой вектором «Уровень» для каждой строки.

Пример:

Level = c(2,3) 

Пусть первая строка массива X быть: c(2, -1, 3, 0.5, 4).

При поиске позиции наименьшего значения в диапазоне 1:Level[1] от строки (то есть (2, -1)), я получаю 2, потому что -1 < 2 и -1 стоит на второй позиции строки. Затем, ища положение самого низкого значения во втором диапазоне (Level[1]+1):(Level[1]+Level[2]) (то есть (3, 0.5, 4)), я получаю 4, потому что 0,5 4 и 0,5 стоит на четвертой позиции строки.

Мне нужно выполнить это над каждой строкой массива.

Мое решение проблемы работает следующим образом:

Level = c(2,3,3) #elements per section, here: 3 sections with 2,3 and 3 levels 
rows = 10 #number of rows in array X 
X = matrix(runif(rows*sum(Level),-5,5),rows,sum(Level)) #array with 10 rows and sum(Level) columns, here: 8 
Position_min = matrix(0,rows,length(Level)) #array in which the position of minimum values for each section and row are stored 
for(i in 1:rows){ 
for(j in 1:length(Level)){   #length(Level) is number of intervals, here: 3 
    if(j == 1){coeff=0}else{coeff=1} 
    Position_min[i,j] = coeff*sum(Level[1:(j-1)]) + which(X[i,(coeff*sum(Level[1:(j-1)])+1):sum(Level[1:j])] == min(X[i,(coeff*sum(Level[1:(j-1)])+1):sum(Level[1:j])])) 
    } 
} 

Он отлично работает, но я предпочел бы решение с более высокой производительностью. Есть идеи?

Answer 1

Это удалит внешний уровень цикла:

Level1=c(0,cumsum(Level)) 
for(j in 1:(length(Level1)-1)){ 
    Position_min[,j]=max.col(-X[,(Level1[j]+1):Level1[j+1]])+(Level1[j]) 
} 

Answer 2

Вот является «полностью векторизация» решение без явных петель:

findmins <- function(x, level) { 
    series <- rep(1:length(Level), Level) 
    x <- split(x, factor(series)) 
    minsSplit <- as.numeric(sapply(x, which.min)) 
    minsSplit + c(0, cumsum(level[-length(level)])) 
} 

Position_min_vectorized <- t(apply(X, 1, findmins, Level)) 
identical(Position_min, Position_min_vectorized) 
## [1] TRUE 

Вы можете получить более высокую производительность, делая вашу матрицу в список, а затем с помощью parallel «s mclapply():

X_list <- split(X, factor(1:nrow(X))) 
do.call(rbind, parallel::mclapply(X_list, findmins, Level)) 
## [,1] [,2] [,3] 
## 1  1 5 6 
## 2  2 3 6 
## 3  1 4 7 
## 4  1 5 6 
## 5  2 5 7 
## 6  2 4 6 
## 7  1 5 8 
## 8  1 5 8 
## 9  1 3 8 
## 10 1 3 8