Haskell Quiz/Knight's Travails/Solution LukePlant
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
{-
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 }