求VB源程序 波瓦松的分酒趣题
求源程序 请发 1551298227@qq.com
--------------------编程问答--------------------
--------------------编程问答--------------------
Option Explicit
Dim A&, B&, C&, D&
Private Sub Command1_Click()
A = Val(Text1(0).Text)
B = Val(Text1(1).Text)
C = Val(Text1(2).Text)
D = Val(Text1(3).Text)
Pour A, 0, 0
Pour2 A, 0, 0
End Sub
Sub Pour(ByVal x&, ByVal y&, ByVal z&)
'倒酒：A杯子，B杯子，C杯子，上一次状态
List1.AddItem x & " " & y & " " & z
If x = D And y = D Then
List1.AddItem "任务完成！"
Else
If x > 0 And y = 0 Then 'x->y
If x + y > B Then x = x + y - B: y = B Else y = y + x: x = 0
Pour x, y, z
ElseIf y > 0 And z < C Then 'y->z
If y + z > C Then y = y + z - C: z = C Else z = z + y: y = 0
Pour x, y, z
ElseIf z > 0 And x < A Then 'z->x
x = x + z: z = 0
Pour x, y, z
End If
End If
End Sub
Sub Pour2(ByVal x&, ByVal y&, ByVal z&)
'倒酒：A杯子，B杯子，C杯子，上一次状态
List1.AddItem x & " " & y & " " & z
If x = D And y = D Then
List1.AddItem "任务完成！"
Else
If x > 0 And z = 0 Then 'x->z
If x + z > C Then x = x + z - C: z = C Else z = z + x: x = 0
Pour2 x, y, z
ElseIf z > 0 And y < B Then 'z->y
If y + z > B Then z = y + z - B: y = B Else y = y + z: z = 0
Pour2 x, y, z
ElseIf y > 0 And x < A Then 'y->x
x = x + y: y = 0
Pour2 x, y, z
End If
End If
End Sub
--------------------编程问答--------------------
12倒到8里，12里剩4.
--------------------编程问答--------------------
不是我写的，搜出来的 --------------------编程问答--------------------
呵呵，我都还没想明白，你就贴出来了，赞一个 --------------------编程问答-------------------- 两个6品脱的啤酒要装到那里去呢？
只有一个8品脱和5品脱的容器，5品脱的装不下6品脱的啤酒
求解8*x+5*y=6的同余方程，得到：
X=-3, Y=6
X=2, Y=-2
也就是可以
取6次5品脱，倒出3次8品脱
取2次8品脱，倒出2次5品脱
前提是要有一个足够大的容器来容纳倒酒时产生的容量
Option Explicit--------------------编程问答--------------------
Private Sub Command1_Click()
Call ExtendedEuclid(8, 5, 6)
End Sub
Private Sub ExtendedEuclid(A As Long, B As Long, C As Long) 'ax+by=c, A,B,C为正数
Dim 易做图AB As Long
Dim R As Long
Dim X As Long, Y As Long
易做图AB = 易做图(A, B)
If C Mod 易做图AB = 0 Then
A = A / 易做图AB
B = B / 易做图AB
C = C / 易做图AB
If A <> 0 Then
For R = 0 To A - 1
If (C - B * R) Mod A = 0 Then
Debug.Print "X=" & (C - B * R) / A & ", Y=" & R
End If
Next R
End If
If B <> 0 Then
For R = 0 To B - 1
If (C - A * R) Mod B = 0 Then
Debug.Print "X=" & R & ", Y=" & (C - A * R) / B
End If
Next R
End If
Else
MsgBox "没有整数数解！"
Exit Sub
End If
End Sub
Private Function 易做图(A As Long, B As Long) As Long
Dim Min As Long, Max As Long, ModResult As Long
Dim Result As Long
Min = A
Max = B
Do
ModResult = Max Mod Min
If ModResult = 0 Then
易做图 = Min
Exit Do
End If
Max = Min
Min = ModResult
Loop
End Function
抽象出来的算法分析是这样的
将12品脱酒 8品脱和5品脱的空瓶平分，可以抽象为解不定方程：
8x-5y=6
其意义是：从12品脱的瓶中向8品脱的瓶中倒x次，并且将5品脱瓶中的酒向12品脱的瓶中倒y次，最后在12品脱的瓶中剩余6品脱的酒。
用a,b,c代表12品脱、8品脱和5品脱的瓶子，求出不定方程的整数解，按照不定方程的意义则倒法为：
a -> b -> c ->a
x y
倒酒的规则如下：
1) 按a -> b -> c ->a的顺序；
2) b倒空后才能从a中取
3) c装满后才能向a中倒 --------------------编程问答-------------------- 最大容量限定是12品脱，可以这样倒酒（取2次8品脱，倒出2次5品脱）
12品脱的作为倒酒时的最大容器
12品脱 8品脱 5品脱
12 0 0
0 8 4
8 4 0
3 4 5
3 8 1
11 0 1
11 1 0
6 1 5
6 6 0
--------------------编程问答-------------------- 这个解方程速度快点
Option Explicit--------------------编程问答-------------------- 0 7 5
Private Sub Command1_Click()
Call ExtendedEuclid(7, 13, 8)
End Sub
Private Sub ExtendedEuclid(A As Long, B As Long, C As Long) 'ax+by=c, A,B,C为正整数，(A|B)互质
Dim 易做图AB As Long
Dim ModResultSeries() As Long, ModResultSeriesUpper As Long
Dim Min As Long, Max As Long, ModResult As Long
Dim i As Long
Dim R As Long
Dim Ra As Long, Rb As Long
Dim IsX As Boolean
ReDim ModResultSeries(B) As Long
ModResultSeriesUpper = 0
易做图AB = 易做图(A, B)
If C Mod 易做图AB = 0 Then
A = A / 易做图AB
B = B / 易做图AB
C = C / 易做图AB
ModResultSeriesUpper = 1
ModResultSeries(ModResultSeriesUpper) = -B
Min = A
Max = B
Do
ModResult = Max Mod Min
If ModResult = 0 Then
R = 1
For i = ModResultSeriesUpper - 1 To 1 Step -1
R = (1 + ModResultSeries(i) * R) / -ModResultSeries(i + 1)
Next i
R = R * C
Rb = R Mod B
Ra = (C - A * Rb) / B
Debug.Print "X=" & B & "*k+(" & Rb & ")"
Debug.Print "Y=-(" & A & ")*k+(" & Ra & ")"
Exit Do
End If
ModResultSeriesUpper = ModResultSeriesUpper + 1
ModResultSeries(ModResultSeriesUpper) = -Min
Max = Min
Min = ModResult
Loop
Else
MsgBox "没有整数数解！"
Exit Sub
End If
End Sub
Private Function 易做图(A As Long, B As Long) As Long
Dim Min As Long, Max As Long, ModResult As Long
Dim Result As Long
Min = A
Max = B
Do
ModResult = Max Mod Min
If ModResult = 0 Then
易做图 = Min
Exit Do
End If
Max = Min
Min = ModResult
Loop
End Function
5 7 0
5 2 5
10 2 0
2 8 2
4 3 5
9 3 0
1 8 3
1 6 5
6 6 0
--------------------编程问答-------------------- 4 8 0
4 3 5
9 3 0
1 8 3
1 6 5
6 6 0
补充：VB , 基础类
