Iterating through all df column pairs and counting non-zero intersections - r

Question

I have a ~15000*1000 dataframe, where each column represents an individual, and each row represents the incidence of a trait (0 or 1).
I want to efficiently compare all pairs of columns, and generate a comma separated list of all mutual traits (row names) for all possible pairs.
Currently, I am looping through all the columns via combn, and pasting mutual row names into a string. That's to say I have a solution, however, it is very, very slow (probably quadratic with column number).
Is there a way to vectorise this problem/approach it with tidyr/dplyr etc.? I can't seem to find a way.
For example:
------|individual1 | individual2 | individual3 | ...
trait1| 0 | 1 | 1 | ...
trait2| 0 | 0 | 0 | ...
trait3| 1 | 1 | 1 | ...
... | ... | ... | ... | ...
Yields the string trait1,trait3 for the pair individual 2 and individual 3.
Thanks!
Toy data (the actual data is too sparse just to pull a subset):
df <- data.frame(trait = c("a", "b", "c", "d", "e"), ind1 = c(0, 1, 1, 0, 1), ind2 = c(1, 0, 1, 0, 1), ind3 = c(1, 0, 1, 1, 1))

Answer 1

Try to apply a custom function on each combination of columns. Maybe the efficiency can be improved a little.
t(combn(1:(ncol(df)-1), 2, function(x){
string <- paste(df$trait[df[[x[1]+1]] == 1 & df[[x[2]+1]] == 1], collapse = ",")
c(names(df)[x+1], string)
}))
# [,1] [,2] [,3]
# [1,] "Alice" "Bob" "c,e"
# [2,] "Alice" "Charlie" "c,e"
# [3,] "Bob" "Charlie" "a,c,e"
Data
df <- data.frame(trait = c("a", "b", "c", "d", "e"),
Alice = c(0, 1, 1, 0, 1),
Bob = c(1, 0, 1, 0, 1),
Charlie = c(1, 0, 1, 1, 1))

Answer 2

Although this question has an accepted answer, I would like to suggest a different approach which uses dplyr and tidyr as well as a data.table variant.
Whenever column names are treated as data items this indicates that the dataset is stored in an untidy format, IMHO. Reshaping the data into long format will allow to apply the usual data manipulations like joining, grouping, aggregating.
dplyr and tidyr
library(dplyr)
library(tidyr)
df %>%
pivot_longer(!"trait") %>%
filter(value == 1L) %>%
select(-value) %>%
inner_join(., ., by = "trait") %>%
filter(name.x < name.y) %>%
group_by(name.x, name.y) %>%
summarise(traits = toString(trait)) %>%
ungroup()
# A tibble: 3 x 3
name.x name.y traits
<chr> <chr> <chr>
1 Alice Bob c, e
2 Alice Charlie c, e
3 Bob Charlie a, c, e
Explanation
df %>%
pivot_longer(!"trait") %>%
filter(value == 1L)
reshapes the data into long format which is compact representation of the original matrix in wide format:
# A tibble: 10 x 3
trait name value
<fct> <chr> <dbl>
1 a Bob 1
2 a Charlie 1
3 b Alice 1
4 c Alice 1
5 c Bob 1
6 c Charlie 1
7 d Charlie 1
8 e Alice 1
9 e Bob 1
10 e Charlie 1
The value column is dropped as it is no longer needed. Then, the long data is joined with itself to find all names which match on trait. The result includes pairs of names which are given in a different order, e.g., (Alice, Bob) and (Bob, ALice) as well as duplicates names, e.g., (Bob, Bob). These are removed.
Finally, the data are grouped and summarised.
data.table
The data.table variant implements the same approach but has the advantage to allow for a non-equi self-join which reduces the number of rows directly in the join instead of a subsequent filtering step.
library(data.table)
long <- melt(setDT(df), id.vars = "trait", variable.name = "name")[value == 1]
long[long, on = .(trait, name < name), .(name1 = x.name, name2 = i.name, trait), nomatch = NULL][
, .(traits = toString(trait)), keyby = .(name1, name2)]
name1 name2 traits
1: Alice Bob c, e
2: Alice Charlie c, e
3: Bob Charlie a, c, e