Aggregating while merging two dataframes in R

Question

The ultimate goal is to sum the total quantity(transact_data$qty) for each record in product_info where the transact_data$productId exists in product_info, and where transact_data$date is between product_info$beg_date and product_info$end_date.

The dataframes are below:

product_info <- data.frame(productId = c("A", "B", "A", "C","C","B"), 
                      old_price = c(0.5,0.10,0.11,0.12,0.3,0.4),
                      new_price = c(0.7,0.11,0.12,0.11,0.2,0.3),
                      beg_date = c("2014-05-01", "2014-06-01", "2014-05-01", "2014-06-01","2014-05-01", "2014-06-01"),
                      end_date = c("2014-05-31", "2014-06-31", "2014-05-31", "2014-06-31","2014-05-31", "2014-06-31"), stringsAsFactors=FALSE)

transact_data <- data.frame(productId=c('A', 'B','A', 'C','A', 'B','C', 'B','A', 'C','A', 'B'),
                  date=c("2014-05-05", "2014-06-22", "2014-07-05", "2014-08-31","2014-05-03", "2014-02-22",
                    "2014-05-21", "2014-06-19", "2014-03-09", "2014-06-22","2014-04-03", "2014-07-08"),
                    qty =c(12,15,5,21,13,17,2,5,11,9,6,4), stringsAsFactors=FALSE)

My first step was to merge both dataframes by productId:

sku_transact_merge <-merge(x=product_info, y=transact_data, by = c("productId"))

The next step was to calculate the quantity sum:

sku_transact_merge$total_qty <- ifelse(sku_transact_merge$date >= sku_transact_merge$beg_date & 
                                       sku_transact_merge$date <= sku_transact_merge$end_date, 
                                     aggregate(qty ~ productId+beg_date+end_date,
                                               data= sku_transact_merge, sum), 0)

The result is not what I desire, and i'm getting an error that says

(list) object cannot be coerced to type 'double'

Any pointers on how to properly execute this logic would be much appreciated!

Answer 1

This could be another way to do this using dplyr() (This should be effective if your data set is huge)

library(dplyr)
df = subset(sku_transact_merge, date > beg_date & date < end_date)
df = subset(df, select= -c(date))
out = unique(df %>% group_by(productId,old_price) %>% mutate(qty = sum(qty)))

#> out
#Source: local data frame [6 x 6]
#Groups: productId, old_price

#productId old_price new_price   beg_date   end_date qty
#1         A      0.50      0.70 2014-05-01 2014-05-31  25
#2         A      0.11      0.12 2014-05-01 2014-05-31  25
#3         B      0.10      0.11 2014-06-01 2014-06-31  20
#4         B      0.40      0.30 2014-06-01 2014-06-31  20
#5         C      0.12      0.11 2014-06-01 2014-06-31   9
#6         C      0.30      0.20 2014-05-01 2014-05-31   2

or else you could use data.table

library(data.table)
out = setDT(df)[, list(qtynew = sum(qty)), by = list(productId, old_price)]

#> out
#   productId old_price qtynew
#1:         A      0.50     25
#2:         A      0.11     25
#3:         B      0.10     20
#4:         B      0.40     20
#5:         C      0.12      9
#6:         C      0.30      2

Answer 2

product_info$total_qty <- aggregate(col~row,which(outer(product_info$productId,transact_data$productId,`==`)&outer(product_info$beg_date,transact_data$date,`<=`)&outer(product_info$end_date,transact_data$date,`>=`),arr.ind=T),function(x) sum(transact_data$qty[x]))$col;
product_info;
##   productId old_price new_price   beg_date   end_date total_qty
## 1         A      0.50      0.70 2014-05-01 2014-05-31        25
## 2         B      0.10      0.11 2014-06-01 2014-06-31        20
## 3         A      0.11      0.12 2014-05-01 2014-05-31        25
## 4         C      0.12      0.11 2014-06-01 2014-06-31         9
## 5         C      0.30      0.20 2014-05-01 2014-05-31         2
## 6         B      0.40      0.30 2014-06-01 2014-06-31        20

