[已解决]VBA编写分酒问题

vbyou127 · 发表于 2016-5-14 10:38

VBA编写分酒问题

某人有12品脱的啤酒一瓶，想从中倒出6品脱，但他没有6品脱的容器，

仅有一个8品脱和一个5品脱的容器，怎样倒才能将啤酒分为两个6品脱呢?

找出全部的倒酒方法，并找出一种倒酒次数最少的方法?

最佳答案

月排行榜 / 总排行榜

香川群子

2016-5-14 22:59

不用递归，直接循环计算的代码：

Sub test5() 'by kagawa
Dim ar&(), br(), a, b, c, d, i
a = 12: b = 8: c = 5: d = 6 '目标值
ReDim ar(1 To 3, 1 To 99)
ar(1, 1) = a
For i = 1 To 99 '按大中小顺序计算
If ar(2, i) = 0 Then 'x>0,y=0: x->y
If ar(1, i) > b Then ar(2, i + 1) = b: ar(1, i + 1) = ar(1, i) - b Else ar(2, i + 1) = ar(1, i)
ar(3, i + 1) = ar(3, i)
ElseIf ar(3, i) < c Then 'y>0,z<C: y->z
If ar(2, i) + ar(3, i) > c Then ar(2, i + 1) = ar(2, i) + ar(3, i) - c: ar(3, i + 1) = c Else ar(3, i + 1) = ar(3, i) + ar(2, i)
ar(1, i + 1) = ar(1, i)
Else 'z>0,x<A: z->x
ar(1, i + 1) = ar(1, i) + ar(3, i)
ar(2, i + 1) = ar(2, i)
End If
If ar(1, i + 1) = d And ar(2, i + 1) = d Then Exit For
Next
ReDim Preserve ar(1 To 3, 1 To i + 1)
br = WorksheetFunction.Transpose(ar)
Stop
End Sub

复制代码

跳转到最佳答案楼层

香川群子 · 发表于 2016-5-14 21:59

本帖最后由香川群子于 2016-5-14 22:00 编辑

最快7步：
12 0 0
4 8 0
4 3 5
9 3 0
9 0 3
1 8 3
1 6 5
6 6 0

递归广度搜索得到各个层级的所有可分配结果如下：

最大容量	12	8	5
层级	大瓶	中瓶	小瓶	备注
0	12	0	0	起始状态
1	4	8	0	大瓶倒入中瓶 12-8=4
1	7	0	5	(其它无效路径)
2	0	8	4	(其它无效路径)
2	4	3	5	中瓶倒入小瓶 8-5=3
2	0	7	5	(其它无效路径)
2	7	5	0	(其它无效路径)
3	8	0	4	(其它无效路径)
3	9	3	0	小瓶倒回大瓶 4+5=9
3	5	7	0	(其它无效路径)
3	2	5	5	(其它无效路径)
4	8	4	0	(其它无效路径)
4	9	0	3	中瓶倒入小瓶 3-3=0
4	5	2	5	(其它无效路径)
4	2	8	2	(其它无效路径)
5	3	4	5	(其它无效路径)
5	1	8	3	大瓶倒入中瓶 9-8=1
5	10	2	0	(其它无效路径)
5	10	0	2	(其它无效路径)
6	3	8	1	(其它无效路径)
6	1	6	5	中瓶倒入小瓶 8-(5-3)=6
7	11	0	1	(其它无效路径)
7	6	6	0	小瓶倒回大瓶 1+5=6

香川群子 · 发表于 2016-5-14 22:05

本帖最后由香川群子于 2016-5-14 22:07 编辑

按大瓶 -> 中瓶、中瓶 -> 小瓶、小瓶 -> 大瓶、中瓶 -> 小瓶……这样每四步形成一个顺序循环，那么25步以后回到起点。

