form1.frm

自己编写的过桥问题的算法源码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6360
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9285
   LinkTopic       =   "Form1"
   ScaleHeight     =   6360
   ScaleWidth      =   9285
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Left            =   5880
      Top             =   2760
   End
   Begin VB.TextBox Text1 
      Height          =   1695
      Left            =   840
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   3120
      Width           =   3735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   1095
      Left            =   960
      TabIndex        =   0
      Top             =   1320
      Width           =   3375
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************
'  七个人过桥，时间分别为1,4,5,5,5,8,9，每次两个人过桥
'  以时间最慢的为过桥时间，过桥后选一个人带电筒回来
'  求最快的过桥时间
'  答案是40分钟
'  本解法不假思索采用穷举法，以后再完善
'******************************************************
Option Explicit
Private totalTime As Integer
Private minTime As Integer

Dim TimeToPass(7) As Integer
Dim minPassOrder(11, 2) As Integer

Private Type MemberPos
   SideA(7) As Integer
   SideB(7) As Integer
   timeConsume As Integer
   isUsed As Boolean
   personNum As Integer '人数
   passOrder(11, 2) As Integer
   nStep As Integer '步数
End Type

Dim pStime
Dim pEtime

'Dim m_memberPos As MemberPos

Private Sub Command1_Click()
    
  pStime = Time
    
  TimeToPass(0) = 4
  TimeToPass(1) = 5
  TimeToPass(2) = 5
  TimeToPass(3) = 1
  TimeToPass(4) = 5
  TimeToPass(5) = 9
  TimeToPass(6) = 8
   
  '设置初始化的状态
  Dim iniMember As MemberPos
  minTime = 5000 '最短时间设置为一个很大的数
'  Dim pass As Integer
  Dim way As Integer '0表示手电筒从左岸到右岸，1表示手电筒从右岸到左岸
  Dim pMemberInProcess As MemberPos
  
  Dim i As Integer: Dim j As Integer
  Dim a As Integer: Dim b As Integer
  
  '初始化
  iniMember = iniMemberPos
  Dim p As Integer: Dim q As Integer
  For p = 0 To 10
    For q = 0 To 1
        
        iniMember.passOrder(p, q) = 0
        minPassOrder(p, q) = 0
        
    Next q
  Next p
  
  '开始穷举
  For i = 0 To iniMember.personNum - 1
    For j = i + 1 To iniMember.personNum - 1
       iniMember = iniMemberPos
       If i <> j And iniMemberPos.SideA(i) > 0 And iniMemberPos.SideA(j) > 0 Then
          gotoB iniMember, i, j
       End If
    Next j
  Next i
  
  '输出结果
  For p = 0 To 10
        If p Mod 2 = 0 Then
           Text1.Text = Text1.Text + CStr(minPassOrder(p, 0)) + CStr(minPassOrder(p, 1)) + "---> " + Chr(13) + Chr(10)
        Else
           Text1.Text = Text1.Text + "<--- " + CStr(minPassOrder(p, 0)) + Chr(13) + Chr(10)
        End If
  Next p
  
  pEtime = Time
  
  Dim pInterval
  pInterval = pEtime - pStime
'  pInterval = Format(pInterval, "#.00")
  
  MsgBox CStr(minTime) + "用时" + CStr(pInterval) + "秒"
End Sub

Private Function NotZero(a() As Integer) As Integer
   Dim k As Integer
   NotZero = 0
   
   For k = 0 To UBound(a) - 1
      If a(k) > 0 Then
         NotZero = NotZero + 1
      End If
   Next k
   
End Function
'选两个人到B岸，如果A岸还有人则从B岸选最快的人到A岸
Private Function gotoB(pMemberPos As MemberPos, i As Integer, j As Integer)
      Dim a As Integer: Dim b As Integer
      Dim aNum As Integer: Dim bNum As Integer
      Dim k As Integer
      Dim p As Integer: Dim q As Integer
      
      pMemberPos.SideA(i) = 0
      pMemberPos.SideA(j) = 0
      pMemberPos.SideB(i) = 1
      pMemberPos.SideB(j) = 1
      
      pMemberPos.passOrder(pMemberPos.nStep, 0) = i
      pMemberPos.passOrder(pMemberPos.nStep, 1) = j
      pMemberPos.nStep = pMemberPos.nStep + 1
         
      pMemberPos.timeConsume = pMemberPos.timeConsume + BigConsume(TimeToPass(i), TimeToPass(j))
         
      aNum = NotZero(pMemberPos.SideB())
      If aNum = pMemberPos.personNum Then
         '************测试******************************
'         If pMemberPos.timeConsume = 40 Then
            Debug.Print pMemberPos.timeConsume
'            For p = 0 To 10
'                  If p Mod 2 = 0 Then
'                     Text1.Text = Text1.Text + CStr(minPassOrder(p, 0)) + CStr(minPassOrder(p, 1)) + "---> " + Chr(13) + Chr(10)
'                  Else
'                     Text1.Text = Text1.Text + "<--- " + CStr(minPassOrder(p, 0)) + Chr(13) + Chr(10)
'                  End If
'            Next p
'         End If
         '**********************************************
         
         If pMemberPos.timeConsume < minTime Then
            minTime = pMemberPos.timeConsume
            For p = 0 To 10
               For q = 0 To 1
                  
                   minPassOrder(p, q) = pMemberPos.passOrder(p, q)
                  
               Next q
            Next p
         End If
      Else
         gotoA pMemberPos
      End If
      
