R语言 批量规划求解
2016-07-29 14:12
447 查看
昨天读到一个项目,是关于优化求解的。
约束条件如下:
公司里有很多客户,客户之所以不继续用我们的产品了,是因为他账户余额是负的,所以,为了重新赢回这些客户,公司决定发放优惠券cover掉客户账户的负余额。
具体细节:
只有8元,80元,200元的优惠券
发放给一个客户的优惠券总张数不能超过15张
要既能cover掉客户的负余额,又要保证发放给客户的优惠券张数最少
发放给客户的总金额-客户的亏损额不能大于8,且越小越好。(不能送太多便宜了)
\[f(x)=
\begin{cases}
x \le 15 ,\\
y \le 15 ,\\
z& \le 15 ,\\
x+y+z \le 15 ,\\
200x+80y+8z \ge -temp ,\\
\text{x,y,z为正整数}
\end{cases}\]
约束条件如下:
公司里有很多客户,客户之所以不继续用我们的产品了,是因为他账户余额是负的,所以,为了重新赢回这些客户,公司决定发放优惠券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)=
\begin{cases}
x \le 15 ,\\
y \le 15 ,\\
z& \le 15 ,\\
x+y+z \le 15 ,\\
200x+80y+8z \ge -temp ,\\
\text{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
相关文章推荐
- tomcat8 https ssl证书配置
- VC++获取不同Windows版本的方法
- eCryptfs - creat系统调用
- httpurlconnection
- 1095. Cars on Campus (30)
- u盘刻录光盘后空间缩小解决方法
- a20 nand更换emmc 版本sdk修改记录
- 使用TortoiseGit处理代码冲突
- curl 获取外网IP
- JSON 数据格式
- #开篇第一章
- (可再看)基于深度学习的目标检测研究进展
- solr5的基本操作
- 回味经典——uboot1.1.6 之 第二阶段 第三阶段
- android自定义控件之中间是斜线的占比条
- java生成一年中假日表(包括周末和法定假期),用于计算一年中的工作日
- ACM--字母排序--HDOJ 1379--DNA Sorting--字符串
- sql查询where/in
- 如何实现 java 接口中的部分方法
- hdu2089:不要62