Is there a faster way of merging data frames and looping through combinations?

Question

I have two data frames:

dfA has 10 observations per row.
dfB has the corresponding price on all the individual observations.

My task is to look at any 2 rows in dfA, figure out which elements are in both rows, sum up the price of the matching items, and store the results in new dataframe, dfC.

For example, say we have in dfA:

row 1: A, B, C, X, X, X, X, X, X, X  
row 2: Z, Z, A, Z, C, Z, Z, B, Z, Z

and in dfB:

A, 63  
B, 22  
C, 99  
...

The overlap in rows 1 and 2 is A, B, and C, so I'd want (63 + 22 + 99) / 1000 in dfC[1, 2] and dfC[2, 1].

The following code does what I need it do, but it is not efficient as n gets large. My actual dfA has over 1000 rows and it can take about 10 minutes to run, so I'm looking ways to write this more efficiently.

set.seed(42)
n <- 10
dfA <- data.frame(replicate(10 ,sample(LETTERS,n,rep=TRUE)), stringsAsFactors = F)
dfB <- data.frame(ID = LETTERS, Price = as.numeric(sample(1:100, 26, replace=FALSE)), stringsAsFactors = F)

overlapPrice <- function (A, B) {
        if (A == B) {
                return(1)
        } else {
                x <- intersect(t(dfA[A, ]), t(dfA[B, ]))     
                return(sum(dfB$Price[match(x, dfB$ID)])/1000)  
        }
}

dfC <- data.frame(matrix(vector(), n, n))    
for (i in (1:n)) {
        for (j in (i:n)) {
                dfC[i, j]  <-   overlapPrice(i, j)  
                dfC[j, i]  <-   dfC[i, j]  

        }
}

user_4497050 · Answer

Working across rows like this, it's quicker to turn dfA into a matrix, or else you're subsetting repeatedly from all the vectors that make up the data frame.

matA <- as.matrix(dfA)

Next, let's use combn, which will only create each pairing once, so you're not calculating each combination twice. combn() can take a function to run on each combination, where the function takes a vector of what combn would otherwise output, e.g.

str(combn(seq(3), 2, simplify = FALSE))
#> List of 3
#>  $ : int [1:2] 1 2
#>  $ : int [1:2] 1 3
#>  $ : int [1:2] 2 3
str(combn(seq(3), 2, function(x) rev(x), simplify = FALSE))
#> List of 3
#>  $ : int [1:2] 2 1
#>  $ : int [1:2] 3 1
#>  $ : int [1:2] 3 2

We can use this function to subset matA and do the calculations for each combination.

vecC <- combn(nrow(matA), 2, function(x) {
    row1 <- matA[x[1], ]
    row2 <- matA[x[2], ]
    sum(dfB$Price[match(intersect(row1, row2), dfB$ID)]) / 1000
})

vecC
#>  [1] 0.329 0.103 0.119 0.204 0.204 0.255 0.262 0.196 0.146 0.160 0.071 0.204
#> [13] 0.370 0.109 0.260 0.181 0.000 0.066 0.018 0.019 0.018 0.039 0.081 0.000
#> [25] 0.105 0.018 0.108 0.000 0.133 0.113 0.233 0.141 0.148 0.184 0.112 0.190
#> [37] 0.178 0.181 0.000 0.192 0.157 0.273 0.194 0.145 0.169

This result is equivalent to the lower triangle of dfC:

all(vecC == dfC[lower.tri(dfC)])
#> [1] TRUE

It's hard to see what goes with what, though, so let's turn it into a data frame of indices and values:

dfCi <- as.data.frame(t(combn(nrow(matA), 2)))
names(dfCi) <- c('i1', 'i2')
dfCi$value <- vecC

str(dfCi)
#> 'data.frame':    45 obs. of  3 variables:
#>  $ i1   : int  1 1 1 1 1 1 1 1 1 2 ...
#>  $ i2   : int  2 3 4 5 6 7 8 9 10 3 ...
#>  $ value: num [1:45(1d)] 0.329 0.103 0.119 0.204 0.204 0.255 0.262 0.196 0.146 0.16 ...

head(dfCi)
#>   i1 i2 value
#> 1  1  2 0.329
#> 2  1  3 0.103
#> 3  1  4 0.119
#> 4  1  5 0.204
#> 5  1  6 0.204
#> 6  1  7 0.255

If you want to reshape this to recreate a square matrix like dfC, you can:

# reverse indices to get points for opposite triangle
dfCiRev <- dfCi
dfCiRev[1:2] <- dfCi[2:1]
names(dfCiRev) <- names(dfCi)

# reshape to wide form (use `pivot_wider` or `reshape` or `dcast` or whatever you prefer)
matC <- as.matrix(tidyr::spread(rbind(dfCi, dfCiRev), i2, value, fill = 1)[-1])
dimnames(matC) <- rep(list(colnames(matA)), 2)

matC
#>        X1    X2    X3    X4    X5    X6    X7    X8    X9   X10
#> X1  1.000 0.329 0.103 0.119 0.204 0.204 0.255 0.262 0.196 0.146
#> X2  0.329 1.000 0.160 0.071 0.204 0.370 0.109 0.260 0.181 0.000
#> X3  0.103 0.160 1.000 0.066 0.018 0.019 0.018 0.039 0.081 0.000
#> X4  0.119 0.071 0.066 1.000 0.105 0.018 0.108 0.000 0.133 0.113
#> X5  0.204 0.204 0.018 0.105 1.000 0.233 0.141 0.148 0.184 0.112
#> X6  0.204 0.370 0.019 0.018 0.233 1.000 0.190 0.178 0.181 0.000
#> X7  0.255 0.109 0.018 0.108 0.141 0.190 1.000 0.192 0.157 0.273
#> X8  0.262 0.260 0.039 0.000 0.148 0.178 0.192 1.000 0.194 0.145
#> X9  0.196 0.181 0.081 0.133 0.184 0.181 0.157 0.194 1.000 0.169
#> X10 0.146 0.000 0.000 0.113 0.112 0.000 0.273 0.145 0.169 1.000

all(matC == as.matrix(dfC))
#> [1] TRUE

The best part is calculating vecC is quite a bit faster than dfC:

# A tibble: 3 x 13
  expression     min  median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory time  gc   
                       
1 original   36.14ms 37.85ms      24.4      63KB     2.03    12     1      493ms

user_3732271 · Answer

Using outer could speed up

f1 <- function(i, j) {
       x <- intersect(t(dfA[i, ]),  t(dfA[j, ]))
       sum(dfB$Price[match(x, dfB$ID)])/1000
    }
out <-  outer(seq_len(n), seq_len(n), FUN = Vectorize(f1))
diag(out) <- 1
all.equal(dfC, as.data.frame(out), check.attributes = FALSE)
#[1] TRUE

Is there a faster way of merging data frames and looping through combinations?

2 Answers