Uma solução pode ser encontrada com o pacote igraph
, para problemas de grafos. Parece ser natural tratar do problema da pergunta como sendo um problema de encontrar as componentes conexas de um grafo.
1. Carregar o pacote igraph
e criar um grafo a partir da base.
library(igraph)
g <- graph_from_data_frame(input)
plot(g, vertex.size = 30, vertex.color = 'lightgrey', edge.arrow.width = 0.5)
2. Agora determinar as componentes. A função all_simple_paths
é uma opção. Mas vou usar a função subcomponent
passando cada um dos vértices da primeira coluna da base input
.
v_num <- unique(match(input[[1]], names(V(g))))
path_list <- mapply(subcomponent, list(g), v_num)
names(path_list) <- v_num
3. Agora, saber quais são únicas, o código acima dá uma componente para cada elemento do vetor input$id_a
, possivelmente com repetições.
Nota: aqui é chamada a função str_sort
de mais um pacote externo, stringr
. Isto serve para ordenar os nomes dos vértices, que são de classes "character"
, por ordem numérica mas não é absolutamente necessário para o resultado final. A ordem dada pela função base sort
também serve.
path_list2 <- lapply(path_list, function(p){
p <- unlist(p, recursive = FALSE)
stringr::str_sort(unique(names(p)), numeric = TRUE)
})
path_list2
#$`1`
#[1] "12" "67764"
#
#$`2`
#[1] "15" "68663" "68667"
#
#$`3`
#[1] "15" "68663" "68667"
#
#$`4`
#[1] "14" "19" "34" "1001" "2112"
#
#$`5`
#[1] "20"
#
#$`6`
#[1] "14" "19" "34" "1001" "2112"
4. Estes vetores são os vetores do gráfico acima mas há de facto repetições, é preciso ficar com um de cada um desses vetores.
final <- lapply(seq_along(path_list2), function(i){
keep <- sapply(seq_along(path_list2)[-seq_len(i)], function(j){
length(intersect(path_list2[[i]], path_list2[[j]])) == 0
})
if(all(keep)) path_list2[[i]] else NULL
})
final <- final[lengths(final) > 0]
final
#[[1]]
#[1] "12" "67764"
#
#[[2]]
#[1] "15" "68663" "68667"
#
#[[3]]
#[1] "20"
#
#[[4]]
#[1] "14" "19" "34" "1001" "2112"
Agora só temos um de cada, que correspondem ao resultado pretendido.
5. Com o formato da pergunta.
sapply(final, paste, collapse = "//")
#[1] "12//67764" "15//68663//68667" "20"
#[4] "14//19//34//1001//2112"