Cannibals, Missionaries and the State Monad pt. 1

Part 2: A State Monad Introduction
Part 3: State Monad Implementation of Cannibals and Missionaries


As a preparation for my master, and to get myself into A.I. a bit more before starting my master, I have started working through Artificial Intelligence: A Modern Approach. I'm combining the exercises and interesting algorithms with functional programming by implementing the problems in Haskell.

The last exercise I did was a long solution to the well known Missionaries and Cannibals problem. (This is exercise 3.9b of the second edition of AIMA btw.)

From wikipedia: "In the missionaries and cannibals problem, three missionaries and three cannibals must cross a river using a boat which can carry at most two people, under the constraint that, for both banks, if there are missionaries present on the bank, they cannot be outnumbered by cannibals (if they were, the cannibals would eat the missionaries.) The boat cannot cross the river by itself with no people on board."

The exercise asks you two solve this problem by first formalizing it, and then searching through the state space by an appropriate search algorithm. (Complete and optimal). I chose iterative deepening depth-first search which is complete if the solution is at finite depth, and optimal if step costs are equal.

I'll introduce two solutions to this problem. The first was the solution I worked out the first time. I will work out that solution in this post.

But I was not really happy with all the parameters used in the search function and I decided to finally tackle the state monad to try to improve that solution, which I'll work out in the next blog post.

An Explicit State Implementation of Cannibals and Missionaries
First formalizing the problem:

We have two types of people, namely missionaries and cannibals. Furthermore we have 2 sides of the river, which we'll call left and right. This will be used to track the position of the boat. Therefore:

data Person = Missionary | Cannibal
 deriving (Ord, Eq, Show) -- used later

data Position = LeftSide | RightSide
 deriving (Eq, Show) -- used later

This would be nice to track in a record therefore:

data PState = PState {left :: [Person], right :: [Person], boat :: Position} 
 deriving (Eq, Show) -- used later

With this record we can already define the start and goalstate of the problem, namely:

beginState = PState {left = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], right = [], boat = LeftSide}
goalState =  PState {left = [], right = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], boat = RightSide}

Before trying to tackle the search algorithm we will try define a successors function, meaning a function that given a state, generates the subsequent possible states. Because of the boat size of 2 and the minimum number of passengers 1, we need to consider moves containing combinations of 1 or 2 People. I used a function to generate all permutations of length 1 and 2 and filter all doubles to retain the combinations.

-- unique combinations
genCombs :: Ord a => [a] -> [[a]]
genCombs = nub . map sort . genPerms

-- permutations of length 1 and 2 
genPerms :: Eq a => [a] -> [[a]]
genPerms [] = []
genPerms (x:xs) = [x] : (map (: [x]) xs) ++ genPerms xs

