Вычисленная стоимость должна быть равномерно распределена вперед - PullRequest
0 голосов
/ 08 июля 2019

Ниже 4 - фрейм входных данных:

LCtoLC

structure(list(Item = structure(c(1L, 1L, 1L), .Label = "8T4121", class = "factor"), 
LC = structure(c(1L, 2L, 2L), .Label = c("MW92", "OY01"), class = "factor"), 
ToLC = structure(1:3, .Label = c("OY01", "RM11", "RS11"), class = "factor")), class = "data.frame", row.names = c(NA, -3L))

Custfcst

structure(list(Item = structure(c(1L, 1L, 1L, 1L), .Label = "8T4121", class = "factor"), 
LC = structure(1:4, .Label = c("MW92", "OY01", "RM11", "RS11"
), class = "factor"), custfcst = c(10L, 12L, 10L, 10L)), class = "data.frame", row.names = c(NA, -4L))

Rolledfcst

structure(list(Item = structure(c(1L, 1L, 1L), .Label = "8T4121", class = "factor"), 
LC = structure(c(1L, 2L, 2L), .Label = c("MW92", "OY01"), class = "factor"), 
ToLC = structure(1:3, .Label = c("OY01", "RM11", "RS11"), class = "factor"), 
Rolledfcst = c(22L, 10L, 9L)), class = "data.frame", row.names = c(NA,-3L))

safetystock

structure(list(Item = structure(c(1L, 1L, 1L, 1L), .Label = "8T4121", class = "factor"), 
LC = structure(1:4, .Label = c("MW92", "OY01", "RM11", "RS11"
), class = "factor"), SS = c(15L, 7L, 5L, 5L), x = c(0.25, 
0.25, NA, NA)), class = "data.frame", row.names = c(NA, -4L))

Выход:

LC Item SS x Rolledfcst custfcst xprcnt remainingss prcntvalue share SSNew Leftover
MW92    8T4121  15.00000    0.25    22  10  3.750000    11.25000    0.3125000   3.515625    7.265625    7.734375
OY01    8T4121  14.73438    0.25    19  12  3.683594    11.05078    0.3870968   4.277722    7.961316    6.773059
RM11    8T4121  11.77306    NA  0   10  NA  NA  1.0000000   NA  NA  NA
RS11    8T4121  NA  NA  0   10  NA  NA  1.0000000   NA  NA  NA

В этих выходных данных остаток в OY должен быть равномерно распределен между RM и RS как в кадре данных LCtoLC OY, подключенном к RM & RS, поэтому на основе этого кадра данных это должно разделить остаток и добавить его в SS в RM & RS.

Код пробовал до сих пор:

   library(plyr)
    library(dplyr)
    library(tidyr)
    library(igraph)
    library(data.table)
    library(magrittr)
    library(reshape2)


lctolc <- read.csv("LCtoLC.csv")
custfcst <- read.csv("custfcst.csv")
rolledfcst <- read.csv("rolledfcst.csv")
safetystock <- read.csv("safetystock.csv")

bodlane <- lapply(
  lapply(split(lctolc, lctolc$Item), function(x) graph.data.frame(x[, 2:3])), 
  function(x) lapply(
    all_simple_paths(x, from = V(x)[degree(x, mode = "in") == 0], 
                     to = V(x)[degree(x, mode = "out") == 0]),
    function(y) as.data.table(t(names(y))) %>% setnames(paste0("LC", seq_along(.)))
  ) %>% rbindlist(fill = TRUE)
) %>% rbindlist(fill = TRUE, idcol = "Item")


df1<- merge(custfcst,lctolc,by=c("LC","Item"),all.x=TRUE)
df2<- merge(rolledfcst, df1,by.x=c("LC","Item","ToLC"),by.y=c("LC","Item","ToLC"),all=TRUE)
Final<- merge(safetystock, df2, by = c("LC","Item"))


#Replace NA in decomposed with 0
Final$Rolledfcst <- replace(Final$Rolledfcst, is.na(Final$Rolledfcst), 0);

#Remove multiple rows and aggregate rolledfcst
Final <- ddply(Final,.(LC,Item),summarize,SS=mean(SS),x=mean(x),Rolledfcst=sum(Rolledfcst),custfcst=mean(custfcst))

#Sort by Item for Max Rolled fcst
Final <- Final[order(Final$Item,-Final$Rolledfcst),];


df <- as.data.frame(unique(Final$Item))

df_final<- NA
j <- 1
i<-1
for(j in 1:nrow(df)) {
  Final_v1 <- Final[Final$Item == as.character(df[j,1]),]


  for(i in 1:nrow(Final_v1)) {

    Final_v1[i,7] <- (Final_v1[i,4] * Final_v1[i,3]) #xprcnt
    Final_v1[i,8]= (Final_v1[i,3] - Final_v1[i,7])   #remainingss
    Final_v1[i,9] = (Final_v1[i,6]  / (Final_v1[i,6] +Final_v1[i,5]))   #prcntvalue
    Final_v1[i,10] = (Final_v1[i,9] * Final_v1[i,8])  #share
    Final_v1[i,11] = (Final_v1[i,7] + Final_v1[i,10])  #SSNew
    Final_v1[i,12] = (Final_v1[i,3] - Final_v1[i,11])  #Leftover

    Leftover <- Final_v1[i,12]
    Final_v1[i+1,3]  <- Final_v1[i+1,3] + Leftover
  }

  df_final <- rbind(df_final,Final_v1)

}

df_final <-subset(df_final, !is.na(df_final$Item))
names(df_final)[7] <- "xprcnt"
names(df_final)[8] <- "remainingss"
names(df_final)[9] <- "prcntvalue"
names(df_final)[10] <- "share"
names(df_final)[11] <- "SSNew"
names(df_final)[12] <- "Leftover"
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...