Count unique values of a column by pairwise combinations of another column in R

Question

Let's say I have the following data frame:

I would like to get the count of unique values of the column "ID" by pairwise combinations of the column "Code":

  Code.Combinations Count.of.ID
1              A, B           2
2              A, C           2
3              A, D           1
4              B, C           3
5              B, D           3
6              C, D           2

I have searched for solution(s) online, so far haven't been able to achieve the desired result. Any help would be appreciated. Thanks!

score 4 · Accepted Answer · answered Jul 12 '16 at 17:08

4

Here is a data.table way to solve the problem. Use combn function to pick up all possible combinations of Code and then count ID for each unique CodeComb:

library(data.table)
setDT(df)[, .(CodeComb = sapply(combn(Code, 2, simplify = F), 
                                function(cmb) paste(sort(cmb), collapse = ", "))), .(ID)]
# list all combinations of Code for each ID
         [, .(IdCount = .N), .(CodeComb)]    
# count number of unique id for each code combination

#    CodeComb IdCount
# 1:     A, B       2
# 2:     A, C       2
# 3:     B, C       3
# 4:     B, D       3
# 5:     C, D       2
# 6:     A, D       1

answered Jul 12 '16 at 17:08

Psidom

209,562
33
339
356

I pasted your code and I can't get it to work. The first part is fine, however the line `[, .(IdCount = .N), .(CodeComb)]` is returning `Error: unexpected '[' in "["` – Joseph Wood Jul 12 '16 at 17:14
Try this. `setDT(df)[, .(CodeComb = sapply(combn(Code, 2, simplify = F), function(cmb) paste(sort(cmb), collapse = ", "))), .(ID)][, .(IdCount = .N), .(CodeComb)]`. Sometimes the paste and run gives errors. – Psidom Jul 12 '16 at 17:17
Thanks, need to familiarize myself more with data.table – sharmanas Jul 12 '16 at 18:03

Carl · Answer 2 · 2016-07-12T18:07:07.623

3

Assuming your data.frame is named df and using dplyr

df %>% full_join(df, by="ID") %>% group_by(Code.x,Code.y) %>% summarise(length(unique(ID))) %>% filter(Code.x!=Code.y)

Join the df with itself and then count by the groups

edited Jul 12 '16 at 18:07

answered Jul 12 '16 at 17:01

Carl

5,569
6
39
74

When I try your code, I don't get the correct results. Some rows that should be counted as the same (e.g. row 4 and 13 from the result of the above code) are separate (row 4 is A D and row 13 is D A). Also, there are some that shouldn't show up at all (e.g. row 16 -->> D D), this is mixing ID. – Joseph Wood Jul 12 '16 at 17:58
I added an extra filter for you – Carl Jul 12 '16 at 18:09
There is still something missing. If I set your code equal to `myDf` and subsequently subset like so: `myDf[-c(4,7,8,10,11,12), ]`, I obtain the correct solution for the example given in the question. I've played around with your solution for a little bit, and I really think this could be super awesome if you could figure out a way to remove duplicate entries (in terms of combinations i.e. AB and BA are the same, but it is getting listed separately). – Joseph Wood Jul 12 '16 at 18:46
Check out my updated solution. With a little altering, your approach is the fastest!! +1 – Joseph Wood Jul 12 '16 at 19:15
Great alternative to data.table approach! – sharmanas Jul 12 '16 at 21:22

Joseph Wood · Answer 3 · 2016-07-12T19:42:07.940

Below makes use of combinations from the gtools package as well as count from the plyr package.

library(gtools)
library(plyr)

PairWiseCombo <- function(df) {
    myID <- df$ID
    BreakDown <- rle(myID)
    Unis <- BreakDown$values
    numUnis <- BreakDown$lengths
    Len <- length(Unis)
    e <- cumsum(numUnis)
    s <- c(1L, e + 1L)

    ## more efficient to generate outside of the "do.call(c, lapply(.."
    ## below. This allows me to reference a particular combination 
    ## rather than re-generating the same combination multiple times
    myCombs <- lapply(2:max(numUnis), function(x) combinations(x,2L))

    tempDF <- plyr::count(do.call(c, lapply(1:Len, function(i) {
                myRange <- s[i]:e[i]
                combs <- myCombs[[numUnis[i]-1L]]
                vapply(1:nrow(combs), function(j) paste(sort(df$Code[myRange[combs[j,]]]), collapse = ","), "A,D")
              })))

    names(tempDF) <- c("Code.Combinations", "Count.of.ID")
    tempDF
}

Below are some metrics. I didn't test the solution by @Carl as it was giving different results than the other solutions.

set.seed(537)
ID <- do.call(c, lapply(1:100, function(x) rep(x, sample(2:26,1))))
temp <- rle(ID)
Code <- do.call(c, lapply(1:100, function(x) LETTERS[sample(temp$lengths[x])]))
TestDF <- data.frame(ID, Code, stringsAsFactors = FALSE)

system.time(t1 <- Noah(TestDF))
 user  system elapsed 
97.05    0.31   97.42

system.time(t2 <- DTSolution(TestDF))
 user  system elapsed 
0.43    0.00    0.42

system.time(t3 <- PairWiseCombo(TestDF))
 user  system elapsed 
0.42    0.00    0.42

identical(sort(t3[,2]),sort(t2$IdCount))
TRUE

identical(sort(t3[,2]),sort(t1[,2]))
TRUE

Using microbenchmark we have:

library(microbenchmark)
microbenchmark(Joseph = PairWiseCombo(TestDF), Psidom = DTSolution(TestDF), times = 10L)
Unit: milliseconds
  expr      min       lq     mean   median       uq      max neval
Joseph 420.1090 433.9471 442.0133 446.4880 450.4420 452.7852    10
Psidom 396.8444 413.4933 416.3315 418.5573 420.9669 423.6303    10

Overall, the data.table solution provided by @Psidom was the fastest (not surprisingly). Both my solution and the data.table solution performed similarly on really large examples. However, the solution provided from @Noah is extremely memory intensive and couldn't be tested on larger data frames.

sessionInfo()
R version 3.3.0 (2016-05-03)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Update After tweaking @Carl's solution, the dplyr approach is by far the fastest. Below is the code (you will see what parts I altered):

DPLYRSolution <- function(df) {
    df <- df %>% full_join(df, by="ID") %>% group_by(Code.x,Code.y) %>% summarise(length(unique(ID))) %>% filter(Code.x!=Code.y)

    ## These two lines were added by me to remove "duplicate" rows
    df <- mutate(df, Code=ifelse(Code.x < Code.y, paste(Code.x, Code.y), paste(Code.y, Code.x)))
    df[which(!duplicated(df$Code)), ]
}

Below are the new metrics:

system.time(t4 <- DPLYRSolution(TestDF))
 user  system elapsed 
 0.03    0.00    0.03     ### Wow!!! really fast

microbenchmark(Joseph = PairWiseCombo(TestDF), Psidom = DTSolution(TestDF),
               Carl = DPLYRSolution(TestDF), times = 10L)
Unit: milliseconds
  expr       min       lq      mean    median        uq       max neval
Joseph 437.87235 442.7348 450.91085 452.77204 457.09465 461.85035    10
Psidom 407.81519 416.9444 422.62793 425.26041 429.02064 434.38881    10
  Carl  44.33698  44.8066  48.39051  45.35073  54.06513  59.35653    10

## Equality Check
identical(sort(c(t4[,3])[[1]]), sort(t1[,2]))
[1] TRUE

score 2 · Answer 4 · answered Jul 12 '16 at 17:28

Using base only:

df <- data.frame(ID=c(1,1,1,2,2,2,3,3,3,3,4,4), 
                 code=c("A", "B", "C", "B", "C", "D", "C", "A", "D", "B", "D", "B"), stringsAsFactors =FALSE)
# Create data.frame of unique combinations of codes
e <- expand.grid(df$code, df$code)
e <- e[e[,1]!=e[,2],]
e1 <- as.data.frame(unique(t(apply(e, 1, sort))), stringsAsFactors = FALSE)

# Count the occurrence of each code combination across IDs
e1$count <- apply(e1, 1, function(y) 
                  sum(sapply(unique(df$ID), function(x) 
                             sum(y[1] %in% df$code[df$ID==x] & y[2] %in% df$code[df$ID==x]))))

# Turn the codes into a string and print output
out <- data.frame(Code.Combinations=do.call(paste, c(e1[,1:2], sep=", ")),
                  Count.of.ID=e1$count, stringsAsFactors = FALSE)


out
#   Code.Combinations Count.of.ID
# 1              A, B           2
# 2              A, C           2
# 3              A, D           1
# 4              B, C           3
# 5              B, D           3
# 6              C, D           2

Count unique values of a column by pairwise combinations of another column in R

4 Answers4

Linked