返回列表 回復 發帖
shege

管理員

Rank: 9Rank: 9Rank: 9

熱心助人技巧高超優良網友傑出貢獻榮譽版主論壇元老銀牌會員高級會員金牌會員論壇顧問
1樓
打印
tT
發表於 2008-6-21 11:15 | 只看該作者

過河問題（一、二）

Cannibals & Missioneries

遊戲網址

野人與傳教士

遊戲的內容是這樣：幫助三個野人與三位傳教士過河，過河的工具為一艘船，這船一次最多只能搭載兩人，而且當其中一邊野人人數大於傳教士時，野人吃掉就會傳教士，讓這六個人過河失敗。

請問，要如何安全的讓這六個人輪流過河？

首先，要用暴力搜尋法找出所有解，一定要先做資料規劃：

１．全部搭船過河的搭配狀況為，傳教士一人、傳教士兩人，傳教與野人各一人，野人一人，野人兩人。還會有第六種嗎？沒了，總不能空船自己過河吧？
２．船一去一返，故全部完成過河時，總步驟數一定為單數。既然全部都過了河，船也就沒有必要把它弄回來，故為結束條件。
３．去程與返程搭船搭配狀況同條件１，故，過河步數可用單雙來表示去程或回程，並依此條件來增減本岸或對岸人數狀況。
４．全部到達對岸即搜尋結束，更換搜尋其他可符合的組合。
５．一定要記錄本岸（或對岸）人數狀況，同時也要排除送兩個野人過河後，又把兩個野人給送回來，一去一返後本岸（或對岸）人數完全相同之重複過河情況。
６．必要時增加步驟數最大上限，防止搜尋時出錯造成程式無法中斷。


