#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
показывает, что @user20650trcrossprod
в 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