1

Тема: Задачі по штучному інтелекту

В цій темі буду пробувати розв’язувати задачі з 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), і це вже не кажучи про те, що і інші вузли можуть повторюватись. До того ж, пройшовши всі вузли і знаючи їх, ми могли б стверджувати, що задача не має розв’язку. Але ця задача відносно невелика і має розв’язок, тому програма легко з нею справляється.

МАКЕ ЦКЯАІИЕ БЯЕАТ АБАІИ
Подякували: 0xDADA11C7, Blast2

2

Re: Задачі по штучному інтелекту

Прихований текст
це відчуття... коли почуваєш себе повним дебилом... http://puu.sh/cqvGd/72fa81ea14.png
тут спілкуються українці, про політику, і інше (серед них є програмісти, але дуже мало, тому не заходьте туди лише з питаннями про програмування)
https://discord.gg/Zk29v4P
Подякували: 0xDADA11C7, Blast2