Finden Sie unmittelbare Nachbarn nach Gruppe mithilfe von Datentabelle oder igraph

14

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
r  data.table  igraph 
— User2321
quelle
Könnte mit igraph gemacht werden.
— zx8754
1
Mein Ziel ist es, das Ergebnis igraph zuzuführen, um eine Adjazenzmatrix zu erstellen. Wenn mir eine Funktionalität fehlt, die dies tun würde, weisen Sie mich bitte darauf hin, das wäre wirklich hilfreich!
— User2321
1
@ zx8754 Bitte überlegen Sie, eine Lösung zu veröffentlichen igraph, die wirklich interessant sein könnte.
— tmfmnk
@tmfmnk hat gepostet, obwohl ich denke, dass es einen besseren igraph-Weg gibt, dies zu tun.
— zx8754

Antworten:

10

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: Geben Sie hier die Bildbeschreibung ein

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"       ""
— zx8754
quelle
Ohne ein Experte für Igraph zu sein, sieht das wirklich seltsam aus. Es scheint zu funktionieren :) Wenn ich es richtig verstehe, erstellt es zuerst ein Diagramm, in dem die Codes die unmittelbaren Nachbarn sind, und findet dann die tatsächlichen unmittelbaren Nachbarn als die zweiten Nachbarn aus diesem Diagramm?
— User2321
@ User2321 hat weitere Infos hinzugefügt, hoffe es ist klarer.
— zx8754
1
@ User2321 übrigens überhaupt kein Experte, mag es einfach manchmal, igraph Probleme zu lösen. Ich warte immer noch auf einen Experten, der einen besseren Weg vorschlägt.
— zx8754
1
Ja, ich denke darüber nach, für alle Fälle ein Kopfgeld anzubieten. Aber mal sehen in 2 Tagen :)
— User2321
7

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
— sindri_baldur
quelle
5

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
— Cole
quelle
5

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
— chinsoon12
quelle
1
Könnte xtabseine ähnliche Ausgabe wie der igraphSchritt erstellen ?
— Cole
Dies ist eine wirklich hilfreiche und (für meine Augen) elegante Antwort, danke!
— User2321
@Cole, ja kann tableoderxtabs
— chinsoon12
Durch die Nutzung unserer Website bestätigen Sie, dass Sie unsere Cookie-Richtlinie und Datenschutzrichtlinie gelesen und verstanden haben.
Licensed under cc by-sa 3.0 with attribution required.