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:

dataPerson = Missionary | Cannibal

deriving(Ord, Eq, Show)-- used laterdataPosition = LeftSide | RightSide

deriving(Eq, Show)-- used later

This would be nice to track in a record therefore:

dataPState = 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 =letoldLeft = left s

oldRight = right s

ins {left = sort $ oldLeft \\ p,

right = sort $ oldRight ++ p,

boat = RightSide

}-- move a number of cannibals and missonaries to the left side

updatePStateRight s p =letoldLeft = left s

oldRight = right s

ins {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)

wherehasNoMoreCannibals lst =letlenMiss = length ( filter (== Missionary) lst)

lenCann = length ( filter (== Cannibal) lst)

inlenMiss == 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 =caseidfs' 0 n False sof

[] -> 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 =casedropWhile (==[]) $ 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:

moduleAIMAMissionarieswhereimportData.List(sort, nub, (\\))dataPerson = Missionary | Cannibal

deriving(Ord, Eq, Show)

dataPosition = LeftSide | RightSide

deriving(Eq, Show)dataPState = 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 =caseidfs' 0 n False sof

[] -> 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 =casedropWhile (==[]) $ 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 =letoldLeft = left s

oldRight = right s

ins {left = sort $ oldLeft \\ p,

right = sort $ oldRight ++ p,

boat = RightSide

}-- move a number of cannibals and missonaries to the left side

updatePStateRight s p =letoldLeft = left s

oldRight = right s

ins {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)

wherehasNoMoreCannibals lst =letlenMiss = length ( filter (== Missionary) lst)

lenCann = length ( filter (== Cannibal) lst)

inlenMiss == 0 || lenMiss >= lenCann

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

## No comments:

## Post a Comment