Vrftsjtryk

I have a DataFrame, df.

n is a column denoting the number of groups in the x column.
x is a column containing the comma-separated groups.

df <- data.frame(n = c(2, 3, 2, 2), 

                 x = c("a, b", "a, c, d", "c, d", "d, b"))



> df

n        x

2     a, b

3  a, c, d

2     c, d

2     d, b

I would like to convert this DataFrame into a weights matrix where the row and column names are the unique values of the groups in df$c, and the elements represent the number of times each of the groups appear together in df$c.

The output should look like this:

m <- matrix(c(0, 1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 2, 1, 1, 2, 0), nrow = 4, ncol = 4)

rownames(m) <- letters[1:4]; colnames(m) <- letters[1:4]



> m

  a b c d

a 0 1 1 1

b 1 0 0 1

c 1 0 0 2

d 1 1 2 0

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

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