nub deletes all double (or more) elements, and sort sorts the list. (That's why I defined Person deriving Ord.) These are both imported from Data.List.

Let's generate all successors of a given state using these combinations:

-- generate all states after applying all possible combinations 
allSucc :: PState -> [PState] 
allSucc s 
 | boat s == LeftSide = map (updatePStateLeft s) (genCombs (left s))
 | otherwise          = map (updatePStateRight s) (genCombs (right s))

As you can see we consider two cases, the boat on the left side and on the right side of the river. The possible combinations are generated by taking all the persons available on the specific side of the river and calling genCombs. The sides are then updated for all combinations and returned as a list of possible next states.

-- move a number of cannibals and missonaries to the right side
updatePStateLeft s p = let oldLeft = left s
                           oldRight = right s 
                       in s {left = sort $ oldLeft \\ p,
                             right = sort $ oldRight ++ p,
                             boat = RightSide
                            }

-- move a number of cannibals and missonaries to the left side
updatePStateRight s p = let oldLeft = left s
                            oldRight = right s 
                        in s {left = sort $ oldLeft ++ p,
                              right = sort $ oldRight \\ p,
                              boat = LeftSide
                             }

But now we have a successor function that generates all possible states given the available persons, the other conditions are not met yet though. In some of our states some poor missionaries will be eaten, so we'll have to filter these out too. First we define a new successor function and then the corresponding filter function.

-- filter legal states
successors :: PState -> [PState]
successors = filter isLegalState . allSucc 

-- legal states are states with the number of cannibals equal or less 
-- to the number of missionaries on one riverside (or sides with no missionaries)
isLegalState :: PState -> Bool
isLegalState s = hasNoMoreCannibals (left s) && hasNoMoreCannibals (right s)
 where hasNoMoreCannibals lst = let lenMiss = length ( filter (== Missionary) lst) 
                                    lenCann = length ( filter (== Cannibal) lst)
                                in lenMiss == 0 || lenMiss >= lenCann

As you can see we first generate all successors using our previous function, and then filter out the incorrect states using isLegalState and filter. (//) takes a list and deletes the elements given if present. This function is also imported from Data.List.

So now that we have a begin and goal state, and a successor function we'll only need a goal test and a search function.

The goal test is trivial:

-- check if the state is a goal state
isGoalState :: PState -> Bool
isGoalState = (== goalState)

The solution to the problem will be a call to the search function with the beginstate and the startdepth to search. The result is a list of PState that depicts the trace of states to the goal state. So:

solution :: [PState]
solution = idfs beginState 0 

The search function idfs and especially the helper function idfs' will need some more explaining though and they aren't very elegant. First idfs:

idfs :: PState -> Int -> [PState]
idfs s n = case idfs' 0 n False s of 
            [] -> idfs s (n+1)
            other -> other

idfs is called with a state (at the first call the beginState), the current maxDepth, and it results in a lists of states containing the trace to the goal.
It calls the idfs' helper function to deliver the actual trace. If the result of the helper function is "[]", then there was no solution and the search depth is increased by a recursive call. Otherwise the solution is returned.

Now for the more difficult helper function idfs':

 where
  idfs' :: Int -> Int -> Bool -> PState -> [PState]

idfs' takes 4 parameters, which respectively are: the current depth, the current max depth, a boolean depicting if the solution is found and finally the current search node (or state).

Now I'll first explain the three border cases. The search should end if:
1. The boolean depicting the solution is found is true. In that case the current state should be added to the state trace.
2. The current state is a goal state. In that case the function should recursively be called with the boolean as true.
3. The current search depth is as large as the maximum search depth, in which case the search should stop. (And [] should be returned.

Therefore:

  idfs' m n True s = [s]
  idfs' m n False s
   | isGoalState s  = idfs' m n True s 
   | m==n           = []

If these cases do not happen then the search should recursively be applied to each successor of the current state. The first result of these searches that does not contain the empty list, contains the solution. In that case we should take that first result and return that along with the current state. Therefore:

   | otherwise      = case dropWhile (==[]) $ map (idfs' (m+1) n False) (successors s) of
                       []     -> []
                       (x:xs) -> s : x

And this concludes the search function :).

So now we're ready to call solution! Load up the definitions in ghci and call solution. The result will be:

[PState {left = [Missionary,Missionary,Missionary,Cannibal,Cannibal,Cannibal], r
ight = [], boat = LeftSide},PState {left = [Missionary,Missionary,Cannibal,Canni
bal], right = [Missionary,Cannibal], boat = RightSide},PState {left = [Missionar
y,Missionary,Missionary,Cannibal,Cannibal], right = [Cannibal], boat = LeftSide}
,PState {left = [Missionary,Missionary,Missionary], right = [Cannibal,Cannibal,C
annibal], boat = RightSide},PState {left = [Missionary,Missionary,Missionary,Can
nibal], right = [Cannibal,Cannibal], boat = LeftSide},PState {left = [Missionary
,Cannibal], right = [Missionary,Missionary,Cannibal,Cannibal], boat = RightSide}
,PState {left = [Missionary,Missionary,Cannibal,Cannibal], right = [Missionary,C
annibal], boat = LeftSide},PState {left = [Cannibal,Cannibal], right = [Missiona
ry,Missionary,Missionary,Cannibal], boat = RightSide},PState {left = [Cannibal,C
annibal,Cannibal], right = [Missionary,Missionary,Missionary], boat = LeftSide},
PState {left = [Cannibal], right = [Missionary,Missionary,Missionary,Cannibal,Ca
nnibal], boat = RightSide},PState {left = [Missionary,Cannibal], right = [Missio
nary,Missionary,Cannibal,Cannibal], boat = LeftSide},PState {left = [], right =
[Missionary,Missionary,Missionary,Cannibal,Cannibal,Cannibal], boat = RightSide}
]

It's not pretty, but at least it's a solution and an optimal one (the shortest solution is 11 steps, and therefore length 12) too.

Well this concludes the first part of the cannibals and missonaries problem. I will explain the state monad implementation of the search function in the next blog post.

I hope this was enjoyable :-).

For a State Monad introduction see Cannibals, Missionaries and the State Monad pt. 2.

The final code:

module AIMAMissionaries where
import Data.List(sort, nub, (\\))


data Person = Missionary | Cannibal
 deriving (Ord, Eq, Show)
 
data Position = LeftSide | RightSide
 deriving (Eq, Show)

data PState = PState {left :: [Person], right :: [Person], boat :: Position} 
 deriving (Eq, Show)
 
beginState = PState {left = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], right = [], boat = LeftSide}
goalState =  PState {left = [], right = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal], boat = RightSide}

