还是靠VBA来帮我计算最少用你多少根棍子吧

灰袍法师 · 发表于 2012-9-22 04:37

本帖最后由灰袍法师于 2012-9-22 04:44 编辑

0.3 beta 版
什么参数都取消了，扔到程序内部随机生成
本版最大改变是
1 评估切割方案的标准，从之前的产品权重，改为“本切割方案能够切出最多的产品”，实际上也就是希望尽可能少的方案数完成全部产品
2 随机决定产品的切割顺序，而不是之前的从最长的产品开始切。
3 每次生成全部切割方案以后，把使用次数只有1的切割方案，其包含的产品，其切割顺序往前提升（即下一次优先切割这些落后分子）
结果还不错。
虽然往往不能找出最低的原料消耗，但相差也极少，而且切割方案数一般比较低。
我现在越来越倾向于“先生成原料切割方案库”，然后从中抽选的做法了，这个做法别的不说，光是不需要每次切割都重新生成一次切割方案，就能提速几十倍。
而且最明显的是，生成了切割方案库以后，找出最优解其实就只是一个线性规划问题
线性规划求解部分可以扔给其他软件做，如 Lingo 之流
这对于验证自己的程序效率，就有了一个很好的参照物。

三坛老窖 · 发表于 2012-9-23 03:02

灰袍法师发表于 2012-9-22 04:37
0.3 beta 版
什么参数都取消了，扔到程序内部随机生成
本版最大改变是

测试了这个版本，用理论最优797根这组数据连续运行10次（搜索=100），结果如下：
序号       用量    方案    耗时
1             800    46       98
2             800    44       100
3             800    43       101
4             800    43       98
5             800    45       99
6             800    48       99
7             799    49       101
8             800    43       101
9             800    43       102
10          798    51       97
=====================
从上面数据看，就解的质量而言，我想这个版本应该优于你前面提及的Go Nest 1D了吧（我下了你在哪个地方贴的这个软件，装了后用不起来，不知何故？）。

关于797这组数据，用我的程序记录下的通过随机切割得到的解的分布数据如下：（方案连胜=500，方式连胜=75，总耗时在92s左右）

需求	797	798	799	800	801	802	803	804
频次	0	2	69	208	177	103	13	2
概率	0.0%	0.3%	12.0%	36.2%	30.8%	17.9%	2.3%	0.3%

上面数据说明：随机切能产生最优解（基本可以猜想，797的解不存在），但概率较小，而近优解则很容易出现（800及以下的出现概率为48.5%）。
针对一维的下料问题，随机切与蚁群、遗传、退火等高级算法类似，其算法复杂性与数据量近乎无关，但得到的结果估计应该不会逊色于蚁群、遗传、退火等高级算法。

下面链接中的这篇论文，我只看懂个大概，其解题的思路应该与你现在想的相同的，也是先取得切割方式库，再从中选取80-100个方式，用整数规划法求得最优解。
http://wenku.baidu.com/view/4174c4323968011ca3009143.html
对此种解题思路，我有两点不解：
1.如何从海量的方式中选取用于整数规划的方式集？其中提到的用【有效度】来评价，而其定义的【有效度】来自于之前的线性规划所得的解，那岂不是要用这海量的方式集先进行一次线性规划？可能吗？
2.整数规划法本身就是个NP难问题，对规模稍大一点的数据，其时间能耗得起吗？
======================================
在这个问题上，能与法师在一个层面上进行探讨，倍感荣幸！

灰袍法师 · 发表于 2012-9-23 03:52

本帖最后由灰袍法师于 2012-9-23 03:58 编辑

三坛老窖发表于 2012-9-23 03:02
测试了这个版本，用理论最优797根这组数据连续运行10次（搜索=100），结果如下：
序号用量 ...

逐点讨论一下吧
我的VBA跟 Go Nest 1D 相比，确实在很多情况都能做得比它更好
不过也有很多情况比不上它。
比如多根可用原料，我的程序目前完全没处理。

选取方案集，然后再从方案集选最终结果
其实是把原来的多重背包问题（n个产品放入m个原料），这是整数规划问题。
转化为线性规划问题（k种切割方案组合出n种产品），这只是求解线性方程组而已。
求解线性方程组是很容易的，目前的常见软件求解几十万个变量的线性方程组应该没啥问题。
虽然这个线性方程组还是要求整数解，但是求到小数解以后，也大致可以判断整数解的可行范围，上下限。
实际上有个算法是：线性方程组的精确小数解直接取整丢弃小数位，这样就会得到一个没有足够产品的解
这时候再对不够的产品进行一次求解。
等于不断减少需要的产品。

