#### 96 lines 3.6 KiB Haskell Raw Normal View History

 2012-08-30 22:21:24 +05:30 ```{- ``` ` A solution to rubyquiz 27 (http://rubyquiz.com/quiz27.html).` ``` ``` ` Given a standard 8 x 8 chessboard where each position is indicated in algebraic` ` notation (with the lower left corner being a1), design a script that accepts` ` two or more arguments.` ``` ``` ` The first argument indicates the starting position of the knight. The second` ` argument indicates the ending position of the knight. Any additional arguments` ` indicate positions that are forbidden to the knight.` ``` ``` ` Return an array indicating the shortest path that the knight must travel to` ` get to the end position without landing on one of the forbidden squares.` ` If there is no valid path to the destination return nil.` ``` ``` ` Usage: ./KnightsTravails start_pos target_pos [blocked_pos]*` ``` ``` ` Copyright 2012 Abhinav Sarkar ` `-}` ``` ``` `{-# LANGUAGE MultiParamTypeClasses, RecordWildCards #-}` ``` ``` 2012-10-27 11:07:22 +05:30 `module KnightsTravails (Square, Board(..), fromNotation, toNotation, isValidNotation,` ` bfsSearch, astarSearch, main)` `where` 2012-08-30 22:21:24 +05:30 ``` ``` `import qualified Data.Set as S` `import AStar` `import Data.List (elemIndex)` `import Data.Maybe (fromJust)` `import Control.Arrow (second)` `import System.Environment (getArgs)` ``` ``` `-- A square on the chess board` `type Square = (Int, Int)` ``` ``` `-- A chess board with the knight's current position and a set of blocked squares` `data Board = Board { knightPos :: Square, blockedSquares :: S.Set Square }` ` deriving (Ord, Eq)` ``` ``` `-- Converts a string in chess notation to a square. eg. a1 -> (1,1)` `fromNotation :: String -> Square` `fromNotation (x : y) = (fromJust (x `elemIndex` ['a'..'h']) + 1, read y)` ``` ``` `-- Converts a square to a string in chess notation. eg. (1,1) -> a1` `toNotation :: Square -> String` `toNotation (x, y) = ((['a'..'h'] !! (x - 1)) : "") ++ show y` ``` ``` `-- Checks if a string is a valid chess notation` `isValidNotation notation =` ` and [length notation == 2,` ` head notation `elem` ['a'..'h'],` ` last notation `elem` ['1'..'8']]` ``` ``` 2012-08-31 13:30:28 +05:30 `-- Finds the next possible board configurations for one knight's move.` `-- Move cost is one.` `nextKnightPos board@(Board {..}) =` ` zip` ` (map (\pos -> board { knightPos = pos })` ` . filter isValidMove` ` . map (\(x, y) -> (fst knightPos + x, snd knightPos + y))` ` \$ moves)` ` (repeat 1)` ` where` ` moves = [(1,2), (1,-2), (-1,2), (-1,-2), (2,1), (2,-1), (-2,1), (-2,-1)]` ` isValidMove (x, y) =` ` and [x > 0, x < 9, y > 0, y < 9, not \$ (x, y) `S.member` blockedSquares]` 2012-08-30 22:21:24 +05:30 ``` ``` `knightAstar heuristic blockedSquares start target =` ` fmap (second (map knightPos))` 2012-08-31 13:30:28 +05:30 ` \$ astar (Board start blockedSquares) (Board target blockedSquares)` ` nextKnightPos heuristic` 2012-08-30 22:21:24 +05:30 ``` ``` `-- Finds a path from a start square to an end square using BFS` `bfsSearch :: S.Set Square -> Square -> Square -> Maybe (Int, [Square])` `bfsSearch = knightAstar (\_ _ -> 0)` ``` ``` `-- Finds a path from a start square to an end square using AStar with` `-- half of the max of coordinate deltas as the heuristic` `astarSearch :: S.Set Square -> Square -> Square -> Maybe (Int, [Square])` `astarSearch =` ` knightAstar (\(Board (x1,y1) _) (Board (x2,y2) _) ->` ` max (abs (x1-x2)) (abs (y1-y2)) `div` 2)` ``` ``` `main = do` ` args <- getArgs` ` if length args < 2` ` then error "Usage: ./KnightsTravails start_pos target_pos [blocked_pos]*"` ` else if any (not . isValidNotation) args` ` then error "Invalid board position"` ` else let` ` (start : target : blocked) = args` ` in case astarSearch (S.fromList . map fromNotation \$ blocked)` ` (fromNotation start) (fromNotation target) of` ` Just (_, path) -> putStrLn . unwords . map toNotation \$ path` ` Nothing -> putStrLn "No path found"`