Finden Sie unmittelbare Nachbarn nach Gruppe mithilfe von Datentabelle oder igraph

Ich habe eine data.table :

groups <- data.table(group = c("A", "B", "C", "D", "E", "F", "G"), 
                     code_1 = c(2,2,2,7,8,NA,5),
                     code_2 = c(NA,3,NA,3,NA,NA,2),
                     code_3 = c(4,1,1,4,4,1,8))

group code_1 code_2 code_3
  A      2     NA      4
  B      2      3      1
  C      2     NA      1
  D      7      3      4
  E      8     NA      4
  F     NA     NA      1
  G      5      2      8

Was ich erreichen möchte, ist, dass jede Gruppe anhand der verfügbaren Codes die unmittelbaren Nachbarn findet. Beispiel: Gruppe A hat aufgrund von Code_1 unmittelbare Nachbargruppen B, C (Code_1 ist in allen Gruppen gleich 2) und aufgrund von Code_3 unmittelbare Nachbargruppen D, E (Code_3 ist in allen diesen Gruppen gleich 4).

Ich habe versucht, für jeden Code die erste Spalte (Gruppe) basierend auf den Übereinstimmungen wie folgt zu unterteilen:

groups$code_1_match = list()
for (row in 1:nrow(groups)){

  set(groups, i=row, j="code_1_match", list(groups$group[groups$code_1[row] == groups$code_1]))
}

  group code_1 code_2 code_3          code_1_match
    A      2     NA      4              A,B,C,NA
    B      2      3      1              A,B,C,NA
    C      2     NA      1              A,B,C,NA
    D      7      3      4                  D,NA
    E      8     NA      4                  E,NA
    F     NA     NA      1 NA,NA,NA,NA,NA,NA,...
    G      5      2      8                  NA,G

Das "irgendwie" funktioniert, aber ich würde annehmen, dass es eine Art Datentabelle gibt, wie man das macht. Ich habe es versucht

groups[, code_1_match_2 := list(group[code_1 == groups$code_1])]

Das funktioniert aber nicht.

Vermisse ich einen offensichtlichen Datentabellentrick, um damit umzugehen?

Mein ideales Fallergebnis würde folgendermaßen aussehen (was derzeit die Verwendung meiner Methode für alle drei Spalten und die anschließende Verkettung der Ergebnisse erfordern würde):

group code_1 code_2 code_3    Immediate neighbors
  A      2     NA      4         B,C,D,E
  B      2      3      1         A,C,D,F
  C      2     NA      1         A,B,F
  D      7      3      4           B,A
  E      8     NA      4           A,D
  F     NA     NA      1           B,C
  G      5      2      8           

Holen Sie sich mit igraph Nachbarn 2. Grades, löschen Sie numerische Knoten und fügen Sie die verbleibenden Knoten ein.

library(data.table)
library(igraph)

# reshape wide-to-long
x <- melt(groups, id.vars = "group")[!is.na(value)]

# convert to graph
g <- graph_from_data_frame(x[, .(from = group, to = paste0(variable, "_", value))])

# get 2nd degree neighbours
x1 <- ego(g, 2, nodes = groups$group)

# prettify the result
groups$res <- sapply(seq_along(x1), function(i) toString(intersect(names(x1[[ i ]]),
                                                                   groups$group[ -i ])))

#    group code_1 code_2 code_3        res
# 1:     A      2     NA      4 B, C, D, E
# 2:     B      2      3      1 A, C, D, F
# 3:     C      2     NA      1    A, B, F
# 4:     D      7      3      4    B, A, E
# 5:     E      8     NA      4       A, D
# 6:     F     NA     NA      1       B, C
# 7:     G      5      2      8           

Mehr Info

So sehen unsere Daten vor der Konvertierung in ein igraph-Objekt aus. Wir möchten sicherstellen, dass sich Code1 mit Wert 2 von Code2 mit Wert 2 usw. unterscheidet.

x[, .(from = group, to = paste0(variable, "_", value))]
#     from       to
#  1:    A code_1_2
#  2:    B code_1_2
#  3:    C code_1_2
#  4:    D code_1_7
#  5:    E code_1_8
#  6:    G code_1_5
#  7:    B code_2_3
#  8:    D code_2_3
#  9:    G code_2_2
# 10:    A code_3_4
# 11:    B code_3_1
# 12:    C code_3_1
# 13:    D code_3_4
# 14:    E code_3_4
# 15:    F code_3_1
# 16:    G code_3_8

So sieht unser Netzwerk aus:

Beachten Sie, dass A..GKnoten immer durch verbunden sind code_x_y. Wir müssen also den 2. Grad erhalten, ego(..., order = 2)geben uns Nachbarn bis einschließlich Nachbarn 2. Grades und geben ein Listenobjekt zurück.

So erhalten Sie die Namen:

