Увеличение скорости для цикла ifelse-for в R при заполнении матрицы внутри цикла

#r #for-loop #if-statement #matrix

#r #for-цикл #if-оператор #матрица

Вопрос:

Как я могу увеличить скорость следующей операции цикла, если фактический диапазон цикла составляет 1000? В приведенном ниже коде:

DF3= Фрейм данных

OP и k — это два столбца в фрейме данных DF3. Здесь k принимает значение от 1 до 10.

 l1 <- seq(1, 10, 1)
E<-matrix(data=0, nrow=10, ncol=10)
for (i in seq_along(l1)){
  for (j in seq_along(l1)){
    E[i,j]=sum(ifelse (DF3$OP[DF3$k==i]<DF3$OP[DF3$k==j],1,0))
  }
}
 

Пример DF3:

 k   OP
1   60
1   30
1   38
1   46
2   29
2   35
2   13
2   82
3   100
3   72
3   63
3   45
 

Комментарии:

1. Вот небольшие предложения для большей простоты: (1) Вместо seq(1, 2552, 1) этого вы можете использовать 1:2552 ; (2) Вместо seq_along(l1) , вы можете просто использовать l1 ; (3), Вместо sum(ifelse ( ... ,1,0)) , просто удалите ifelse() из него функцию, потому что суммирование логических значений TRUE / FALSE совпадает с суммированием 1 и 0.

2. Я думаю, вы отпугнете многих людей, пытающихся помочь, столкнувшись с проблемой, которая слишком велика, чтобы показывать и / или просто «играть». Хотя я знаю, что вы хотите расширить это до гораздо больших размеров, может быть полезно показать на гораздо меньшей матрице, в масштабе 10×10 вместо 2552×2552.

Ответ №1:

Возможно, вы можете упростить свои вложенные for циклы с помощью using combn , который вычисляет значения только для верхней треугольной матрицы (но их достаточно для получения значений во всей матрице)

 E <- matrix(data = 0, nrow = max(DF3$k), ncol = max(DF3$k))
v <- split(DF3$OP, DF3$k)
E[lower.tri(E)] <- combn(v, 2, FUN = function(x) sum(do.call("-", x) < 0))
E[upper.tri(E)] <- max(lengths(v)) - t(E)[upper.tri(E)]
E <- t(E)
 

и, наконец, вы получите

 > E
     [,1] [,2] [,3]
[1,]    0    2    3
[2,]    2    0    3
[3,]    1    1    0
 

Данные

 > dput(DF3)
structure(list(k = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 
3L, 3L), OP = c(60L, 30L, 38L, 46L, 29L, 35L, 13L, 82L, 100L,
72L, 63L, 45L)), class = "data.frame", row.names = c(NA, -12L
))
 

Ответ №2:

Логическое сравнение

 DF3$OP[DF3$k==i]<DF3$OP[DF3$k==j]
 

подразумевает, что во всех группах k этого есть равное количество результатов. Если бы между группами было неравномерное количество записей, возникли бы проблемы с вычислением.

В вашем наборе данных у вас есть 4 записи в каждой группе. Это говорит о том, что вместо работы с фреймом данных нам может быть лучше работать с матрицей.

 ncols = length(unique(DF3$k))
mat = matrix(DF3$OP, ncol = ncols)
E = matrix(0L, ncols, ncols)

for (i in seq_len(ncols)) {
  x = mat[, i]
  for (j in seq_len(ncols)) {
    E[i, j] = sum(x < mat[, j])
  }
}
E

##      [,1] [,2] [,3]
## [1,]    0    2    3
## [2,]    2    0    3
## [3,]    1    1    0
 

Ответ №3:

Поскольку вам нужны попарные блоки групп DF3$OP by DF3$k с обратными дубликатами для большего и меньшего сравнения, вы, по сути, заполняете верхний и нижний треугольники квадратной матрицы. Поэтому рассмотрите возможность разделения фрейма данных на операционные блоки с by помощью и перехода в combn для заполнения матрицы.

 OP_list <- by(DF3, DF3$k, function(sub) sub$OP)
OP_list
# DF3$k: 1
# [1] 60 30 38 46
# ------------------------------------------------------------ 
# DF3$k: 2
# [1] 29 35 13 82
# ------------------------------------------------------------ 
# DF3$k: 3

E <- matrix(data=0, nrow=max(DF3$k), ncol=max(DF3$k))

# COMPARE ACROSS ALL COMBINATIONS OF K-GROUP VECTORS
E[upper.tri(E)] <- combn(OP_list, 2, function(x) sum(x[[1]] < x[[2]]))
E[lower.tri(E)] <- combn(OP_list, 2, function(x) sum(x[[1]] > x[[2]]))

E
#      [,1] [,2] [,3]
# [1,]    0    2    3
# [2,]    2    0    3
# [3,]    1    1    0
 

Должно работать для небольших или больших наборов. См.: Online Demo