Count co-occurences across groups

user_6149975 0
Viewed 120

I would like to count co-occurences of a variable across groups. I'm sure there's an easy {dplyr}/{tidyr} solution with count or pivot_ but I'm stuck. Thank you for your help! Below is a reprex of my input and potential output (I don't care about the format of the output, could also be a contingency table). Note that order of the variable does not matter, i.e., "green" then "blue" is the same as "blue" then "green".

library(dplyr)

df_in <- tribble(
  ~id, ~color,
  1, "green",
  1, "blue",
  2, "blue",
  2, "green",
  3, "blue",
  3, "red"
)

df_out <- tribble(
  ~colors, ~n,
  "blue-green", 2,
  "blue-red", 1
)

Or as a contingency table: | | blue |green|red| | ----- | - | - | - | | blue | - | 2 | 1 | | green | 2 | - | 0 | | red | 1 | 0 | - |

contingency tidyr dplyr count r
4 Answers

You can try

library(tidyverse)
df_in %>% 
 group_by(id) %>% 
 summarise(color = toString(sort(color)), .groups = "drop") %>%
 count(color)
# A tibble: 2 x 2
color           n
<chr>        <dbl>
1 blue, green     2
2 blue, red       1

Instead of using toString you can use paste with collapse="-" or glue::glue_collapse(sort(color), sep = "-") of course. In addition I added a sort if the colors are not similar ordered within the groups.

user_48706950

Here's a one-liner in base R:

as.data.frame(table(
                 sapply( split(df_in, df_in$id), 
                      function(d) paste( sort(d$color), sep="", collapse="-") ) )
              )
#---------------------------------
        Var1 Freq
1 blue-green    2
2   blue-red    1

If you are happy with a contingency table then take off the as.data.frame call:

table( sapply( split(df_in, df_in$id), 
             function(d) paste( sort(d$color), sep="", collapse="-")))
#------------------
blue-green   blue-red 
         2          1

The problem I see with any of the solutions so far is that there is no "pair creation". Your example may or may not represent the most complex possible inputs. If there are three distinct items in a split based on id, then you have not specified how these should be handled.

user_18556770

Here is one using the widyr package:

library(widyr)
df_in %>% 
  pairwise_count(color, id, upper = TRUE) %>%
  # remove pairs with same colours
  rowwise() %>% 
  mutate(pairs = toString(sort(c(item1, item2)))) %>% 
  ungroup() %>% 
  filter(!duplicated(pairs))
#> # A tibble: 2 × 4
#>   item1 item2     n pairs      
#>   <chr> <chr> <dbl> <chr>      
#> 1 blue  green     2 blue, green
#> 2 red   blue      1 blue, red

Created on 2021-08-16 by the reprex package (v2.0.0)

widyr is a neat little package that provides functions for tidy data which are "mathematically convenient on wide matrices" and then turns the results back into a tidy format. The package is in my experience quite fast and convenient.

user_50288410

We can get the adjacency matrix, A, using table and crossprod, also show it in long form and then show the graph using the igraph package.

A <- crossprod(table(df_in))
diag(A) <- 0

A # as symmetric matrix
##        color
## color   blue green red
##   blue     0     2   1
##   green    2     0   0
##   red      1     0   0

A[upper.tri(A)] <- 0
A  # lower triangular matrix
##        color
## color   blue green red
##   blue     0     0   0
##   green    2     0   0
##   red      1     0   0

A |>
  as.data.frame.table() |>
  subset(Freq > 0) |>
  with(data.frame(pairs = paste(color, color.1, sep = "-"), n = Freq))
##        pairs n
## 1 green-blue 2
## 2   red-blue 1

Plot graph

library(igraph)
g <- graph_from_adjacency_matrix(A, "undirected")

# combine parallel edges
E(g)$weight <- 1
gg <- simplify(g, edge.attr.comb = list(weight = "sum"))

set.seed(123)
plot(gg, vertex.size = 30, edge.label = E(gg)$weight, 
  vertex.color = adjustcolor(names(V(gg)), 0.5))

screenshot

user_5165480
Related