實作：
' 需一個 Command , Name = Command1 ；一個 ListBox , Name = List1 。
  1. Option Explicit
  2. ' 過河
  3. Private Const MaxStep = 100     ' 預設步數上限值

  5. Dim b(1, MaxStep) As Integer    ' 本岸人數狀況
  6. ' b(0, x) = 本岸傳教 x 步時人數
  7. ' b(1, x) = 本岸野人 x 步時人數
  8. Dim r(MaxStep) As Integer   ' 目前正在執行的過河動作 (路徑)
  9. Dim Peoples As Integer      ' 人數上限
  10. Dim Counts As Integer       ' 符合組數

  12. Private Sub Command1_Click()
  13. List1.Clear
  14. Peoples = 3         ' 設定過河人數
  15. Counts = 0          ' 清除解答數
  16. b(0, 0) = Peoples   ' 設定本岸傳教人數
  17. b(1, 0) = Peoples   ' 設定本岸傳教人數
  18. run 0               ' 開始搜尋
  19. MsgBox "過河搜尋完畢，解答數為：" & vbCrLf & Counts
  20. End Sub

  22. Sub run(iStep As Integer)
  23. ' 執行過河動作, 傳入步數
  24. Dim i As Integer, j As Integer

  26. If iStep > MaxStep Then Exit Sub        ' 防溢位

  28. j = iStep + 1   ' 步驟數加一

  30. r(iStep) = 1    ' 設定傳教二人過河, 須對應觀察函式設定
  31. i = runChk(2, 0, iStep) ' 取得檢查變數, 供除錯用
  32. If i = 1 Then ' 未發生吃人, 繼續往下搜尋; 已有解就不呼叫遞迴
  33. '    Debugs iStep    ' 觀察求解過程, 請自行添加觀察
  34.     runOK 2, 0, iStep   ' 處理下個過河動作
  35.     run j
  36. End If

  38. r(iStep) = 2    ' 設定傳教一人過河
  39. If runChk(1, 0, iStep) = 1 Then     ' 直接判斷, 簡化程式碼與升速
  40.     runOK 1, 0, iStep
  41.     run j
  42. End If

  44. r(iStep) = 3    ' 設定傳教與野人各一人過河
  45. If runChk(1, 1, iStep) = 1 Then
  46.     runOK 1, 1, iStep
  47.     run j
  48. End If

  50. r(iStep) = 4    ' 設定野人各一人過河
  51. If runChk(0, 1, iStep) = 1 Then
  52.     runOK 0, 1, iStep
  53.     run j
  54. End If

  56. r(iStep) = 5    ' 設定野人各二人過河
  57. If runChk(0, 2, iStep) = 1 Then
  58.     runOK 0, 2, iStep
  59.     run j
  60. End If
  61. End Sub

  63. Function runChk(s1 As Integer, s2 As Integer, st As Integer) As Integer
  64. ' 判斷過河還是返回, 執行成功傳回 1, 否則為 0
  65. ' 若已全部渡河完畢, 傳回 0, 並秀出解答
  66. ' s1 為傳教人數, s2 為野人人數, st 為執行步數
  67. Dim i As Integer
  68. runChk = 0

  70. If st > 0 Then  ' 第二步以上要做重複路徑檢查
  71.     If r(st) = 0 Then Exit Function ' 詭異路徑, 防 Bug

  73.     If r(st - 1) = r(st) Then Exit Function ' 檢查是否跟上一動作一樣

  75.     If st Mod 2 = 0 Then
  76.         ' 去程處理
  77.         If b(0, st) - s1 = 0 And b(1, st) - s2 = 0 Then ' 是否完成渡河
  78.             chkEnd st           ' 顯示解答處理
  79.             Counts = Counts + 1 ' 解答數累加
  80.             Exit Function
  81.         End If
  82.         For i = 0 To st - 1 Step 2  ' 防止重複路徑搜尋
  83.             If b(0, i) = b(0, st) And b(1, i) = b(1, st) Then Exit Function
  84.         Next
  85.     End If
  86. End If

  88. If st Mod 2 = 0 Then
  89.     ' 去程
  90.     If b(0, st) - s1 < 0 Or b(1, st) - s2 < 0 Then Exit Function    ' 過河人數是否合理
  91.     If b(0, st) - s1 = 0 Or b(0, st) - s1 = Peoples Then            ' 傳教都在同一岸, 絕對安全
  92.         runChk = 1
  93.         Exit Function
  94.     End If
  95.     If b(0, st) - s1 < b(1, st) - s2 Then Exit Function                         ' 本岸傳教太少
  96.     If Peoples - b(0, st) + s1 < Peoples - b(1, st) + s2 Then Exit Function     ' 對岸傳教太少
  97. Else
  98.     ' 回程
  99.     If b(0, st) + s1 > Peoples Or b(1, st) + s2 > Peoples Then Exit Function    ' 返回人數是否合理
  100.     If b(0, st) + s1 = Peoples And b(1, st) + s2 = Peoples Then Exit Function   ' 不需要返回
  101.     If b(0, st) + s1 = 0 Or b(0, st) + s1 = Peoples Then            ' 傳教都在同一岸, 絕對安全
  102.         runChk = 1
  103.         Exit Function
  104.     End If
  105.     If b(0, st) + s1 < b(1, st) + s2 Then Exit Function                         ' 本岸傳教太少
  106.     If Peoples - b(0, st) - s1 < Peoples - b(1, st) - s2 Then Exit Function     ' 對岸傳教太少
  107. End If
  108. runChk = 1
  109. End Function

  111. Sub chkEnd(st As Integer)
  112. ' 顯示路徑搜尋結果, 傳入執行步數
  113. Dim i As Integer
  114. Dim s As String
  115. s = ""
  116. For i = 0 To st
  117.     s = s & r(i)
  118. Next
  119. ' 若想把輸出改成檔案時, 請取消下三行註解
  120. 'Open "C:\Ap.txt" For Append As #1
  121. 'Print #1, s
  122. 'Close #1
  123. List1.AddItem s
  124. End Sub

  126. Sub runOK(s1 As Integer, s2 As Integer, st As Integer)
  127. ' 處理過河人數狀況, 分別代入過河傳教人數, 野人人數, 與步驟數
  128. ' 雙數為過河, 單數為返回
  129. If st Mod 2 = 0 Then
  130.     b(0, st + 1) = b(0, st) - s1
  131.     b(1, st + 1) = b(1, st) - s2
  132. Else
  133.     b(0, st + 1) = b(0, st) + s1
  134.     b(1, st + 1) = b(1, st) + s2
  135. End If
  136. End Sub

  138. Sub Debugs(iStep As Integer)
  139. ' 觀察求解過程用
  140. Dim i As Integer
  141. Dim s As String
  142. Debug.Print iStep, r(iStep),
  143. s = Left(String(b(0, iStep), "人") & "   ", 3) & Left(String(b(1, iStep), "鬼") & "   ", 3)

  145. If iStep Mod 2 = 0 Then
  146.     s = s & "    "
  147. Else
  148.     s = s & " <- "
  149. End If

  151. Select Case r(iStep)
  152. Case 1
  153.     s = s & "人人"
  154. Case 2
  155.     s = s & "人 "
  156. Case 3
  157.     s = s & "人鬼"
  158. Case 4
  159.     s = s & " 鬼"
  160. Case 5
  161.     s = s & "鬼鬼"
  162. End Select

  164. If iStep Mod 2 = 0 Then
  165.     s = s & " -> "
  166. Else
  167.     s = s & "    "
  168. End If

  170. Debug.Print s & Left(String(Peoples - b(0, iStep), "人") & "   ", Peoples) & Left(String(Peoples - b(1, iStep), "鬼") & "   ", Peoples)
  171. End Sub
