Увеличьте скорость выполнения операций, используя комбинацию гребенчатых и внешних функций

У меня есть фрейм данных, df с двумя переменными, как указано ниже. Используя приведенный ниже код, я хочу получить матричный мат.

Этот код отлично работает для unique (df $ V1) = 3, но требует много времени (›10 часов) для операций, где unique (df $ V1) находится в тысячах.

Dataframe

V1   V2
1   60
1   30
1   38
1   46
2   29
2   35
2   13
2   82
3   100
3   72
3   63
3   45

Код:

#Unique V1 values
vec <- unique(df$V1)
#Count <= valies
val <- combn(vec, 2, function(x) 
  sum(outer(df$V2[df$V1 == x[1]], df$V2[df$V1 == x[2]], `<=`)))
val
#[1]  5 14 13

#Create an empty matrix
mat <- matrix(0,length(vec), length(vec))
#Fill the lower triangle of the matrix. 
mat[lower.tri(mat)] <- val
mat

По сути, для V1 = 1 мы хотим сравнить все значения V2 со всеми значениями V2 для V1 = 2 и 3. Повторите то же самое для V1 = 2 и V1 = 3. Другими словами, для данного значения V1 мы хотим увидеть, меньше ли значения в V2, чем значения в V2 для остальных значений в V1. Например, мы сравниваем значения в V2 для V1 = 1 и V1 = 2. Если значение в V2 для V1 = 1 меньше значения в V2 для V1 = 2, то возвращаемое значение равно 1, иначе 0. Например:

For V1=1->
( 60 > 29 : returns 0,
60 > 35 : returns 0,
60 > 13 : returns 0,
60 < 82 : returns 1,
30 > 29 : returns 0,
30 < 35 : returns 1,
30 > 13 : returns 0,
30 < 82 : returns 1,
38 > 29 : returns 0,
38 > 35 : returns 0,
38 > 13 : returns 0,
38 < 82 : returns 1,
46 > 29 : returns 0,
46 > 35 : returns 0,
46 > 13 : returns 0,
30 < 82 : returns 1)=Sum is 5 (i.e. mat[1,2])

r combn
person vp_050    schedule 19.12.2020    source источник

Ответы (3)


arrow_upward
7
arrow_downward

Это должно быть молниеносно для этой проблемы и не использовать слишком много памяти.

library(data.table)
setDT(df)
numvec <- max(df[,V1])
dl <- lapply(1:numvec, function(i) df[V1 == i, sort(V2)])
dmat <- CJ(x=1:numvec, y=1:numvec)[, .(z = sum(findInterval(dl[[y]],dl[[x]]))), .(x,y)]
mat <- as.matrix(dcast(dmat, x~y, value.var = 'z')[, -'x'])
person pseudospin    schedule 19.12.2020
comment
Отлично. Мне стыдно, что я об этом не подумал. - person Ian Campbell; 19.12.2020
comment
Можно ли еще улучшить этот код, чтобы ускорить процесс? или запустить его по-другому для верхнего и нижнего треугольников, а затем объединить? - person vp_050; 10.02.2021
comment
Я полагаю, вы могли бы произвести расчет для верхнего треугольника, а затем сгенерировать нижний треугольник путем вычитания из произведения длин векторов. Но в лучшем случае вы получите только множитель 2. Есть еще проблема равенства, которая сбивает с толку. - person pseudospin; 11.02.2021

arrow_upward
2
arrow_downward

Мне сложно понять, что именно вы хотите, потому что я не думаю, что ваша матрица должна быть симметричной.

Возможно, этот вариант с data.table::CJ - это то, что вы ищете:

library(data.table)
setDT(df)
result <- df[,CJ(A = V1, B = V1,unique=TRUE)][
  ,.(sum(sapply(df[V1==A,V2],function(x)x <= df[V1==B,V2]))),by = c("A","B")]
result
   A B V1
1: 1 1 10
2: 1 2  5
3: 1 3 14
4: 2 1 11
5: 2 2 10
6: 2 3 13
7: 3 1  2
8: 3 2  3
9: 3 3 10

mat <- matrix(result$V1, ncol = length(unique(df$V1)), nrow = length(unique(df$V1)))
diag(mat) <- 0
mat
     [,1] [,2] [,3]
[1,]    0   11    2
[2,]    5    0    3
[3,]   14   13    0

set.seed(3)
df2 <- data.table(V1 = sample(1:100,1000,TRUE), V2 = sample(10:100,1000,TRUE))
system.time(df2[,CJ(A = V1, B = V1,unique=TRUE)][
                ,.(sum(sapply(df2[V1==A,V2],function(x)x <= df2[V1==B,V2]))),by = c("A","B")])
   user  system elapsed 
118.817   1.081 119.949
person Ian Campbell    schedule 19.12.2020
comment
Спасибо. Это именно то, что я ищу. Однако для меня V1 имеет 2552 уникальных значения. И я получаю ошибку памяти. Конфигурация системы Тип системы - 64-разрядная операционная система РАЗМЕР ОЗУ - 16 ГБ Что я пробовал? а) Увеличен лимит памяти: memory.limit (размер = 10000000000000) - person vp_050; 19.12.2020
comment
Да, это никак не поместится в памяти. Это 6512704 комбинаций. Вы можете попробовать разделить df[,CJ(A = V1, B = V1,unique=TRUE)] на несколько таблиц data.tables и распараллелить их, но это все равно займет много времени. Вы смотрите на 21 час на одном ядре моего ноутбука из расчета 10 V2 с на V1. - person Ian Campbell; 19.12.2020

arrow_upward
1
arrow_downward

Вот подход, который позволяет избежать outer.

sapply(combn(split(df$V2, df$V1), 2, simplify = FALSE), function(x){
    sum(sapply(x[[1]], function(a) sum(a <= x[[2]])))
})
# [1]  5 14 13

Or

sapply(vec, function(x) sapply(vec, function(y){
    if (x == y) {
        0
    } else {
        d1 = df$V2[df$V1 == x]
        d2 = df$V2[df$V1 == y]
        sum(sapply(d1, function(a) sum(a <= d2)))
    }
}))
#     [,1] [,2] [,3]
#[1,]    0   11    2
#[2,]    5    0    3
#[3,]   14   13    0
person d.b    schedule 19.12.2020