Permalink
Browse files

Used different types for board and lookup table indexes.

Unsurprisingly, this almost immediately caught a couple of
semi-problems. Forcing code to be clear about what table an index is
intended for will help development and debugging.
  • Loading branch information...
1 parent f018bf9 commit 40b6ed95ba89a3f35e0d0cdf9abcc62402dd6d70 @malcolmt committed Oct 31, 2011
Showing with 42 additions and 18 deletions.
  1. +11 −5 src/ChessTools/Board.hs
  2. +22 −8 src/ChessTools/Board/Internal.hs
  3. +6 −2 src/ChessTools/Board/Western.hs
  4. +3 −3 src/ChessTools/Test/Board.hs
@@ -14,12 +14,16 @@ module ChessTools.Board (
, Square(..)
, squareToIndex
, indexToSquare
+ , Board
+ , BIndex
+ , biMinus
-- * Creating lookup tables
-- $lookup_creation
, LookupTable
, CoveringIndexList(..)
, repIndexList
+ , LIndex
-- * Existing lookup creation functions
-- $tables
@@ -77,10 +81,11 @@ boardArraySize s@(BoardSize _ v vBuf) = rowLength s * (v + 2 * vBuf)
-- constant for a given 'BoardSize' and the board size doesn't change for a
-- particular sort of game, they can be computed once and reused.
--- | Return the 'LookupTable' value for a pair of indexes. The first index is
--- the \"/from/\" location, the second is the \"/to/\" location.
-fetch :: LookupTable -> Int -> Int -> Int
-fetch (LookupTable arr) s1 s2 = arr ! (s1 - s2)
+-- | Return the 'LookupTable' value for a pair of indexes into a 'Board' array.
+-- The first index is the \"/from/\" location, the second is the \"/to/\"
+-- location.
+fetch :: LookupTable -> BIndex -> BIndex -> Int
+fetch (LookupTable arr) s1 s2 = arr ! (s1 `biMinus` s2)
-- | Returns a list of representative 'Square' pairs that cover all the lookup
-- table index values. On a square board, there are @(2x-1)^2@ possible index
@@ -94,7 +99,8 @@ fetch (LookupTable arr) s1 s2 = arr ! (s1 - s2)
-- the cost is a negligible contribution to the total runtime in practice.
repIndexList :: BoardSize -> CoveringIndexList
repIndexList s@(BoardSize h v _) = CL $ map head $ groupBy compFirst $ sort l
- where l = [(d1 - d2, (s1, s2)) | (d1, s1) <- squares, (d2, s2) <- squares]
+ where l = [(d1 `biMinus` d2, (s1, s2)) |
+ (d1, s1) <- squares, (d2, s2) <- squares]
compFirst x y = fst x == fst y
squares = zip (map (squareToIndex s) sqs) sqs
sqs = [Square (x, y) | x <- [0 .. h - 1], y <- [0 .. v - 1]]
@@ -49,11 +49,25 @@ instance Ord Square where
GT -> GT
EQ -> x1 `compare` x2
+
+-- | A representation of a board position.
+newtype Board = Board (Array BIndex Int) deriving (Show, Eq)
+
+-- | An index into a 'Board' array.
+newtype BIndex = BI {fromBI :: Int} deriving (Show, Eq, Ord, Ix)
+
+-- | Subtract two board indexes to get an offset into a lookup table.
+biMinus :: BIndex -> BIndex -> LIndex
+biMinus x y = LI $ fromBI x - fromBI y
+
+-- | An index into a 'LookupTable' array.
+newtype LIndex = LI {fromLI :: Int} deriving (Show, Eq, Ord, Ix)
+
-- | A rapid lookup (/O(1)/) data structure for computing various values based
-- on two squares on the board. These could be distances between the squares in
-- some form (file or rank separation) or whether some kind of piece can move
-- between those two squares (using 0 values for invalid moves).
-data LookupTable = LookupTable (Array Int Int)
+data LookupTable = LookupTable (Array LIndex Int)
-- | Used to hold a representative set of squares when computing 'LookupTable'
-- results. Create one with 'repIndexList' and use it in all lookup table
@@ -62,20 +76,20 @@ data LookupTable = LookupTable (Array Int Int)
-- For internal code using this, the main invariant to note is that the offset
-- component (the first 'Int') is in sorted order. This is used by, for
-- example, the 'lookupBounds' function.
-newtype CoveringIndexList = CL [(Int, (Square, Square))]
+newtype CoveringIndexList = CL [(LIndex, (Square, Square))]
-- | Convert a 'Square' to an index into a board array. The index is the same
-- for all board arrays associated with a given 'BoardSize'.
-squareToIndex :: BoardSize -> Square -> Int
+squareToIndex :: BoardSize -> Square -> BIndex
squareToIndex s (Square (x, y))
- | x < 0 || y < 0 || x >= h || y >= v = 0
- | otherwise = (y + vBuf) * rowLength s + leftBuf s + x
+ | x < 0 || y < 0 || x >= h || y >= v = BI 0
+ | otherwise = BI $ (y + vBuf) * rowLength s + leftBuf s + x
where BoardSize h v vBuf = s
-- | Convert a board array index to a 'Square'. This is the inverse of
-- 'squareToIndex'.
-indexToSquare :: BoardSize -> Int -> Square
-indexToSquare s idx = Square (x, y)
+indexToSquare :: BoardSize -> BIndex -> Square
+indexToSquare s (BI idx) = Square (x, y)
where rl = rowLength s
idx' = idx - rl * boardVertBuffer s
(y, x') = idx' `divMod` rl
@@ -93,7 +107,7 @@ leftBuf s = boardHorizSize s `div` 2
-- | Returns a pair that can be used to specify the bounds for a
-- 'Data.Array.Array'.
-lookupBounds :: CoveringIndexList -> (Int, Int)
+lookupBounds :: CoveringIndexList -> (LIndex, LIndex)
lookupBounds (CL cs) = (fst $ head cs, fst $ last cs)
-- | Utility function for computing the file, rank and square distance tables.
@@ -21,7 +21,7 @@ coveringIndices = repIndexList westernBoardSize
-- | Converts a square name, such as /"e5"/ to an index into a board array.
-- Returns 'Nothing' if the provided string is invalid (too long or not a
-- reference to a legal square).
-algebraicToIndex :: [Char] -> Maybe Int
+algebraicToIndex :: [Char] -> Maybe BIndex
algebraicToIndex cs
| length cs /= 2 = Nothing
| file < 0 || file > 7 = Nothing
@@ -37,10 +37,14 @@ algebraicToIndex cs
-- FIXME: How to handle errors? How to even detect errors? (I don't want
-- indexToSquare having to go through Maybe all the time, since it will be
-- called all over the place.)
-indexToAlgebraic :: Int -> Maybe [Char]
+indexToAlgebraic :: BIndex -> Maybe [Char]
indexToAlgebraic x = Just $ chr (f + ord 'a') : chr (r + ord '1') : []
where Square (f, r) = indexToSquare westernBoardSize x
+-- | Determine if a move /from/ an index /to/ another index is legal on the
+-- given 'Board'.
+-- legalMove :: Board -> BIndex -> BIndex -> Bool
+
-- kingMoves
-- queenMoves
-- rookMoves
@@ -55,11 +55,11 @@ boardAndTwoSquareGen = do
-- implemented, so it's not really verifying the result of that conversion by
-- different means.
-boardAndIndexGen :: Gen (BoardSize, Int)
+boardAndIndexGen :: Gen (BoardSize, BIndex)
boardAndIndexGen = do
bs <- arbitrary :: Gen BoardSize
Square (dx, dy) <- genSquare bs
- return (bs, (dy + boardVertBuffer bs) * rowLength bs + dx + leftBuf bs)
+ return (bs, BI ((dy + boardVertBuffer bs) * rowLength bs + dx + leftBuf bs))
-- The squareToIndex and indexToSquare functions should be inverses of each
@@ -92,7 +92,7 @@ prop_boardArraySize bs = boardArraySize bs == expected
prop_repIndexListRepresents = forAll smallBoardGen $ \bs ->
let cl@(CL xs) = repIndexList bs
(l, u) = lookupBounds cl
- in length xs == u - l + 1 &&
+ in length xs == fromLI u - fromLI l + 1 &&
(length . group . sort $ map fst xs) == length xs

0 comments on commit 40b6ed9

Please sign in to comment.