```{-| ``` ``` A solution to rubyquiz 27 (). ``` ``` ``` ``` /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 #-} ``` ``` ``` ```module KnightsTravails (Square, fromNotation, toNotation, isValidNotation, search, main) ``` ```where ``` ``` ``` ```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']] ``` ``` ``` ```-- 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] ``` ``` ``` ```knightAstar heuristic blockedSquares start target = ``` ``` fmap (second (map knightPos)) ``` ``` \$ astar (Board start blockedSquares) (Board target blockedSquares) ``` ``` nextKnightPos heuristic ``` ``` ``` ```-- | 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 = ``` ``` 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 search (S.fromList . map fromNotation \$ blocked) ``` ``` (fromNotation start) (fromNotation target) of ``` ``` Just (_, path) -> putStrLn . unwords . map toNotation \$ path ``` ` Nothing -> putStrLn "No path found"`