MissionariesAndCannibals.hs

-- MissionariesAndCannibals.hs

import qualified Data.Map as Map

data Human = Missionary | Cannibal deriving (Eq,Show,Ord)
data Boat = LeftSide | RightSide deriving (Eq,Show)
type Place = [Human]
data State = State {
 steps :: Int,
 boat :: Boat,
 leftSide :: Place,
 rightSide :: Place,
 lastState :: Maybe State,
 lastTravel :: Maybe Travel
}
type Travel = [Human]
data Counters = Counters {
 missionaries :: Int,
 cannibals :: Int
} deriving (Show)

placeToString :: Place -> String
placeToString humans=
 (take (missionaries counters) $ repeat 'M')++(take (cannibals counters) $ repeat 'C')
 where counters=countHumans humans

instance Eq State where
 state0 == state1 =
  and
   [missionaries lc0==missionaries lc1,cannibals lc0==cannibals lc1,
    missionaries rc0==missionaries rc1,cannibals rc0==cannibals rc1,
    (boat state0)==(boat state1)]
  where
   lc0=countHumans (leftSide state0)
   rc0=countHumans (rightSide state0)
   lc1=countHumans (leftSide state1)
   rc1=countHumans (rightSide state1)

instance Show State where
 show (State steps boat leftSide rightSide lastState lastTravel) =
  concat [parentString lastState lastTravel,"[",leftString,"~",rightString,"]"]
  where
   leftString=placeToString leftSide
   rightString=placeToString rightSide
   riverString Nothing=""
   riverString (Just theLastTravel)=
    let
     direction=if boat==LeftSide then "<-" else "->";
     travelString=placeToString theLastTravel
    in
     concat [show steps," ",direction,travelString,direction]
   parentString Nothing _ = ""
   parentString (Just theLastState) lastTravel =
    concat [show theLastState," ",riverString lastTravel," "]


initialState = State {
 steps = 0,
 --boat = RightSide,
 boat = LeftSide,
 leftSide = [Missionary,Missionary,Missionary,Cannibal,Cannibal,Cannibal],
 rightSide = [],
 lastState = Nothing,
 lastTravel = Nothing
}

initialState2 = State {
 steps = 0,
 --boat = RightSide,
 boat = LeftSide,
 leftSide = [Missionary,Missionary,Missionary,Cannibal,Cannibal],
 rightSide = [],
 lastState = Nothing,
 lastTravel = Nothing
}

countHuman :: Counters -> Human -> Counters
countHuman counters human =
 Counters {
  missionaries=(missionaries counters)+(if human==Missionary then 1 else 0),
  cannibals=(cannibals counters)+(if human==Cannibal then 1 else 0)
 }

countHumans :: [Human] -> Counters
countHumans humans = foldl countHuman Counters {missionaries=0,cannibals=0} humans

areThereEnoughHumans :: Place -> Travel -> Bool
areThereEnoughHumans place travel =
 and [missionaries placeCounters>=missionaries travelCounters,cannibals placeCounters>=cannibals travelCounters]
 where
  placeCounters=countHumans place
  travelCounters=countHumans travel

allPossibleTravels = [[Missionary],[Cannibal],[Missionary,Cannibal],[Missionary,Missionary],[Cannibal,Cannibal]]

getPossibleTravels :: State -> [Travel]
getPossibleTravels State {steps=_,boat=LeftSide,leftSide=leftSide,rightSide=_} =
 filter (areThereEnoughHumans leftSide) allPossibleTravels
getPossibleTravels State {steps=_,boat=RightSide,leftSide=_,rightSide=rightSide} =
 filter (areThereEnoughHumans rightSide) allPossibleTravels

isPlaceSafe :: Place -> Bool
isPlaceSafe place =
 or [missionaries counters >= cannibals counters,missionaries counters == 0]
 where counters=countHumans place

isStateSafe :: State -> Bool
isStateSafe state =
 and [isPlaceSafe $ leftSide state,isPlaceSafe $ rightSide state]

createPlace :: Int -> Int -> Place
createPlace missionaries cannibals =
 (take missionaries $ repeat Missionary) ++ (take cannibals $ repeat Cannibal)

travel :: State -> Travel -> State
travel state travel =
 State {
  steps=(steps state)+1,
  boat=newBoatPosition,
  leftSide=newLeftSide,
  rightSide=newRightSide,
  lastState=Just state,
  lastTravel=Just travel
 }
 where
  leftCounters=countHumans $ leftSide state
  rightCounters=countHumans $ rightSide state
  travelCounters=countHumans travel
  newBoatPosition=if boat state == LeftSide then RightSide else LeftSide
  sign=if boat state == LeftSide then 1 else (-1)
  newLeftSide=
   createPlace ((missionaries leftCounters)-sign*(missionaries travelCounters)) ((cannibals leftCounters)-sign*(cannibals travelCounters))
  newRightSide=
   createPlace ((missionaries rightCounters)+sign*(missionaries travelCounters)) ((cannibals rightCounters)+sign*(cannibals travelCounters))

getPossibleNextStates :: State -> [State]
getPossibleNextStates state =
 filter isStateSafe (map (travel state) (getPossibleTravels state))

isFinalState :: State -> Bool
isFinalState state =
 and [missionaries rightCounters==3,cannibals rightCounters==3]
 where rightCounters=countHumans $ rightSide state

isStateVisited :: [State] -> State -> Bool
isStateVisited visitedStates state =
 any (== state) visitedStates

getNextGeneration :: [State] -> [State] -> [State]
getNextGeneration states visitedStates =
 filter (not . (isStateVisited visitedStates)) newGen
 where
  newGen = foldl (\acc state -> acc++(getPossibleNextStates state)) [] states

findSolution :: [State] -> [State]-> Maybe State
findSolution [] _ = Nothing
findSolution states visitedStates =
 if length solutions > 0 then
  Just $ head solutions
 else
  findSolution (getNextGeneration states visitedStates) (visitedStates++states)
 where
  solutions = filter isFinalState states

main = do
 putStrLn $ "Find Solution: " ++ (show $ findSolution [initialState] [])