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:

dataPState = 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 =letdepth = curDepth sins{curDepth = depth + 1}-- increase max search depth by 1

increaseMaxDepth :: PState -> PState

increaseMaxDepth s =letdepth = maxDepth sins{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 =caseevalState idfs' sof

[] -> 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' =domodify addPath

s <- get

ifisGoalState s

thenreturn (path s)

elseifcurDepth s >= maxDepth s

thenreturn []

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.

elsedomodify increaseDepth

s <- get

letstates = 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:

moduleAIMAMissionariesStateMonadwhereimportData.List(sort, nub, (\\))importControl.Monad.StatedataPerson = Missionary | Cannibal

deriving(Ord, Eq, Show)

dataPosition = LeftSide | RightSide

deriving(Eq, Show)dataPState = 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 =caseevalState idfs' sof

[] -> idfs $ increaseMaxDepth s

other -> other

where

idfs' :: State PState [PState]

idfs' =domodify addPath

s <- get

ifisGoalState s

thenreturn (path s)

elseifcurDepth s >= maxDepth s

thenreturn []

elsedomodify increaseDepth

s <- get

letstates = 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 =letdepth = curDepth sins{curDepth = depth + 1}-- increase max search depth by 1

increaseMaxDepth :: PState -> PState

increaseMaxDepth s =letdepth = maxDepth sins{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 =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 :: PState -> [Person] -> PState

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

## No comments:

## Post a Comment