Encuentre vecinos inmediatos por grupo utilizando la tabla de datos o igraph

14

Tengo un 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

Lo que me gustaría lograr es que cada grupo encuentre a los vecinos inmediatos según los códigos disponibles. Por ejemplo: el grupo A tiene grupos vecinos inmediatos B, C debido al código_1 (código_1 es igual a 2 en todos los grupos) y tiene grupos vecinos inmediatos D, E debido al código_3 (código_3 es igual a 4 en todos esos grupos).

Lo que probé es para cada código, subconjustando la primera columna (grupo) según las coincidencias de la siguiente manera:

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

Este "tipo" funciona, pero supongo que hay una forma más de tabla de datos de hacer esto. Lo intenté

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

Pero esto no funciona.

¿Me estoy perdiendo algún truco obvio de la tabla de datos para manejarlo?

El resultado de mi caso ideal sería el siguiente (que actualmente requeriría usar mi método para las 3 columnas y luego concatenar los resultados):

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 
— Usuario2321
fuente
Podría hacerse usando igraph.
— zx8754
1
Mi objetivo es alimentar el resultado a igraph para crear una matriz de adyacencia. Si me falta alguna funcionalidad que lo haga, por favor, apúnteme, ¡sería realmente útil!
— Usuario2321
1
@ zx8754 por favor considere publicar una solución que involucre igraph, podría ser realmente interesante.
— tmfmnk
@tmfmnk publicó, aunque pensó que podría haber una mejor forma igraph de hacerlo.
— zx8754

Respuestas:

10

Usando igraph , obtenga vecinos de segundo grado, suelte nodos numéricos, pegue los nodos restantes.

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

Más información

Así es como se ven nuestros datos antes de convertirlos en un objeto igraph. Queremos asegurarnos de que el código1 con valor 2 sea diferente del código2 con valor 2, etc.

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

Así es como se ve nuestra red: ingrese la descripción de la imagen aquí

Tenga en cuenta que los A..Gnodos siempre están conectados a través decode_x_y . Por lo tanto, necesitamos obtener el segundo grado, ego(..., order = 2)nos da vecinos hasta incluir vecinos de segundo grado y devuelve un objeto de lista.

Para obtener los nombres:

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"

Para embellecer el resultado, necesitamos eliminar los code_x_ynodos y el nodo de origen (primer nodo)

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
fuente
Sin ser un experto en igraph, esto se ve realmente extraño. Parece que funciona :) Si lo entiendo correctamente, primero crea un gráfico donde los códigos son los vecinos inmediatos y luego encuentra los vecinos inmediatos reales como los segundos vecinos de ese gráfico.
— Usuario2321
@ User2321 agregó más información, espero que sea más claro.
— zx8754
1
@ User2321 por cierto no es experto en absoluto, solo me gusta resolver problemas de igraph a veces. Todavía estoy esperando que algún experto sugiera una mejor manera.
— zx8754
1
Sí, estoy considerando ofrecer una recompensa por si acaso. Pero veamos en 2 días :)
— Usuario2321
7

Probablemente exista una forma más práctica de lograr esto, pero podría hacer algo como esto, utilizando fusiones y uniones:

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
fuente
5

Esto está inspirado en la fusión de @ sindri_baldur. Esta solución:

  1. Derrite los grupos
  2. Realiza una auto-unión cartesiana.
  3. Pega todos los grupos que coinciden.
  4. Vuelve al DT original.
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
— Col
fuente
5

Como se menciona por zx8754, usando data.table::meltcon combny luegoigraph::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))

salida:

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

o sin usar 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

salida:

   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
fuente
1
¿Podría xtabscrear una salida similar al igraphpaso?
— Cole
Esta es una respuesta realmente útil y (a mis ojos) elegante, ¡gracias!
— Usuario2321
@Cole, sí puede usar tableoxtabs
— chinsoon12
Al usar nuestro sitio, usted reconoce que ha leído y comprende nuestra Política de Cookies y Política de Privacidad.
Licensed under cc by-sa 3.0 with attribution required.