эффективный способ реализации правил на основе вектора вычитания (просадки) над матрицами в R без LOOPS или применять

Question

мне нужно не использовать циклы или применять, потому что это должно быть очень эффективными:

Для тех из вас, кто знает, что LIFO или FIFO, это правила, которые я пытаюсь использовать. В основном, рассмотрит следующую матрицу инвентаризации:

В принципе, учитывая матрицу инвентаризации «C» и некоторые «просадка», «достаточное количество»:

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 

Этой матрица инвентаризации показывает, что существует два продукта, которые имеют по два марочные. Например, у нас есть 3 единицы 1-дневного продукта 1 и 2 единицы 2-дневного продукта 2. Предположим, нам сказали вычесть 3 единицы продукта1. Мы могли бы либо взять его из винтажа 1 или 2 в первую очередь. LIFO будет сначала уничтожить все урожай 1, оставив 0 единиц урожая 1 и 2 единиц урожая 2. FIFO сначала возьмет 2 единицы урожая 2, а так как есть дополнительный блок, который нужно выполнить, перейдите к взятию с vintage 1, оставляя 0 урожая 2 и 2 урожая 1.

Ниже я показываю это правило, реализованное в целом для многих «просадок» (например, требование 3 продукта 1 и 4 блока 2 будет 1 примером ничьи).

И просадки:

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 

Каждой строка просадки представляют собой отдельные моделируемые просадки, который должен быть применен с помощью LIFO или FIFO к матрице. (ЛИФО означает, что вы берете новейший винтаж прочь первый (марочные 2) при удовлетворении спроса Q и FIFO означает, что вы идете в другой стороне.).

Так я бег:

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

Выход для ЛИФО должен выглядеть что-то вроде этого:

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 
... 

Answer 1

Здесь векторизованный подход с data.table вы можете попробовать:

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 
# ... 

Обновления: более общее решение с использованием data.table, который является довольно длинным, но в основном она готовит данные для обработки:

построить функцию, чтобы вычесть число из вектора, который будет исчерпать первый элемент, а затем вторая до суммы равна нулю:

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

Подготовка данных: Перерисуйте рисовать вниз матрицу и инвентарь, связать их вместе для дальнейшей обработки

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)] 

Создать новый инвентарь путем вычитания значения Draw из инвентаря для каждого Draw и Product и изменить результат:

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 
# ...