almostGoalState = PState {left = [Cannibal], right = [Missionary, Missionary, Missionary, Cannibal, Cannibal], boat = LeftSide}
almostGoalState2 = PState {left = [Cannibal, Missionary, Missionary], right = [Missionary, Cannibal, Cannibal], boat = LeftSide}



solution :: [PState]
solution = idfs beginState 0

idfs :: PState -> Int -> [PState]
idfs s n = case idfs' 0 n False s of 
            [] -> idfs s (n+1)
            other -> other
 where
  idfs' :: Int -> Int -> Bool -> PState -> [PState]
  idfs' m n True s = [s]
  idfs' m n False s
   | isGoalState s  = idfs' m n True s 
   | m==n           = []
   | otherwise      = case dropWhile (==[]) $ map (idfs' (m+1) n False) (successors s) of
                       []     -> []
                       (x:xs) -> s : x

-- check if the state is a goal state
isGoalState :: PState -> Bool
isGoalState = (== goalState)

-- filter legal states
successors :: PState -> [PState]
successors = filter isLegalState . allSucc 

-- generate all states after applying all possible combinations 
allSucc :: PState -> [PState] 
allSucc s 
 | boat s == LeftSide = map (updatePStateLeft s) (genCombs (left s))
 | otherwise          = map (updatePStateRight s) (genCombs (right s))

-- move a number of cannibals and missonaries to the right side
updatePStateLeft s p = let oldLeft = left s
                           oldRight = right s 
                       in s {left = sort $ oldLeft \\ p,
                             right = sort $ oldRight ++ p,
                             boat = RightSide
                            }

-- move a number of cannibals and missonaries to the left side
updatePStateRight s p = let oldLeft = left s
                            oldRight = right s 
                        in s {left = sort $ oldLeft ++ p,
                              right = sort $ oldRight \\ p,
                              boat = LeftSide
                             }

-- unique combinations
genCombs :: Ord a => [a] -> [[a]]
genCombs = nub . map sort . genPerms

-- permutations of length 1 and 2 
genPerms :: Eq a => [a] -> [[a]]
genPerms [] = []
genPerms (x:xs) = [x] : (map (: [x]) xs) ++ genPerms xs
  
-- legal states are states with the number of cannibals equal or less 
-- to the number of missionaries on one riverside (or sides with no missionaries)
isLegalState :: PState -> Bool
isLegalState s = hasNoMoreCannibals (left s) && hasNoMoreCannibals (right s)
 where hasNoMoreCannibals lst = let lenMiss = length ( filter (== Missionary) lst) 
                                    lenCann = length ( filter (== Cannibal) lst)
                                in lenMiss == 0 || lenMiss >= lenCann

Edit: Added colouring :) and link to part 2.