grid 1.1 → 2.0
raw patch · 4 files changed
+362/−38 lines, 4 filesdep +containersPVP ok
version bump matches the API change (PVP)
Dependencies added: containers
API changes (from Hackage documentation)
+ Math.Geometry.Grid: edges :: Grid g s x => g -> [(x, x)]
+ Math.Geometry.GridInternal: edges :: Grid g s x => g -> [(x, x)]
+ Math.Geometry.GridInternal: instance Eq HexHexGrid
+ Math.Geometry.GridInternal: instance Eq ParaHexGrid
+ Math.Geometry.GridInternal: instance Eq ParaTriGrid
+ Math.Geometry.GridInternal: instance Eq RectSquareGrid
+ Math.Geometry.GridInternal: instance Eq TorSquareGrid
+ Math.Geometry.GridInternal: instance Eq TriTriGrid
+ Math.Geometry.GridMap: (!) :: Ord k => GridMap g k v -> k -> v
+ Math.Geometry.GridMap: adjust :: Ord k => (v -> v) -> k -> GridMap g k v -> GridMap g k v
+ Math.Geometry.GridMap: adjustWithKey :: Ord k => (k -> v -> v) -> k -> GridMap g k v -> GridMap g k v
+ Math.Geometry.GridMap: data GridMap g k v
+ Math.Geometry.GridMap: distance :: Grid g s x => x -> x -> g -> Int
+ Math.Geometry.GridMap: elems :: GridMap g k a -> [a]
+ Math.Geometry.GridMap: empty :: Grid g s x => g -> Bool
+ Math.Geometry.GridMap: findWithDefault :: Ord k => v -> k -> GridMap g k v -> v
+ Math.Geometry.GridMap: fold :: (a -> b -> a) -> a -> GridMap g k b -> a
+ Math.Geometry.GridMap: fold' :: (a -> b -> a) -> a -> GridMap g k b -> a
+ Math.Geometry.GridMap: foldWithKey :: (a -> k -> b -> a) -> a -> GridMap g k b -> a
+ Math.Geometry.GridMap: foldWithKey' :: (a -> k -> b -> a) -> a -> GridMap g k b -> a
+ Math.Geometry.GridMap: inGrid :: Grid g s x => x -> g -> Bool
+ Math.Geometry.GridMap: indices :: Grid g s x => g -> [x]
+ Math.Geometry.GridMap: instance (Eq g, Eq k, Eq v) => Eq (GridMap g k v)
+ Math.Geometry.GridMap: instance (Eq k, Grid g s k) => Grid (GridMap g k v) s k
+ Math.Geometry.GridMap: instance (Show g, Show v) => Show (GridMap g k v)
+ Math.Geometry.GridMap: keysSet :: GridMap g k a -> Set k
+ Math.Geometry.GridMap: lazyGridMap :: (Ord k, Grid g s k) => g -> [v] -> GridMap g k v
+ Math.Geometry.GridMap: lookup :: Ord k => k -> GridMap g k v -> Maybe v
+ Math.Geometry.GridMap: map :: (a -> b) -> GridMap g k a -> GridMap g k b
+ Math.Geometry.GridMap: mapAccum :: (a -> b -> (a, c)) -> a -> GridMap g k b -> (a, GridMap g k c)
+ Math.Geometry.GridMap: mapAccumWithKey :: (a -> k -> b -> (a, c)) -> a -> GridMap g k b -> (a, GridMap g k c)
+ Math.Geometry.GridMap: mapWithKey :: (k -> a -> b) -> GridMap g k a -> GridMap g k b
+ Math.Geometry.GridMap: neighbours :: Grid g s x => x -> g -> [x]
+ Math.Geometry.GridMap: nonEmpty :: Grid g s x => g -> Bool
+ Math.Geometry.GridMap: size :: Grid g s x => g -> s
+ Math.Geometry.GridMap: tileCount :: Grid g s x => g -> Int
+ Math.Geometry.GridMap: toList :: GridMap g k a -> [(k, a)]
+ Math.Geometry.GridMap: viewpoint :: Grid g s x => x -> g -> [(x, Int)]
- Math.Geometry.Grid: class Eq x => Grid g s x | g -> s, g -> x where neighbours x g = filter (\ a -> distance x a g ≡ 1) $ indices g inGrid x g = x `elem` indices g viewpoint p g = map f (indices g) where f x = (x, distance p x g) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty
+ Math.Geometry.Grid: class Eq x => Grid g s x | g -> s, g -> x where neighbours x g = filter (\ a -> distance x a g ≡ 1) $ indices g inGrid x g = x `elem` indices g viewpoint p g = map f (indices g) where f x = (x, distance p x g) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g
- Math.Geometry.Grid: empty :: (Grid g s x, Grid g s x) => g -> Bool
+ Math.Geometry.Grid: empty :: Grid g s x => g -> Bool
- Math.Geometry.Grid: nonEmpty :: (Grid g s x, Grid g s x) => g -> Bool
+ Math.Geometry.Grid: nonEmpty :: Grid g s x => g -> Bool
- Math.Geometry.Grid: tileCount :: (Grid g s x, Grid g s x) => g -> Int
+ Math.Geometry.Grid: tileCount :: Grid g s x => g -> Int
- Math.Geometry.GridInternal: class Eq x => Grid g s x | g -> s, g -> x where neighbours x g = filter (\ a -> distance x a g ≡ 1) $ indices g inGrid x g = x `elem` indices g viewpoint p g = map f (indices g) where f x = (x, distance p x g) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty
+ Math.Geometry.GridInternal: class Eq x => Grid g s x | g -> s, g -> x where neighbours x g = filter (\ a -> distance x a g ≡ 1) $ indices g inGrid x g = x `elem` indices g viewpoint p g = map f (indices g) where f x = (x, distance p x g) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g
- Math.Geometry.GridInternal: empty :: (Grid g s x, Grid g s x) => g -> Bool
+ Math.Geometry.GridInternal: empty :: Grid g s x => g -> Bool
- Math.Geometry.GridInternal: nonEmpty :: (Grid g s x, Grid g s x) => g -> Bool
+ Math.Geometry.GridInternal: nonEmpty :: Grid g s x => g -> Bool
- Math.Geometry.GridInternal: tileCount :: (Grid g s x, Grid g s x) => g -> Int
+ Math.Geometry.GridInternal: tileCount :: Grid g s x => g -> Int
Files
- grid.cabal +5/−3
- src/Math/Geometry/GridInternal.hs +38/−24
- src/Math/Geometry/GridMap.hs +258/−0
- test/Math/Geometry/GridQC.hs +61/−11
grid.cabal view
@@ -1,5 +1,5 @@ name: grid-version: 1.1+version: 2.0 synopsis: Tools for working with regular grids\/graphs\/lattices. description: Provides tools for working with regular arrangements of tiles, such as might be used in a board game or some@@ -19,10 +19,12 @@ library hs-source-dirs: src build-depends: base ==4.*,- base-unicode-symbols ==0.2.*+ base-unicode-symbols ==0.2.*,+ containers ==0.4.2.* ghc-options: -Wall -rtsopts exposed-modules: Math.Geometry.Grid,- Math.Geometry.GridInternal+ Math.Geometry.GridInternal,+ Math.Geometry.GridMap test-suite grid-tests type: exitcode-stdio-1.0
src/Math/Geometry/GridInternal.hs view
@@ -36,7 +36,7 @@ ) where import Data.Eq.Unicode ((≡))-import Data.List (nub)+import Data.List (nub, nubBy) import Data.Ord.Unicode ((≤), (≥)) -- | A regular arrangement of tiles.@@ -44,10 +44,10 @@ class Eq x ⇒ Grid g s x | g → s, g → x where -- | Returns the indices of all tiles in a grid. indices ∷ g → [x]- -- | @'distance' a b@ returns the minimum number of moves required to get from- -- @a@ to @b@, moving between adjacent tiles at each step. (Two tiles are - -- adjacent if they share an edge.) If @a@ or @b@ are not contained within- -- @g@, the result is undefined.+ -- | @'distance' a b@ returns the minimum number of moves required to get+ -- from @a@ to @b@, moving between adjacent tiles at each step. (Two tiles+ -- are adjacent if they share an edge.) If @a@ or @b@ are not contained+ -- within @g@, the result is undefined. distance ∷ x → x → g → Int -- | Returns the dimensions of the grid. -- For example, if @g@ is a 4x3 rectangular grid, @'size' g@ would return @@ -68,15 +68,27 @@ viewpoint p g = map f (indices g) where f x = (x, distance p x g) -- | Returns the number of tiles in a grid. Compare with @'size'@.- tileCount ∷ Grid g s x ⇒ g → Int+ tileCount ∷ g → Int tileCount = length . indices- -- | Returns @True@ if the number of tiles in a grid is zero, @False@ otherwise.- empty ∷ Grid g s x ⇒ g → Bool+ -- | Returns @True@ if the number of tiles in a grid is zero, @False@ + -- otherwise.+ empty ∷ g → Bool empty g = tileCount g ≡ 0- -- | Returns @False@ if the number of tiles in a grid is zero, @True@ otherwise.- nonEmpty ∷ Grid g s x ⇒ g → Bool+ -- | Returns @False@ if the number of tiles in a grid is zero, @True@ + -- otherwise.+ nonEmpty ∷ g → Bool nonEmpty = not . empty- + -- | A list of all edges in a Grid, where the edges are represented by a+ -- pair of adjacent tiles.+ edges ∷ g → [(x,x)]+ edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g++sameEdge :: Eq t => (t, t) -> (t, t) -> Bool+sameEdge (a,b) (c,d) = (a,b) == (c,d) || (a,b) == (d,c)++adjacentEdges :: Grid g s t => t -> g -> [(t, t)]+adjacentEdges i g = map (\j -> (i,j)) $ i `neighbours` g+ -- -- Triangular tiles --@@ -105,8 +117,8 @@ -- | A triangular grid with triangular tiles. -- The grid and its indexing scheme are illustrated in the user guide,--- available at https://github.com/mhwombat/grid/wiki.-data TriTriGrid = TriTriGrid Int [(Int, Int)]+-- available at <https://github.com/mhwombat/grid/wiki>.+data TriTriGrid = TriTriGrid Int [(Int, Int)] deriving Eq instance Show TriTriGrid where show (TriTriGrid s _) = "triTriGrid " ++ show s @@ -137,8 +149,8 @@ -- | A Parallelogrammatical grid with triangular tiles. -- The grid and its indexing scheme are illustrated in the user guide,--- available at https://github.com/mhwombat/grid/wiki.-data ParaTriGrid = ParaTriGrid (Int, Int) [(Int, Int)]+-- available at <https://github.com/mhwombat/grid/wiki>.+data ParaTriGrid = ParaTriGrid (Int, Int) [(Int, Int)] deriving Eq instance Show ParaTriGrid where show (ParaTriGrid (r,c) _) = "paraTriGrid " ++ show r ++ " " ++ show c@@ -164,8 +176,8 @@ -- | A rectangular grid with square tiles. -- The grid and its indexing scheme are illustrated in the user guide,--- available at https://github.com/mhwombat/grid/wiki.-data RectSquareGrid = RectSquareGrid (Int, Int) [(Int, Int)]+-- available at <https://github.com/mhwombat/grid/wiki>.+data RectSquareGrid = RectSquareGrid (Int, Int) [(Int, Int)] deriving Eq instance Show RectSquareGrid where show (RectSquareGrid (r,c) _) = "rectSquareGrid " ++ show r ++ " " ++ show c@@ -192,8 +204,8 @@ -- | A toroidal grid with square tiles. -- The grid and its indexing scheme are illustrated in the user guide,--- available at https://github.com/mhwombat/grid/wiki.-data TorSquareGrid = TorSquareGrid (Int, Int) [(Int, Int)]+-- available at <https://github.com/mhwombat/grid/wiki>.+data TorSquareGrid = TorSquareGrid (Int, Int) [(Int, Int)] deriving Eq instance Show TorSquareGrid where show (TorSquareGrid (r,c) _) = "torSquareGrid " ++ show r ++ " " ++ show c@@ -237,8 +249,8 @@ -- | A hexagonal grid with hexagonal tiles -- The grid and its indexing scheme are illustrated in the user guide,--- available at https://github.com/mhwombat/grid/wiki.-data HexHexGrid = HexHexGrid Int [(Int, Int)]+-- available at <https://github.com/mhwombat/grid/wiki>.+data HexHexGrid = HexHexGrid Int [(Int, Int)] deriving Eq instance Show HexHexGrid where show (HexHexGrid s _) = "hexHexGrid " ++ show s @@ -249,7 +261,8 @@ distance = hexDistance size (HexHexGrid s _) = s --- | @'hexHexGrid' s@ returns a grid of hexagonal shape, with -- sides of length @s@, using hexagonal tiles. If @s@ is nonnegative, the +-- | @'hexHexGrid' s@ returns a grid of hexagonal shape, with+-- sides of length @s@, using hexagonal tiles. If @s@ is nonnegative, the -- resulting grid will have @3*s*(s-1) + 1@ tiles. Otherwise, the resulting -- grid will be empty and the list of indices will be null. hexHexGrid ∷ Int → HexHexGrid@@ -262,8 +275,8 @@ -- | A parallelogramatical grid with hexagonal tiles -- The grid and its indexing scheme are illustrated in the user guide,--- available at https://github.com/mhwombat/grid/wiki.-data ParaHexGrid = ParaHexGrid (Int, Int) [(Int, Int)]+-- available at <https://github.com/mhwombat/grid/wiki>.+data ParaHexGrid = ParaHexGrid (Int, Int) [(Int, Int)] deriving Eq instance Show ParaHexGrid where show (ParaHexGrid (r,c) _) = "paraHexGrid " ++ show r ++ " " ++ show c@@ -283,3 +296,4 @@ paraHexGrid ∷ Int → Int → ParaHexGrid paraHexGrid r c = ParaHexGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]+
+ src/Math/Geometry/GridMap.hs view
@@ -0,0 +1,258 @@+-----------------------------------------------------------------------------+-- |+-- Module : Math.Geometry.GridMap+-- Copyright : (c) Amy de Buitléir 2012+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- Ordered maps from tiles on a grid to values.+-- This module is a wrapper around @'Math.Geometry.Grid'@ and @'Data.Map'@,+-- in order to combine the functionality of grids and maps into a single type.+--+-----------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FlexibleInstances, + UndecidableInstances #-}++module Math.Geometry.GridMap+ (+ -- * Differences between @GridMap@ and @Map@.+ -- $Compare++ -- * Map type+ GridMap,++ -- * Construction+ lazyGridMap,++ -- * Grid functions+ indices,+ distance,+ size,+ neighbours,+ inGrid,+ viewpoint,+ tileCount,+ empty,+ nonEmpty,+ ++ -- * Map functions+ -- ** Operators+ (!),++ -- ** Query+ lookup,+ findWithDefault,++ -- ** Update+ adjust,+ adjustWithKey,++ -- ** Map+ map,+ mapWithKey,+ mapAccum,+ mapAccumWithKey,++ -- ** Folds+ fold,+ foldWithKey,+ fold',+ foldWithKey',++ -- ** Conversion+ elems,+ keysSet,++ -- ** Lists+ toList+ ) where++import Prelude hiding (lookup, map)+import qualified Data.Map as M+--import qualified Data.Map.Strict as Strict (Map)+import Data.Maybe (fromMaybe)+import Data.Set (Set)+import Math.Geometry.Grid (Grid(..))++-- | A Map from tile positions in a grid to values. +data GridMap g k v = LGridMap { toGrid ∷ g, toMap ∷ M.Map k v }+ deriving Eq+-- Future: add alternative constructor for strict maps++instance (Show g, Show v) ⇒ Show (GridMap g k v) where+ show (LGridMap g m) = "lazyGridMap (" ++ show g ++ ") " ++ show (M.elems m)++-- | Construct a grid map which is strict in the keys (tile positions), but+-- lazy in the values.+lazyGridMap ∷ (Ord k, Grid g s k) ⇒ g → [v] → GridMap g k v+lazyGridMap g vs = LGridMap g (M.fromList kvs)+ where kvs = zip ks vs+ ks = indices g++instance (Eq k, Grid g s k) ⇒ Grid (GridMap g k v) s k where+ indices = indices . toGrid+ distance x y = distance x y . toGrid+ size = size . toGrid+ neighbours k = (k `neighbours`) . toGrid+ inGrid k = (k `inGrid`) . toGrid+ viewpoint k = (k `viewpoint`) . toGrid+ tileCount = tileCount . toGrid+ empty = empty . toGrid+ nonEmpty = nonEmpty . toGrid++-- | /O(min(n,W))/. Find the value at a tile position in the grid.+-- Calls 'error' when the element can not be found.+(!) ∷ Ord k ⇒ GridMap g k v → k → v+(!) m k = toMap m M.! k++modifyMap ∷ (M.Map k a → M.Map k b) → GridMap g k a → GridMap g k b+modifyMap f m = m { toMap = f (toMap m)}++applyToMap ∷ (M.Map k v → c) → GridMap g k v → c+applyToMap f = f . toMap++-- | /O(min(n,W))/. Lookup the value at a tile position in the grid map.+lookup ∷ Ord k ⇒ k → GridMap g k v → Maybe v+lookup k = applyToMap $ M.lookup k++-- | /O(min(n,W))/. Adjust a value at a specific tile position. When the tile+-- is not within the bounds of the grid map, the original grid map is+-- returned.+adjust ∷ Ord k ⇒ (v → v) → k → GridMap g k v → GridMap g k v+adjust f k = modifyMap (M.adjust f k)++-- | /O(min(n,W))/. Adjust a value at a specific key. When the tile+-- is not within the bounds of the grid map, the original grid map is+-- returned.+adjustWithKey ∷ Ord k ⇒ (k → v → v) → k → GridMap g k v → GridMap g k v+adjustWithKey f k = modifyMap (M.adjustWithKey f k)++-- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@+-- returns the value at tile position @k@ or returns @def@ when the tile+-- is not within the bounds of the grid map.+findWithDefault ∷ Ord k ⇒ v → k → GridMap g k v → v+findWithDefault v k m = fromMaybe v $ applyToMap (M.lookup k) m++-- | /O(n)/. Map a function over all values in the grid map.+map ∷ (a → b) → GridMap g k a → GridMap g k b+map f = modifyMap (M.map f)++-- | /O(n)/. Map a function over all values in the grid map.+mapWithKey ∷ (k → a → b) → GridMap g k a → GridMap g k b+mapWithKey f = modifyMap (M.mapWithKey f)++-- | /O(n)/. The function @'mapAccum'@ threads an accumulating+-- argument through the grid map.+-- WARNING: The order in which the elements are processed is not guaranteed.+mapAccum ∷ (a → b → (a, c)) → a → GridMap g k b → (a, GridMap g k c)+mapAccum f = mapAccumWithKey (\a _ x → f a x)++-- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating+-- argument through the grid map.+-- WARNING: The order in which the elements are processed is not guaranteed.+mapAccumWithKey ∷ + (a → k → b → (a, c)) → a → GridMap g k b → (a, GridMap g k c)+mapAccumWithKey f a gm = (b, gm {toMap=m'})+ where (b, m') = applyToMap (M.mapAccumWithKey f a) gm++-- | /O(n)/. Fold the values in the grid map using the given left-associative+-- binary operator.+-- WARNING: The order in which the elements are processed is not guaranteed.+fold ∷ (a → b → a) → a → GridMap g k b → a+fold f x = applyToMap (M.foldl f x)++-- | /O(n)/. Fold the keys and values in the grid map using the given +-- left-associative binary operator.+-- WARNING: The order in which the elements are processed is not guaranteed.+foldWithKey ∷ (a → k → b → a) → a → GridMap g k b → a+foldWithKey f x = applyToMap (M.foldlWithKey f x)++-- | /O(n)/. A strict version of 'fold'.+fold' ∷ (a → b → a) → a → GridMap g k b → a+fold' f x = applyToMap (M.foldl' f x)++-- | /O(n)/. A strict version of 'foldWithKey'.+foldWithKey' ∷ (a → k → b → a) → a → GridMap g k b → a+foldWithKey' f x = applyToMap (M.foldlWithKey' f x)++-- | /O(n)/.+-- Return all elements of the grid map. The order is not guaranteed.+elems ∷ GridMap g k a → [a]+elems = applyToMap M.elems++-- | /O(n*min(n,W))/. The set of all tile positions in the grid map.+keysSet ∷ GridMap g k a → Set k+keysSet = applyToMap M.keysSet++-- | /O(n)/. Returns all key (tile position)\/value pairs in the grid map.+toList ∷ GridMap g k a → [(k, a)]+toList = applyToMap M.toList++{- $Compare+Some functions in @Data.Map@ have been replaced in @GridMap@.+These changes are listed in the table below.++@+Map function | corresponding GridMap function+----------------+-------------------------------+assocs | 'toList'+empty | 'lazyGridMap' g []+foldl | 'fold'+foldl' | 'fold''+foldlWithKey | 'foldWithKey'+foldlWithKey' | 'foldWithKey''+foldr | 'fold'+foldr' | 'fold''+foldrWithKey | 'foldWithKey'+foldrWithKey' | 'foldWithKey''+fromList | 'lazyGridMap'+fromListWithKey | 'lazyGridMap'+fromListWith | 'lazyGridMap'+fromSet | 'lazyGridMap'+keys | 'indices'+member | 'inGrid'+notMember | not 'inGrid'+null | 'empty'+singleton | 'lazyGridMap' g [v]+size | 'size', 'tileCount'+@++The functions (\\), @alter@, @delete@, @deleteFindMax@, @deleteFindMin@,+@deleteMax@, @deleteMin@, @difference@, @differenceWith@, @differenceWithKey@,+@filter@, @filterWithKey@, @insert@, @insertLookupWithKey@, @insertWith@,+@insertWithKey@, @intersection@, @intersectionWith@, @intersectionWithKey@,+@isProperSubmapOf@, @isProperSubmapOfBy@, @isSubmapOf@, @isSubmapOf@,+@isSubmapOfBy@, @mapEither@, @mapEitherWithKey@, @mapKeys@, @mapKeysWith@,+@mapMaybe@, @mapMaybeWithKey@, @mergeWithKey@, @partition@,+@partitionWithKey@, @split@, @splitLookup@, @traverseWithKey@, @union@,+@unions@, @unionsWith@, @unionWith@, @unionWithKey@, @update@,+@updateLookupWithKey@ and @updateWithKey@ are not implemented because the+resulting map might have different dimensions than the original, or because+they combine maps of different dimensions. +As a result, these functions may not be as useful for grid maps.+If you need one of these functions, you can extract the map using @toMap@+and apply the function from @Data.Map@ to the result.++The functions @deleteAt@, @elemAt@, @findIndex@, @findMax@, @findMin@, +@fromAscList@, @fromAscListWith@, @fromAscListWithKey@, @fromDistinctAscList@,+@lookupGE@, @lookupGT@, @lookupIndex@, @lookupLE@, @lookupLT@, +@mapAccumRWithKey@, @mapKeysMonotonic@, @maxView@, @maxViewWithKey@, +@minView@, @minViewWithKey@, @toAscList@, @toDescList@, @updateAt@, +@updateMax@, @updateMaxWithKey@, @updateMin@ and @updateMinWithKey@ are not+implemented because they rely on a meaningful ordering of keys.+While tile positions can be ordered (e.g., @(1,2) < (2,1)@), the ordering+may not be relevant to grid maps.+(Comparisons such as /east of/ or /south of/ may be more meaningful.)+If you need one of these functions, you can extract the map using @toMap@+and apply the function from @Data.Map@ to the result.++The debugging functions @showTree@, @showTreeWith@ and @valid@ are not+implemented.+If you need one of these functions, you can extract the map using @toMap@+and apply the function from @Data.Map@ to the result.+-}++
test/Math/Geometry/GridQC.hs view
@@ -8,8 +8,8 @@ import Math.Geometry.GridInternal -import Data.Eq.Unicode ((≡))-import Data.List (sort)+import Data.Eq.Unicode ((≡), (≠))+import Data.List (nub, sort) import Data.Ord.Unicode ((≤)) import Test.Framework as TF (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)@@ -41,14 +41,32 @@ b = j `pointIn` g -- "cw" = "consistent with"-prop_neighbours_cw_viewpoint ∷ - (Grid g s x, Ord x) ⇒ g → Int → Property++prop_neighbours_cw_viewpoint ∷ (Grid g s x, Ord x) ⇒ g → Int → Property prop_neighbours_cw_viewpoint g i = n > 0 ==> sort (a `neighbours` g) ≡ sort expected where n = (length . indices) g a = indices g !! (i `mod` n) -- make sure point is in grid expected = map fst $ filter (\p → 1 ≡ snd p) $ a `viewpoint` g +prop_edges_cw_neighbours ∷ (Grid g s x, Ord x) ⇒ g → Int → Property+prop_edges_cw_neighbours g i = n > 0 ==> + sort (a `neighbours` g) ≡ sort expected+ where n = (length . indices) g+ a = indices g !! (i `mod` n) -- make sure point is in grid+ nEdges = filter (`involves` a) $ edges g+ expected = filter (≠ a) $ nub $ map fst nEdges ++ map snd nEdges++involves ∷ Eq a ⇒ (a, a) → a → Bool+involves (a, b) c = c ≡ a || c ≡ b++prop_edges_are_adjacent ∷ (Grid g s x, Ord x) ⇒ g → Property+prop_edges_are_adjacent g = property $ and $ map f $ edges g+ where f (a, b) = isAdjacent a b g++isAdjacent :: Grid g s x => x -> x -> g -> Bool+isAdjacent a b g = (distance a b g) ≡ 1+ -- -- Triangular grids with triangular tiles --@@ -116,8 +134,8 @@ b = j `pointIn` g -- If the ordering produced by paraTriGrid is ever changed, this--- property may need to be changed too. It relies on the first and last elements--- being at corners.+-- property may need to be changed too. It relies on the first and last +-- elements being at corners. prop_ParaTriGrid_distance_corner_to_corner ∷ ParaTriGrid → Property prop_ParaTriGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> distance a b g ≡ 2*(r+c) - 3@@ -160,8 +178,8 @@ b = j `pointIn` g -- If the ordering produced by rectSquareGrid is ever changed, this--- property may need to be changed too. It relies on the first and last elements--- being at opposite corners.+-- property may need to be changed too. It relies on the first and last +-- elements being at opposite corners. prop_RectSquareGrid_distance_corner_to_corner ∷ RectSquareGrid → Property prop_RectSquareGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> distance a b g ≡ r + c - 2@@ -170,7 +188,8 @@ a = head ps b = last ps -prop_RectSquareGrid_neighbour_count_in_bounds ∷ RectSquareGrid → Int → Property+prop_RectSquareGrid_neighbour_count_in_bounds ∷ + RectSquareGrid → Int → Property prop_RectSquareGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f where x = i `pointIn` g neighbourCount = length (x `neighbours` g)@@ -317,6 +336,7 @@ test ∷ Test test = testGroup "Math.Geometry.GridQC" [+ -- TriTriGrid tests testProperty "prop_TriTriGrid_tile_count_correct" prop_TriTriGrid_tile_count_correct, testProperty "prop_distance_reflexive - TriTriGrid"@@ -331,6 +351,11 @@ prop_TriTriGrid_neighbour_count_in_bounds, testProperty "prop_neighbours_cw_viewpoint - TriTriGrid" (prop_neighbours_cw_viewpoint ∷ TriTriGrid → Int → Property),+ testProperty "prop_edges_cw_neighbours - TriTriGrid"+ ( prop_edges_cw_neighbours ∷ TriTriGrid → Int → Property),+ testProperty "prop_edges_are_adjacent - TriTriGrid"+ ( prop_edges_are_adjacent ∷ TriTriGrid → Property),+ -- ParaTriGrid tests testProperty "prop_ParaTriGrid_tile_count_correct" prop_ParaTriGrid_tile_count_correct, testProperty "prop_distance_reflexive - ParaTriGrid"@@ -345,6 +370,11 @@ prop_ParaTriGrid_neighbour_count_in_bounds, testProperty "prop_neighbours_cw_viewpoint - ParaTriGrid" (prop_neighbours_cw_viewpoint ∷ ParaTriGrid → Int → Property),+ testProperty "prop_edges_cw_neighbours - ParaTriGrid"+ ( prop_edges_cw_neighbours ∷ ParaTriGrid → Int → Property),+ testProperty "prop_edges_are_adjacent - ParaTriGrid"+ ( prop_edges_are_adjacent ∷ ParaTriGrid → Property),+ -- RectSquareGrid tests testProperty "prop_RectSquareGrid_tile_count_correct" prop_RectSquareGrid_tile_count_correct, testProperty "prop_distance_reflexive - RectTriGrid"@@ -359,6 +389,11 @@ prop_RectSquareGrid_neighbour_count_in_bounds, testProperty "prop_neighbours_cw_viewpoint - RectSquareGrid" (prop_neighbours_cw_viewpoint ∷ RectSquareGrid → Int → Property),+ testProperty "prop_edges_cw_neighbours - RectSquareGrid"+ ( prop_edges_cw_neighbours ∷ RectSquareGrid → Int → Property),+ testProperty "prop_edges_are_adjacent - RectSquareGrid"+ ( prop_edges_are_adjacent ∷ RectSquareGrid → Property),+ -- TorSquareGrid tests testProperty "prop_TorSquareGrid_tile_count_correct" prop_TorSquareGrid_tile_count_correct, testProperty "prop_distance_reflexive - TorSquareGrid"@@ -373,6 +408,11 @@ prop_TorSquareGrid_neighbour_count_in_bounds, testProperty "prop_neighbours_cw_viewpoint - TorSquareGrid" (prop_neighbours_cw_viewpoint ∷ TorSquareGrid → Int → Property),+ testProperty "prop_edges_cw_neighbours - TorSquareGrid"+ ( prop_edges_cw_neighbours ∷ TorSquareGrid → Int → Property),+ testProperty "prop_edges_are_adjacent - TorSquareGrid"+ ( prop_edges_are_adjacent ∷ TorSquareGrid → Property),+ -- HexHexGrid tests testProperty "prop_HexHexGrid_tile_count_correct" prop_HexHexGrid_tile_count_correct, testProperty "prop_distance_reflexive - HexHexGrid"@@ -387,6 +427,11 @@ prop_HexHexGrid_neighbour_count_in_bounds, testProperty "prop_neighbours_cw_viewpoint - HexHexGrid" (prop_neighbours_cw_viewpoint ∷ HexHexGrid → Int → Property),+ testProperty "prop_edges_cw_neighbours - HexHexGrid"+ ( prop_edges_cw_neighbours ∷ HexHexGrid → Int → Property),+ testProperty "prop_edges_are_adjacent - HexHexGrid"+ ( prop_edges_are_adjacent ∷ HexHexGrid → Property),+ -- ParaHexGrid tests testProperty "prop_ParaHexGrid_tile_count_correct" prop_ParaHexGrid_tile_count_correct, testProperty "prop_distance_reflexive - HexHexGrid"@@ -400,5 +445,10 @@ testProperty "prop_ParaHexGrid_neighbour_count_in_bounds" prop_ParaHexGrid_neighbour_count_in_bounds, testProperty "prop_neighbours_cw_viewpoint - ParaHexGrid"- (prop_neighbours_cw_viewpoint ∷ ParaHexGrid → Int → Property)- ]+ (prop_neighbours_cw_viewpoint ∷ ParaHexGrid → Int → Property),+ testProperty "prop_edges_cw_neighbours - ParaHexGrid"+ ( prop_edges_cw_neighbours ∷ ParaHexGrid → Int → Property),+ testProperty "prop_edges_are_adjacent - ParaHexGrid"+ ( prop_edges_are_adjacent ∷ ParaHexGrid → Property)+ ]+