В цій темі буду пробувати розв’язувати задачі з Artificial Intelligence: a Modern Approach, а місцеві гуру критикуватимуть мене за не звідти вирослі кінцівки і не туди повернені мізки.
Три місіонери та три канібали знаходяться на березі річки. Там же знаходиться човен, який може вмістити одного або двох людей. Потрібно знайти спосіб переправити на іншу сторону річки весь цей натовп, не допускаючи переваги канібалів над місіонерами на жодному з берегів річки.
Формуємо дерево пошуку. Його коренем буде початковий стан, який матиме п’ять нащадків, в кожного з яких теж буде п’ять нащадків, в кожного з яких... Ну ви зрозуміли. Шукатимемо в глибину: перевіряємо всіх нащадків на певній відстані від кореня. Цю відстань підбиратимемо послідовно: спочатку спустившись до найближчих нащадків, якщо там немає відповіді — спустимось далі і далі.
▼Код
import Data.List
data Human = Missioner | Cannibal deriving (Eq, Show)
data Boat = OnLeft | OnRight deriving (Eq, Show)
type Group = [Human]
data State = State{ leftBank :: Group, rightBank :: Group, boat :: Boat} deriving Show
isCannibalsNotMore :: Group -> Bool
isCannibalsNotMore b = let m = length $ filter (== Missioner) b
in
m == 0 || (length $ filter (== Cannibal) b) <= m
isSafeState :: State -> Bool
isSafeState s = (isCannibalsNotMore $ leftBank s) && (isCannibalsNotMore $ rightBank s)
--змінюємо стан: забираємо персонажів з одного берега, додаємо їх до іншого і переміщуємо човен
movePeople :: State -> Group -> State
movePeople state inBoat | (boat state == OnLeft) = State{ leftBank = leftBank state \\ inBoat,
rightBank = rightBank state ++ inBoat,
boat = OnRight
}
| (boat state == OnRight) = State{ leftBank = leftBank state ++ inBoat,
rightBank = rightBank state \\ inBoat,
boat = OnLeft
}
isEnoughFor :: Group -> Group -> Bool
isEnoughFor x [] = True
isEnoughFor xs (y:ys) = if y `elem` xs
then (y `delete` xs) `isEnoughFor` ys
else False
isDone :: State -> Bool
isDone s = null $ leftBank s
--повертає персонажі на тому березі, на якому знаходиться човен
boatsBank :: State -> Group
boatsBank s | (boat s == OnLeft) = leftBank s
| (boat s == OnRight) = rightBank s
--шукає відповідь; якщо не знайдено, обробляє нащадків
searchAnswer :: State -> Int -> String -> String
searchAnswer s 0 ans = ""
searchAnswer s depth ans | isDone s = ans
| not $ isSafeState s = ""
| otherwise = let
c = (processBranch s [Cannibal] depth ans)
m = (processBranch s [Missioner] depth ans)
cc = (processBranch s [Cannibal, Cannibal] depth ans)
cm = (processBranch s [Cannibal, Missioner] depth ans)
mm = (processBranch s [Missioner, Missioner] depth ans)
in
if not (c == "") then c else
if not (m == "") then m else
if not (cc == "") then cc else
if not (cm == "") then cm else
mm
--задача рекурсивна: пошук в дереві глибиною n — це пошук в кожному з піддерев глибиною n-1
processBranch :: State -> Group -> Int -> String -> String
processBranch state group depth acc = if (boatsBank state) `isEnoughFor` group then
let s = movePeople state group in
searchAnswer s (depth - 1) ((if boat s == OnLeft then "<-" else "->") ++ show group ++ "\n" ++ acc)
else ""
--якщо не знайдено на глибині n, шукаємо на глибині n+1
iterativeSearch :: State -> Int -> String
iterativeSearch s n = let str = searchAnswer s n "" in if str == "" then iterativeSearch s (n + 1) else str
state = State{leftBank =[Cannibal, Missioner, Cannibal, Missioner, Cannibal, Missioner, Cannibal, Missioner], rightBank = [], boat =OnLeft}
main = putStr $ iterativeSearch state 0 ""
▼Вивід
->[Cannibal,Cannibal]
<-[Cannibal]
->[Cannibal,Cannibal]
<-[Cannibal]
->[Missioner,Missioner]
<-[Cannibal,Missioner]
->[Missioner,Missioner]
<-[Cannibal]
->[Cannibal,Cannibal]
<-[Cannibal]
->[Cannibal,Cannibal]
Знайдене таким чином рішення оптимальне по довжині — якщо пошук дійшов до такої глибини, то вище рішення точно немає. Але цей алгоритм не пам’ятає своєї історії і змушений постійно її повторювати. Наприклад, у кожного вузла на рівні n є ідентичний нащадок, розташований на рівні n+2. Виключення їх з розгляду спростило б алгоритм з O(5^n) до O(4^n), і це вже не кажучи про те, що і інші вузли можуть повторюватись. До того ж, пройшовши всі вузли і знаючи їх, ми могли б стверджувати, що задача не має розв’язку. Але ця задача відносно невелика і має розв’язок, тому програма легко з нею справляється.
