Compare two different length data.frames in R [r]

Viewed 111

I'm having trouble trying to compare two different length data.frames i.e.

id<-c("a","b","c","d","e")
a<-c(2,4,20,8,7)
b<-c(1,3,4,7)
c<-c(3,6,9,12)
d1<-data.frame(id,a)
d2<-data.frame(b,c)

What I'm trying to do is sum the values of d2$c for each d1$id that fulfills the condition d1$a>=d2$b. I've been trying with dplyr by doing this.

d1<-mutate(d1, sumb = sum(ifelse(a>d2$b,d2$c,0)))

However I'm getting this

Warning message:
In a > d2$b :
  longer object length is not a multiple of shorter object length

I know it's incorrect using this code. I've checked tons, literally TONS of forums looking for the answer. The output I want should look something like this.

| id | a  | sumb| 
|----|----|-----|
| a  | 2  | 3   |
| b  | 4  | 9   |
| c  | 20 | 30  |

Just to explain for id="a", a=2. This a=2is only greater than the first value in d2$b[1]=1 so I just need the sum(d2$c[1])=3. However, for id="c", a=20. a=20 is greater than all the values in d2$b. Then I need the sum of all values in d2$c for id="c" which is sum(d2$c).

I hope this is clear enough for you to help me. Thanks!

4 Answers

Seems the most sensible method is using a cartesian join or a series of for-loops.

Using data.table's non-equi joins, we can obtain this by changing the data.frames to data.table, non-equi merge and then sum of the columns

id <- c("a", "b", "c", "d", "e")
a <- c(2, 4, 20, 8, 7)
b <- c(1, 3, 4, 7)
c <- c(3, 6, 9, 12)
d1 <- data.frame(id, a)
d2 <- data.frame(b, c)

library(data.table)
#Could have used "d1 <- data.table(id, a)" and "d2 <- data.table(b, c" instead of setDT
setDT(d1)
setDT(d2)

#Non-equi join, following by sum using dt[i, j, by, ...] syntax. (see link wiki in link)
d2[d1, on = .(b <= a), allow.cartesian = TRUE][, sum(c), by = id]

Edit: Workaround for 2e31+ rows

A problem that might occur when using cartesian joins is the vector length limitation of R. One possible work-around for this (and there are likely myriads) is to avoid joining altogether, and use the fast subsetting aspect of data.table, as shown below

setkey(d1, 'id')
d1[.(unique(id)), d2[a >= b, sum(c)], by = .EACHI]

explanation:

The query goes as follows:

  1. setkey(d1, 'id') reorders d1 according to id, which allows using the i argument.
  2. d1[.(unique(id))]: Once we've reordered we can utilize fast binary subsetting in the first argument. Here it is saying "give me all rows with id's contained in unique(id).
  3. While (2) seems unnecessary, it is necessary for the by = .EACHI argument, which lets data.table know we want to perform the action in j seperately for each i.
  4. letting j = d2[a >= b, sum(c)] performs all the calculations. data.table will automatically index a such that the comparison b <= a can be performed using binary search.

This should be somewhat if not much faster than subsetting using a regular for-loop. Albeit slower than using a cartesian join.

Edit: Alternative using Rcpp

Looking at the comment from @caalbarracinb, the number of summations to be done seems to be quit large, using either of these methods. Avoiding duplicate summation will speed up this calculation quite handsomely.
One method for doing this is to assume that a, and b are sorted in ascending order, and iterating over values in a smart way.
Below is my (likely quite inefficient) example of how one could achieve this with an Rcpp function.

#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export(rng=false)]]
NumericVector sumCompar(NumericVector a, NumericVector b, NumericVector c){
  // assumes b, a are sorted in ascending order according to sum.
  int na = a.length(), nb = b.length(), j = 0;
  NumericVector sums(na);
  auto sum = 0.0;
  // Iterate over a, sum over elements in b until a < b. 
  // Once this happens we've summed over all values in the specific category.
  for(int i = 0; i < na; ++i){
    while(j < nb){
      if(a(i) < b(j))
        break;
      sum += c(j);
      j++;
    }
    sums(i) = sum;
  }
  return sums;
}

which we can use as

aa <- d1[, .(a = max(a)), by = id][order(a), a]
idd <- d1[, .(a = max(a)), by = id][order(a), id]
bb <- d2[order(b), b]
cc <- d2[order(b), c]
data.table(id = idd, sum = sumCompar(a = aa, b = bb, c = cc))

Now to make a (horrible) comparison of speed, we could use microbenchmark:

microbenchmark::microbenchmark(
  cart_join = d2[d1, on = .(b <= a), allow.cartesian = TRUE][, sum(c), by = id],
  subset = d1[.(unique(id)), d2[a >= b, sum(c)], by = .EACHI],
  rcpp = {
    out <- data.table(id = d1[, id[1L], by = id]$id, 
                      sum = sumCompar(a = aa, b = bb, c = cc))
  }
)
#output:
Unit: microseconds
      expr      min        lq     mean   median       uq       max neval
 cart_join 2224.201 2457.6510 3972.440 3063.801 5195.200 12475.101   100
    subset 3251.001 3573.3510 5638.339 3994.851 7969.900 13460.502   100
      rcpp  530.701  645.3015 1055.473  735.201 1016.551  9147.501   100

And looking at the median time, we can see the Rcpp implementation is quite a bit faster in this example.

But the important thing here, is that this speed difference will be much greater for larger inputs, as it does not have to perform unnecessary comparisons as a, b and c are assumed to have the correct order.

Apply a function computing the sums to each element of d1$a.

fun <- function(x, y) sum(y[x > y])
d1$sumb <- sapply(d1$a, fun, y = d2$c)

This can be rewritten as a one-liner, with an anonymous function.

d1$sumb <- sapply(d1$a, function(x) sum(d2$c[x > d2$b]))

Try this:

library(dplyr)

d1 %>% 
  group_by(row_number()) %>% 
  mutate(sumb = sum(d2$c[d2$b < a])) %>%
  ungroup() %>%
  select(id, a, sumb)

You should see results like this:

# A tibble: 5 x 3
  id        a  sumb
  <chr> <dbl> <dbl>
1 a         2     3
2 b         4     9
3 c        20    30
4 d         8    30
5 e         7    18

Also notice that you asked for condition d1$a>=d2$b, but your sample results are based on d1$a>d2$b. I followed your sample.

There is no plyr actually needed for that. There is only character vector with names id, then there is a values vector relative to that names a and then there is some computing of third vector sumb. Like below ...

> id<-c("a","b","c","d","e")
> a<-c(2,4,20,8,7)
> b<-c(1,3,4,7)
> c<-c(3,6,9,12)
> 
> d1 <- data.frame(id,a,sum=sapply(a,function(a,b,c)sum(c[a > b]),b,c))
> 
> print(d1)
  id  a sum
1  a  2   3
2  b  4   9
3  c 20  30
4  d  8  30
5  e  7  18
> 
Related