Temukan tetangga langsung dengan grup menggunakan tabel data atau igraph

14

Saya punya data.tabel :

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

Apa yang ingin saya capai, adalah untuk setiap kelompok untuk menemukan tetangga terdekat berdasarkan kode yang tersedia. Misalnya: Grup A memiliki grup tetangga langsung B, C karena kode_1 (kode_1 sama dengan 2 di semua grup) dan memiliki grup tetangga langsung D, E karena kode_3 (kode_3 sama dengan 4 di semua grup itu).

Apa yang saya coba adalah untuk setiap kode, dengan mengelompokkan kolom (grup) pertama berdasarkan kecocokan sebagai berikut:

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

Ini "agak" bekerja tetapi saya akan berasumsi ada lebih banyak jenis tabel data cara melakukan ini. Saya mencoba

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

Tetapi ini tidak berhasil.

Apakah saya kehilangan beberapa trik tabel data yang jelas untuk menghadapinya?

Hasil kasus ideal saya akan terlihat seperti ini (yang saat ini akan membutuhkan menggunakan metode saya untuk semua 3 kolom dan kemudian merangkai hasilnya):

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
sumber
Bisa dilakukan menggunakan igraph.
— zx8754
1
Tujuan saya adalah untuk memberi makan hasil ke igraph untuk membuat matriks adjacency. Jika saya kehilangan beberapa fungsionalitas yang akan melakukannya tolong arahkan saya ke sana, itu akan sangat membantu!
— User2321
1
@ zx8754 tolong pertimbangkan memposting solusi yang melibatkan igraph, itu bisa sangat menarik.
— tmfmnk
@ tmfmnk diposting, meskipun berpikir mungkin ada cara igraph yang lebih baik untuk melakukannya.
— zx8754

Jawaban:

10

Menggunakan igraph , dapatkan tetangga tingkat 2, drop node numerik, rekatkan node yang tersisa.

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

Info lebih lanjut

Beginilah tampilan data kami sebelum mengonversi ke objek igraph. Kami ingin memastikan kode1 dengan nilai 2 berbeda dari kode2 dengan nilai 2, dll.

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

Begini tampilannya jaringan kami: masukkan deskripsi gambar di sini

Perhatikan bahwa A..Gnode selalu terhubung melalui code_x_y. Jadi kita perlu mendapatkan gelar ke-2, ego(..., order = 2)memberi kita tetangga untuk menyertakan tetangga tingkat ke-2, dan mengembalikan objek daftar.

Untuk mendapatkan nama:

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"

Untuk memastikan hasil, kita perlu menghapus code_x_ynode dan node asal (1st node)

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
sumber
Tanpa menjadi ahli dalam igraph, ini terlihat sangat aneh. Tampaknya berfungsi :) Jika saya memahaminya dengan benar itu pertama kali membuat grafik di mana kode adalah tetangga langsung dan kemudian menemukan tetangga langsung yang sebenarnya sebagai tetangga kedua dari grafik itu?
— User2321
@ User2321 menambahkan info lebih lanjut, harap ini lebih jelas.
— zx8754
1
@ User2321 btw tidak ahli sama sekali, hanya ingin menyelesaikan masalah igraph kadang-kadang. Masih menunggu beberapa pakar menyarankan cara yang lebih baik.
— zx8754
1
Ya saya sedang mempertimbangkan menawarkan hadiah untuk berjaga-jaga. Tapi mari kita lihat dalam 2 hari :)
— User2321
7

Mungkin ada beberapa cara yang lebih praktis untuk mencapai ini, tetapi Anda bisa melakukan sesuatu seperti ini, menggunakan meleleh dan bergabung:

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

Ini terinspirasi oleh lelehan @ sindri_baldur. Solusi ini:

  1. Melelehkan kelompok
  2. Melakukan penggabungan diri kartesian.
  3. Rekatkan semua grup yang cocok.
  4. Bergabung kembali ke DT asli
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
sumber
5

Seperti yang disebutkan oleh zx8754, menggunakan data.table::melt dengan combndan kemudianigraph::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))

keluaran:

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

atau tanpa menggunakan 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

keluaran:

   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
sumber
1
Bisakah xtabsmembuat output yang serupa sebagai igraphlangkahnya?
— Cole
Ini adalah jawaban yang sangat membantu dan elegan (bagi saya), terima kasih!
— User2321
@Cole, ya bisa menggunakan tableatauxtabs
— chinsoon12
Dengan menggunakan situs kami, Anda mengakui telah membaca dan memahami Kebijakan Cookie dan Kebijakan Privasi kami.
Licensed under cc by-sa 3.0 with attribution required.