# Haskell Quiz/Knight's Travails/Solution LukePlant

### From HaskellWiki

< Haskell Quiz | Knight's Travails(Difference between revisions)

Spookylukey (Talk | contribs) (Solution to 'Knight's Travails' added) |
m |

## Latest revision as of 00:20, 22 February 2010

{- Solution to "Knight's travails" by Luke Plant, http://lukeplant.me.uk/ Confession: I got quite a bit of help from the Ruby solutions. Notes: 1) I'm a total Haskell newbie, this could probably be lots better 2) It can be used as a complete command line program, otherwise the main entry point is 'solve' Interesting extras: Unique positions on board paired with the maximum number of jumps it takes to go from that position to any position on the board: [(Pos x y, length $ allNeighbours [Pos x y] []) | x <- [0..3], y <- [0..x]] -} import Control.Monad (guard) import Data.List (nub) import System.Environment (getArgs) import System.Exit (exitFailure) -- Pretty printing: data Position = Pos Int Int deriving (Eq) instance Show Position where show (Pos x y) = toEnum (x + fromEnum 'a') : toEnum (y + fromEnum '1') : [] showList ps = \x -> "[" ++ (unwords $ map show ps) ++ "]" ++ x parsePosition s = case s of (x:y:[]) -> let x' = fromEnum x - fromEnum 'a' y' = fromEnum y - fromEnum '1' ans = Pos x' y' in if validPosition ans then ans else invalid s otherwise -> invalid s where invalid s = error ("'" ++ s ++ "' is not a valid position.") -- Position is index from 0 to 7 on the board validPosition (Pos x y) = let inrange z = 0 <= z && z < 8 in inrange x && inrange y -- Calculate the Knight neighbours of a position, avoiding forbidden squares knightjumps = [(-2,-1),(-2,1),(-1,-2),(-1,2),(1,-2),(1,2),(2,-1),(2,1)] neighbours (Pos x y) forbidden = do (dx, dy) <- knightjumps let newpos = Pos (x + dx) (y + dy) guard (newpos `notElem` forbidden && validPosition newpos) return newpos isNeighbour (Pos x1 y1) (Pos x2 y2) = (x1 - x2, y1 - y2) `elem` knightjumps -- All the neighbours of given start positions, returned -- as a list of lists -- first item is nearest set of neighbours etc. allNeighbours :: [Position] -> [Position] -> [[Position]] allNeighbours startps forbidden = let newps = nub $ concatMap (\p -> neighbours p forbidden) startps in if newps == [] then [] else [newps] ++ allNeighbours newps (startps ++ forbidden) -- Search through the neighbours we have found, -- and if we find our target, calculate (any) path back to first item routeToPosition :: [[Position]] -> Position -> Maybe [Position] routeToPosition ps item = routeToPosition' ps item [] -- helper which carries inverted list of 'used' [Position] -- so we can go back and find the route: routeToPosition' [] _ _ = Nothing routeToPosition' (ps:pss) item used = if item `elem` ps then Just $ (reverse $ item : searchForPath used item) else routeToPosition' pss item (ps:used) -- invert the 'used' list as we go where searchForPath [] _ = [] searchForPath (ps:pss) item = let parent = head $ filter (isNeighbour item) ps in parent : searchForPath pss parent solve :: Position -> Position -> [Position] -> Maybe [Position] solve start end forbidden = let all = allNeighbours [start] forbidden in routeToPosition all end -- Main input and output usage = "Usage: knight_travails startpos endpos [forbidden positions]" main = do args <- getArgs if length args < 2 then do putStrLn ("Insufficient arguments.\n\n" ++ usage) exitFailure else let start = parsePosition (args!!0) end = parsePosition (args!!1) forbidden = map parsePosition (drop 2 args) solution = solve start end forbidden in case solution of Nothing -> do { putStrLn "No solutions"} Just ps -> do { print ps }