Haskell Quiz/Knight's Travails/Solution Nroets
From HaskellWiki
import System.Environment (getArgs) import System.Exit (exitFailure) -- The first argument is a list of "squares" that can be reached. The "squares" are ordered -- with the ones that can be reached in the smallest number of moves first. -- What is a "square" ? It is a sequence of moves in reverse order (list of strings). So the -- head is also the square that have been reached. -- Note that the "squares" are built at the same time, so if the compiler is doing it's job, -- the "squares" should be sharing their tails and a maximum of one linked list element -- should be allocated for each square. shortest [] end forbid = Nothing shortest (s1:start) end forbid = if head s1 == end then Just (tail $ reverse s1) else shortest (start ++ (signs1 2 1) ++ (signs1 1 2)) end (head s1 : forbid) -- We add 'head s1' to 'forbid' to prevent making an exponential number of calls. where col = fromEnum $ head $ head s1 row = fromEnum $ last $ head s1 signs1 c r = newLoc (-c) (-r) ++ newLoc (-c) r ++ newLoc c (-r) ++ newLoc c r newLoc c r = if col + c < fromEnum 'a' || col + c > fromEnum 'h' || row + r < fromEnum '1' || row + r > fromEnum '8' || head s1 `elem` forbid then [] else [ ( [ toEnum (col + c) :: Char, toEnum (row + r) :: Char ] : s1) ] test = shortest [ [ "a8" ] ] "b7" [ "b6" ] test2 = shortest [ [ "a8" ] ] "g6" [ "b6", "c7" ] test3 = shortest [ [ "a8" ] ] "h2" [ "b6", "a6", "b5", "d5", "e6", "d6", "f6", "f5", "g3", "h3", "g2", "d3", "f3", "e3" ] test4 = shortest [ [ "h8" ] ] "a8" [ "c7", "a4", "c4", "d5", "d7", "d6", "e7", "c6", "d4", "c7", "c3", "c2" ] -- If the algorithm does not prune properly, then test4 can take close to 8^11 = 8 billion -- iterations. 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 result = shortest [ [ args !! 0 ]] (args !! 1) (drop 2 args) in case result of Nothing -> do { putStrLn "No solutions" } Just ps -> do { print ps }