Consider these tables of purchases and sales
purchases <- data.table(
purchase_id = c(10,20,30,40,50,60),
store = c("a", "a", "a", "b", "b", "b"),
date = c(1,1,2,3,3,3)
)
sales <- data.table(
sale_id = c(1,2,3,4,5,6),
store = c("a", "a", "a", "b", "b", "b"),
date = c(1,1,1,3,3,4)
)
> purchases
purchase_id store date
1: 10 a 1
2: 20 a 1
3: 30 a 2
4: 40 b 3
5: 50 b 3
6: 60 b 3
> sales
sale_id store date
1: 1 a 1
2: 2 a 1
3: 3 a 1
4: 4 b 3
5: 5 b 3
6: 6 b 4
I would like to map each purchase to the sale that occurred at the same time or later (and at the same store). The catch is one purchase should be mapped to exactly one or none sales, and vice-versa.
There are multiple solutions that satisfy my requirements, but a simple one follows the following algorithm:
For each purchase:
Subset sales where sale store matches purchase store and sale date >= purchase date
Select the first sale in the subset and map it to this purchase
REMOVE THIS SALE FROM THE sales TABLE!
which would produce a mapping like
purchase_id sale_id
1: 10 1
2: 20 2
3: 30 NA
4: 40 4
5: 50 5
6: 60 6
Is there an elegant way to do this with data.table?
Dirty Solution
Here's a dirty, but working solution I developed.
rolling_join_without_replacement <- function(x, i, on, roll, allow.cartesian = FALSE){
# Dirty implementation of a rolling join matching algo without replacement
# Each row in i maps to exactly one row in the result
# Each row in x maps to exactly zero or one rows in the result
# Copy x and i
x2 <- copy(x)
i2 <- copy(i)
# Create row id fields for each table
x2[, x_row := .I]
i2[, i_row := .I]
allmatches <- list()
while(TRUE){
# Execute the rolling join
matches <- x2[i2, on = on, roll = roll, allow.cartesian = allow.cartesian, nomatch = 0L]
# If no matches, break
if(nrow(matches) == 0) break
# Get the first match per i, then get the first match per x
matches <- matches[matches[, .I[1L], by = i_row]$V1]
matches <- matches[matches[, .I[1L], by = x_row]$V1]
# Save these matches
allmatches <- c(allmatches, list(matches))
# Exclude these x and i from future matches
x2 <- x2[!matches, on = "x_row"]
i2 <- i2[!matches, on = "i_row"]
}
# Combine matches
allmatches <- rbindlist(allmatches, use.names = TRUE)
# Include unmatched i rows
unmatched <- i2[!allmatches, on = "i_row"]
allmatches <- rbind(allmatches, unmatched, use.names = TRUE, fill = TRUE)
return(allmatches[])
}
Usage
rolling_join_without_replacement(
x = sales,
i = purchases,
on = c("store", "date"),
roll = -Inf,
allow.cartesian = TRUE
)
purchase_id sale_id
1: 10 1
2: 20 2
3: 30 NA
4: 40 4
5: 50 5
6: 60 6