複製代碼
說明：

１．本程式使用遞迴求解，對於遞迴使用請多加研究。
２．解出來的路徑為最佳路徑解，自然是步驟數越少越好。
３．請勿直接拿本原始碼當作業交差了事，被教授逮著不給分是不關本文的事，請小心服用。

本文同步刊載於：http://tw.myblog.yahoo.com/shege-1975/article?mid=1988
收藏 分享 評分
回復 引用

訂閱 TOP

shege

管理員

Rank: 9Rank: 9Rank: 9

熱心助人技巧高超優良網友傑出貢獻榮譽版主論壇元老銀牌會員高級會員金牌會員論壇顧問
2樓
發表於 2008-7-5 10:08 | 只看該作者

過河問題（二）

這回，過河問題的條件升級了，原過河的吃人條件依然不變，人數各增加為五人，而船的載客量也變大了，最多能搭載三人，問，其符合解為？

同樣也需要做資料規劃，需要變更的規劃為：

１．除了原過河搭配狀況之外，還得增加傳教三人、傳教二人與野人一人、野人三人等合理狀況，請記得，傳教一人與野人二人是不能一塊搭船的，還沒過完河，人早就被吃了，故此條件不加入搜尋，不必浪費時間。

其餘的，請在除錯用函式裡新增這三種顯示結果。