End Function
'选一个人带电筒去A岸，然后在选两个人到B岸
Private Function gotoA(pMemberPos As MemberPos)
       Dim a As Integer: Dim b As Integer: Dim k As Integer
       Dim pStorePos3 As MemberPos
       Dim pStorePos4 As MemberPos
       Dim pStorePos5 As MemberPos
       Dim pStorePos6 As MemberPos
       
       k = minIndex(pMemberPos, pMemberPos.SideB())
       pMemberPos.SideB(k) = 0
       pMemberPos.SideA(k) = 1
       pMemberPos.timeConsume = pMemberPos.timeConsume + TimeToPass(k)
       pMemberPos.passOrder(pMemberPos.nStep, 0) = k
       pMemberPos.passOrder(pMemberPos.nStep, 1) = 0
       pMemberPos.nStep = pMemberPos.nStep + 1
       
       Dim numA As Integer
       numA = NotZero(pMemberPos.SideA())
               
       If numA = 3 Then
            pStorePos3 = pMemberPos
            For a = 0 To pMemberPos.personNum - 1
              For b = a + 1 To pMemberPos.personNum - 1
                  pMemberPos = pStorePos3
                  If a <> b And pMemberPos.SideA(a) > 0 And pMemberPos.SideA(b) > 0 Then
                     gotoB pMemberPos, a, b
                  End If
              Next b
            Next a
       ElseIf numA = 6 Then
            pStorePos6 = pMemberPos
            For a = 0 To pMemberPos.personNum - 1
              For b = a + 1 To pMemberPos.personNum - 1
                  pMemberPos = pStorePos6
                  If a <> b And pMemberPos.SideA(a) > 0 And pMemberPos.SideA(b) > 0 Then
                     gotoB pMemberPos, a, b
                  End If
              Next b
            Next a
       ElseIf numA = 5 Then
            pStorePos5 = pMemberPos
            For a = 0 To pMemberPos.personNum - 1
              For b = a + 1 To pMemberPos.personNum - 1
                  pMemberPos = pStorePos5
                  If a <> b And pMemberPos.SideA(a) > 0 And pMemberPos.SideA(b) > 0 Then
                     gotoB pMemberPos, a, b
                  End If
              Next b
            Next a
       ElseIf numA = 4 Then
            pStorePos4 = pMemberPos
            For a = 0 To pMemberPos.personNum - 1
              For b = a + 1 To pMemberPos.personNum - 1
                  pMemberPos = pStorePos4
                  If a <> b And pMemberPos.SideA(a) > 0 And pMemberPos.SideA(b) > 0 Then
                     gotoB pMemberPos, a, b
                  End If
              Next b
            Next a
       Else
            For a = 0 To 3
              For b = a + 1 To 3
                  If a <> b And pMemberPos.SideA(a) > 0 And pMemberPos.SideA(b) > 0 Then
                     gotoB pMemberPos, a, b
                  End If
              Next b
            Next a
       End If
       
End Function
'冒泡排序
Private Function sort(ByRef a() As Integer) As Integer
  Dim k As Integer
  Dim c As Integer
  Dim m As Integer
  
  For m = 0 To UBound(a) - 2
     For k = 0 To UBound(a) - 1 - m
        If a(k) < a(k + 1) Then
           c = a(k)
           a(k) = a(k + 1)
           a(k + 1) = c
        End If
     Next k
  Next m
  
End Function

Private Function BigConsume(i As Integer, j As Integer)
  
  If i >= j Then BigConsume = i
  If i <= j Then BigConsume = j
  
End Function

Private Function minIndex(pMemberPos As MemberPos, a() As Integer) As Integer
  Dim i As Integer
  Dim t As Integer
  Dim ret As Integer
  
  t = 5000
  
  For i = 0 To pMemberPos.personNum - 1
      If a(i) > 0 Then
          If TimeToPass(i) <= t Then
             t = TimeToPass(i)
             ret = i
          End If
      End If
  Next i
  
  minIndex = ret
End Function

Private Function iniMemberPos() As MemberPos
  Dim iniMember As MemberPos
  iniMember.SideA(0) = 1
  iniMember.SideA(1) = 1
  iniMember.SideA(2) = 1
  iniMember.SideA(3) = 1
  iniMember.SideA(4) = 1
  iniMember.SideA(5) = 1
  iniMember.SideA(6) = 1
  
  iniMember.SideB(0) = 0
  iniMember.SideB(1) = 0
  iniMember.SideB(2) = 0
  iniMember.SideB(3) = 0
  iniMember.SideB(4) = 0
  iniMember.SideB(5) = 0
  iniMember.SideB(6) = 0
   
  iniMember.timeConsume = 0
  iniMember.personNum = 7
  
  iniMember.nStep = 0
  
  iniMemberPos = iniMember
  
End Function