sáp nhập danh sách với các yếu tố chung

Question

tôi có một danh sách

[[1]] 
[1] 7 

[[2]] 
[1] 10 11 12 211 446 469 

[[3]] 
[1] 10 11 12 13 

[[4]] 
[1] 11 12 13 215 

[[5]] 
[1] 15 16 

[[6]] 
[1] 15 17 216 225 

Tôi muốn kết hợp danh sách lát rằng có những yếu tố phổ biến, và chỉ số đó liệt kê lát đã được sáp nhập. Sản lượng mong muốn của tôi là dưới đây.

$`1` 
[1] 7 

$`2`, `3`, `4` 
[1] 10 11 12 13 211 215 446 469 

$`5`,`6` 
[1] 15 16 17 216 225 

(Tôi đã đưa các chỉ số danh sách lát gốc như tên danh sách mới, nhưng bất kỳ hình thức đầu ra là tốt.)

dữ liệu tái sản xuất:

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)) 

Answer 1

Không hài lòng với giải pháp nhưng điều này tôi nghĩ đưa ra câu trả lời. Vẫn còn phạm vi cải tiến:

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 

Đây là vòng lặp cơ bản kép để kiểm tra xem có bất kỳ phần tử danh sách nào có trong danh sách khác không. Nếu bạn tìm thấy bất kỳ yếu tố nào như vậy thì hãy hợp nhất chúng lại với nhau chỉ lấy các giá trị unique trong số chúng.

dữ liệu

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)) 

Answer 2

Dưới đây là một hàm đệ quy mà hoàn thành nhiệm vụ (mặc dù ngay bây giờ nó tạo ra một loạt các cảnh báo).

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) 

Về cơ bản, vượt qua trong một danh sách và nhanh chóng các đầu ra, o, với phần tử đầu tiên của l. Sau đó kiểm tra từng giá trị của l đối với mỗi nhóm trong o, nếu nó không khớp với nhau, hãy tạo thành phần mới trong o, nếu nó khớp với một, giữ bộ duy nhất và nếu nó khớp với nhiều hơn 1, nối các nhóm trong o và thả phần bổ sung .

Answer 3

Đây là một cách tiếp cận khác sử dụng các gói "Ma trận" và "igraph".

Trước tiên, chúng tôi cần trích xuất thông tin về yếu tố nào được kết nối. Sử dụng ma trận thưa thớt có thể, potetially, tiết kiệm sử dụng bộ nhớ rất nhiều:

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 

Tìm nếu mỗi phần tử được kết nối với nhau:

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

Sau đó, sử dụng đồ thị, chúng ta có thể nhóm các chỉ số của "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 

Và, cuối cùng, tiếp nhau:

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" 

Answer 4

Dưới đây là một cách tiếp cận dựa trên 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 

Logic ở đây cũng tương tự như câu trả lời của Ronak; Tôi chỉ thấy điều này dễ đọc hơn. Nếu muốn, bạn có thể viết dòng cuối cùng là map(~unique(flatten_dbl(mylist[.x]))) hoặc chia dòng thành map(~mylist[.x]) %>% simplify_all() %>% map(unique).

Đối với các chỉ số trong đó yếu tố được tổng hợp mà nhóm, chỉ cần gọi which trên các yếu tố được sử dụng để Subsetting:

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 

Một logic thay thế cho toàn bộ điều là để làm cho danh sách lồng nhau thay vì các cuộc gọi, có nghĩa là tự tham gia là lên phía trước (với cross2), không có Subsetting sau, và hầu hết các chức năng này chỉ cần thiết lập các hoạt động:

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

hoặc sử dụng cross2 's .filter tham số,

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

có thể được ngưng tụ để

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

Những cách tiếp cận không thả các nhóm trùng lặp cho đến cuối cùng, mặc dù, vì vậy họ đang có khả năng kém hiệu quả.