Missionaries and Cannibals
I’m still working through HTDP when I get the chance and motivation but have noticed I’m increasingly answering questions in Haskell rather than Scheme. Where HTDP teaches design through disciplined function recipes, Haskell enforces such discipline as a language construct through its type system. I’ve also gained a new appreciation for the expressive power of the ‘Maybe’ type.
I’ve reached an interesting problem that involves backtracking, depth-first search, and accumulators (extended exercise 32.2), which is a nice general exercise in solving a problem in functional style:
Once upon a time, three cannibals were guiding three missionaries through a jungle. They were on their way to the nearest mission station. After some time, they arrived at a wide river, filled with deadly snakes and fish. There was no way to cross the river without a boat. Fortunately, they found a row boat with two oars after a short search. Unfortunately, the boat was too small to carry all of them. It could barely carry two people at a time. Worse, because of the river’s width there was no way to bring the boat back other than to row it back.
Since the missionaries could not trust the cannibals they had to figure out a plan to get all six of them safely across the river.
The problem was that these cannibals would kill and eat missionaries as soon as there were more cannibals than missionaries at some place. Thus our missionary-programmer had to devise a plan that guaranteed that there were never any missionaries in the minority at either side of the river. The cannibals, however, can be trusted to cooperate otherwise. Specifically, they won’t abandon any potential food, just as the missionaries won’t abandon any potential converts.
The first task is to define appropriate data representations. The major relevant structures are the state (the positions and counts of missionaries and cannibals on the banks of the river, and the position of the boat), and a boatload, which specifies a boat direction and who is in the boat. When a boatload is ‘applied to’ a ‘before’ state, an ‘after’ state is given.
I’ll also include some type aliases for readability’s sake:
type Mis = Int
type Can = Int
data BoatPos = BoatLeft | BoatRight deriving (Show, Eq)
type Direction = BoatPos
data State = State Mis Can Mis Can BoatPos deriving (Show, Eq)
-- State left-mis left-can right-mis right-can boat-position
data BoatLoad = BoatLoad Mis Can Direction deriving (Show, Eq)
We must also define the initial and the final (desired) states, the numbers of missionaries and cannibals, and the boat capacity as constants:
mc = 3 -- Number of missionaries and cannibals
capacity = 2 -- Boat capacity
initial = State mc mc 0 0 BoatLeft
final = State 0 0 mc mc BoatRight
So with this in mind, a solution for a given initial and final states would be a list of boatloads in the sequence they should be applied, or nothing, if a solution is not possible. This suggests the type signature:
solution :: State -> State -> Maybe [BoatLoad]
As the exercise is to give practice in accumulator function design, solution should call an auxiliary function that is called with an initial, empty accumulator value. In this case, the relevant thing to be accumulated is a list of boatloads, so we would start by calling the auxiliary function with an empty one of those:
solution :: State -> State -> Maybe [BoatLoad]
solution st final = solve st (possibleLoads st Nothing) []
-- the accumulator, takes a state, a list of boatloads to try for that state,
-- and the path of boatloads accumulated so far,
-- and gives that path if the state is final,
-- or nothing if there are no boatloads to try
where solve :: State -> [BoatLoad] -> [BoatLoad] -> Maybe [BoatLoad]
Now to the definition of solve. First, it will need to test if the state it is given is equal to the final, desired state. If so, it should return the list of boatloads accumulated so far.
Otherwise, more boat trips will need to be made. So the function must test if the first boatload in the list of those to try results in a state that doesn’t violate the rules when applied to the given state. If so, we can recur on solve with the new state, and the boatload it took to get to that state added to the list of trips.
If that whole expression yields no valid state, then we recur on solve with the same state and the rest of the list.
Finally, if the list of boatloads to try is empty, we return Nothing.
This completes our broad approach to the solution. We have only then to define the helper functions that make it work: applyLoad and possibleLoads.
solution :: State -> State -> Maybe [BoatLoad]
solution st final = solve st (possibleLoads st Nothing) []
where solve :: State -> [BoatLoad] -> [BoatLoad] -> Maybe [BoatLoad]
solve state (p:ps) trips
| state == final = Just trips
| otherwise =
let possNextState = applyLoad state p
in case possNextState of
Just nextState ->
solve nextState (possibleLoads nextState (Just p)) (p : trips)
Nothing ->
solve state ps trips
solve _ [] _ = Nothing
applyLoad shows how handy Maybe is. You can run a state and a boatload through it and maybe get a state back. Passing around maybes as values feels a cleaner way to deal with uncertainty than checking for either the desired type or false at every turn.
applyLoad uses its own helper function, validState, which simply checks a given state against the constraints in the problem description. Again, we are passing around maybes, so it will yield Just the state if it is ok, or Nothing:
-- there should be no more cannibals than missionaries on a side
-- unless there are zero missionaries on a side to eat
validState :: Maybe State -> Maybe State
validState Nothing = Nothing
validState (Just st@(State lM lC rM rC boatPos)) =
if (lM >= lC || lM == 0) && (rM >= rC || rM == 0) then Just st else Nothing
-- given an state and a boatload, return just the state after
-- the boadload, if it is valid, or nothing if it is invalid
applyLoad :: State -> BoatLoad -> Maybe State
applyLoad (State lM lC rM rC boatPos) (BoatLoad bM bC dir)
| boatPos == dir = Nothing -- boat must go in opposite direction
| dir == BoatLeft = validState (Just (State (lM+bM) (lC+bC) (rM-bM) (rC-bC) BoatLeft))
| otherwise = validState (Just (State (lM-bM) (lC-bC) (rM+bM) (rC+bC) BoatRight))
applyLoad is a constraining function, but the algorithm also needs a generating function. possibleLoads takes a state and the previous boatload (if there was one), and returns all possible boatloads that are allowable under the rules given in the problem description. It uses list comprehensions to generate all the possible basic cominations of missionaries and cannibals, and these are filtered by another helper function, validLoad, which determines if the load isn’t over capacity or the same as the previous load with reversed direction:
-- takes previous load and candidate new load
-- the candiate load (with reversed direction) can't be the same as the previous load
-- (otherwise it will never terminate)
validLoad :: Maybe BoatLoad -> BoatLoad -> Bool
validLoad prevLoad oppLoad@(BoatLoad m c _) =
let mc = m+c
loadSizeTest = mc <= capacity && mc > 0
in case prevLoad of
Nothing -> loadSizeTest
(Just prevLoad2) -> loadSizeTest && prevLoad2 /= oppLoad
-- given a state, and the immediately previous boatload (if any),
-- return the possible next boatloads
possibleLoads :: State -> Maybe BoatLoad -> [BoatLoad]
possibleLoads (State lM lC _ _ BoatLeft) prevLoad =
[BoatLoad m c BoatRight | m <- [lM,lM-1..0], c <- [lC,lC-1..0],
validLoad prevLoad (BoatLoad m c BoatLeft)]
possibleLoads (State _ _ rM rC BoatRight) prevLoad =
[BoatLoad m c BoatLeft| m <- [rM,rM-1..0], c <- [rC,rC-1..0],
validLoad prevLoad (BoatLoad m c BoatRight)]
Now all the helper functions are defined and the solution is complete. We can call solution initial final and get the first valid list of trips. The full solution is here