Подсчитайте количество пар между элементами в списке в R?

#r

Вопрос:

Аналогичные вопросы задавались о подсчете пар, однако ни один из них не кажется особенно полезным для того, что я пытаюсь сделать.

Я хочу подсчитать количество пар между несколькими элементами списка и превратить их в матрицу. Например, если у меня есть такой список:

 myList <- list(
  a = c(2,4,6),
  b = c(1,2,3,4),
  c = c(1,2,5,7),
  d = c(1,2,4,5,8)
)
 

Мы видим, что пара 1:2 появляется 3 раза (по одному разу в a , b , и c ). Пара 1:3 появляется только один раз b . Пара 1:4 появляется 2 раза (по одному разу в b и d )… и т. Д.

Я хотел бы подсчитать, сколько раз появляется пара, а затем превратить ее в симметричную матрицу. Например, мой желаемый результат будет выглядеть примерно как матрица, которую я создал вручную (где каждый элемент матрицы-это общее количество для этой пары значений).:

 > myMatrix
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    0    3    1    2    2    0    1    1
[2,]    3    0    1    3    2    1    1    1
[3,]    1    1    0    1    0    0    0    0
[4,]    2    3    1    0    0    0    0    1
[5,]    2    2    0    0    0    0    1    1
[6,]    0    1    0    0    0    0    0    0
[7,]    1    1    0    0    1    0    0    0
[8,]    1    1    0    1    1    0    0    0
 

Любые предложения будут высоко оценены

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

1. возможно, совершил ошибку .. tcrossprod(sapply(myList, function(x) table(factor(x, 1:8))))

2. microbenchmark показывает, что @user20650 trcrossprod в 300 раз быстрее, чем Reduce код @akrun.

3. Я думаю, что приведенные ответы работают только в том случае, если вы гарантируете, что в каждом исходном векторе нет повторяющихся записей. Если есть, например myList$a = c(2,4,2) , то вы не можете отличить нежелательные диагонали от фактически 2,2 найденной пары .

4. О, и я думаю, что это не сработает, если входные векторы также не упорядочены

Ответ №1:

Вдохновленный ответом @akrun, я думаю, что вы можете использовать перекрестный продукт, чтобы получить это очень быстро и просто:

 out <- tcrossprod(table(stack(myList)))
diag(out) <- 0

#      values
#values 1 2 3 4 5 6 7 8
#     1 0 3 1 2 2 0 1 1
#     2 3 0 1 3 2 1 1 1
#     3 1 1 0 1 0 0 0 0
#     4 2 3 1 0 1 1 0 1
#     5 2 2 0 1 0 0 1 1
#     6 0 1 0 1 0 0 0 0
#     7 1 1 0 0 1 0 0 0
#     8 1 1 0 1 1 0 0 0
 

Оригинальный ответ:

Используйте combn для получения комбинаций, а также для изменения каждой комбинации.
Затем преобразуйте в a data.frame и table результаты.

 tab <- lapply(myList, (x) combn(x, m=2, FUN=(cm) rbind(cm, rev(cm)), simplify=FALSE))
tab <- data.frame(do.call(rbind, unlist(tab, rec=FALSE)))
table(tab)

#   X2
#X1  1 2 3 4 5 6 7 8
#  1 0 3 1 2 2 0 1 1
#  2 3 0 1 3 2 1 1 1
#  3 1 1 0 1 0 0 0 0
#  4 2 3 1 0 1 1 0 1
#  5 2 2 0 1 0 0 1 1
#  6 0 1 0 1 0 0 0 0
#  7 1 1 0 0 1 0 0 0
#  8 1 1 0 1 1 0 0 0
 

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

1. После повторного просмотра кода кажется, что при определенных условиях (которые я еще не выяснил) код akrun приводил к небольшим ошибкам, когда он неправильно суммировал общее количество пар. Это в сочетании с увеличением скорости заставило меня изменить это на лучший ответ. Спасибо!

Ответ №2:

