A blag containing my current adventures in logic, haskell and agents.

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.


(First we import Control.Monad.State)

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 state
isGoalState :: PState -> Bool
isGoalState 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 1
increaseDepth :: PState -> PState
increaseDepth s = let depth = curDepth s in s{curDepth = depth + 1}

-- increase max search depth by 1
increaseMaxDepth :: PState -> PState
increaseMaxDepth 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 -> PState
addPath 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 implementation
idfs :: 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 solutions
safeHead :: [[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 order
solution :: [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 where
import Data.List(sort, nub, (\\))
import Control.Monad.State

data 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 order
solution :: [PState]
solution = reverse $ idfs beginState

-- State monad implementation
idfs :: 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 solutions
safeHead :: [[a]] -> [a]
safeHead [] = []
safeHead xs = head xs

-- increase current search depth by 1
increaseDepth :: PState -> PState
increaseDepth s = let depth = curDepth s in s{curDepth = depth + 1}

-- increase max search depth by 1
increaseMaxDepth :: PState -> PState
increaseMaxDepth 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 -> PState
addPath s = s{path = (s {path = []}) : path s}

-- check if the state is a goal state
isGoalState :: PState -> Bool
isGoalState s = left s == left goalState && right s == right goalState && boat s == boat 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 :: PState -> [Person] -> PState
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 :: PState -> [Person] -> PState
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

No comments:

Post a Comment

Post a Comment

Followers