求VB源程序 波瓦松的分酒趣题

Question

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

Answer 1

两个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 ExplicitPrivate Sub Command1_Click()
  Call ExtendedEuclid(8, 5, 6)
End SubPrivate Sub ExtendedEuclid(A As Long, B As Long, C As Long) 'ax+by=c, A,B,C为正数
  Dim GCDAB As Long
  Dim R As Long
  Dim X As Long, Y As Long
  
  GCDAB = GCD(A, B)  If C Mod GCDAB = 0 Then
    A = A / GCDAB
    B = B / GCDAB
    C = C / GCDAB
    
    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 SubPrivate Function GCD(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
      GCD = Min
      Exit Do
    End If
    Max = Min
    Min = ModResult
  Loop
End Function

Answer 2

不是我写的，搜出来的呵呵，我都还没想明白，你就贴出来了，赞一个抽象出来的算法分析是这样的
将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中倒

Answer 3

这个解方程速度快点
Option ExplicitPrivate Sub Command1_Click()
  Call ExtendedEuclid(7, 13, 8)
End SubPrivate Sub ExtendedEuclid(A As Long, B As Long, C As Long) 'ax+by=c, A,B,C为正整数，(A|B)互质
  Dim GCDAB 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
  
  GCDAB = GCD(A, B)  If C Mod GCDAB = 0 Then
    A = A / GCDAB
    B = B / GCDAB
    C = C / GCDAB
     
    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 SubPrivate Function GCD(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
      GCD = Min
      Exit Do
    End If
    Max = Min
    Min = ModResult
  Loop
End Function