另一方面，我也想试一下 Lingo 求解整数约束的线性方程组有多强（直接求解多重背包是完全不可行的，我试过了，速度慢的要自杀，而且求解结果非常差。）
这种做法其实是作了一个假设：选出来的方案集，必然包括最优解的所有方案，或者包括近似最优解的所有方案。
这个假设可以这样证明：
如果存在最优解797根原料，那么最优解的每个切割方案，都必定接近 99.99% 的利用率
所以，只要列举全部利用率高于 99.99 的切割方案即可，这样的切割方案其实并不多。
又，有些切割方案是可以互相等价的，所以只需要找到其中一种组合，则所有与它等价的组合都可以算找到了。
如 1a+2b 和 1A+2c 等价于 2 x (1a + 1b +1c)
所以，方案集虽然不大，但是它组合出来的可能方案却是非常大的！
又，实际上我们也不追求最优解，而是所有接近最优解的方案都可以，这也进一步放宽了对方案集的质量要求。

三坛老窖 · 发表于 2012-9-23 04:33

灰袍法师发表于 2012-9-23 03:52
逐点讨论一下吧
我的VBA跟 Go Nest 1D 相比，确实在很多情况都能做得比它更好
不过也有很多情况比不上 ...

看你的回帖，有三点收获，不枉熬夜了。
1.求解线性方程组是很容易的，目前的常见软件求解几十万个变量的线性方程组应该没啥问题。----此前不知
2.线性方程组的精确小数解直接取整丢弃小数位，对不够的产品进行一次求解-----从未见过，也不曾想到是思路
3.假设及其证明--------豁然开朗
------------------------
谢谢法师的解惑！

灰袍法师 · 发表于 2012-9-23 20:19

本帖最后由灰袍法师于 2012-9-25 02:56 编辑

啊哈
列出所有方案，然后线性求解是可行的
我用理论最佳797的数据测试
先用 VBA 生成 2万多个方案，耗时才几秒。
然后 Lingo 对其进行整数线性规划，求解时间才20秒，得到 799 用料，方案数55，最大余料 3970 的结果，还不错嘛。

又用6000x1500的一组数据测试，可以轻松找出1504的解，不过切割方案数就比三坛老窖的多，要17个

附件包括自动生成所有原料的指定数量的切割方案，以及 Lingo 整数线性规划的求解模型
好处是：
1 支持多种原料同时求解
2 Lingo 求解几万个切割方案也就几十秒到几分钟不等（当然，最好还是运行 .lg4 而不是在Excel里面运行，避免时间太长造成OLE超时）

坏处是：
1 无法进一步追求最大余料，或者最少切割方案，如果Lingo的求解模型加上这些要求，就会变得很慢很慢，求解时间超过一小时，而且结果很差劲！
2 经常出现超额生产产品，需要人手减掉多出来的产品（或者加一段程序处理）

一维下料方案库 Lingo.rar (596.79 KB, 下载次数: 671)

不过。。。。。。
至少验证了生成一个方案库，然后从中选择“好”的方案，最终也可以得到很不错的结果。
也可以自己用VBA代替Lingo做挑选工作，估计会更快。。。。。。

840205910 · 发表于 2012-9-24 11:03

pp9257 发表于 2012-9-20 18:45
其实我发这个图片，只是想说，国内已经有了成熟的线性材料下料优化软件

42种不同规格，耗时0.3s

既然不愿意与别人分享代码，就别卖弄这些图片

pp9257 · 发表于 2012-9-24 12:19

840205910 发表于 2012-9-24 11:03
既然不愿意与别人分享代码，就别卖弄这些图片

这个是MSTEEL 里面其中的一个功能---线性优化免费的，我也没代码啊。。。。

灰袍法师 · 发表于 2012-9-24 19:40

本帖最后由灰袍法师于 2012-9-24 20:19 编辑

pp9257 发表于 2012-9-24 12:19
这个是MSTEEL 里面其中的一个功能---线性优化免费的，我也没代码啊。。。。