Мы могли бы перебрать все list , сделать попарные комбинации с combn , stack это в два столбца набора данных, преобразовать значения столбца В factor С levels задан как 1 к 8, получаем частоту граф ( table ), сделать векторное произведение ( crossprod ), преобразовать данные обратно в логическую, а затем Reduce на list элементы, добавив поэлементно и окончательно назначить diag дополнительные элементы к 0. (При необходимости установите names атрибуты dimnames в значение NULL

 out <- Reduce(` `, lapply(myList, function(x) 
        crossprod(table(transform(stack(setNames(
          combn(x,
         2, simplify = FALSE), combn(x, 2, paste, collapse="_"))), 
          values = factor(values, levels = 1:8))[2:1]))> 0))
diag(out) <- 0
names(dimnames(out)) <- NULL
 

-выход

 > out
  1 2 3 4 5 6 7 8
1 0 3 1 2 2 0 1 1
2 3 0 1 3 2 1 1 1
3 1 1 0 1 0 0 0 0
4 2 3 1 0 1 1 0 1
5 2 2 0 1 0 0 1 1
6 0 1 0 1 0 0 0 0
7 1 1 0 0 1 0 0 0
8 1 1 0 1 1 0 0 0
 

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

1. Мастер акрун, не могли бы вы, пожалуйста, проверить мой ответ. Неужели я совершенно не прав? Я попытался сосчитать все комбинации. Заранее спасибо!

2. @TarJae, возможно, вам понадобится использовать pivot_wider в конце

3. Почему бы не использовать перекрестный продукт для выполнения всей тяжелой работы? — `diag<-`(tcrossprod(table(stack(myList))), 0) . Я полностью упустил из виду эту возможность, но я думаю, что это работает.

4. @thelatemail следующий шаг: выполните проверку времени tcrossprod на соответствие вашему lapply(combn) коду. Я делаю ставку на кросспродукт 🙂

5. смотрите комментарий к вопросу: это tcrossprod в 300 раз быстрее, чем это.

Ответ №3:

Я подумал о решении, основанном на ответе @TarJae, не очень элегантном, но это был веселый вызов!

Библиотеки

 library(tidyverse)
 

Код

 map_df(myList,function(x) as_tibble(t(combn(x,2)))) %>% 
  count(V1,V2) %>% 
  {. -> temp_df} %>% 
  bind_rows(
    temp_df %>% 
      rename(V2 = V1, V1 = V2) 
  ) %>% 
  full_join(
    expand_grid(V1 = 1:8,V2 = 1:8)
  ) %>% 
  replace_na(replace = list(n = 0)) %>% 
  arrange(V2,V1) %>% 
  pivot_wider(names_from = V1,values_from = n) %>% 
  as.matrix()
 

Выход

      V2 1 2 3 4 5 6 7 8
[1,]  1 0 3 1 2 2 0 1 1
[2,]  2 3 0 1 3 2 1 1 1
[3,]  3 1 1 0 1 0 0 0 0
[4,]  4 2 3 1 0 1 1 0 1
[5,]  5 2 2 0 1 0 0 1 1
[6,]  6 0 1 0 1 0 0 0 0
[7,]  7 1 1 0 0 1 0 0 0
[8,]  8 1 1 0 1 1 0 0 0
 

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

1. Зачем беспокоиться о переименовании? Может быть, просто поменять порядок ввода последующих вызовов?

Ответ №4:

Сначала определите возможную комбинацию каждого вектора из списка в a tibble , затем я свяжу их с одним tibble и count комбинациями.

 library(tidyverse)

a <- as_tibble(t(combn(myList[[1]],2)))
b <- as_tibble(t(combn(myList[[2]],2)))
c <- as_tibble(t(combn(myList[[3]],2)))
d <- as_tibble(t(combn(myList[[4]],2)))

bind_rows(a,b,c,d) %>% 
    count(V1, V2)
 
       V1    V2     n
   <dbl> <dbl> <int>
 1     1     2     3
 2     1     3     1
 3     1     4     2
 4     1     5     2
 5     1     7     1
 6     1     8     1
 7     2     3     1
 8     2     4     3
 9     2     5     2
10     2     6     1
11     2     7     1
12     2     8     1
13     3     4     1
14     4     5     1
15     4     6     1
16     4     8     1
17     5     7     1
18     5     8     1