lapply(x1, names)
# [[1]]
# [1] "A"        "code_1_2" "code_3_4" "B"        "C"        "D"        "E"       
# 
# [[2]]
# [1] "B"        "code_1_2" "code_2_3" "code_3_1" "A"        "C"        "D"        "F"       
# 
# [[3]]
# [1] "C"        "code_1_2" "code_3_1" "A"        "B"        "F"       
# 
# [[4]]
# [1] "D"        "code_1_7" "code_2_3" "code_3_4" "B"        "A"        "E"       
# 
# [[5]]
# [1] "E"        "code_1_8" "code_3_4" "A"        "D"       
# 
# [[6]]
# [1] "F"        "code_3_1" "B"        "C"       
# 
# [[7]]
# [1] "G"        "code_1_5" "code_2_2" "code_3_8"

Um das Ergebnis zu verschönern, müssen wir code_x_yKnoten und den Ursprungsknoten (1. Knoten) entfernen.

sapply(seq_along(x1), function(i) toString(intersect(names(x1[[ i ]]), groups$group[ -i ])))
#[1] "B, C, D, E" "A, C, D, F" "A, B, F"    "B, A, E"    "A, D"       "B, C"       ""   

Es gibt wahrscheinlich einen praktischeren Weg, dies zu erreichen, aber Sie könnten so etwas tun, indem Sie Schmelzen und Verknüpfungen verwenden:

mgrp <- melt(groups, id.vars = "group")[!is.na(value)]
setkey(mgrp, variable, value)
for (i in seq_along(groups$group)) {
  let = groups$group[i]
  set(
    groups, 
    i = i, 
    j = "inei", 
    value = list(mgrp[mgrp[group == let], setdiff(unique(group), let)])
  )
}

groups
#    group code_1 code_2 code_3    inei
# 1:     A      2     NA      4 B,C,D,E
# 2:     B      2      3      1 A,C,D,F
# 3:     C      2     NA      1   A,B,F
# 4:     D      7      3      4   B,A,E
# 5:     E      8     NA      4     A,D
# 6:     F     NA     NA      1     B,C
# 7:     G      5      2      8       

Dies ist inspiriert von @ sindri_baldurs Schmelze. Diese Lösung:

1. Schmelzt die Gruppen
2. Führt eine kartesische Selbstverbindung durch.
3. Fügt alle übereinstimmenden Gruppen zusammen.
4. Verbindet sich wieder mit dem ursprünglichen DT

library(data.table)
#> Warning: package 'data.table' was built under R version 3.6.2
groups <- data.table(group = c("A", "B", "C", "D", "E", "F", "G"), code_1 = c(2,2,2,7,8,NA,5), code_2 = c(NA,3,NA,3,NA,NA,2), code_3=c(4,1,1,4,4,1,8))

molten_grps = melt(groups, measure.vars = patterns("code"), na.rm = TRUE)

inei_dt = molten_grps[molten_grps,
            on = .(variable, value),
            allow.cartesian = TRUE
            ][,
              .(inei = paste0(setdiff(i.group, .BY[[1L]]), collapse = ", ")),
              by = group]

groups[inei_dt, on = .(group), inei := inei]

groups
#>     group code_1 code_2 code_3       inei
#>    <char>  <num>  <num>  <num>     <char>
#> 1:      A      2     NA      4 B, C, D, E
#> 2:      B      2      3      1 A, C, D, F
#> 3:      C      2     NA      1    A, B, F
#> 4:      D      7      3      4    B, A, E
#> 5:      E      8     NA      4       A, D
#> 6:      F     NA     NA      1       B, C
#> 7:      G      5      2      8

Wie von zx8754 erwähnt, data.table::meltmit combnund dannigraph::as_adjacency_matrix

library(data.table)
df <- melt(groups, id.vars="group", na.rm=TRUE)[,
    if (.N > 1L) transpose(combn(group, 2L, simplify=FALSE)), value][, (1) := NULL]

library(igraph)
as_adjacency_matrix(graph_from_data_frame(df, FALSE))

Ausgabe:

7 x 7 sparse Matrix of class "dgCMatrix"
  A B C E D G F
A . 1 1 1 1 1 .
B 1 . 2 . 1 1 1
C 1 2 . . . 1 1
E 1 . . . 1 1 .
D 1 1 . 1 . . .
G 1 1 1 1 . . .
F . 1 1 . . . .

oder ohne zu benutzen igraph

x <- df[, unique(c(V1, V2))]
df <- rbindlist(list(df, data.table(x, x)))
tab <- table(df)   #or xtabs(~ V1 + V2, data=df)
ans <- t(tab) + tab
diag(ans) <- 0L
ans

Ausgabe:

   V1
V2  A B C D E F G
  A 0 1 1 1 1 0 1
  B 1 0 2 1 0 1 1
  C 1 2 0 0 0 1 1
  D 1 1 0 0 1 0 0
  E 1 0 0 1 0 0 1
  F 0 1 1 0 0 0 0
  G 1 1 1 0 1 0 0