R语言 批量规划求解

昨天读到一个项目，是关于优化求解的。
约束条件如下：
公司里有很多客户，客户之所以不继续用我们的产品了，是因为他账户余额是负的，所以，为了重新赢回这些客户，公司决定发放优惠券cover掉客户账户的负余额。

具体细节：

• 只有8元，80元，200元的优惠券
• 发放给一个客户的优惠券总张数不能超过15张
• 要既能cover掉客户的负余额，又要保证发放给客户的优惠券张数最少
• 发放给客户的总金额－客户的亏损额不能大于8，且越小越好。（不能送太多便宜了）

####################### 构造一个数据框，里面包含所有可能的送券组合################################
x=data.frame(x=rep(0:15,1)) # 表示 200的券 的张数
y=data.frame(y=rep(0:15,1))  # 表示 80的券 的张数
z=data.frame(z=rep(0:15,1))  # 表示 8的券 的张数
library(sqldf)
# 做笛卡尔积
df <- sqldf('select * from x,y,z')
head(df)
df$coupon_sum <-apply(df,1,sum) # 对行求和
df$amt_sum <- df$x*200+df$y*80+df$z*8 # 加权重求和
#过滤掉 sum>15的 组合
df <- sqldf('select * from df where coupon_sum<=15 order by amt_sum asc')
## step 2
#######################################################
### 下面是给出任意一个 亏损 比如 loss＝－987，则 fun2(-987) 返回出用200，80，8各几张，能获得gap最小
fun2 <- function(i){
  if(i< -3000){
    return(data.frame(loss=i,x=15,y=0,z=0,coupon_sum=15,amt_sum=3000,gap=3000+i))
  } else {
    df$gap <- i+df$amt_sum
    df_positive <- sqldf('select * from df where gap>=0')
    res <- sqldf('select * from df
                 where gap in (select gap from df_positive order by gap limit 1)
                 order by gap,coupon_sum
                 limit 1')
    return(cbind(loss=i,res))
  }
}
## step 3
# #### 建一个 函数 fun3，其中调用了fun2
fun3 <- function(original_df){
  final_res <- data.frame()
  for(m in 1:length(original_df[,1])){
    row.res <- cbind(customID=original_df[m,1],fun2(original_df[m,2]))
    final_res <- rbind(final_res,row.res)
  }
  return(final_res)
}

## step 4
# 构造一个测试数据集 test.df  进行测试
test.df <- data.frame(customID=rep(1:200,1),loss=abs(rnorm(200))*(-2000))
test.df
final_res <- fun3(test.df)
head(final_res)
write.csv(final_res,"final_res.csv",sep = ",")

规划求解

(min result= 200x+80y+8z)

[f(x)= egin{cases} x le 15 ,\ y le 15 ,\ z& le 15 ,\ x+y+z le 15 ,\ 200x+80y+8z ge -temp ,\ ext{x,y,z为正整数} end{cases}]

library(Rglpk)

obj <-c(200,80,8,)
mat<-matrix(c(1,0,0,1,200,0,1,0,1,80,0,0,1,1,8),nrow = 5)
mat
dir<-c(rep("<=",4),">=")
types<-c("I", "I", "I")
max<-F
Rglpk_solve_LP(obj, mat, dir, rhs, types = types, max = F)
resa<-data.frame()
for (i in 1:nrow(test.df)){
  temp<-test.df[i,2]
  rhs<-c(15,15,15,15,-temp)
  if(temp < -3000){
  temp1<-cbind(temp,matrix(c(15,0,0,15,3000),ncol=5),temp+3000)
  }else{
  temp_result<-Rglpk_solve_LP(obj, mat, dir, rhs, types = types, max = F)
  temp1<-cbind(temp,matrix(temp_result$auxiliary$primal,ncol = 5),temp+temp_result$auxiliary$primal[5])
  }
  resa<-rbind(resa,temp1)
}
str(resa)
write.table(resa,"resa3.csv",sep=",")

结果如下

head(resa)
        temp V2 V3 V4 V5   V6            V7
1 -2367.9663 11  2  1 14 2368  3.374016e-02
2  -640.3149  0  8  1  9  648  7.685126e+00
3 -1281.4575  6  1  1  8 1288  6.542478e+00
4 -4498.5225 15  0  0 15 3000 -1.498523e+03
5 -2639.6479 12  3  0 15 2640  3.521064e-01
6 -2447.9996 11  3  1 15 2448  4.106828e-04