今天测试了一下 MSteel
这其实是一个 Autocad 的插件，还要安装 autocad ，超级麻烦
使用界面一个窗口＋N个弹窗，简洁是简洁，但。。。操作很麻烦！！！
不能导入Excel，只能导入自定格式的txt，又是一件麻烦事。

性能测试如下，左边是已知较优解，右边是MSteel运行结果：

6300x29 x29_8方案或者 x30_7方案 : MSteel只能算出 6300x30 15方案

6000x58_14方案 : MSteel算出 6000x58 33方案余料2328

5600x73_12方案 : 只能算出5600x74 12方案

6000x1500 目前已知较优解是 1504 : MSteel默认参数算出 1598，佩服作者真敢把这个结果放出来吖？？？多次人手调允许余料长度，最佳一次算出 1513 (超级麻烦!干吗不做成程序自动!)

3000x797 目前已知较优解是 798原料 56方案，或者799原料 44方案 : MSteel多次人手调参数算出 804 原料 59方案

意见：
最起码，允许余料长度，这个参数就是多余的，明显应该程序自动扫描出最佳的参数，而不是要用户一次一次地输入，运行，拉滑动条看结果。。。。。。
优点是：运行时间很快，不过作为一个c++编译的程序，对数据又只用贪婪发计算一次，不快的话就真该跳楼自杀了。

结论：作为autocad插件，不予置评，作为线材下料计算软件，就是一垃圾！明显没有经过仔细测试和优化。

lee1892 · 发表于 2012-11-29 19:41

本帖最后由 lee1892 于 2012-11-29 19:53 编辑

灰袍法师发表于 2012-9-23 20:19
啊哈
列出所有方案，然后线性求解是可行的
我用理论最佳797的数据测试

从头到尾仔细看了遍贴子，发现以我目前的水平和精力是不可能自己写出高效的代码了。
貌似前面老窖有很好的算法，奈何即未共享代码也没有把成品的库分享一下。。。
我自己的需求是多种料长求最优排料，把法师的方案库仔细学习了一下，改成了类文件，打算编译后结合Lingo自用。貌似还需要学习一下Lingo。。。

貌似还要学学Lingo的DLL调用。。。

附件是法师的生成方案的类代码，变量名都改成俺习惯的方式了，呵呵。。。

另外，那个超额出来是没错的，另加代码处理就是了。
下料原则本身就是让余料尽可能的集中，我有时间琢磨琢磨你这个代码，不知道有没有可能加入余料长度控制。比如余料在某个不易利用的范围内则该方案得分低，而余料即便很大但可利用价值高则该方案得分反而高。
对于经常性的较小规模是有实际意义的。

lee1892 · 发表于 2012-12-1 13:47

本帖最后由 lee1892 于 2012-12-1 14:15 编辑

花了2天时间研究LindoAPI，总算模型搞定，给我来这么个消息：
"License is too small for the given problem."
我吐血啊。。。

查了一下人家的API价格
变量2000->$195，变量8000->$395，变量32000->$695，变量无限->$995
法师这个要设置60000个方案，贵死。。。6000+RMB啊

API快是快，实在是不值得买啊，俺还是用那个OLE的办法吧，跳对话框烦就烦点吧。。。

找LindoAPI Crack中。。。
调用LindoAPI的办法，结合上面那个CLASS文件的，要编译成DLL用。。。
可惜了。。。

