How do I match a group of observations with a dyad? - r

Question

Say I have a data frame with a list of names and the companies they have as clients:
name <- c("Anne", "Anne", "Mary", "Mary", "Mary", "Joe", "Joe", "Joe", "David", "David", "David", "David", "David")
company <- c("A", "B", "C", "D", "E", "A", "B", "C", "D", "E", "F", "G", "H")
df1 <- data.frame(name, company)
Then I have a second data frame where I have companies who are working together on projects:
company1 <- c("A", "B", "C", "D", "E", "F", "G", "H")
company2 <- c("B", "C", "E", "E", "G", "A", "B", "C")
df2 <- data.frame(company1, company2)
My preferred outcome would be something like this:
name A B C D E F G No of sets
1 Anne 1 1 0 0 0 0 0 1
2 David 0 0 0 1 1 1 1 1
3 Joe 1 1 1 0 0 0 0 2
4 Mary 0 0 1 1 1 0 0 1
So this counts the number of "sets" that match the sets in df2. For example, Anne has A and B with 1s, and it matches row 1 in df2. Joe has A, B, C, and both A and B and B and C are rows in df2, thus Joe's row has two matches.

Answer 1

I think this might work for you. Let me know. It doesn't match your expected result because you didn't include H, which I presumed to be a typo? Likewise, should Mary's No_of_sets also equal 2?
# Tabulate the frequency of name x company combinations
r <- as.data.frame.matrix(table(df1$name, df1$company))
r
#> A B C D E F G H
#> Anne 1 1 0 0 0 0 0 0
#> David 0 0 0 1 1 1 1 1
#> Joe 1 1 1 0 0 0 0 0
#> Mary 0 0 1 1 1 0 0 0
# Get "sets" of companies working together
s <- paste(df2$company1, df2$company2)
s
#> [1] "A B" "B C" "C E" "D E" "E G" "F A" "G B" "H C"
# Get all potential company sets associated with each name
m <- apply(r, MARGIN = 1, FUN = function(x) combn(names(which(x==1)), 2))
# Intersect sets of companies potentially working together (m) with
# companies actually working together (df2)
# (You could use a nested apply here, but I thought that it
# would be too opaque. Looping is a little more clear.)
for(name in rownames(r)){
pairs <- m[[name]]
ppairs <- apply(pairs, 2, paste0, collapse = " ")
r[which(rownames(r)==name),"No_of_sets"] <- length(intersect(ppairs, s))
}
r
#> A B C D E F G H No_of_sets
#> Anne 1 1 0 0 0 0 0 0 1
#> David 0 0 0 1 1 1 1 1 2
#> Joe 1 1 1 0 0 0 0 0 2
#> Mary 0 0 1 1 1 0 0 0 2
Created on 2021-10-19 by the reprex package (v2.0.1)
Edit: Let's say there's a chance that one name isn't working with more than one company. In that case, you'd need to add a conditional to account for this in both steps. First, new data... notice that the name "Solo" is only working with one company.
r
#> A B C D E F G H
#> Anne 1 1 0 0 0 0 0 0
#> David 0 0 0 1 1 1 1 1
#> Joe 1 1 1 0 0 0 0 0
#> Mary 0 0 1 1 1 0 0 0
#> Solo 1 0 0 0 0 0 0 0
m <- apply(r, MARGIN = 1, FUN = function(x)
if(length(names(which(x==1)))>1) {
combn(names(which(x==1)), 2)
} else names(which(x==1))
)
m
#> $Anne
#> [,1]
#> [1,] "A"
#> [2,] "B"
#>
#> $David
#> [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
#> [1,] "D" "D" "D" "D" "E" "E" "E" "F" "F" "G"
#> [2,] "E" "F" "G" "H" "F" "G" "H" "G" "H" "H"
#>
#> $Joe
#> [,1] [,2] [,3]
#> [1,] "A" "A" "B"
#> [2,] "B" "C" "C"
#>
#> $Mary
#> [,1] [,2] [,3]
#> [1,] "C" "C" "D"
#> [2,] "D" "E" "E"
#>
#> $Solo
#> [1] "A"
for(name in rownames(r)){
pairs <- m[[name]]
if(length(pairs)>1){
ppairs <- apply(pairs, 2, paste0, collapse = " ")
} else ppairs <- pairs
r[which(rownames(r)==name),"No_of_sets"] <- length(intersect(ppairs, s))
}
r
#> A B C D E F G H No_of_sets
#> Anne 1 1 0 0 0 0 0 0 1
#> David 0 0 0 1 1 1 1 1 2
#> Joe 1 1 1 0 0 0 0 0 2
#> Mary 0 0 1 1 1 0 0 0 2
#> Solo 1 0 0 0 0 0 0 0 0