各步骤的中间状态如下：
12 0 0
4 8 0
4 3 5
9 3 0
9 0 3
1 8 3
1 6 5
6 6 0 ……题目需要的状态
6 1 5
11 1 0
11 0 1
3 8 1
3 4 5
8 4 0
8 0 4
0 8 4
0 7 5
5 7 0
5 2 5
10 2 0
10 0 2
2 8 2
2 5 5
7 5 0
7 0 5
12 0 0……回到起始状态。

香川群子 · 发表于 2016-5-14 22:32

本帖最后由香川群子于 2016-5-14 23:01 编辑

倒酒有2种方法，不同的顺序将导致不同的结果。

Dim a&, b&, c&, d&
Sub test() 'by kagawa
a = 12: b = 8: c = 5: d =6 '目标值
Debug.Print vbCr; a; 0; 0
Call Pour(a, 0, 0) '按大中小顺序递归计算
a = 12: b = 5: c = 8: d = 6 '目标值
Debug.Print vbCr; a; 0; 0
Call Pour(a, 0, 0) '按大小中顺序递归计算
End Sub
Sub Pour(x&, y&, z&) 'ABC顺序倒酒
If y = 0 Then 'x>0,y=0: x->y
If x > b Then y = b: x = x - b Else y = x: x = 0
ElseIf z < c Then 'y>0,z<C: y->z
If y + z > c Then y = y + z - c: z = c Else z = z + y: y = 0
Else 'z>0,x<A: z->x
x = x + z: z = 0
End If
Debug.Print x; y; z
If x = d And (y = d Or z = d) Then Debug.Print "任务完成！" Else Call Pour(x, y, z)
End Sub

复制代码

运行结果如下：
首先，按大中小顺序递归计算，只要7步：
12  0  0
4  8  0
4  3  5
9  3  0
9  0  3
1  8  3
1  6  5
6  6  0
任务完成！

其次，按大小中顺序递归计算，则需要18个步骤：
12  0  0
7  5  0
7  0  5
2  5  5
2  2  8
10  2  0
10  0  2
5  5  2
5  0  7
0  5  7
0  4  8
8  4  0
8  0  4
3  5  4
3  1  8
11  1  0
11  0  1
6  5  1
6  0  6
任务完成！

香川群子 · 发表于 2016-5-14 22:59

不用递归，直接循环计算的代码：

Sub test5() 'by kagawa
Dim ar&(), br(), a, b, c, d, i
a = 12: b = 8: c = 5: d = 6 '目标值
ReDim ar(1 To 3, 1 To 99)
ar(1, 1) = a
For i = 1 To 99 '按大中小顺序计算
If ar(2, i) = 0 Then 'x>0,y=0: x->y
If ar(1, i) > b Then ar(2, i + 1) = b: ar(1, i + 1) = ar(1, i) - b Else ar(2, i + 1) = ar(1, i)
ar(3, i + 1) = ar(3, i)
ElseIf ar(3, i) < c Then 'y>0,z<C: y->z
If ar(2, i) + ar(3, i) > c Then ar(2, i + 1) = ar(2, i) + ar(3, i) - c: ar(3, i + 1) = c Else ar(3, i + 1) = ar(3, i) + ar(2, i)
ar(1, i + 1) = ar(1, i)
Else 'z>0,x<A: z->x
ar(1, i + 1) = ar(1, i) + ar(3, i)
ar(2, i + 1) = ar(2, i)
End If
If ar(1, i + 1) = d And ar(2, i + 1) = d Then Exit For
Next
ReDim Preserve ar(1 To 3, 1 To i + 1)
br = WorksheetFunction.Transpose(ar)
Stop
End Sub

复制代码

雄鹰2013 · 发表于 2016-9-3 15:33

香川群子发表于 2016-5-14 22:05
按大瓶 -> 中瓶、中瓶 -> 小瓶、小瓶 -> 大瓶、中瓶 -> 小瓶……这样每四步形成一个顺序循环，那么25步以后 ...

为什么还要最后一步中瓶到小瓶，直接三步不行吗

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

[已解决]VBA编写分酒问题

相关帖子

评分

评分

评分

评分