2012-08-27 14 views
5

Weź tę prostą ramkę danych połączonych identyfikatorów:zidentyfikować grupy epizodów połączonych których łańcuch razem

test <- data.frame(id1=c(10,10,1,1,24,8),id2=c(1,36,24,45,300,11)) 

> test 
    id1 id2 
1 10 1 
2 10 36 
3 1 24 
4 1 45 
5 24 300 
6 8 11 

I teraz chcą zgrupować wszystkie identyfikatory, które łączą. Przez "link" mam na myśli śledzenie łańcucha linków, aby wszystkie identyfikatory w jednej grupie były oznaczone razem. Rodzaj rozgałęzionej struktury. tj .:

Group 1 
10 --> 1, 1 --> (24,45) 
        24 --> 300 
          300 --> NULL 
        45 --> NULL 
10 --> 36, 36 --> NULL, 
Final group members: 10,1,24,36,45,300 

Group 2 
8 --> 11 
     11 --> NULL 
Final group members: 8,11 

Teraz z grubsza znam logikę, jakiej bym chciał, ale nie wiem, jak ją zrealizować elegancko. Myślę o rekursywnym użyciu match lub %in%, aby przejść do każdej gałęzi, ale tym razem jestem naprawdę zakłopotany.

Wynik końcowy będę pogoni jest:

result <- data.frame(group=c(1,1,1,1,1,1,2,2),id=c(10,1,24,36,45,300,8,11)) 

> result 
    group id 
1  1 10 
2  1 1 
3  1 24 
4  1 36 
5  1 45 
6  1 300 
7  2 8 
8  2 11 
+0

Życzę WIĘCEJ, a to pytanie było dostępne 25 lat temu, kiedy waliłem głową w ścianę z SAS próbując rozwiązać to pytanie. –

+0

@bondeddust - przypadkowo to pytanie powstało w wyniku próby zastąpienia brzydkiego i nieefektywnego fragmentu kodu SAS, który zrobił coś podobnego. – thelatemail

Odpowiedz

6

Pakiet BioConductor RBGL (interfejs R do biblioteki wykres boost) zawiera funkcję, connectedComp() identyfikujący połączonych składników w wykres - właśnie tego, czego chcesz.

(Aby skorzystać z funkcji, trzeba najpierw zainstalować na wykresie i RBGL pakiety, dostępne here i here.)

library(RBGL) 
test <- data.frame(id1=c(10,10,1,1,24,8),id2=c(1,36,24,45,300,11)) 

## Convert your 'from-to' data to a 'node and edge-list' representation 
## used by the 'graph' & 'RBGL' packages 
g <- ftM2graphNEL(as.matrix(test)) 

## Extract the connected components 
cc <- connectedComp(g) 

## Massage results into the format you're after 
ld <- lapply(seq_along(cc), 
      function(i) data.frame(group = names(cc)[i], id = cc[[i]])) 
do.call(rbind, ld) 
# group id 
# 1  1 10 
# 2  1 1 
# 3  1 24 
# 4  1 36 
# 5  1 45 
# 6  1 300 
# 7  2 8 
# 8  2 11 
+0

Dzięki za odpowiedź. Mam też teraz określenie "połączone komponenty", które będą używane podczas wyszukiwania dodatkowych informacji. – thelatemail

+0

Cieszę się, że mogę wskazać Ci pomocną ścieżkę. Pozdrawiam i szczęśliwe szlaki do ciebie. –

3

Oto alternatywna odpowiedź, że odkryli siebie po popychanie w dobrym kierunku przez Josha. Ta odpowiedź używa pakietu igraph. Dla tych, którzy szukają i natknąć się tej odpowiedzi, mój test zestaw danych jest określany jako „listy krawędzi” lub „listy przylegania” w teorii grafów (http://en.wikipedia.org/wiki/Graph_theory)

library(igraph) 
test <- data.frame(id1=c(10,10,1,1,24,8),id2=c(1,36,24,45,300,11)) 
gr.test <- graph.data.frame(test) 
links <- data.frame(id=unique(unlist(test)),group=clusters(gr.test)$membership) 
links[order(links$group),] 

# id group 
#1 10  1 
#2 1  1 
#3 24  1 
#5 36  1 
#6 45  1 
#7 300  1 
#4 8  2 
#8 11  2 
1

Bez użycia pakiety:

# 2 sets of test data 
mytest <- data.frame(id1=c(10,10,3,1,1,24,8,11,32,11,45),id2=c(1,36,50,24,45,300,11,8,32,12,49)) 
test <- data.frame(id1=c(10,10,1,1,24,8),id2=c(1,36,24,45,300,11)) 

grouppairs <- function(df){ 

    # from wide to long format; assumes df is 2 columns of related id's 
    test <- data.frame(group = 1:nrow(df),val = unlist(df)) 

    # keep moving to next pair until all same values have same group 
    i <- 0 
    while(any(duplicated(unique(test)$val))){ 
    i <- i+1 

    # get group of matching values 
    matches <- test[test$val == test$val[i],'group'] 

    # change all groups with matching values to same group 
    test[test$group %in% matches,'group'] <- test$group[i] 
    } 

    # renumber starting from 1 and show only unique values in group order 
    test$group <- match(test$group, sort(unique(test$group))) 
    unique(test)[order(unique(test)$group), ] 
} 

# test 
grouppairs(test) 
grouppairs(mytest) 
Powiązane problemy