自力更生：钢筋下料组合优化正式版发布（一维）

aoe1981 · 发表于 2014-10-28 16:15

　　对比测试二：
　　将数据改大：

序号	下料长度	数量/根
1	1200	9
2	2650	5
3	6350	7
4	6000	3
5	3000	8

则法师的附件为优！

图如下：
对比1.jpg

看来，我要努力实现随机算法了……

我的“排序＋小遍历”看来是凑巧的……

惭愧惭愧！！！

aoe1981 · 发表于 2014-10-28 16:23

本帖最后由 aoe1981 于 2014-10-31 22:24 编辑

　　如果实现了随机算法，我想就可以摆脱对原始数据排序的依赖了……

　　我采用排序的策略，可能是基于：优先搭配大料，其次是小料的思路影响……这种思路很狭隘！！！

　　所谓“小遍历”，即是实现了每种规格的料都有可能进行优先搭配……这个和上面的思路似乎有所不协调，可能更接近随机的方法，但不是真正地随机，可能我是受到了偶然数据表现出的最优结果的误导了……

　　其实，我尝试过可控大量的随机算法，我的做法是用［香川经典数组洗牌法］把原始数据打乱，重新搭配，然后沉淀优秀方案……
　　但我在测试时发现，还不如我上面的做法，那怕随机到很大的次数上……

　　我想，我没有发现随机算法的真谛……

　　现在想来，随机算法应当有以下特点：
　　必须要使整个随机过程呈现收敛的特点，要向最优方案逼近……这个过程不能是随机不可控的、漫无目标的，更不能是发散的……

aoe1981 · 发表于 2014-10-29 15:29

　　经测试研究发现，5楼所罗列的两条优化标准的第2条：
　　“余料方差最大”
　　不太妥帖。

　　这条标准目前不如改换为：
　　余料根数最少。
　　因为，有种极端情况下，余料方差也会很大，比如：实现的余料长度为4000，假设这4000的余料如此分布：
　　3500，100，100，100，100，100　　（此时方差为：12300000）
　　这时得到的余料方差就很大，但是余料根数很多，往往不如下面的方案：
　　1000，1000，1000，1000　　　　　　（此时方差为：4000000）

　　所以，优化的标准要有次序：
　　1.余料要少；
　　2.余料根数要少；
　　3.余料方差要大。

　　下面传一个不太成熟的随机版：
　　

钢筋下料优化（随机版）.rar (50.5 KB, 下载次数: 239)

aoe1981 · 发表于 2014-10-29 15:33

　　上楼附件采用了上楼1、2两条标准，名为随机，不太随机，待进一步研究……
　　在许多与法师附件的对比测试中发现，还是不如法师附件中的算法。因为我的算法其实是伪随机……

　　现在，也有了随机的思路，需重写代码了……能利用的代码估计得排除之前的所谓“核心代码”了……希望能成功，是一个值得一试的思路……

aoe1981 · 发表于 2014-10-30 08:30

本帖最后由 aoe1981 于 2014-10-30 08:36 编辑

　　实现了真正随机算法的附件已发布，见1楼，先占楼，再做介绍。
　　所以叫正式版，有两大原因：
　　一、实现了随机优化的算法；
　　二、实现了14楼关于“优化”的三条标准：
　　1.余料要少；
　　2.余料根数要少；
　　3.余料方差要大。

aoe1981 · 发表于 2014-10-30 08:40

　　正式版附件一角：
　　

　　该附件一直在与法师“一维下料”附件的对比测试中进行不断完善，下面再传两个相关附件：
　　尊敬的法师的附件：
　　

一维下料.rar (31.17 KB, 下载次数: 461)
　　我的方差验证附件：
　　

方差验算.rar (5.63 KB, 下载次数: 246)

aoe1981 · 发表于 2014-10-30 08:51

本帖最后由 aoe1981 于 2014-11-1 21:26 编辑

　　是怎样的随机算法呢？
　　我们想像一下：
　　假设下料的总根数为n，首先要实现【起点随机】，这一步是通过【香川经典数组洗牌法】打乱原始数据实现的，为何不直接随机抽取一个作为随机抽取的起点呢？是因为这样做，始终使随机抽取的第一根料保持在首位，从而使得下料搭配只考虑“向后搭配”，便于代码的展开。其实我前面所发的一个“伪随机”附件已经做到了这一点，但光这一点远远不够，还需要【搭配过程随机】相辅助，才能真正模拟随机的状态，这也正是前面附件所欠缺的，也正是“正式版”的核心优点！

　　随机抽取第1根料后，假设抽取的是n1，可与之进行搭配的料设有m1个，构成一个集合，这个m1大多数时候应当比n-1要小。好了，此时，在这个集合中，不再按序搭配了，而是改成随机抽取搭配，假设抽取到的是n2。

　　下面再看当前的搭配：n1+n2，如果可以继续搭配的话，可与之搭配的集合设为m2，这时的元素个数多数时候应当比m1要小。好了，继续从中随机抽取搭配。

　　……

