# A dose of logic

## Monday, 10 August 2009

### Cannibals, Missionaries and the State Monad pt. 3

Part 1: An Explicit State Implementation of Cannibals and Missionaries
Part 2: A State Monad Introduction

Well this post took a lot longer to materialize due to the a lot of rewriting and extending of part 2. Anyway, I hope you will enjoy it. Comments are very welcome btw.

State Monad Implementation of Cannibals and Missionaries
I will start this post by pointing out possible improvements of the example from part 1, the cannibals and missionaries problem solution. Refer to part 1 for the old implementation if you need a refresher.

As we have seen at the first solution of the Cannibal problem we had defined a search function containing the type signature:
`idfs :: PState -> Int -> [PState]`

In the idfs function we increase our Int argument for each recursive call. This Int functioned as a counter for the current maximum search depth.
We could hide this integer argument instead of having to explicitly pass it every time we call it recursively.

The biggest improvement, however, can be gained by using the state monad in our helper function idfs'. Recall the large type signature of idfs':
`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).

We will hide this arguments by extending our record PState with some new fields. We will then use PState as our state in the state monad. (We won't need a boolean depicting if the solution is found.)
Our new PState:

`data PState = PState {                      left :: [Person],    -- left side of canal                      right :: [Person],   -- right side of canal                      boat :: Position,    -- position of boat                      curDepth :: Int,     -- current search depth                      maxDepth :: Int,     -- max search depth                      path :: [PState]     -- path found to solution                     }  deriving (Eq, Show)`

Defining our new beginState will be straightforward. The starting current and maxdepth should just be 0. Our idfs algorithm will increment the maxdepth with each recursive call, so 0 seems like a good starting point. The path should start empty.
`beginState :: PState beginState =  PState {         left = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal],         right = [],          boat = LeftSide,          curDepth = 0,          maxDepth = 0,         path = []        }`

Defining the goal state now has a slight quirk. The fields curDepth, maxDepth and path don't have a sensible goal value and I therefore just use undefined.
Our new goalState therefore is:
`goalState =  PState {         left = [],         right = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal],          boat = RightSide,          curDepth = undefined, -- arbitrary, to avoid warnings         maxDepth = undefined, -- arbitrary, to avoid warnings          path = undefined      -- arbitrary, to avoid warnings        }`

This new implementation of PState, and corresponding new goal and beginstate, forces almost no changes in the rest of our program. The only necessary change beside our idfs (and idfs') function(s) is the check for a goal state.
It is still straightforward though:
`-- check if the state is a goal stateisGoalState :: PState -> BoolisGoalState s = left s == left goalState && right s == right goalState && boat s == boat goalState`

Before starting with defining our search function and state monad we will define some helper functions to change our PState record more cleanly. We will need to able to increase the current and maxDepth by 1, and we need to be able to build up our path while maneuvering the search space.
`-- increase current search depth by 1increaseDepth :: PState -> PStateincreaseDepth s = let depth = curDepth s in s{curDepth = depth + 1}-- increase max search depth by 1increaseMaxDepth :: PState -> PStateincreaseMaxDepth s = let depth = maxDepth s in s{maxDepth = depth + 1}`

These functions are a straightforward record update, the following addPath function is a bit more dense though. Our current state not only contains the information of the problem, but also the path. When we add the current state to the path, the added state will still contain the older shorter path. This is needless clutter for our solution. We therefore empty the old path in the state that is added to the (possible) solution path.
`-- add the current state in front of the the path-- before adding the state the path in that state is replaced by [] (to avoid clutter) addPath :: PState -> PStateaddPath s = s{path = (s {path = []}) : path s}`

Now let's think about a sensible State s a for our solution. We already decided on our state type s, namely PState. A sensible type for our result a, would be the path, and would therefore we be a list of PStates ([PState]).
Thus: State PState [PState]

We can already change the type signature of idfs' into a much cleaner new one.
`    idfs' :: State PState [PState]`

Before diving in to the definition of idfs' we will first redefine idfs. Because we use a list for our solution path we can use the empty list as our case for failure. So when idfs calls the helper function idfs' and gets an empty list as a result it can increase the current max search depth by 1 and start the process again at the beginstate.

`-- State monad implementationidfs :: PState -> [PState]idfs s = case evalState idfs' s of            []    -> idfs \$ increaseMaxDepth s           other -> other`

