Convert a DataFrame into Adjacency/Weights Matrix in R
Here's a very rough and probably pretty inefficient solution using tidyverse
for wrangling and combinat
to generate permutations.
library(tidyverse)
library(combinat)
df <- data.frame(n = c(2, 3, 2, 2),
x = c("a, b", "a, c, d", "c, d", "d, b"))
df %>%
## Parse entries in x into distinct elements
mutate(split = map(x, str_split, pattern = ', '),
flat = flatten(split)) %>%
## Construct 2-element subsets of each set of elements
mutate(combn = map(flat, combn, 2, simplify = FALSE)) %>%
unnest(combn) %>%
## Construct permutations of the 2-element subsets
mutate(perm = map(combn, permn)) %>%
unnest(perm) %>%
## Parse the permutations into row and column indices
mutate(row = map_chr(perm, 1),
col = map_chr(perm, 2)) %>%
count(row, col) %>%
## Long to wide representation
spread(key = col, value = nn, fill = 0) %>%
## Coerce to matrix
column_to_rownames(var = 'row') %>%
as.matrix()
Using Base R, you could do something like below
a = strsplit(as.character(df$x),', ')
b = unique(unlist(a))
d = unlist(sapply(a,combn,2,toString))
e = data.frame(table(factor(d,c(paste(b,b,sep=','),combn(b,2,toString)))))
f = read.table(text = do.call(paste,c(sep =',', e)),sep=',',strip.white = T)
g = xtabs(V3~V1+V2,f)
g[lower.tri(g)] = t(g)[lower.tri(g)]
g
V2
V1 a b c d
a 0 1 1 1
b 1 0 0 0
c 1 0 0 2
d 1 0 2 0
Here is another possible approach using data.table
:
#generate the combis
combis <- df[, transpose(combn(sort(strsplit(x, ", ")[[1L]]), 2L, simplify=FALSE)),
by=1L:df[,.N]]
#create new rows for identical letters within a pair or any other missing combi
withDiag <- out[CJ(c(V1,V2), c(V1,V2), unique=TRUE), on=.(V1, V2)]
#duplicate the above for lower triangular part of the matrix
withLowerTri <- rbindlist(list(withDiag, withDiag[,.(df, V2, V1)]))
#pivot to get weights matrix
outDT <- dcast(withLowerTri, V1 ~ V2, function(x) sum(!is.na(x)), value.var="df")
outDT
output:
V1 a b c d
1: a 0 1 1 1
2: b 1 0 0 1
3: c 1 0 0 2
4: d 1 1 2 0
If matrix output is desired, then
mat <- as.matrix(outDT[, -1L])
rownames(mat) <- unlist(outDT[,1L])
output:
a b c d
a 0 1 1 1
b 1 0 0 1
c 1 0 0 2
d 1 1 2 0