Explanation

First, a logical matrix is constructed for each of the three match criteria, using outer() to compare every record in product_info with every record in transact_data. These three logical matrices are logical-ANDed together to form a final logical matrix representing which combinations of records match.

outer(product_info$productId,transact_data$productId,`==`)
&outer(product_info$beg_date,transact_data$date,`<=`)
&outer(product_info$end_date,transact_data$date,`>=`)
##       [,1]  [,2]  [,3]  [,4]  [,5]  [,6]  [,7]  [,8]  [,9] [,10] [,11] [,12]
## [1,]  TRUE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [2,] FALSE  TRUE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE
## [3,]  TRUE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [4,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE
## [5,] FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE
## [6,] FALSE  TRUE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE

Then, the row and column indexes with TRUE are ascertained via a call to which() with arr.ind=T. Row indexes represent the matching records from product_info (since it was on the left of the outer() calls), and column indexes represent the matching records from transact_data.

which(...,arr.ind=T)
##       row col
##  [1,]   1   1
##  [2,]   3   1
##  [3,]   2   2
##  [4,]   6   2
##  [5,]   1   5
##  [6,]   3   5
##  [7,]   5   7
##  [8,]   2   8
##  [9,]   6   8
## [10,]   4  10

Since we want to sum qty values from transact_data for each record in product_info, we can aggregate() the col indexes grouping by row by writing a custom aggregation function to index transact_data$qty with the col indexes and sum() them to return a single value for each row.

aggregate(col~row,...,function(x) sum(transact_data$qty[x]))
##   row col
## 1   1  25
## 2   2  20
## 3   3  25
## 4   4   9
## 5   5   2
## 6   6  20

Finally, we can assign the result directly to product_info$total_qty to complete the solution.

product_info$total_qty <- ...$col;

---

I'm not entirely sure if it is a guarantee that aggregate() will always return its result ordered by the grouping column(s). I just asked this at Does aggregate() guarantee that the result will be ordered by the grouping columns?.

Also, I just realized that direct assignment will fail if not all records in product_info had at least one matching record in transact_data.

If either of those assumptions are violated, the solution can be fixed as follows:

product_info$total_qty <- with(aggregate(col~row,which(outer(product_info$productId,transact_data$productId,`==`)&outer(product_info$beg_date,transact_data$date,`<=`)&outer(product_info$end_date,transact_data$date,`>=`),arr.ind=T),function(x) sum(transact_data$qty[x])),col[match(1:nrow(product_info),row)]);
product_info;
##   productId old_price new_price   beg_date   end_date total_qty
## 1         A      0.50      0.70 2014-05-01 2014-05-31        25
## 2         B      0.10      0.11 2014-06-01 2014-06-31        20
## 3         A      0.11      0.12 2014-05-01 2014-05-31        25
## 4         C      0.12      0.11 2014-06-01 2014-06-31         9
## 5         C      0.30      0.20 2014-05-01 2014-05-31         2
## 6         B      0.40      0.30 2014-06-01 2014-06-31        20

Now, instead of the final step of dereferencing $col, we must construct a complete vector of length equal to the number of rows in product_info, and match() the qty sums (which are inside col) to their corresponding indexes (inside row), with a little help from with().

product_info$total_qty <- with(...,col[match(1:nrow(product_info),row)]);

Answer 3

One approach would be to loop through the elements in product_info, determining all matching products in transact_data and summing their quantities:

sapply(seq(nrow(product_info)), function(x) {
  d <- product_info[x,]
  sum(transact_data$qty[transact_data$productId == d$productId &
                        transact_data$date >= d$beg_date &
                        transact_data$date <= d$end_date])
})
# [1] 25 20 25  9  2 20

You could add this as a new column in product_info if desired.