The call to idfs' is done by using evalState. Recall that evalState runs the state and pulls out the result. When no solution is found the search depth is increased by 1, otherwise the solution is returned. The first call to our idfs function will be applied with beginState, therefore starting the search at maxDepth 0.

Now to define idfs'. The function starts by adding the current node to the path. After that the border cases are handled.
The search should end if:
1. The current state is a goal state. In this case we can immediately return our current path.
2. The current search depth is as large as the maximum search depth, in which case a path of [] should be returned.

`    idfs' = do modify addPath               s <- get               if isGoalState s                 then return (path s)                else if curDepth s >= maxDepth s                  then return []`

If no border cases occur our search will continue by calling idfs' recursively on all successors and taking the first solution that can be found. We will take the first real solution by taking the first non empty list as solution. If no solutions are found we should return the empty list indicating our search failed.

`                 else do modify increaseDepth                         s <- get                         let states = map (evalState idfs') (successors s)                          return . safeHead \$ dropWhile null states-- returns [] if there are no solutionssafeHead :: [[a]] -> [a]safeHead [] = []safeHead xs = head xs`

Now all that remains is our redefinition of the final solution. All the other functions can remain the same :).

`-- State trace of the solution to the cannibal/missionaries problem-- The solution is in reverse ordersolution :: [PState]solution = reverse \$ idfs beginState`

As you can see we also reverse our solution because we always added the last state on the front (for efficiency).

I hope you enjoyed this post as much as I did writing it :-).

If you have some corrections or comments, please feel free to make them.

The final code:

`module AIMAMissionariesStateMonad whereimport Data.List(sort, nub, (\\))import Control.Monad.Statedata Person = Missionary | Cannibal deriving (Ord, Eq, Show) data Position = LeftSide | RightSide deriving (Eq, Show)data PState = PState {                      left :: [Person],    -- left side of canal                      right :: [Person],   -- right side of canal                      boat :: Position,    -- position of boat                      curDepth :: Int,     -- current search depth                      maxDepth :: Int,     -- max search depth                      path :: [PState]     -- path found to solution                     }  deriving (Eq, Show) beginState :: PState beginState =  PState {         left = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal],         right = [],          boat = LeftSide,          curDepth = 0,          maxDepth = 0,         path = []        }goalState =  PState {         left = [],         right = [Missionary, Missionary, Missionary, Cannibal, Cannibal, Cannibal],          boat = RightSide,          curDepth = undefined, -- arbitrary, to avoid warnings         maxDepth = undefined, -- arbitrary, to avoid warnings          path = undefined      -- arbitrary, to avoid warnings        }-- State trace of the solution to the cannibal/missionaries problem-- The solution is in reverse ordersolution :: [PState]solution = reverse \$ idfs beginState-- State monad implementationidfs :: PState -> [PState]idfs s = case evalState idfs' s of            []    -> idfs \$ increaseMaxDepth s           other -> other where                idfs' :: State PState [PState]    idfs' = do modify addPath               s <- get               if isGoalState s                 then return (path s)                else if curDepth s >= maxDepth s                  then return []                 else do modify increaseDepth                         s <- get                         let states = map (evalState idfs') (successors s)                          return . safeHead \$ dropWhile null states-- returns [] if there are no solutionssafeHead :: [[a]] -> [a]safeHead [] = []safeHead xs = head xs-- increase current search depth by 1increaseDepth :: PState -> PStateincreaseDepth s = let depth = curDepth s in s{curDepth = depth + 1}-- increase max search depth by 1increaseMaxDepth :: PState -> PStateincreaseMaxDepth s = let depth = maxDepth s in s{maxDepth = depth + 1}-- add the current state in front of the the path-- before adding the state the path in that state is replaced by [] (to avoid clutter) addPath :: PState -> PStateaddPath s = s{path = (s {path = []}) : path s}-- check if the state is a goal stateisGoalState :: PState -> BoolisGoalState s = left s == left goalState && right s == right goalState && boat s == boat goalState-- filter legal statessuccessors :: 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 sideupdatePStateLeft :: PState -> [Person] -> PStateupdatePStateLeft 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 sideupdatePStateRight :: PState -> [Person] -> PStateupdatePStateRight s p = let oldLeft = left s                            oldRight = right s                         in s {                              left = sort \$ oldLeft ++ p,                              right = sort \$ oldRight \\ p,                              boat = LeftSide                             }  -- unique combinationsgenCombs :: 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 -> BoolisLegalState 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`