R 中的数学优化

Question

我有以下数据框：

Required <- data.table( Country=c("AT", "BE", "BG", "CY"),Mat1=c(0,5,0,5),Mat2=c(0,3,2,0),Mat3=c(10,2,0,12))
Supplied <- data.table( Country=c("AT", "BE", "BG", "CY"),Mat1=c(0,4,0,10),Mat2=c(20,20,20,0),Mat3=c(8,10,0,10))

> Required
   Country Mat1 Mat2 Mat3
1:      AT    0    0   10
2:      BE    5    3    2
3:      BG    0    2    0
4:      CY    5    0    2

> Supplied
   Country Mat1 Mat2 Mat3
1:      AT    0   20    8
2:      BE    4   20   10
3:      BG    5   20    0
4:      CY   10    0   10

"Required"显示了三种material对不同国家的需求，而"Supplied"显示了这些国家的供应能力。我试图应用一种优化算法，根据供应能力修改 "Required" 数据框。例如"Mat1"需要5个单位到"BE"国家，而它只能提供4个单位。该算法应寻找约束较少的国家/地区来提供此 material，在这种情况下，"BG" 和 "CY" 国家/地区都有 5 个单位 "available"。因此，受限制较少的国家/地区是 material 可用绝对值单位最多的国家/地区。

由此产生的需求 table "RequiredNew" 应该是：

> Required
       Country Mat1 Mat2 Mat3
    1:      AT    0    0    8
    2:      BE    4    3    3
    3:      BG  0.5    2    0
    4:      CY  5.5    0    3

关于如何进行的任何想法？这是一个示例，实际 table 相当大，所以我寻求一种编程方法。

非常感谢。

Answer 1

这有点复杂，但应该可以：

library(data.table)

Required <- data.table( Country=c("AT", "BE", "BG", "CY"),Mat1=c(0,5,0,5),Mat2=c(0,3,2,0),Mat3=c(10,2,0,2))
Supplied <- data.table( Country=c("AT", "BE", "BG", "CY"),Mat1=c(0,4,5,10),Mat2=c(20,20,20,0),Mat3=c(8,10,0,10))

# I prefer to work with matrices, so here I turn Required and Supplied into matrices
req <- as.matrix(Required[,-1,with=FALSE])
row.names(req) <- Required$Country
sup <- as.matrix(Supplied[,-1,with=FALSE])
row.names(sup) <- Supplied$Country

# create a copy of Required data.table to contain the result (we'll overwrite the values)
RequiredNew <- copy(Required)

# for each material...
for(col in 1:(ncol(req))){

  # for each country we compute the remaining stock and requirement after satisfying itself
  netreq <- req[,col] - sup[,col]
  netreq[netreq < 0] <- 0
  netstk <- sup[,col] - req[,col]
  netstk[netstk < 0] <- 0

  # we loop until we satisfy all the requirements or we finish the stock
  finalreq <- req[,col] - netreq
  while(sum(netreq) > 0 && sum(netstk) > 0){
    maxavailidxs <- which(netstk == max(netstk))
    requiredqty <- min(sum(netreq),sum(netstk[maxavailidxs]))
    deltareq <- (requiredqty * netreq) / sum(netreq)
    deltastk <- rep(0,length(netstk))
    deltastk[maxavailidxs] <- requiredqty / length(netstk[maxavailidxs])

    netreq <- netreq - deltareq
    netstk <- netstk - deltastk

    finalreq <- finalreq + deltastk
  }

  # we set the current material final requirement column into the result data.table
  set(RequiredNew,NULL,col+1L, finalreq)
}

RequiredNew
> RequiredNew
   Country Mat1 Mat2 Mat3
1:      AT  0.0    0    8
2:      BE  4.0    3    3
3:      BG  0.5    2    0
4:      CY  5.5    0    3

R 中的数学优化

Mathematical optimization in R

r

mathematical-optimization

dataframe