實作，只列出修改的部分，其餘者請參閱過河問題（一）：
  1. Private Sub Command1_Click()
  2. List1.Clear
  3. Peoples = 5         ' 設定過河人數
  4. Counts = 0          ' 清除解答數
  5. b(0, 0) = Peoples   ' 設定本岸傳教人數
  6. b(1, 0) = Peoples   ' 設定本岸傳教人數
  7. run 0               ' 開始搜尋
  8. MsgBox "過河搜尋完畢，解答數為：" & vbCrLf & Counts
  9. End Sub

  11. Sub run(iStep As Integer)
  12. ' 執行過河動作, 傳入步數
  13. Dim i As Integer, j As Integer

  15. If iStep > MaxStep Then Exit Sub        ' 防溢位

  17. j = iStep + 1   ' 步驟數加一

  19. r(iStep) = 1    ' 設定傳教二人過河, 須對應觀察函式設定
  20. i = runChk(2, 0, iStep) ' 取得檢查變數, 供除錯用
  21. If i = 1 Then ' 未發生吃人, 繼續往下搜尋; 已有解就不呼叫遞迴
  22. '    Debugs iStep    ' 觀察求解過程, 請自行添加觀察
  23.     runOK 2, 0, iStep   ' 處理下個過河動作
  24.     run j
  25. End If

  27. r(iStep) = 2    ' 設定傳教一人過河
  28. If runChk(1, 0, iStep) = 1 Then     ' 直接判斷, 簡化程式碼與升速
  29.     runOK 1, 0, iStep
  30.     run j
  31. End If

  33. r(iStep) = 3    ' 設定傳教與野人各一人過河
  34. If runChk(1, 1, iStep) = 1 Then
  35.     runOK 1, 1, iStep
  36.     run j
  37. End If

  39. r(iStep) = 4    ' 設定野人各一人過河
  40. If runChk(0, 1, iStep) = 1 Then
  41.     runOK 0, 1, iStep
  42.     run j
  43. End If

  45. r(iStep) = 5    ' 設定野人二人過河
  46. If runChk(0, 2, iStep) = 1 Then
  47.     runOK 0, 2, iStep
  48.     run j
  49. End If

  51. r(iStep) = 6    ' 設定傳教三人過河
  52. If runChk(3, 0, iStep) = 1 Then
  53.     runOK 3, 0, iStep
  54.     run j
  55. End If

  57. r(iStep) = 7    ' 設定傳教二人, 野人一人過河
  58. If runChk(2, 1, iStep) = 1 Then
  59.     runOK 2, 1, iStep
  60.     run j
  61. End If

  63. r(iStep) = 8    ' 設定野人三人過河
  64. If runChk(0, 3, iStep) = 1 Then
  65.     runOK 0, 3, iStep
  66.     run j
  67. End If
  68. End Sub

  70. Sub Debugs(iStep As Integer)
  71. ' 觀察求解過程用
  72. Dim i As Integer
  73. Dim s As String
  74. Debug.Print iStep, r(iStep),
  75. s = Left(String(b(0, iStep), "人") & "   ", 3) & Left(String(b(1, iStep), "鬼") & "   ", 3)

  77. If iStep Mod 2 = 0 Then
  78.     s = s & "    "
  79. Else
  80.     s = s & " <- "
  81. End If

  83. Select Case r(iStep)
  84. Case 1
  85.     s = s & "人人"
  86. Case 2
  87.     s = s & "人 "
  88. Case 3
  89.     s = s & "人鬼"
  90. Case 4
  91.     s = s & " 鬼"
  92. Case 5
  93.     s = s & "鬼鬼"
  94. Case 6
  95.     s = s & "人人人"
  96. Case 7
  97.     s = s & "人人鬼"
  98. Case 8
  99.     s = s & "鬼鬼鬼"
  100. End Select

  102. If iStep Mod 2 = 0 Then
  103.     s = s & " -> "
  104. Else
  105.     s = s & "    "
  106. End If

  108. Debug.Print s & Left(String(Peoples - b(0, iStep), "人") & "   ", Peoples) & Left(String(Peoples - b(1, iStep), "鬼") & "   ", Peoples)
  109. End Sub
複製代碼
說明：

１．跟過河問題（一）來比較，本程式並沒有修改多少程式碼，只是增加幾個符合條件，以及修改過河人數這個參數罷了，對於相同類型的程式升級來，可謂快速升級。
２．請在開發程式前就先將常數資料盡可能用公用變數的方式來宣告，未來對程式升級時會省下許多維護時間。
３．同樣的要求，請勿直接拿程式碼當作業交差了事，還是花點心思弄懂搜尋原理。
４．求出來的解一共有８５５個，而且所用步驟數都不一樣，故有所謂「最佳路徑」解的說法，也就是說，在同樣的條件底下，所用的次數越少則愈佳！

本文同步刊載於：http://tw.myblog.yahoo.com/shege-1975/article?mid=2013
1

評分次數
回復 引用

TOP

返回列表 回復 發帖