robertevansanders - 1 year ago 56
R Question

# Efficient way to implement rule-based vector subtraction (drawdown) over matrices in R without LOOPS or apply

I need to not use loops or apply because this needs to be very efficient:

For those of you who know what LIFO or FIFO are, these are the rules I am trying to use. Basically, consider the following inventory matrix:

Basically, given an inventory matrix "C" and some "drawdowns", "qs":

``````J=2
Tp=2
C = matrix(2,J,Tp)
rownam = as.character()
colnam = as.character()
for(j in 1:J){rownam = c(rownam,paste0('prod',j))}
for(j in 1:Tp){colnam = c(colnam,paste0('vint',j))}
rownames(C) = rownam
colnames(C) = colnam

C[1,1]=C[1,1]+1
C[2,1]=C[2,1]-1

> C
vint1 vint2
prod1     3     2
prod2     1     2
``````

This inventory matrix indicates there are two products that each have two vintages. For example, we have 3 units of 1 day old product 1 and 2 units of 2 day old product 2. Suppose we are told to subtract 3 units of product1. We could either take it from vintage 1 or 2 first. LIFO would have it first deplete all of vintage 1, leaving 0 units of vintage 1 and 2 units of vintage 2. FIFO would take the 2 units of vintage 2 first, and since there's an extra unit to be fulfilled, move up to taking from vintage 1, leaving 0 of vintage 2 and 2 of vintage 1.

Below, I show this rule implemented generally for many "drawdowns" (e.g. demand 3 of product 1 and 4 of unit 2 would be 1 example of a draw).

And the drawdowns:

``````qs = rbind(
c(4, 1),  c(4,1),
c(4, 1),  c(1, 3),
c(3, 2),  c(4, 1),
c(1, 2),  c(2, 0),
c(2, 1),  c(2, 3),
c(0, 3),  c(2, 2))

> qs
[,1] [,2]
[1,]    4    1
[2,]    4    1
[3,]    4    1
[4,]    1    3
[5,]    3    2
[6,]    4    1
[7,]    1    2
[8,]    2    0
[9,]    2    1
[10,]    2    3
[11,]    0    3
[12,]    2    2
``````

Each row of the drawdown is a separate simulated drawdown that is to be applied using LIFO or FIFO to the matrix. (LIFO means you take the newest vintages away first (vintage 2) when satisfying demand q's. and FIFO means you go the other way.)

So I run:

``````Cmat = do.call(rbind, replicate(dim(qs)[1], C, simplify=FALSE)) #matrix
``````

The output for LIFO should look something like this:

``````drawndown
vint1 vint2
prod1     1     0
prod2     1     1
prod1     1     0
prod2     1     1
prod1     1     0
prod2     1     1
prod1     3     1
prod2     0     0
...
``````

Here is a vectorized approach with `data.table` you can try:

``````library(data.table)
draw_value <- as.vector(t(qs))      # flatten the draw down matrix as a vector
CmatDT <- data.table(Cmat, keep.rownames = T)   # convert the Cmat to data.table

CmatDT[, `:=` (vint1 = ifelse(vint2 >= draw_value, vint1, vint1 + vint2 - draw_value),
vint2 = ifelse(vint2 >= draw_value, vint2 - draw_value, 0))]
# mutate the vint1 and vint2 columns based on if vint2 contains enough product for the draw down.

CmatDT
#       rn vint1 vint2
# 1: prod1     1     0
# 2: prod2     1     1
# 3: prod1     1     0
# 4: prod2     1     1
# 5: prod1     1     0
# 6: prod2     1     1
# 7: prod1     3     1
# 8: prod2     0     0
# ...
``````

Update: a more general solution using `data.table` which is quite long but mostly it is preparing the data for the processing:

Build a function to subtract a number from a vector, which will exhaust the first element and then the second until the amount is zero:

``````minus <- function(vec, amount) {
if(vec[1] >= amount) c(vec[1] - amount, vec[-1])
else c(0, minus(vec[-1], amount - vec[1]))
}
``````

Data Preparation: Reshape the draw down matrix and inventory, bind them together for further processing

``````qsDT <- setNames(data.table(qs, keep.rownames = T), c("DrawId", "Prod1", "Prod2"))
longQs <- melt(qsDT, id.vars = "DrawId", value.name = "Draw", variable.name = "Product")[order(as.numeric(DrawId))]
longQsC <- melt(cbind(longQs, C), measure.vars = c("vint1", "vint2"), value.name = "Inventory", variable.name = "Vintage")[order(as.numeric(DrawId), Product, -Vintage)]
``````

Create the new inventory by subtracting the `Draw` value from the inventory for each `Draw` and `Product` and reshape the result:

``````longQsC[, NewInventory := minus(Inventory, unique(Draw)), .(DrawId, Product)]
longQsC[, dcast(.SD, Product ~ Vintage, value.var = "NewInventory"), .(DrawId)]

#   DrawId Product vint1 vint2
#1:      1   Prod1     1     0
#2:      1   Prod2     1     1
#3:      2   Prod1     1     0
#4:      2   Prod2     1     1
#5:      3   Prod1     1     0
#6:      3   Prod2     1     1
#7:      4   Prod1     3     1
#8:      4   Prod2     0     0
# ...
``````
Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download