You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

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

 11 years ago {-| A solution to rubyquiz 27 (). 11 years ago 11 years ago /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./ 11 years ago 11 years ago /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./ 11 years ago 11 years ago /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./ 11 years ago 11 years ago Usage: 11 years ago 11 years ago > ./KnightsTravails start_pos target_pos [blocked_pos]* Copyright 2012 Abhinav Sarkar \ 11 years ago -} {-# LANGUAGE MultiParamTypeClasses, RecordWildCards #-} 11 years ago module KnightsTravails (Square, fromNotation, toNotation, isValidNotation, search, main) 11 years ago where 11 years ago import qualified Data.Set as S import AStar import Data.List (elemIndex) import Data.Maybe (fromJust) import Control.Arrow (second) import System.Environment (getArgs) 11 years ago -- | A square on the chess board 11 years ago 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) 11 years ago -- | Converts a string in chess notation to a square. eg. a1 -> (1,1) 11 years ago fromNotation :: String -> Square fromNotation (x : y) = (fromJust (x `elemIndex` ['a'..'h']) + 1, read y) 11 years ago -- | Converts a square to a string in chess notation. eg. (1,1) -> a1 11 years ago toNotation :: Square -> String toNotation (x, y) = ((['a'..'h'] !! (x - 1)) : "") ++ show y 11 years ago -- | Checks if a string is a valid chess notation 11 years ago isValidNotation notation = and [length notation == 2, head notation `elem` ['a'..'h'], last notation `elem` ['1'..'8']] -- 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] 11 years ago knightAstar heuristic blockedSquares start target = fmap (second (map knightPos)) \$ astar (Board start blockedSquares) (Board target blockedSquares) nextKnightPos heuristic 11 years ago 11 years ago -- | Finds a path from a start square to an end square using A* with -- half of the max of coordinate deltas as the heuristic function search :: S.Set Square -- ^ The set of blocked squares -> Square -- ^ The start square -> Square -- ^ The target square -> Maybe (Int, [Square]) -- ^ The solution cost and path if found else 'Nothing' search = 11 years ago 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 11 years ago in case search (S.fromList . map fromNotation \$ blocked) 11 years ago (fromNotation start) (fromNotation target) of Just (_, path) -> putStrLn . unwords . map toNotation \$ path Nothing -> putStrLn "No path found"