　　好的，接下来继续重复上述过程。

aoe1981 · 发表于 2014-10-30 08:56

本帖最后由 aoe1981 于 2014-11-1 21:29 编辑

　　附件中全部代码如下：

Option Explicit
Public Sub YouHua() '优化
'准备工作与转存数组
Range("f12:f16,f21:f24").ClearContents
Range("i2:i" & Rows.Count).ClearContents
Range("k2:v" & Rows.Count).ClearContents
Dim m%, n&, arr, i&, j&, k&, lzh#, lduan#, js&, gd#
lzh = Range("f1").Value '整料
lduan = Range("f3").Value '短料
m = Range("f4").Value '种数
n = Range("f5").Value '根数
If m = 0 Then MsgBox "请输入下料长度与数量！", , "友情提示": Exit Sub
ReDim yssj#(1 To n), crr#(1 To m, 1 To 2) '原始数据
arr = Range("b2:c31").Value
k = 0 '计数初始化
For i = 1 To 30 '排除arr中空值，形成crr数组
If arr(i, 1) <> "" And arr(i, 2) <> "" Then
k = k + 1
crr(k, 1) = arr(i, 1): crr(k, 2) = arr(i, 2)
End If
Next i
k = 0
For i = 1 To m '转存一维数组
For j = 1 To crr(i, 2)
k = k + 1
yssj(k) = crr(i, 1)
Next j
Next i
'排除整料与准整料（即余料小于短料）
ReDim jg11(1 To 1, 1 To m), jg12(1 To 1, 1 To m) '结果1
js = 0 '输出第一部分结果时的行数
For i = 1 To m
If crr(i, 1) > lzh - lduan Then
js = js + 1
jg11(1, js) = crr(i, 1)
jg12(1, js) = crr(i, 2)
End If
Next i
If js > 0 Then
ReDim Preserve jg11(1 To 1, 1 To js), jg12(1 To 1, 1 To js)
Range("i2").Resize(js) = WorksheetFunction.Transpose(jg12) '输出根数
Range("k2").Resize(js) = WorksheetFunction.Transpose(jg11) '输出规格
End If
'整理原始数据
Dim n1& '需搭配的下料根数
n1 = n - WorksheetFunction.Sum(jg12)
If n1 = 0 Then MsgBox "下料长度不能搭配，不需要优化！", , "友情提示": Exit Sub
ReDim sj#(1 To n1), sj1#(1 To n1), sj2$(1 To n1), jg$(1 To n1)
k = 0
For i = 1 To n
If yssj(i) <= lzh - lduan Then
k = k + 1
sj(k) = yssj(i) '排除整料和准整料后的原始数据
sj1(k) = yssj(i) '用于搭配求和
End If
Next i
Range("f12") = WorksheetFunction.Max(sj) '搭配料最长
Range("f13") = WorksheetFunction.Min(sj) '搭配料最短
Range("f14") = m - js '搭配料种数
Range("f15") = n1 '搭配料根数
Range("f16") = WorksheetFunction.Sum(sj) '搭配料总长
If n1 = n Then
MsgBox "没有整料和准整料！" & Chr(10) & Chr(10) & "下面即将开始可以搭配下料的组合优化，请耐心等待！", , "友情提示"
Else
MsgBox "不能搭配下料的整料和准整料已排除完毕！" & Chr(10) & Chr(10) & "下面即将开始可以搭配下料的组合优化，请耐心等待！", , "友情提示"
End If
'需搭配的下料组合优化（★★★核心代码★★★）
Dim t#, pd As Boolean, yl#, minyl#, r&, h%, l%, brr, sxgs&
Dim ylgs&, minylgs&, ylfc#, ylfc1#, maxylfc#, sjcs&, ii&, i3&, sjxb&, dapaizhi# '随机次数、随机下标、搭配值
t = Timer
minyl = Range("f16").Value '最小余料
sxgs = 0 '实现根数
minylgs = n1 '最小余料根数
maxylfc = 0 '最大余料方差
sjcs = Range("f27").Value * 1000
Randomize
For ii = 1 To sjcs
For k = 1 To n1 - 1
If sj1(k) > 0 Then '跳过已搭配的料
dapaizhi = sj1(k) '当前搭配值
sj2(k) = sj1(k) '搭配组合连接初值
100:
ReDim sj3#(1 To n1)
i3 = 0
For i = k + 1 To n1
If sj1(i) > 0 And sj1(i) <= lzh - dapaizhi Then '筛选出当前dapaizhi的可搭配料存入sj3，sj3的元素可变
i3 = i3 + 1
sj3(i3) = sj1(i)
End If
Next i
If i3 > 0 Then '存在可搭配料时
ReDim Preserve sj3#(1 To i3)
sjxb = Int(Rnd() * i3) + 1 '★随机搭配可搭配的下料规格★
dapaizhi = dapaizhi + sj3(sjxb)
sj1(k) = dapaizhi
sj2(k) = sj2(k) & "+" & sj3(sjxb)
For i = k + 1 To n1
If sj1(i) = sj3(sjxb) Then sj1(i) = 0: Exit For '已搭配料归0
Next i
GoTo 100
End If
End If
Next k
If sj1(n1) > 0 Then sj2(n1) = sj1(n1) '防止最后一个值未被搭配时遗漏
yl = 0: ylgs = 0: ylfc = 0
For i = 1 To n1
If sj1(i) <> 0 Then
yl = yl + (lzh - sj1(i)) '计算余料
If sj1(i) < lzh Then ylgs = ylgs + 1 '计算余料根数（搭配后小于整料长度）
ylfc = ylfc + (lzh - sj1(i)) ^ 2 '计算余料方差
End If
Next i
If yl <= minyl And ylgs <= minylgs Then '记录相对较优方案：余料少、余料根数少
If ylfc > maxylfc Then '余料方差大
For i = 1 To n1 '结果出口1
jg(i) = sj2(i)
Next i
ylfc1 = ylfc '用于正确输出结果
pd = True
End If
If ylgs < minylgs Then
maxylfc = ylfc '★余料根数减少时重新记录最大余料方差★
For i = 1 To n1 '结果出口2
jg(i) = sj2(i)
Next i
pd = False
End If
minyl = yl: minylgs = ylgs
End If
Randomize
For i = 1 To n1 '利用【香川经典数组洗牌法】乱序恢复sj1数组数据，准备下一次随机搭配
r = Int(Rnd() * (n1 - i + 1)) + i
gd = sj(r): sj(r) = sj(i): sj(i) = gd
sj1(i) = sj(i): sj2(i) = ""
Next i
Next ii
'输出结果至工作表
Range("f22").Value = minyl
Range("f23").Value = minylgs
Range("f24").Value = Format(Sqr(IIf(pd, ylfc1, maxylfc)) / minylgs, "0.00")
ReDim jgjs(1 To n1) '结果计数
For i = 1 To n1 '对结果字串中连接的下料规格做从大到小排序处理
If jg(i) <> "" Then
brr = Split(jg(i), "+")
For j = 0 To UBound(brr) - 1
For k = j + 1 To UBound(brr)
If brr(j) < brr(k) Then gd = brr(k): brr(k) = brr(j): brr(j) = gd
Next k
Next j
jg(i) = ""
For j = 0 To UBound(brr)
jg(i) = jg(i) & "+" & brr(j)
Next j
End If
Next i
For i = 1 To n1 - 1 '去重并计数
If jg(i) <> "" Then
For j = i + 1 To n1
If jg(j) = jg(i) Then jgjs(i) = jgjs(i) + 1: jg(j) = ""
Next j
End If
Next i
h = js + 2 '行
For i = 1 To n1
If jg(i) <> "" Then
Cells(h, "i").Value = jgjs(i) + 1
sxgs = sxgs + jgjs(i) + 1
brr = Split(jg(i), "+")
l = 11 'K列
For j = 1 To UBound(brr)
Cells(h, l).Value = brr(j)
l = l + 1
Next j
h = h + 1
End If
Next i
Range("f21").Value = sxgs
MsgBox "用时：" & Format(Timer - t, "0.0000") & "秒。", , "友情提示"
End Sub