Public Sub Calculate()
Dim i As Long, j As Long
'----------------------------
' 获得检查证书
'----------------------------
Dim pEnv As Long, nErr As Long
Dim LicenseKey As String * LS_MAX_ERROR_MESSAGE_LENGTH
nErr = LSloadLicenseString(strLicensePath, LicenseKey)
Call CheckErr(pEnv, nErr)
'----------------------------
' 创建Lindo环境
'----------------------------
pEnv = LScreateEnv(nErr, LicenseKey)
If nErr > 0 Then
Err.Raise Number:=1000, Description:="创建Lindo环境失败"
Exit Sub
End If
'----------------------------
' 计算切割方案
'----------------------------
Call GeneratePatterns
'----------------------------
' 创建计算模型实例
'----------------------------
Dim pMod As Long
pMod = LScreateModel(pEnv, nErr)
Call CheckErr(pEnv, nErr)
'----------------------------
' 构造计算模型
'----------------------------
'变量数量，即所获得的方案数量
Dim nVars As Long
nVars = lngPlansCount
'约束数量，等于产品种类个数
Dim nRows As Long
nRows = lngProdCount
'目标方向，最小
Dim nDir As Long
nDir = LS_MIN
'目标常数，A constant value to be added to the objective value.
Dim dObjConst As Double
dObjConst = 0
'目标参数,即方案原材料长度数组
Dim dObjCoef() As Double
ReDim dObjCoef(0 To nVars)
For i = 0 To nVars - 1
dObjCoef(i) = arrLngAllRaws(i + 1, 1)
Next
'约束值数组，即产品数量数组
Dim dB() As Double
ReDim dB(0 To nRows)
For i = 0 To nRows - 1
dB(i) = arrLngProdReq(i + 1)
Next
'约束条件
Dim cConTypes As String
For i = 0 To nRows - 1
cConTypes = cConTypes & Chr(LS_CONTYPE_LE) '"L"
Next
'约束非0参数个数，即全部方案中非0数值的个数
Dim nNZ As Long
nNZ = 0
'约束非0参数数组
Dim dA() As Double
ReDim dA(0 To nVars * nRows)
'约束非0参数的列起始编号数组，个数为方案个数+1
Dim nBegCol() As Long
ReDim nBegCol(0 To nVars + 1)
'约束非0参数的行编号数组
Dim nRowX() As Long
ReDim nRowX(0 To nVars * nRows)
Dim dMaxBound As Double '变量最大值
dMaxBound = 0
Dim bNewRow As Boolean
For i = 1 To nVars '列为方案
bNewRow = True
For j = 1 To nRows '行为产品种类
If arrLngAllPlans(i, j) > 0 Then
dA(nNZ) = arrLngAllPlans(i, j)
If bNewRow Then
nBegCol(i - 1) = nNZ
bNewRow = False
End If
nRowX(nNZ) = j - 1
nNZ = nNZ + 1
If dMaxBound < arrLngProdReq(j) / arrLngAllPlans(i, j) Then
dMaxBound = arrLngProdReq(j) / arrLngAllPlans(i, j)
End If
End If
Next
Next
ReDim Preserve dA(nNZ)
nBegCol(nVars) = nNZ
ReDim Preserve nRowX(nNZ)
'变量左边界数组
Dim dLower() As Double
ReDim dLower(0 To nVars)
For i = 0 To nVars - 1
dLower(i) = 0
Next
'变量右边界数组
Dim dUpper() As Double
ReDim dUpper(0 To nVars)
For i = 0 To nVars - 1
dUpper(i) = dMaxBound
Next
'----------------------------
' 输入到计算模型
'----------------------------
nErr = LSloadLPData(pMod, nRows, nVars, nDir, _
dObjConst, dObjCoef(0), dB(0), _
cConTypes, nNZ, nBegCol(0), ByVal 0, _
dA(0), nRowX(0), dLower(0), dUpper(0))
Call CheckErr(pEnv, nErr)
'----------------------------
' 设置变量类型
'----------------------------
'变量类型
Dim cVarType As String
For i = 0 To lngPlansCount
cVarType = cVarType & Chr(LS_VARTYPE_INT) '"I"
Next
nErr = LSloadVarType(pMod, cVarType)
Call CheckErr(pEnv, nErr)
'----------------------------
' 模型计算
'----------------------------
nErr = LSsolveMIP(pMod, ByVal 0)
Call CheckErr(pEnv, nErr)
'Dim nSolStat As Long
'nErr = LSoptimize(pMod, LS_METHOD_PSIMPLEX, nSolStat)
'Call CheckErr(pEnv, nErr)
'----------------------------
' 获取计算结果
'----------------------------
Dim dObj As Long
nErr = LSgetInfo(pMod, LS_DINFO_POBJ, dObj)
Call CheckErr(pEnv, nErr)
Dim dX() As Double
ReDim dX(0 To lngPlansCount)
nErr = LSgetPrimalSolution(pMod, dX(0))
Call CheckErr(pEnv, nErr)
'********************************************
'* 变量太多，免费证书不支持，后面不写了。。。*
'********************************************
'----------------------------
' 删除Lindo环境
'----------------------------
Call LSdeleteEnv(pEnv)
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 还是靠VBA来帮我计算最少用你多少根棍子吧

评分

评分

点评