# Difference between revisions of "Haskell Quiz/Knight's Travails/Solution LukePlant"

Jump to navigation
Jump to search

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

Line 22: | Line 22: | ||

import Control.Monad (guard) |
import Control.Monad (guard) |
||

− | import Data. |
+ | import Data.List (nub) |

− | import Data.List (nub, sort) |
||

import System.Environment (getArgs) |
import System.Environment (getArgs) |
||

import System.Exit (exitFailure) |
import System.Exit (exitFailure) |

## 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 }
```