复制代码

　　为了查看下行数，只有一个过程，没有复杂的调用。

aoe1981 · 发表于 2014-10-30 08:58

　　下面是关于如何实现“优化”的三条标准的代码，是我的代码的第二个核心，也是自认为比法师附件强的地方：

If yl <= minyl And ylgs <= minylgs Then '记录相对较优方案：余料少、余料根数少
If ylfc > maxylfc Then '余料方差大
For i = 1 To n1 '结果出口1
jg(i) = sj2(i)
Next i
ylfc1 = ylfc '用于正确输出结果
pd = True
End If
If ylgs < minylgs Then
maxylfc = ylfc '★余料根数减少时重新记录最大余料方差★
For i = 1 To n1 '结果出口2
jg(i) = sj2(i)
Next i
pd = False
End If
minyl = yl: minylgs = ylgs
End If

复制代码

aoe1981 · 发表于 2014-10-30 09:05

　　三条优化标准，不是简单的并列关系，也不是简单的顺序关系，总体上应当是这样：
　　首先要实现余料总长度最少（终极目标是实现“理想余料”）；
　　其次是，该余料总长度有许多种分布，要找出“余数根数最少”的所有组合；
　　最后，在上述组合中挑出“余料方差最大”的组合，这样，估计在大量随机下，将愈来愈接近“最优方案”！

　　上述2、3步的作用，是为了共同实现“余料余大料且根数少”的目标！

　　有兴趣的可以进一步研究下，上述2、3两条标准的逻辑关系甚是复杂，我在测试中反复在这出错，所以大家可以看到，我的实现三条标准的代码处理比较奇怪、复杂，就是这个原因。简单地说：因为在余料根数大的时候，往往会得到更大的方差，必须要先完成余料最小根数的寻找后再比较方差。

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

[原创] 自力更生：钢筋下料组合优化正式版发布（一维）

最新热点 /1