packages feed

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 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)+ ]+