выполнить расчет по всем комбинациям столбцов матрицы

Question

Я пытаюсь применить функцию к очень большой матрице. Я хочу со временем создать (40,000 by 40,000) матрицу (где завершена только одна сторона диагонали) или создать список результатов.

Матрица выглядит так:

            obs 1     obs 2     obs 3     obs 4     obs 5     obs 6     obs 7     obs 8     obs 9
words 1 0.2875775 0.5999890 0.2875775 0.5999890 0.2875775 0.5999890 0.2875775 0.5999890 0.2875775
words 2 0.7883051 0.3328235 0.7883051 0.3328235 0.7883051 0.3328235 0.7883051 0.3328235 0.7883051
words 3 0.4089769 0.4886130 0.4089769 0.4886130 0.4089769 0.4886130 0.4089769 0.4886130 0.4089769
words 4 0.8830174 0.9544738 0.8830174 0.9544738 0.8830174 0.9544738 0.8830174 0.9544738 0.8830174
words 5 0.9404673 0.4829024 0.9404673 0.4829024 0.9404673 0.4829024 0.9404673 0.4829024 0.9404673
words 6 0.0455565 0.8903502 0.0455565 0.8903502 0.0455565 0.8903502 0.0455565 0.8903502 0.0455565

Я использую функцию, используя cosine(mat[, 3], mat[, 4]), которая дает мне одно число.

          [,1]
[1,] 0.7546113

Я могу сделать это для всех столбцов, но я хочу знать, из каких столбцов они взяты, то есть приведенные выше вычисления получены из столбцов 3 и 4, то есть "obs 3" и "obs 4".

Ожидаемый результат может быть результатом в виде списка или матрицы, например:

          [,1]   [,1]   [,1]
[1,]        1      .      .
[1,]      0.75     1      .
[1,]      0.23    0.87    1

(где цифры здесь составлены)

Так что размеры будут размером ncol(mat) на ncol(mat) (если я пойду матричным методом).

Данные / Код:

#generate some data

mat <- matrix(data = runif(200), nrow = 100, ncol = 20, dimnames = list(paste("words", 1:100),
                                                                        paste("obs", 1:20)))


mat


#calculate the following function
library(lsa)
cosine(mat[, 3], mat[, 4])
cosine(mat[, 4], mat[, 5])
cosine(mat[, 5], mat[, 6])

Дополнительно

Я думал о том, чтобы сделать следующее: - Создание пустой матрицы и вычисление функции в цикле forloop, но она не работает должным образом, а создание 40,000 by 40,000 матрицы нулей вызывает проблемы с памятью.

co <- matrix(0L, nrow = ncol(mat), ncol = ncol(mat), dimnames = list(colnames(mat), colnames(mat)))
co

for (i in 2:ncol(mat)) {
  for (j in 1:(i - 1)) {
    co[i, j] = cosine(mat[, i], mat[, j])
  }
}

co

Я также попытался поместить результаты в список:

List <- list()
for(i in 1:ncol(mat))
{
  temp <- List[[i]] <- mat
}

res <- List[1][[1]]
res

Что тоже не так.

Поэтому я пытаюсь создать функцию, которая будет столбец за столбцом вычислять функцию и сохранять результаты.

Answer 1

1) Используя mat, показанный в вопросе, первая строка создает матрицу 20x20 с заполненными всеми косинусами 20 * 20. Вторая строка обнуляет значения на диагонали и над ней. Вместо этого используйте lower.tri, если вы предпочитаете, чтобы значения на диагонали и под ней были равны нулю.

comat <- cosine(mat)
comat[upper.tri(comat, diag = TRUE)] <- 0

2) Альтернативно для создания именованного числового вектора результатов:

covec <- c(combn(as.data.frame(mat), 2, function(x) c(cosine(x[, 1], x[, 2]))))
names(covec) <- combn(colnames(mat), 2, paste, collapse = "-")

3) Мы можем использовать тот факт, что недиагональные косинусы такие же, как корреляции с точностью до множителя, mult.

mult <- c(cosine(mat[, 1], mat[, 2]) / cor(mat[, 1], mat[, 2]))
co3 <- mult * cor(mat)
co3[upper.tri(co3, diag = TRUE)] <- 0

3a) Это открывается с использованием любой из нескольких функций корреляции, доступных в R. Например, с использованием mult только что вычислено:

library(HiClimR)
co4 <- mult * fastCor(mat)
co4[upper.tri(co4, diag = TRUE)] <- 0

3b)

library(propagate)
co5 <- mult * bigcor(mat)
co5[upper.tri(co5, diag = TRUE)] <- 0

3c)

co6 <- crossprod(scale(mat)) / (nrow(mat) - 1)
co6[upper.tri(co6, diag = TRUE)] <- 0

Answer 2

Один из вариантов - определить функцию для применения к двум столбцам, а затем использовать outer для применения ко всем комбинациям столбцов.

fun <- function(x, y) {
   cosine(mat[, x], mat[, y])
}

outer(seq_len(ncol(mat)), seq_len(ncol(mat)), Vectorize(fun))

#       [,1]   [,2]   [,3]   [,4]   [,5]  ..... 
#[1,] 1.0000 0.7824 1.0000 0.7824 1.0000 .....
#[2,] 0.7824 1.0000 0.7824 1.0000 0.7824 .....
#[3,] 1.0000 0.7824 1.0000 0.7824 1.0000 .....
#[4,] 0.7824 1.0000 0.7824 1.0000 0.7824 .....
#[5,] 1.0000 0.7824 1.0000 0.7824 1.0000 .....
#....

Answer 3

Мы можем сделать это с вложенным sapply

i1 <- seq_len(ncol(mat))
sapply(i1, function(i) sapply(i1, function(j) cosine(mat[, i], mat[, j])))    #         [,1]      [,2]      [,3]      [,4]      [,5]      [,6]      [,7]      #[,8]      [,9]     [,10]     [,11]     [,12]
# [1,] 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016
# [2,] 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000
# [3,] 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016
# [4,] 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000
# [5,] 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016
# [6,] 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000
# [7,] 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016 1.0000000 0.7849016
# ....

Answer 4

Мы можем использовать итерацию по индексам, используя purrr (как лучшую (?) Альтернативу циклам for). Я думаю, что у набора данных игрушек должно было быть 2000, а не 200 точек данных?

library(tidyverse)

mat <-
  matrix(
    data = runif(2000),
    nrow = 100,
    ncol = 20,
    dimnames = list(paste("words", 1:100),
                    paste("obs", 1:20))
  )

cos_summary <- tibble(Row1 = 3:5, Row2 = 4:6)

cos_summary <- cos_summary %>%
  mutate(cos_1_2 = map2_dbl(Row1, Row2, ~lsa::cosine(mat[,.x], mat[,.y])))

cos_summary

# A tibble: 3 x 3
   Row1  Row2 cos_1_2
  <int> <int>   <dbl>
1     3     4   0.710
2     4     5   0.734
3     5     6   0.751