Объединение списка с общими элементами

Ответ 1

Не нравится решение, но это, я думаю, дает ответ. По-прежнему существует улучшение:

unique(sapply(lst, function(x) 
       unique(unlist(lst[sapply(lst, function(y) 
                         any(x %in% y))]))))


#[[1]]
#[1] 7

#[[2]]
#[1]  10  11  12 211 446 469  13 215

#[[3]]
#[1]  15  16  17 216 225

Это в основном двойной цикл, чтобы проверить, присутствует ли какой-либо элемент списка в любом другом списке. Если вы найдете какой-либо такой элемент, объедините их вместе, выбирая из них только значения unique.

<сильные > данные

lst <- list(7, c(10 ,11 ,12, 211, 446, 469), c(10, 11, 12, 13),c(11 ,12, 13 ,215), 
               c(15, 16), c(15, 17 ,216 ,225))

Ответ 2

Вот еще один подход с использованием пакетов "Matrix" и "igraph".

Сначала нам нужно извлечь информацию о том, какие элементы связаны. Использование разреженных матриц может, по существу, экономить много памяти:

library(Matrix)
i = rep(1:length(mylist), lengths(mylist)) 
j = factor(unlist(mylist))
tab = sparseMatrix(i = i, j = as.integer(j), x = TRUE, dimnames = list(NULL, levels(j)))
#as.matrix(tab)  ## just to print colnames
#         7    10    11    12    13    15    16    17   211   215   216   225   446   469
#[1,]  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#[2,] FALSE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE  TRUE  TRUE
#[3,] FALSE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#[4,] FALSE FALSE  TRUE  TRUE  TRUE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE
#[5,] FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#[6,] FALSE FALSE FALSE FALSE FALSE  TRUE FALSE  TRUE FALSE FALSE  TRUE  TRUE FALSE FALSE

Найти, если каждый элемент подключен друг к другу:

connects = tcrossprod(tab, boolArith = TRUE)
#connects
#6 x 6 sparse Matrix of class "lsCMatrix"
#                
#[1,] | . . . . .
#[2,] . | | | . .
#[3,] . | | | . .
#[4,] . | | | . .
#[5,] . . . . | |
#[6,] . . . . | |

Затем, используя графики, мы можем сгруппировать индексы "mylist":

library(igraph)
# 'graph_from_adjacency_matrix' seems to not work with the "connects" object directly. 
# An alternative to coercing "connects" here would be to build it as 'tcrossprod(tab) > 0'

group = clusters(graph_from_adjacency_matrix(as(connects, "lsCMatrix")))$membership
#group
#[1] 1 2 2 2 3 3

И, наконец, объедините:

tapply(mylist, group, function(x) sort(unique(unlist(x))))
#$`1`
#[1] 7
#
#$`2`
#[1]  10  11  12  13 211 215 446 469
#
#$`3`
#[1]  15  16  17 216 225

tapply(1:length(mylist), group, toString)
#        1         2         3 
#      "1" "2, 3, 4"    "5, 6" 

Ответ 3

Здесь рекурсивная функция, которая выполняет задачу (хотя прямо сейчас она генерирует кучу предупреждений).

mylist <- list(7, c(10, 11, 12, 211, 446, 469), c(10, 11, 12, 13), c(11, 12, 13, 215), c(15, 16), c(15, 17, 216, 225))

commonElements = function(l,o=list(l[[1]])){
  if(length(l) == 0){return(o)}
  match = which(unlist(lapply(lapply(o,intersect,l[[1]]),any)))
  if(length(match) == 0) o[[length(o)+1]] = l[[1]]
  if(length(match) == 1) o[[match]] = unique(c(o[[match]],l[[1]]))
  if(length(match) > 1){
    o[[match[1]]] = unique(unlist(o[match]))
    p[rev(match)[-1]] = NULL
  }
  l[[1]] = NULL
  commonElements(l,o)
}

commonElements(mylist)

В принципе, перейдите в список и создайте экземпляр, o, с первым элементом l. Затем проверьте каждое значение l на каждую группу в o, если оно ничего не соответствует, создайте новый элемент в o, если он соответствует одному, сохраните уникальный набор и если он соответствует более 1, объедините группы в o и оставьте дополнительные функции.

Ответ 4

Здесь подход, основанный на purrr:

library(purrr)

mylist <- list(7, 
               c(10, 11, 12, 211, 446, 469), 
               c(10, 11, 12, 13), 
               c(11, 12, 13, 215), 
               c(15, 16), 
               c(15, 17, 216, 225))

result <- mylist %>% 
    # check whether any numbers of an element are in any of the elements
    map(~map_lgl(mylist, compose(any, `%in%`), .x)) %>% 
    unique() %>%    # drop duplicated groups
    map(~reduce(mylist[.x], union))    # subset lst by group and collapse subgroups

str(result)
#> List of 3
#>  $ : num 7
#>  $ : num [1:8] 10 11 12 211 446 469 13 215
#>  $ : num [1:5] 15 16 17 216 225

Логика здесь похожа на ответ Ронака; Я просто считаю, что это легче читать. Если вам нравится, вы можете написать последнюю строку как map(~unique(flatten_dbl(mylist[.x]))) или разбить ее на map(~mylist[.x]) %>% simplify_all() %>% map(unique).

Для индексов, из которых элемент агрегируется в какую группу, просто вызовите which для элементов, используемых для подмножества:

mylist %>% 
    map(~map_lgl(mylist, compose(any, `%in%`), .x)) %>% 
    unique() %>% 
    map(which) %>% 
    str()
#> List of 3
#>  $ : int 1
#>  $ : int [1:3] 2 3 4
#>  $ : int [1:2] 5 6

Альтернативная логика всего заключается в том, чтобы сделать список вложенным вместо вызовов, что означает, что самосоединение впереди (с cross2), в дальнейшем нет подмножества, и большинство функций просто установлены операции:

mylist %>% 
    map(cross2, mylist) %>% 
    modify_depth(2, reduce, ~if(length(intersect(.x, .y)) > 0) sort(union(.x, .y))) %>% 
    map(reduce, union) %>% 
    unique()

или используя параметр cross2 .filter,

mylist %>% 
    map(cross2, mylist, ~length(intersect(.x, .y)) == 0) %>% 
    map(compose(sort, unique, unlist)) %>% 
    unique()

который можно было бы конденсировать до

mylist %>% 
    map(function(element) sort(unique(unlist(cross2(element, mylist, ~length(intersect(.x, .y)) == 0))))) %>%
    unique()

Эти подходы не уменьшают повторяющиеся группы до конца, хотя они, вероятно, менее эффективны.