grid 5.0 → 5.1

raw patch · 14 files changed

+1422/−1723 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• grid.cabal +9/−1
• src/Math/Geometry/Grid.hs +15/−51
• src/Math/Geometry/Grid/Hexagonal.hs +33/−0
• src/Math/Geometry/Grid/HexagonalInternal.hs +145/−0
• src/Math/Geometry/Grid/Octagonal.hs +37/−0
• src/Math/Geometry/Grid/OctagonalInternal.hs +139/−0
• src/Math/Geometry/Grid/Square.hs +33/−0
• src/Math/Geometry/Grid/SquareInternal.hs +137/−0
• src/Math/Geometry/Grid/Triangular.hs +39/−0
• src/Math/Geometry/Grid/TriangularInternal.hs +317/−0
• src/Math/Geometry/GridInternal.hs +156/−611
• src/Math/Geometry/GridMap/Lazy.hs +3/−1
• test/Main.hs +8/−2
• test/Math/Geometry/GridQC.hs +351/−1057

@@ -1,5 +1,5 @@ name:           grid-version:        5.0+version:        5.1 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@@ -33,7 +33,15 @@                    containers ==0.4.2.* || ==0.5.*   ghc-options:     -Wall   exposed-modules: Math.Geometry.Grid,+                   Math.Geometry.Grid.Triangular,+                   Math.Geometry.Grid.Square,+                   Math.Geometry.Grid.Hexagonal,+                   Math.Geometry.Grid.Octagonal,                    Math.Geometry.GridInternal,+                   Math.Geometry.Grid.TriangularInternal,+                   Math.Geometry.Grid.SquareInternal,+                   Math.Geometry.Grid.HexagonalInternal,+                   Math.Geometry.Grid.OctagonalInternal,                    Math.Geometry.GridMap,                    Math.Geometry.GridMap.Lazy 

@@ -37,6 +37,8 @@ -- You can still /display/ the tiles as squares, but for internal -- calculations they are octagons. --+-- NOTE: Version 6.0 moved the various grid flavours to sub-modules.+-- -- NOTE: Version 4.0 uses associated (type) synonyms instead of  -- multi-parameter type classes. --@@ -52,61 +54,23 @@   (     -- * Example     -- $Example-    -- * The Grid class-    Grid(..),++    -- * Grids+    Grid(indices, distance, minDistance, neighbours, neighbour, +      contains, tileCount, null, nonNull, edges, isAdjacent,+      adjacentTilesToward, minimalPaths, directionTo),+    Index,+    Direction,++    -- * Finite grids     FiniteGrid(..),-    BoundedGrid(..),-    -- * Grids with triangular tiles-    -- ** Unbounded grid with triangular tiles-    UnboundedTriGrid,-    -- ** Triangular grid with triangular tiles-    TriTriGrid,-    triTriGrid,-    -- ** Parallelogram-shaped grid with triangular tiles-    ParaTriGrid,-    paraTriGrid,-    -- ** Rectangular grid with triangular tiles-    RectTriGrid,-    rectTriGrid,-    -- ** Toroidal grid with triangular tiles-    TorTriGrid,-    torTriGrid,-    -- * Grids with square tiles-    -- ** Unbounded grid with square tiles-    UnboundedSquareGrid,-    -- ** Rectangular grid with square tiles-    RectSquareGrid,-    rectSquareGrid,-    -- ** Toroidal grid with square tiles-    TorSquareGrid,-    torSquareGrid,-    -- * Grids with hexagonal tiles-    -- ** Unbounded grid with hexagonal tiles-    UnboundedHexGrid,-    -- ** Hexagonal grid with hexagonal tiles-    HexHexGrid,-    hexHexGrid,-    -- ** Parallelogram-shaped grid with hexagonal tiles-    ParaHexGrid,-    paraHexGrid,-    -- * Grids with octagonal tiles-    -- ** Unbounded grid with octagonal tiles-    UnboundedOctGrid,-    -- ** Rectangular grid with octagonal tiles-    RectOctGrid,-    rectOctGrid,-    -- ** Toroidal grid with octagonal tiles-    TorOctGrid,-    torOctGrid++    -- * Bounded grids+    BoundedGrid(..)   ) where  import Math.Geometry.GridInternal (Grid(..), FiniteGrid(..), -  BoundedGrid(..), UnboundedTriGrid, TriTriGrid, triTriGrid, -  ParaTriGrid, paraTriGrid, RectTriGrid, rectTriGrid, -  TorTriGrid, torTriGrid, UnboundedSquareGrid, -  RectSquareGrid, rectSquareGrid, TorSquareGrid, torSquareGrid, -  UnboundedHexGrid, HexHexGrid, hexHexGrid, ParaHexGrid, paraHexGrid, -  UnboundedOctGrid, RectOctGrid, rectOctGrid, TorOctGrid, torOctGrid)+  BoundedGrid(..))   {- $Example

@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.HexGrid+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A regular arrangement of hexagonal tiles.+-- The userguide, with illustrations, is available at +-- <https://github.com/mhwombat/grid/wiki>.+-- Also see @Math.Geometry.Grid@ for examples of how to use this class.+--+-----------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, +  FlexibleInstances #-}++module Math.Geometry.Grid.Hexagonal+  (+    -- * Unbounded grid with hexagonal tiles+    UnboundedHexGrid,+    -- * Hexagonal grid with hexagonal tiles+    HexHexGrid,+    hexHexGrid,+    -- * Parallelogram-shaped grid with hexagonal tiles+    ParaHexGrid,+    paraHexGrid+  ) where++import Math.Geometry.Grid.HexagonalInternal (UnboundedHexGrid, HexHexGrid, +  hexHexGrid, ParaHexGrid, paraHexGrid)+

@@ -0,0 +1,145 @@+------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.HexGridInternal+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A module containing private @HexGrid@ internals. Most developers +-- should use @HexGrid@ instead. This module is subject to change +-- without notice.+--+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}++module Math.Geometry.Grid.HexagonalInternal where++import Prelude hiding (null)+import Data.Ord.Unicode ((≤))+import Math.Geometry.GridInternal++data HexDirection = West | Northwest | Northeast | East | Southeast | +                      Southwest deriving (Show, Eq)++-- | An unbounded 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 UnboundedHexGrid = UnboundedHexGrid deriving Show++instance Grid UnboundedHexGrid where+  type Index UnboundedHexGrid = (Int, Int)+  type Direction UnboundedHexGrid = HexDirection+  indices _ = undefined+  neighbours _ (x,y) = +    [(x-1,y), (x-1,y+1), (x,y+1), (x+1,y), (x+1,y-1), (x,y-1)]+  distance _ (x1, y1) (x2, y2) = +    maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]+    where z1 = -x1 - y1+          z2 = -x2 - y2+  directionTo _ (x1, y1) (x2, y2) = f1 . f2 . f3 . f4 . f5 . f6 $ []+    where f1 ds =  if dx < 0 && dz > 0 then West:ds else ds+          f2 ds =  if dx < 0 && dy > 0 then Northwest:ds else ds+          f3 ds =  if dy > 0 && dz < 0 then Northeast:ds else ds+          f4 ds =  if dx > 0 && dz < 0 then East:ds else ds+          f5 ds =  if dx > 0 && dy < 0 then Southeast:ds else ds+          f6 ds =  if dy < 0 && dz > 0 then Southwest:ds else ds+          dx = x2 - x1+          dy = y2 - y1+          z1 = -x1 - y1+          z2 = -x2 - y2+          dz = z2 - z1+  contains _ _ = True+  null _ = False+  nonNull _ = True++--+-- Hexagonal grids with hexagonal tiles+--++-- | 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)] deriving Eq++instance Show HexHexGrid where show (HexHexGrid s _) = "hexHexGrid " ++ show s++instance Grid HexHexGrid where+  type Index HexHexGrid = (Int, Int)+  type Direction HexHexGrid = HexDirection+  indices (HexHexGrid _ xs) = xs+  neighbours = neighboursBasedOn UnboundedHexGrid+  distance = distanceBasedOn UnboundedHexGrid+  directionTo = directionToBasedOn UnboundedHexGrid+  contains g (x,y) = -s < x && x < s && check+    where s = size g+          check = if x < 0+                    then -s-x < y && y < s+                    else -s < y && y < s-x++instance FiniteGrid HexHexGrid where+  type Size HexHexGrid = Int+  size (HexHexGrid s _) = s++instance BoundedGrid HexHexGrid where+  tileSideCount _ = 6+  boundary g = +    north ++ northeast ++ southeast ++ south ++ southwest ++ northwest+    where s = size g+          north = [(k,s-1) | k ← [-s+1,-s+2..0]]+          northeast = [(k,s-1-k) | k ← [1,2..s-1]]+          southeast = [(s-1,k) | k ← [-1,-2..(-s)+1]]+          south = [(k,(-s)+1) | k ← [s-2,s-3..0]]+          southwest = [(k,(-s)+1-k) | k ← [-1,-2..(-s)+1]]+          northwest = [(-s+1,k) | k ← [1,2..s-2]]+  centre _ = [(0,0)]++-- | @'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 null and the list of indices will be null.+hexHexGrid ∷ Int → HexHexGrid+hexHexGrid r = HexHexGrid r [(x, y) | x ← [-r+1..r-1], y ← f x]+  where f x = if x < 0 then [1-r-x .. r-1] else [1-r .. r-1-x]++--+-- Parallelogrammatical grids with hexagonal tiles+--++-- | 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)] deriving Eq++instance Show ParaHexGrid where +  show (ParaHexGrid (r,c) _) = "paraHexGrid " ++ show r ++ " " ++ show c++instance Grid ParaHexGrid where+  type Index ParaHexGrid = (Int, Int)+  type Direction ParaHexGrid = HexDirection+  indices (ParaHexGrid _ xs) = xs+  neighbours = neighboursBasedOn UnboundedHexGrid+  distance = distanceBasedOn UnboundedHexGrid+  directionTo = directionToBasedOn UnboundedHexGrid+  contains g (x,y) = 0 ≤ x && x < c && 0 ≤ y && y < r+    where (r,c) = size g++instance FiniteGrid ParaHexGrid where+  type Size ParaHexGrid = (Int, Int)+  size (ParaHexGrid s _) = s++instance BoundedGrid ParaHexGrid where+  tileSideCount _ = 6+  boundary g = cartesianIndices . size $ g+  centre g = cartesianCentre . size $ g++-- | @'paraHexGrid' r c@ returns a grid in the shape of a +--   parallelogram with @r@ rows and @c@ columns, using hexagonal tiles. If +--   @r@ and @c@ are both nonnegative, the resulting grid will have @r*c@ tiles.+--   Otherwise, the resulting grid will be null and the list of indices will +--   be null.+paraHexGrid ∷ Int → Int → ParaHexGrid+paraHexGrid r c = +  ParaHexGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]+

@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.OctGrid+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A regular arrangement of octagonal tiles.+-- Octagons won't tile a regular plane (there will be diamond-shaped+-- gaps between the tiles), but they will tile a /hyperbolic/ plane.+-- (Alternatively, you can think of these as squares on a board game+-- where diagonal moves are allowed.)+-- The userguide, with illustrations, is available at +-- <https://github.com/mhwombat/grid/wiki>.+-- Also see @Math.Geometry.Grid@ for examples of how to use this class.+--+-----------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, +  FlexibleInstances #-}++module Math.Geometry.Grid.Octagonal+  (+    -- * Unbounded grid with octagonal tiles+    UnboundedOctGrid,+    -- * Rectangular grid with octagonal tiles+    RectOctGrid,+    rectOctGrid,+    -- * Toroidal grid with octagonal tiles+    TorOctGrid,+    torOctGrid+  ) where++import Math.Geometry.Grid.OctagonalInternal (UnboundedOctGrid, RectOctGrid, +  rectOctGrid, TorOctGrid, torOctGrid)+

@@ -0,0 +1,139 @@+------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.OctGridInternal+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A module containing private @OctGrid@ internals. Most developers +-- should use @OctGrid@ instead. This module is subject to change +-- without notice.+--+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}++module Math.Geometry.Grid.OctagonalInternal where++import Prelude hiding (null)++import Data.List (nub)+import Data.Ord.Unicode ((≤))+import Math.Geometry.GridInternal++data OctDirection = West | Northwest | North | Northeast | East | +                      Southeast | South | Southwest deriving (Show, Eq)++-- | An unbounded grid with octagonal tiles.+--   The grid and its indexing scheme are illustrated in the user guide,+--   available at <https://github.com/mhwombat/grid/wiki>.+data UnboundedOctGrid = UnboundedOctGrid deriving Show++instance Grid UnboundedOctGrid where+  type Index UnboundedOctGrid = (Int, Int)+  type Direction UnboundedOctGrid = OctDirection+  indices _ = undefined+  neighbours _ (x,y) = [(x-1,y+1), (x,y+1), (x+1,y+1), (x+1,y), +                        (x+1,y-1), (x,y-1), (x-1,y-1), (x-1,y)]+  distance _ (x1, y1) (x2, y2) = max (abs (x2-x1)) (abs (y2-y1))+  contains _ _ = True+  directionTo _ (x1, y1) (x2, y2) = +    f1 . f2 . f3 . f4 . f5 . f6 . f7 . f8 $ []+    where f1 ds =  if  dy > abs dx then North:ds else ds+          f2 ds =  if -dy > abs dx then South:ds else ds+          f3 ds =  if  dx > abs dy then East:ds else ds+          f4 ds =  if -dx > abs dy then West:ds else ds+          f5 ds =  if dx > 0 && dy > 0 then Northeast:ds else ds+          f6 ds =  if dx > 0 && dy < 0 then Southeast:ds else ds+          f7 ds =  if dx < 0 && dy < 0 then Southwest:ds else ds+          f8 ds =  if dx < 0 && dy > 0 then Northwest:ds else ds+          dx = x2 - x1+          dy = y2 - y1+  null _ = False+  nonNull _ = True++--+-- Rectangular grids with octagonal tiles+--++-- | A rectangular grid with octagonal tiles.+--   The grid and its indexing scheme are illustrated in the user guide,+--   available at <https://github.com/mhwombat/grid/wiki>.+data RectOctGrid = RectOctGrid (Int, Int) [(Int, Int)] deriving Eq++instance Show RectOctGrid where +  show (RectOctGrid (r,c) _) = +    "rectOctGrid " ++ show r ++ " " ++ show c++instance Grid RectOctGrid where+  type Index RectOctGrid = (Int, Int)+  type Direction RectOctGrid = OctDirection+  indices (RectOctGrid _ xs) = xs+  neighbours = neighboursBasedOn UnboundedOctGrid+  distance = distanceBasedOn UnboundedOctGrid+  directionTo = directionToBasedOn UnboundedOctGrid+  contains g (x,y) = 0 ≤ x && x < c && 0 ≤ y && y < r+    where (r,c) = size g++instance FiniteGrid RectOctGrid where+  type Size RectOctGrid = (Int, Int)+  size (RectOctGrid s _) = s++instance BoundedGrid RectOctGrid where+  tileSideCount _ = 4+  boundary g = cartesianIndices . size $ g+  centre g = cartesianCentre . size $ g++-- | @'rectOctGrid' r c@ produces a rectangular grid with @r@ rows+--   and @c@ columns, using octagonal tiles. If @r@ and @c@ are both +--   nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, +--   the resulting grid will be null and the list of indices will be +--   null.+rectOctGrid ∷ Int → Int → RectOctGrid+rectOctGrid r c = +  RectOctGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]]++--+-- Toroidal grids with octagonal tiles.+--++-- | A toroidal grid with octagonal tiles.+--   The grid and its indexing scheme are illustrated in the user guide,+--   available at <https://github.com/mhwombat/grid/wiki>.+data TorOctGrid = TorOctGrid (Int, Int) [(Int, Int)] deriving Eq++instance Show TorOctGrid where +  show (TorOctGrid (r,c) _) = "torOctGrid " ++ show r ++ " " ++ show c++instance Grid TorOctGrid where+  type Index TorOctGrid = (Int, Int)+  type Direction TorOctGrid = OctDirection+  indices (TorOctGrid _ xs) = xs+  neighbours = neighboursWrappedBasedOn UnboundedOctGrid+  neighbour = neighbourWrappedBasedOn UnboundedOctGrid+  distance = distanceWrappedBasedOn UnboundedOctGrid+  directionTo = directionToWrappedBasedOn UnboundedOctGrid+  isAdjacent g a b = distance g a b ≤ 1+  contains _ _ = True++instance FiniteGrid TorOctGrid where+  type Size TorOctGrid = (Int, Int)+  size (TorOctGrid s _) = s++instance WrappedGrid TorOctGrid where+  normalise g (x,y) = (x `mod` c, y `mod` r)+    where (r, c) = size g+  denormalise g a = nub [ (x-c,y+r), (x,y+r), (x+c,y+r), +                          (x-c,y),   (x,y),   (x+c,y),+                          (x-c,y-r), (x,y-r), (x+c,y-r) ]+    where (r, c) = size g+          (x, y) = normalise g a++-- | @'torOctGrid' r c@ returns a toroidal grid with @r@ +--   rows and @c@ columns, using octagonal tiles. If @r@ and @c@ are +--   both nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, +--   the resulting grid will be null and the list of indices will be null.+torOctGrid ∷ Int → Int → TorOctGrid+torOctGrid r c = TorOctGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]+

@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.SquareGrid+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A regular arrangement of square tiles.+-- The userguide, with illustrations, is available at +-- <https://github.com/mhwombat/grid/wiki>.+-- Also see @Math.Geometry.Grid@ for examples of how to use this class.+--+-----------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, +  FlexibleInstances #-}++module Math.Geometry.Grid.Square+  (+    -- * Unbounded grid with square tiles+    UnboundedSquareGrid,+    -- * Rectangular grid with square tiles+    RectSquareGrid,+    rectSquareGrid,+    -- * Toroidal grid with square tiles+    TorSquareGrid,+    torSquareGrid+  ) where++import Math.Geometry.Grid.SquareInternal (UnboundedSquareGrid, +  RectSquareGrid, rectSquareGrid, TorSquareGrid, torSquareGrid)+

@@ -0,0 +1,137 @@+------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.SquareGridInternal+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A module containing private @SquareGrid@ internals. Most developers +-- should use @SquareGrid@ instead. This module is subject to change +-- without notice.+--+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}++module Math.Geometry.Grid.SquareInternal where++import Prelude hiding (null)++import Data.Eq.Unicode ((≠))+import Data.List (nub)+import Data.Ord.Unicode ((≤))+import Math.Geometry.GridInternal++data SquareDirection = North | East | South | West deriving (Show, Eq)++-- | An unbounded 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 UnboundedSquareGrid = UnboundedSquareGrid deriving Show++instance Grid UnboundedSquareGrid where+  type Index UnboundedSquareGrid = (Int, Int)+  type Direction UnboundedSquareGrid = SquareDirection+  indices _ = undefined+  neighbours _ (x,y) = [(x,y+1), (x,y-1), (x+1,y), (x-1,y)]+  distance _ (x1, y1) (x2, y2) = abs (x2-x1) + abs (y2-y1)+  contains _ _ = True+  directionTo _ (x1, y1) (x2, y2) = f1 . f2 . f3 . f4 $ []+    where f1 ds =  if y2 > y1 then North:ds else ds+          f2 ds =  if y2 < y1 then South:ds else ds+          f3 ds =  if x2 > x1 then East:ds else ds+          f4 ds =  if x2 < x1 then West:ds else ds+  null _ = False+  nonNull _ = True++--+-- Rectangular grids with square tiles+--++-- | 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)] deriving Eq++instance Show RectSquareGrid where +  show (RectSquareGrid (r,c) _) = +    "rectSquareGrid " ++ show r ++ " " ++ show c++instance Grid RectSquareGrid where+  type Index RectSquareGrid = (Int, Int)+  type Direction RectSquareGrid = SquareDirection+  indices (RectSquareGrid _ xs) = xs+  neighbours = neighboursBasedOn UnboundedSquareGrid+  distance = distanceBasedOn UnboundedSquareGrid+  adjacentTilesToward g a@(x1, y1) (x2, y2) = +    filter (\i → g `contains` i && i ≠ a) $ nub [(x1,y1+dy),(x1+dx,y1)]+      where dx = signum (x2-x1)+            dy = signum (y2-y1)+  directionTo g x y = if g `contains` x && g `contains` y+                        then directionTo UnboundedSquareGrid x y+                        else []+  contains g (x,y) = 0 ≤ x && x < c && 0 ≤ y && y < r+    where (r, c) = size g++instance FiniteGrid RectSquareGrid where+  type Size RectSquareGrid = (Int, Int)+  size (RectSquareGrid s _) = s++instance BoundedGrid RectSquareGrid where+  tileSideCount _ = 4+  boundary g = cartesianIndices . size $ g+  centre g = cartesianCentre . size $ g++-- | @'rectSquareGrid' r c@ produces a rectangular grid with @r@ rows+--   and @c@ columns, using square tiles. If @r@ and @c@ are both +--   nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, +--   the resulting grid will be null and the list of indices will be +--   null.+rectSquareGrid ∷ Int → Int → RectSquareGrid+rectSquareGrid r c = +  RectSquareGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]]++--+-- Toroidal grids with square tiles.+--++-- | 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)] deriving Eq++instance Show TorSquareGrid where +  show (TorSquareGrid (r,c) _) = "torSquareGrid " ++ show r ++ " " ++ show c++instance Grid TorSquareGrid where+  type Index TorSquareGrid = (Int, Int)+  type Direction TorSquareGrid = SquareDirection+  indices (TorSquareGrid _ xs) = xs+  neighbours = neighboursWrappedBasedOn UnboundedSquareGrid+  neighbour = neighbourWrappedBasedOn UnboundedSquareGrid+  distance = distanceWrappedBasedOn UnboundedSquareGrid+  directionTo = directionToWrappedBasedOn UnboundedSquareGrid+  isAdjacent g a b = distance g a b ≤ 1+  contains _ _ = True++instance FiniteGrid TorSquareGrid where+  type Size TorSquareGrid = (Int, Int)+  size (TorSquareGrid s _) = s++instance WrappedGrid TorSquareGrid where+  normalise g (x,y) = (x `mod` c, y `mod` r)+    where (r, c) = size g+  denormalise g b = nub [ (x-c,y+r), (x,y+r), (x+c,y+r),+                          (x-c,y),   (x,y),   (x+c,y),+                          (x-c,y-r), (x,y-r), (x+c,y-r) ]+    where (r, c) = size g+          (x, y) = normalise g b++-- | @'torSquareGrid' r c@ returns a toroidal grid with @r@ +--   rows and @c@ columns, using square tiles. If @r@ and @c@ are +--   both nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, +--   the resulting grid will be null and the list of indices will be null.+torSquareGrid ∷ Int → Int → TorSquareGrid+torSquareGrid r c = TorSquareGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]+

@@ -0,0 +1,39 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.TriGrid+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A regular arrangement of triangular tiles.+-- The userguide, with illustrations, is available at +-- <https://github.com/mhwombat/grid/wiki>.+-- Also see @Math.Geometry.Grid@ for examples of how to use this class.+--+-----------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, +  FlexibleInstances #-}++module Math.Geometry.Grid.Triangular+  (+    -- * Unbounded grid with triangular tiles+    UnboundedTriGrid,+    -- * Triangular grid with triangular tiles+    TriTriGrid,+    triTriGrid,+    -- * Parallelogram-shaped grid with triangular tiles+    ParaTriGrid,+    paraTriGrid,+    -- * Rectangular grid with triangular tiles+    RectTriGrid,+    rectTriGrid,+    -- * Toroidal grid with triangular tiles+    TorTriGrid,+    torTriGrid+  ) where++import Math.Geometry.Grid.TriangularInternal (UnboundedTriGrid, TriTriGrid, +  triTriGrid, ParaTriGrid, paraTriGrid, RectTriGrid, rectTriGrid, +  TorTriGrid, torTriGrid)

@@ -0,0 +1,317 @@+------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.TriGridInternal+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A module containing private @TriGrid@ internals. Most developers +-- should use @TriGrid@ instead. This module is subject to change +-- without notice.+--+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}++module Math.Geometry.Grid.TriangularInternal where++import Prelude hiding (null)++import Data.Eq.Unicode ((≡))+import Data.List (nub)+import Data.Ord.Unicode ((≤), (≥))+import Math.Geometry.GridInternal++data TriDirection = South | Northwest | Northeast | +                      North | Southeast | Southwest deriving (Show, Eq)++-- | An unbounded 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 UnboundedTriGrid = UnboundedTriGrid deriving Show++instance Grid UnboundedTriGrid where+  type Index UnboundedTriGrid = (Int, Int)+  type Direction UnboundedTriGrid = TriDirection+  indices _ = undefined+  neighbours _ (x,y) = if even y+                         then [(x-1,y+1), (x+1,y+1), (x+1,y-1)]+                         else [(x-1,y-1), (x-1,y+1), (x+1,y-1)]+  distance _ (x1, y1) (x2, y2) = +    maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]+      where z1 = triZ x1 y1+            z2 = triZ x2 y2+  contains _ _ = True+  null _ = False+  nonNull _ = True+  directionTo _ (x1, y1) (x2, y2) = +    if even y1+      then f1 . f2 . f3 $ []+      else f4 . f5 . f6 $ []+    where f1 ds =  if y2 < y1 then South:ds else ds+          f2 ds =  if x2 < x1 then Northwest:ds else ds+          f3 ds =  if z2 < z1 then Northeast:ds else ds+          f4 ds =  if y2 > y1 then North:ds else ds+          f5 ds =  if x2 > x1 then Southeast:ds else ds+          f6 ds =  if z2 > z1 then Southwest:ds else ds+          z1 = triZ x1 y1+          z2 = triZ x2 y2+          ++-- | For triangular tiles, it is convenient to define a third component +--   z.+triZ ∷ Int → Int → Int            +triZ x y = if even y then -x - y else -x - y + 1++--+-- Triangular grids with triangular tiles+--++-- | 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)] deriving Eq++instance Show TriTriGrid where +  show (TriTriGrid s _) = "triTriGrid " ++ show s++instance Grid TriTriGrid where+  type Index TriTriGrid = (Int, Int)+  type Direction TriTriGrid = TriDirection+  indices (TriTriGrid _ xs) = xs+  neighbours = neighboursBasedOn UnboundedTriGrid+  distance = distanceBasedOn UnboundedTriGrid+  contains (TriTriGrid s _) (x, y) = inTriTriGrid (x,y) s+  directionTo = directionToBasedOn UnboundedTriGrid++inTriTriGrid ∷ (Int, Int) → Int → Bool+inTriTriGrid (x, y) s = x ≥ 0 && y ≥ 0 && even (x+y) && abs z ≤ 2*s-2+  where z = triZ x y++instance FiniteGrid TriTriGrid where+  type Size TriTriGrid = Int+  size (TriTriGrid s _) = s++instance BoundedGrid TriTriGrid where+  tileSideCount _ = 3+  boundary g = west ++ east ++ south+    where s = size g+          west = [(0,k) | k ← [0,2..2*s-2]]+          east = [(k,2*s-2-k) | k ← [2,4..2*s-2]]+          south = [(k,0) | k ← [2*s-4,2*s-6..2]]+  centre g = case s `mod` 3 of+    0 → trefoilWithTop (k-1,k+1) where k = (2*s) `div` 3+    1 → [(k,k)] where k = (2*(s-1)) `div` 3+    2 → [(k+1,k+1)] where k = (2*(s-2)) `div` 3+    _ → error "This will never happen."+    where s = size g+          trefoilWithTop (i,j) = [(i,j), (i+2, j-2), (i,j-2)]++-- | @'triTriGrid' s@ returns a triangular grid with sides of +--   length @s@, using triangular tiles. If @s@ is nonnegative, the +--   resulting grid will have @s^2@ tiles. Otherwise, the resulting grid+--   will be null and the list of indices will be null.+triTriGrid ∷ Int → TriTriGrid+triTriGrid s = +  TriTriGrid s [(xx,yy) | xx ← [0..2*(s-1)], +                          yy ← [0..2*(s-1)], +                          (xx,yy) `inTriTriGrid` s]++--+-- Parallelogrammatical grids with triangular tiles+--++-- | 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)] deriving Eq++instance Show ParaTriGrid where +  show (ParaTriGrid (r,c) _) = "paraTriGrid " ++ show r ++ " " ++ show c++instance Grid ParaTriGrid where+  type Index ParaTriGrid = (Int, Int)+  type Direction ParaTriGrid = TriDirection+  indices (ParaTriGrid _ xs) = xs+  neighbours = neighboursBasedOn UnboundedTriGrid+  distance = distanceBasedOn UnboundedTriGrid+  directionTo = directionToBasedOn UnboundedTriGrid+  contains g (x,y) = 0 ≤ x && x < 2*c && 0 ≤ y && y < 2*r && even (x+y)+    where (r,c) = size g++instance FiniteGrid ParaTriGrid where+  type Size ParaTriGrid = (Int, Int)+  size (ParaTriGrid s _) = s++instance BoundedGrid ParaTriGrid where+  tileSideCount _ = 3+  boundary g = west ++ north ++ east ++ south+    where (r,c) = size g+          west = [(0,k) | k ← [0,2..2*r-2], c>0]+          north = [(k,2*r-1) | k ← [1,3..2*c-1], r>0]+          east = [(2*c-1,k) | k ← [2*r-3,2*r-5..1], c>0]+          south = [(k,0) | k ← [2*c-2,2*c-4..2], r>0]+  centre g = f . size $ g+    where f (r,c)+            | odd r && odd c             +                = [(c-1,r-1), (c,r)]+            | even r && even c && r ≡ c +                = bowtie (c-1,r-1)+            | even r && even c && r > c  +                = bowtie (c-1,r-3) ++ bowtie (c-1,r-1) ++ bowtie (c-1,r+1)+            | even r && even c && r < c  +                = bowtie (c-3,r-1) ++ bowtie (c-1,r-1) ++ bowtie (c+1,r-1)+            | otherwise                  +                = [(c-1,r), (c,r-1)]+          bowtie (i,j) = [(i,j), (i+1,j+1)]++-- | @'paraTriGrid' r c@ returns a grid in the shape of a +--   parallelogram with @r@ rows and @c@ columns, using triangular +--   tiles. If @r@ and @c@ are both nonnegative, the resulting grid will+--   have @2*r*c@ tiles. Otherwise, the resulting grid will be null and+--   the list of indices will be null.+paraTriGrid ∷ Int → Int → ParaTriGrid+paraTriGrid r c = +  ParaTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]+++--+-- Rectangular grids with triangular tiles+--++-- | A rectangular 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 RectTriGrid = RectTriGrid (Int, Int) [(Int, Int)] deriving Eq++instance Show RectTriGrid where +  show (RectTriGrid (r,c) _) = "rectTriGrid " ++ show r ++ " " ++ show c++instance Grid RectTriGrid where+  type Index RectTriGrid = (Int, Int)+  type Direction RectTriGrid = TriDirection+  indices (RectTriGrid _ xs) = xs+  neighbours = neighboursBasedOn UnboundedTriGrid+  distance = distanceBasedOn UnboundedTriGrid+  directionTo = directionToBasedOn UnboundedTriGrid+  -- TODO Implement faster "contains"++instance FiniteGrid RectTriGrid where+  type Size RectTriGrid = (Int, Int)+  size (RectTriGrid s _) = s++instance BoundedGrid RectTriGrid where+  tileSideCount _ = 3++-- | @'rectTriGrid' r c@ returns a grid in the shape of a +--   rectangle (with jagged edges) that has @r@ rows and @c@ columns, +--   using triangular tiles. If @r@ and @c@ are both nonnegative, the +--   resulting grid will have @2*r*c@ tiles. Otherwise, the resulting grid will be null and+--   the list of indices will be null.+rectTriGrid ∷ Int → Int → RectTriGrid+rectTriGrid r c = RectTriGrid (r,c) [(x,y) | y ← [0..2*r-1], x ← [xMin y .. xMax c y], even (x+y)]+  where xMin y = if even y then w else w+1+          where w = -2*((y+1) `div` 4)+        xMax c2 y = xMin y + 2*(c2-1)+++--+-- Toroidal grids with triangular tiles+--++-- | A toroidal 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 TorTriGrid = TorTriGrid (Int, Int) [(Int, Int)] deriving Eq++instance Show TorTriGrid where +  show (TorTriGrid (r,c) _) = "torTriGrid " ++ show r ++ " " ++ show c++instance Grid TorTriGrid where+  type Index TorTriGrid = (Int, Int)+  type Direction TorTriGrid = TriDirection+  indices (TorTriGrid _ xs) = xs+  neighbours = neighboursWrappedBasedOn UnboundedTriGrid+  neighbour = neighbourWrappedBasedOn UnboundedTriGrid+  distance = distanceWrappedBasedOn UnboundedTriGrid+  directionTo = directionToWrappedBasedOn UnboundedTriGrid+  isAdjacent g a b = distance g a b ≤ 1+  contains _ _ = True++instance FiniteGrid TorTriGrid where+  type Size TorTriGrid = (Int, Int)+  size (TorTriGrid s _) = s++instance WrappedGrid TorTriGrid where+  normalise g (x,y) | y < 0     = normalise g (x,y+2*r)+                    | y > 2*r-1 = normalise g (x,y-2*r)+                    | x < 0     = normalise g (x+2*c,y)+                    | x > 2*c-1 = normalise g (x-2*c,y)+                    | otherwise = (x,y)+    where (r, c) = size g+  denormalise g a = nub [ (x-2*c,y+2*r), (x,y+2*r), (x+2*c,y+2*r),+                          (x-2*c,y),     (x,y),     (x+2*c,y),+                          (x-2*c,y-2*r), (x,y-2*r), (x+2*c,y-2*r) ]+    where (r, c) = size g+          (x, y) = normalise g a++-- | @'torTriGrid' r c@ returns a toroidal grid with @r@ rows and @c@+--   columns, using triangular tiles. The indexing method is the same as+--   for @ParaTriGrid@. If @r@ and @c@ are both nonnegative, the +--   resulting grid will have @2*r*c@ tiles. Otherwise, the resulting+--   grid will be null and the list of indices will be null.+torTriGrid ∷ Int → Int → TorTriGrid+torTriGrid r c = +  TorTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]++--+-- Cylindrical grids with triangular tiles+--++-- | A cylindrical grid with triangular tiles, where the cylinder is+--   along the y-axis.+--   The grid and its indexing scheme are illustrated in the user guide,+--   available at <https://github.com/mhwombat/grid/wiki>.+data YCylTriGrid = YCylTriGrid (Int, Int) [(Int, Int)] deriving Eq++instance Show YCylTriGrid where +  show (YCylTriGrid (r,c) _) = "yCylTriGrid " ++ show r ++ " " ++ show c++instance Grid YCylTriGrid where+  type Index YCylTriGrid = (Int, Int)+  type Direction YCylTriGrid = TriDirection+  indices (YCylTriGrid _ xs) = xs+  neighbours = neighboursWrappedBasedOn UnboundedTriGrid+  neighbour = neighbourWrappedBasedOn UnboundedTriGrid+  distance = distanceWrappedBasedOn UnboundedTriGrid+  directionTo = directionToWrappedBasedOn UnboundedTriGrid+  isAdjacent g a b = distance g a b ≤ 1+  contains g (x, y) = 0 ≤ y && y ≤ 2*r-1 && even (x+y) +    where (r, _) = size g++instance FiniteGrid YCylTriGrid where+  type Size YCylTriGrid = (Int, Int)+  size (YCylTriGrid s _) = s++instance WrappedGrid YCylTriGrid where+  normalise g (x,y) | x < 0     = normalise g (x+2*c,y)+                    | x > 2*c-1 = normalise g (x-2*c,y)+                    | otherwise = (x,y)+    where (_, c) = size g+  denormalise g a = nub [ (x-2*c,y), (x,y), (x+2*c,y) ]+    where (_, c) = size g+          (x, y) = normalise g a++-- | @'yCylTriGrid' r c@ returns a cylindrical grid with @r@ rows and +--   @c@ columns, using triangular tiles, where the cylinder is along +--   the y-axis. The indexing method is the same as for @ParaTriGrid@. +--   If @r@ and @c@ are both nonnegative, the resulting grid will have +--   @2*r*c@ tiles. Otherwise, the resulting grid will be null and the +--   list of indices will be null.+yCylTriGrid ∷ Int → Int → YCylTriGrid+yCylTriGrid r c = +  YCylTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]+++

@@ -13,50 +13,21 @@ ------------------------------------------------------------------------ {-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-} -module Math.Geometry.GridInternal-  (-    Grid(..),-    FiniteGrid(..),-    BoundedGrid(..),-    WrappedGrid(..),-    UnboundedTriGrid,-    TriTriGrid,-    triTriGrid,-    ParaTriGrid,-    paraTriGrid,-    RectTriGrid,-    rectTriGrid,-    TorTriGrid,-    torTriGrid,-    UnboundedSquareGrid,-    RectSquareGrid,-    rectSquareGrid,-    TorSquareGrid,-    torSquareGrid,-    UnboundedHexGrid,-    HexHexGrid,-    hexHexGrid,-    ParaHexGrid,-    paraHexGrid,-    UnboundedOctGrid,-    RectOctGrid,-    rectOctGrid,-    TorOctGrid,-    torOctGrid,-  ) where+module Math.Geometry.GridInternal where  import Prelude hiding (null) -import Data.Eq.Unicode ((≡), (≠))+import Data.Eq.Unicode ((≡)) import Data.Function (on) import Data.List (groupBy, nub, nubBy, sortBy) import Data.Ord (comparing)-import Data.Ord.Unicode ((≤), (≥))  -- | A regular arrangement of tiles.---   Minimal complete definition: @Index@, @indices@ and @distance@.+--   Minimal complete definition: @Index@, @Direction@, @indices@, +--   @distance@, @directionTo@. class Grid g where   type Index g+  type Direction g    -- | Returns the indices of all tiles in a grid.   indices ∷ g → [Index g]@@ -75,29 +46,28 @@   --   any of @bs@ are not contained within @g@, the result is    --   undefined.   minDistance ∷ g → [Index g] → Index g → Int-  minDistance g xs x = minimum . map (distance g x) $ xs+  minDistance = defaultMinDistance -  -- | @'neighbours' g x@ returns the indices of the tiles in the grid-  --   @g@ which are adjacent to the tile with index @x@.+  -- | @'neighbours' g a@ returns the indices of the tiles in the grid+  --   @g@ which are adjacent to the tile with index @a@.   neighbours ∷ g → Index g → [Index g]-  neighbours g x = filter (\a → distance g x a ≡ 1 ) $ indices g+  neighbours = defaultNeighbours -  -- | @'numNeighbours' g x@ returns the number of tiles in the grid-  --   @g@ which are adjacent to the tile with index @x@.+  -- | @'neighbour' g d a@ returns the indices of the tile in the grid+  --   @g@ which is adjacent to the tile with index @a@, in the +  --   direction @d@.+  neighbour ∷ Eq (Direction g) ⇒ g → Index g → Direction g → Index g+  neighbour = defaultNeighbour++  -- | @'numNeighbours' g a@ returns the number of tiles in the grid+  --   @g@ which are adjacent to the tile with index @a@.   numNeighbours ∷ g → Index g → Int   numNeighbours g = length . neighbours g -  -- | @g `'contains'` x@ returns @True@ if the index @x@ is contained +  -- | @g `'contains'` a@ returns @True@ if the index @a@ is contained    --   within the grid @g@, otherwise it returns false.   contains ∷ Eq (Index g) ⇒ g → Index g → Bool-  contains g x = x `elem` indices g--  -- | @'viewpoint' g x@ returns a list of pairs associating the index-  --   of each tile in @g@ with its distance to the tile with index @x@.-  --   If @x@ is not contained within @g@, the result is undefined.-  viewpoint ∷ g → Index g → [(Index g, Int)]-  viewpoint g p = map f (indices g)-    where f x = (x, distance g p x)+  contains g a = a `elem` indices g    -- | Returns the number of tiles in a grid. Compare with @'size'@.   tileCount ∷ g → Int@@ -116,14 +86,21 @@   -- | A list of all edges in a grid, where the edges are represented by   --   a pair of indices of adjacent tiles.   edges ∷ Eq (Index g) ⇒ g → [(Index g,Index g)]-  edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g+  edges = defaultEdges +  -- | @'viewpoint' g a@ returns a list of pairs associating the index+  --   of each tile in @g@ with its distance to the tile with index @a@.+  --   If @a@ is not contained within @g@, the result is undefined.+  viewpoint ∷ g → Index g → [(Index g, Int)]+  viewpoint g p = map f (indices g)+    where f a = (a, distance g p a)+   -- | @'isAdjacent' g a b@ returns @True@ if the tile at index @a@ is   --   adjacent to the tile at index @b@ in @g@. (Two tiles are adjacent   --   if they share an edge.) If @a@ or @b@ are not contained within   --   @g@, the result is undefined.-  isAdjacent ∷ Eq (Index g) ⇒ g → Index g → Index g → Bool-  isAdjacent g a b = a `elem` (neighbours g b)+  isAdjacent ∷ g → Index g → Index g → Bool+  isAdjacent = defaultIsAdjacent    -- | @'adjacentTilesToward' g a b@ returns the indices of all tiles   --   which are neighbours of the tile at index @a@, and which are@@ -132,8 +109,7 @@   --   or @b@ are not contained within @g@, or if there is no path from    --   @a@ to @b@ (e.g., a disconnected grid), the result is undefined.   adjacentTilesToward ∷ g → Index g → Index g → [Index g]-  adjacentTilesToward g a b = filter f $ neighbours g a-    where f x = distance g x b ≡ distance g a b - 1+  adjacentTilesToward = defaultAdjacentTilesToward    -- | @'minimalPaths' g a b@ returns a list of all minimal paths from    --   the tile at index @a@ to the tile at index @b@ in grid @g@. A@@ -147,19 +123,79 @@   --   consider modifying @'adjacentTilesToward'@ instead of    --   @'minimalPaths'@.   minimalPaths ∷ Eq (Index g) ⇒ g → Index g → Index g → [[Index g]]-  minimalPaths g a b | a ≡ b              = [[a]]-                     | distance g a b ≡ 1 = [[a,b]]-                     | otherwise          = map (a:) xs-    where xs = concatMap (\x → minimalPaths g x b) ys+  minimalPaths = defaultMinimalPaths++  -- | @'directionTo' g a b@ returns the direction(s) of the next +  --   tile(s) in a /minimal/ path from the tile at index @a@ to the +  --   tile at index @b@ in grid @g@.+  directionTo ∷ g → Index g → Index g → [Direction g]++  --+  -- These default implementations are broken out to make it easier to+  -- compare the results with custom implementations (for testing).+  --++  defaultMinDistance ∷ g → [Index g] → Index g → Int+  defaultMinDistance g xs a = minimum . map (distance g a) $ xs++  defaultNeighbours ∷ g → Index g → [Index g]+  defaultNeighbours g a = filter (\b → distance g a b ≡ 1 ) $ indices g++  defaultNeighbour ∷ Eq (Direction g) +    ⇒ g → Index g → Direction g → Index g+  defaultNeighbour g a d =+    head . filter (\b → [d] ≡ directionTo g a b) . neighbours g $ a++  defaultTileCount ∷ g → Int+  defaultTileCount = length . indices++  defaultEdges ∷ Eq (Index g) ⇒ g → [(Index g,Index g)]+  defaultEdges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g++  defaultIsAdjacent ∷ g → Index g → Index g → Bool+  defaultIsAdjacent g a b = distance g a b ≡ 1++  defaultAdjacentTilesToward ∷ g → Index g → Index g → [Index g]+  defaultAdjacentTilesToward g a b = filter f $ neighbours g a+    where f c = distance g c b ≡ distance g a b - 1++  defaultMinimalPaths ∷ Eq (Index g)+    ⇒ g → Index g → Index g → [[Index g]]+  defaultMinimalPaths g a b +    | a ≡ b              = [[a]]+    | distance g a b ≡ 1 = [[a,b]]+    | otherwise          = map (a:) xs+    where xs = concatMap (\c → minimalPaths g c b) ys           ys = adjacentTilesToward g a b +--+-- Helper functions+--+ sameEdge ∷ Eq t ⇒ (t, t) → (t, t) → Bool sameEdge (a,b) (c,d) = (a,b) ≡ (c,d) || (a,b) ≡ (d,c)  adjacentEdges ∷ Grid g ⇒ Index g → g → [(Index g, Index g)] adjacentEdges i g = map (\j → (i,j)) $ neighbours g i +cartesianIndices+  ∷ (Enum r, Enum c, Num r, Num c, Ord r, Ord c) ⇒+     (r, c) → [(c, r)]+cartesianIndices (r, c) = west ++ north ++ east ++ south+  where west = [(0,k) | k ← [0,1..r-1], c>0]+        north = [(k,r-1) | k ← [1,2..c-1], r>0]+        east = [(c-1,k) | k ← [r-2,r-3..0], c>1]+        south = [(k,0) | k ← [c-2,c-3..1], r>1] +cartesianCentre ∷ (Int, Int) → [(Int, Int)]+cartesianCentre (r,c) = [(i,j) | i ← cartesianMidpoints c, j ← cartesianMidpoints r]++cartesianMidpoints ∷ Int → [Int]+cartesianMidpoints k = if even k then [m-1,m] else [m]+  where m = floor (k'/2.0)+        k' = fromIntegral k ∷ Double++ -- | A regular arrangement of tiles where the number of tiles is finite. --   Minimal complete definition: @size@. class Grid g ⇒ FiniteGrid g where@@ -179,596 +215,105 @@   -- | Returns a the indices of all the tiles at the boundary of a grid.   boundary ∷ g → [Index g]   boundary g = map fst . filter f $ xds-    where xds = map (\y → (y, numNeighbours g y)) $ indices g+    where xds = map (\b → (b, numNeighbours g b)) $ indices g           f (_,n) = n < tileSideCount g   -  -- | @'isBoundary' g x@' returns @True@ if the tile with index @x@ is+  -- | @'isBoundary' g a@' returns @True@ if the tile with index @a@ is   --   on a boundary of @g@, @False@ otherwise. (Corner tiles are also   --   boundary tiles.)   isBoundary ∷ Eq (Index g) ⇒ g → Index g → Bool-  isBoundary g x = x `elem` boundary g+  isBoundary g a = a `elem` boundary g    -- | Returns the index of the tile(s) that require the maximum number    --   of moves to reach the nearest boundary tile. A grid may have more   --   than one central tile (e.g., a rectangular grid with an even    --   number of rows and columns will have four central tiles).   centre ∷ g → [Index g]-  centre g = map fst . head . reverse . groupBy ((≡) `on` snd) . +  centre g = map fst . last . groupBy ((≡) `on` snd) .                  sortBy (comparing snd) $ xds-    where xds = map (\y → (y, minDistance g bs y)) $ indices g+    where xds = map (\b → (b, minDistance g bs b)) $ indices g           bs = boundary g  -  -- | @'isCentre' g x@' returns @True@ if the tile with index @x@ is+  -- | @'isCentre' g a@' returns @True@ if the tile with index @a@ is   --   a centre tile of @g@, @False@ otherwise.   isCentre ∷ Eq (Index g) ⇒ g → Index g → Bool-  isCentre g x = x `elem` centre g+  isCentre g a = a `elem` centre g +-- | A regular arrangement of tiles where the boundaries are joined.+--   Minimal complete definition: @normalise@. class (Grid g) ⇒ WrappedGrid g where+  -- | @'normalise' g a@ returns the "normal" indices for @a@.+  --   TODO: need a clearer description and an illustration.   normalise ∷ g → Index g → Index g+  -- | @'denormalise' g a@ returns all of the indices in @a@'s+  --   translation group. In other words, it returns @a@ plus the +  --   indices obtained by translating @a@ in each direction by the+  --   extent of the grid along that direction.+  --   TODO: need a clearer description and an illustration.+  denormalise ∷ g → Index g → [Index g] --- Calculate the neighbours of a tile in a bounded grid by as we would --- in an unbounded grid, but then filter out the tiles that are not in--- bounds. neighboursBasedOn-  ∷ (Eq (Index g), Grid u, Grid g, Index u ~ Index g) ⇒-     g → u → Index g → [Index g]+  ∷ (Eq (Index u), Grid g, Grid u, Index g ~ Index u) ⇒+    u → g → Index g → [Index g] neighboursBasedOn u g = filter (g `contains`) . neighbours u --- Calculate the distance between two tiles in a bounded grid by as we --- would in an unbounded grid, but only if both tiles are in bounds. distanceBasedOn-  ∷ (Eq (Index g), Grid u, Grid g, Index u ~ Index g) ⇒-     g → u → Index g → Index g → Int+  ∷ (Eq (Index g), Grid g, Grid u, Index g ~ Index u) ⇒+    u → g → Index g → Index g → Int distanceBasedOn u g a b =    if g `contains` a && g `contains` b     then distance u a b     else undefined ------ Triangular tiles------- | An unbounded 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 UnboundedTriGrid = UnboundedTriGrid deriving Show--instance Grid UnboundedTriGrid where-  type Index UnboundedTriGrid = (Int, Int)-  indices _ = undefined-  neighbours _ (x,y) = if even y-                         then [(x-1,y+1), (x+1,y+1), (x+1,y-1)]-                         else [(x-1,y-1), (x-1,y+1), (x+1,y-1)]-  distance _ (x1, y1) (x2, y2) = -    maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]-      where z1 = triZ x1 y1-            z2 = triZ x2 y2-  contains _ _ = True---- | For triangular tiles, it is convenient to define a third component ---   z.-triZ ∷ Int → Int → Int            -triZ x y = if even y then -x - y else -x - y + 1------- Triangular grids with triangular tiles------- | 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)] deriving Eq--instance Show TriTriGrid where -  show (TriTriGrid s _) = "triTriGrid " ++ show s--instance Grid TriTriGrid where-  type Index TriTriGrid = (Int, Int)-  indices (TriTriGrid _ xs) = xs-  neighbours = neighboursBasedOn UnboundedTriGrid-  distance = distanceBasedOn UnboundedTriGrid-  contains (TriTriGrid s _) (x, y) = inTriTriGrid (x,y) s--inTriTriGrid ∷ (Int, Int) → Int → Bool-inTriTriGrid (x, y) s = x ≥ 0 && y ≥ 0 && even (x+y) && abs z ≤ 2*s-2-  where z = triZ x y--instance FiniteGrid TriTriGrid where-  type Size TriTriGrid = Int-  size (TriTriGrid s _) = s--instance BoundedGrid TriTriGrid where-  tileSideCount _ = 3-  boundary g = west ++ east ++ south-    where s = size g-          west = [(0,k) | k ← [0,2..2*s-2]]-          east = [(k,2*s-2-k) | k ← [2,4..2*s-2]]-          south = [(k,0) | k ← [2*s-4,2*s-6..2]]-  centre g = case s `mod` 3 of-    0 → trefoilWithTop (k-1,k+1) where k = (2*s) `div` 3-    1 → [(k,k)] where k = (2*(s-1)) `div` 3-    2 → [(k+1,k+1)] where k = (2*(s-2)) `div` 3-    _ → error "This will never happen."-    where s = size g-          trefoilWithTop (i,j) = [(i,j), (i+2, j-2), (i,j-2)]---- | @'triTriGrid' s@ returns a triangular grid with sides of ---   length @s@, using triangular tiles. If @s@ is nonnegative, the ---   resulting grid will have @s^2@ tiles. Otherwise, the resulting grid---   will be null and the list of indices will be null.-triTriGrid ∷ Int → TriTriGrid-triTriGrid s = -  TriTriGrid s [(xx,yy) | xx ← [0..2*(s-1)], -                          yy ← [0..2*(s-1)], -                          (xx,yy) `inTriTriGrid` s]------- Parallelogrammatical grids with triangular tiles------- | 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)] deriving Eq--instance Show ParaTriGrid where -  show (ParaTriGrid (r,c) _) = "paraTriGrid " ++ show r ++ " " ++ show c--instance Grid ParaTriGrid where-  type Index ParaTriGrid = (Int, Int)-  indices (ParaTriGrid _ xs) = xs-  neighbours = neighboursBasedOn UnboundedTriGrid-  distance = distanceBasedOn UnboundedTriGrid--instance FiniteGrid ParaTriGrid where-  type Size ParaTriGrid = (Int, Int)-  size (ParaTriGrid s _) = s--instance BoundedGrid ParaTriGrid where-  tileSideCount _ = 3-  boundary g = west ++ north ++ east ++ south-    where (r,c) = size g-          west = [(0,k) | k ← [0,2..2*r-2], c>0]-          north = [(k,2*r-1) | k ← [1,3..2*c-1], r>0]-          east = [(2*c-1,k) | k ← [2*r-3,2*r-5..1], c>0]-          south = [(k,0) | k ← [2*c-2,2*c-4..2], r>0]-  centre g = f . size $ g-    where f (r,c)-            | odd r && odd c             -                = [(c-1,r-1), (c,r)]-            | even r && even c && r ≡ c -                = bowtie (c-1,r-1)-            | even r && even c && r > c  -                = bowtie (c-1,r-3) ++ bowtie (c-1,r-1) ++ bowtie (c-1,r+1)-            | even r && even c && r < c  -                = bowtie (c-3,r-1) ++ bowtie (c-1,r-1) ++ bowtie (c+1,r-1)-            | otherwise                  -                = [(c-1,r), (c,r-1)]-          bowtie (i,j) = [(i,j), (i+1,j+1)]---- | @'paraTriGrid' r c@ returns a grid in the shape of a ---   parallelogram with @r@ rows and @c@ columns, using triangular ---   tiles. If @r@ and @c@ are both nonnegative, the resulting grid will---   have @2*r*c@ tiles. Otherwise, the resulting grid will be null and---   the list of indices will be null.-paraTriGrid ∷ Int → Int → ParaTriGrid-paraTriGrid r c = -  ParaTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]-------- Rectangular grids with triangular tiles------- | A rectangular 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 RectTriGrid = RectTriGrid (Int, Int) [(Int, Int)] deriving Eq--instance Show RectTriGrid where -  show (RectTriGrid (r,c) _) = "rectTriGrid " ++ show r ++ " " ++ show c--instance Grid RectTriGrid where-  type Index RectTriGrid = (Int, Int)-  indices (RectTriGrid _ xs) = xs-  neighbours = neighboursBasedOn UnboundedTriGrid-  distance = distanceBasedOn UnboundedTriGrid--instance FiniteGrid RectTriGrid where-  type Size RectTriGrid = (Int, Int)-  size (RectTriGrid s _) = s--instance BoundedGrid RectTriGrid where-  tileSideCount _ = 3---- | @'rectTriGrid' r c@ returns a grid in the shape of a ---   rectangle (with jagged edges) that has @r@ rows and @c@ columns, ---   using triangular tiles. If @r@ and @c@ are both nonnegative, the ---   resulting grid will have @2*r*c@ tiles. Otherwise, the resulting grid will be null and---   the list of indices will be null.-rectTriGrid ∷ Int → Int → RectTriGrid-rectTriGrid r c = RectTriGrid (r,c) [(x,y) | y ← [0..2*r-1], x ← [xMin y .. xMax c y], even (x+y)]-  where xMin y = if even y then w else w+1-          where w = -2*((y+1) `div` 4)-        xMax c2 y = xMin y + 2*(c2-1)-------- Toroidal grids with triangular tiles------- | A toroidal 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 TorTriGrid = TorTriGrid (Int, Int) [(Int, Int)] deriving Eq--instance Show TorTriGrid where -  show (TorTriGrid (r,c) _) = "torTriGrid " ++ show r ++ " " ++ show c--instance Grid TorTriGrid where-  type Index TorTriGrid = (Int, Int)-  indices (TorTriGrid _ xs) = xs-  neighbours g = nub . map (normalise g) . neighbours UnboundedTriGrid-  distance g (xa, ya) (xb, yb) = -    if g `contains` (xa, ya) && g `contains` (xb, yb)-      then minimum [distance UnboundedTriGrid (xa, ya) (xb, yb),-                    distance UnboundedTriGrid (xa, ya) (xb + 2*c, yb),-                    distance UnboundedTriGrid (xa, ya) (xb - r, yb + 2*r),-                    distance UnboundedTriGrid (xa, ya) (xb, yb),-                    distance UnboundedTriGrid (xa + 2*c, ya) (xb, yb),-                    distance UnboundedTriGrid (xa - r, ya + 2*r) (xb, yb)]-      else undefined-    where (r,c) = size g--xMinTorTri ∷ Int → Int-xMinTorTri y = if even y then w else w+1-  where w = -2*((y+1) `div` 4)+directionToBasedOn+  ∷ (Eq (Index g), Eq (Direction g), Grid g, Grid u, Index g ~ Index u, +    Direction g ~ Direction u) ⇒+    u → g → Index g → Index g → [Direction g]+directionToBasedOn u g a b = +  if g `contains` a && g `contains` b+    then nub . concatMap (directionTo u a) . adjacentTilesToward g a $ b+    else undefined +neighboursWrappedBasedOn+  ∷ (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) ⇒+    u → g → Index g → [Index g]+neighboursWrappedBasedOn u g = +  filter (g `contains`) . nub . map (normalise g) . neighbours u -instance FiniteGrid TorTriGrid where-  type Size TorTriGrid = (Int, Int)-  size (TorTriGrid s _) = s+neighbourWrappedBasedOn+  ∷ (Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u, +    Index g ~ Index u, Direction g ~ Direction u) ⇒+    u → g → Index g → Direction g → Index g+neighbourWrappedBasedOn u g a d =+  if g `contains` a+    then normalise g . neighbour u a $ d+    else undefined -instance WrappedGrid TorTriGrid where-  normalise g (x,y)-    | y < 0            = normalise g (x-r,y+2*r)-    | y > 2*r-1        = normalise g (x+r,y-2*r)-    | x < xMin         = normalise g (x+2*c,y)-    | x > xMin + 2*c-1 = normalise g (x-2*c,y)-    | otherwise        = (x,y)-    where xMin = xMinTorTri y-          (r, c) = size g+distanceWrappedBasedOn+  ∷ (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) ⇒+    u → g → Index g → Index g → Int+distanceWrappedBasedOn u g a b = +  if g `contains` a && g `contains` b+    then minimum . map (distance u a') $ bs+    else undefined+  where a' = normalise g a+        bs = denormalise g b --- | @'torTriGrid' r c@ returns a toroidal grid with @r@ rows and @c@ ---   columns, using triangular tiles. If @r@ is odd, the result is---   undefined because the grid edges would overlap. If @r@ and @c@  ---   are both nonnegative, the resulting grid will have @2*r*c@ tiles. ---   Otherwise, the resulting grid will be null and the list of indices---   will be null.-torTriGrid ∷ Int → Int → TorTriGrid-torTriGrid r c = -  if even r-    then TorTriGrid (r,c) [(x,y) | y ← [0..2*r-1], -                                   x ← [xMinTorTri y .. xMax c y], -                                   even (x+y)]+directionToWrappedBasedOn+  ∷ (Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u, +    Index g ~ Index u, Direction g ~ Direction u) ⇒+    u → g → Index g → Index g → [Direction g]+directionToWrappedBasedOn u g a b =+  if g `contains` a && g `contains` b+    then nub . concatMap (directionTo u a') $ ys'     else undefined-  where xMax c2 y = xMinTorTri y + 2*(c2-1)+  where a' = normalise g a+        ys = denormalise g b+        minD = distance g a b+        ys' = filter (\c -> distance u a' c == minD) ys  ------ Square tiles--- --- | An unbounde 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 UnboundedSquareGrid = UnboundedSquareGrid deriving Show--instance Grid UnboundedSquareGrid where-  type Index UnboundedSquareGrid = (Int, Int)-  indices _ = undefined-  neighbours _ (x,y) = [(x,y+1), (x,y-1), (x+1,y), (x-1,y)]-  distance _ (x1, y1) (x2, y2) = abs (x2-x1) + abs (y2-y1)-  contains _ _ = True------- Rectangular grids with square tiles------- | 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)] deriving Eq--instance Show RectSquareGrid where -  show (RectSquareGrid (r,c) _) = -    "rectSquareGrid " ++ show r ++ " " ++ show c--instance Grid RectSquareGrid where-  type Index RectSquareGrid = (Int, Int)-  indices (RectSquareGrid _ xs) = xs-  neighbours = neighboursBasedOn UnboundedSquareGrid-  distance = distanceBasedOn UnboundedSquareGrid-  adjacentTilesToward g a@(x1, y1) (x2, y2) = -    filter (\i → g `contains` i && i ≠ a) $ nub [(x1,y1+dy),(x1+dx,y1)]-      where dx = signum (x2-x1)-            dy = signum (y2-y1)--instance FiniteGrid RectSquareGrid where-  type Size RectSquareGrid = (Int, Int)-  size (RectSquareGrid s _) = s--instance BoundedGrid RectSquareGrid where-  tileSideCount _ = 4-  boundary g = cartesianIndices . size $ g-  centre g = cartesianCentre . size $ g--cartesianIndices-  ∷ (Enum r, Enum c, Num r, Num c, Ord r, Ord c) ⇒-     (r, c) → [(c, r)]-cartesianIndices (r, c) = west ++ north ++ east ++ south-  where west = [(0,k) | k ← [0,1..r-1], c>0]-        north = [(k,r-1) | k ← [1,2..c-1], r>0]-        east = [(c-1,k) | k ← [r-2,r-3..0], c>1]-        south = [(k,0) | k ← [c-2,c-3..1], r>1]--cartesianCentre ∷ (Int, Int) → [(Int, Int)]-cartesianCentre (r,c) = [(i,j) | i ← midpoints c, j ← midpoints r]--midpoints ∷ Int → [Int]-midpoints k = if even k then [m-1,m] else [m]-  where m = floor (k'/2.0)-        k' = fromIntegral k ∷ Double---- | @'rectSquareGrid' r c@ produces a rectangular grid with @r@ rows---   and @c@ columns, using square tiles. If @r@ and @c@ are both ---   nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, ---   the resulting grid will be null and the list of indices will be ---   null.-rectSquareGrid ∷ Int → Int → RectSquareGrid-rectSquareGrid r c = -  RectSquareGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]]------- Toroidal grids with square tiles.------- | 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)] deriving Eq--instance Show TorSquareGrid where -  show (TorSquareGrid (r,c) _) = "torSquareGrid " ++ show r ++ " " ++ show c--instance Grid TorSquareGrid where-  type Index TorSquareGrid = (Int, Int)-  indices (TorSquareGrid _ xs) = xs---  neighbours (TorSquareGrid (r,c) _) (x,y) = ---    nub $ filter (\(xx,yy) → xx ≠ x || yy ≠ y) ---      [((x-1) `mod` c,y), (x,(y+1) `mod` r), ((x+1) `mod` c,y), ---        (x,(y-1) `mod` r)]-  neighbours g = nub . map (normalise g) . neighbours UnboundedSquareGrid-  distance g@(TorSquareGrid (r,c) _) (x1, y1) (x2, y2) = -- TODO redo-    if g `contains` (x1, y1) && g `contains` (x2, y2)-      then min adx (abs (c-adx)) + min ady (abs (r-ady))-      else undefined -    where adx = abs (x2 - x1)-          ady = abs (y2 - y1)--instance FiniteGrid TorSquareGrid where-  type Size TorSquareGrid = (Int, Int)-  size (TorSquareGrid s _) = s--instance WrappedGrid TorSquareGrid where-  normalise g (x,y) = (x `mod` c, y `mod` r)-    where (r, c) = size g--denormaliseTor-  :: (FiniteGrid g, Index g ~ (Int, Int), (Int, Int) ~ Size g) =>-     g -> Index g -> [Index g]-denormaliseTor g (x,y) = nub [(x2,y1), (x,y1), (x1,y1), -                              (x2,y),  (x,y),  (x1,y),-                              (x2,y2), (x,y2), (x1,y2)]-  where (r, c) = size g-        x1 = x + c-        y1 = y + r-        x2 = x - c-        y2 = y - r---- | @'torSquareGrid' r c@ returns a toroidal grid with @r@ ---   rows and @c@ columns, using square tiles. If @r@ and @c@ are ---   both nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, ---   the resulting grid will be null and the list of indices will be null.-torSquareGrid ∷ Int → Int → TorSquareGrid-torSquareGrid r c = TorSquareGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]------- Hexagonal tiles------- | An unbounded 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 UnboundedHexGrid = UnboundedHexGrid deriving Show--instance Grid UnboundedHexGrid where-  type Index UnboundedHexGrid = (Int, Int)-  indices _ = undefined-  neighbours _ (x,y) = -    [(x-1,y), (x-1,y+1), (x,y+1), (x+1,y), (x+1,y-1), (x,y-1)]-  distance _ (x1, y1) (x2, y2) = -    maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]-    where z1 = -x1 - y1-          z2 = -x2 - y2-  contains _ _ = True------- Hexagonal grids with hexagonal tiles------- | 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)] deriving Eq--instance Show HexHexGrid where show (HexHexGrid s _) = "hexHexGrid " ++ show s--instance Grid HexHexGrid where-  type Index HexHexGrid = (Int, Int)-  indices (HexHexGrid _ xs) = xs-  neighbours = neighboursBasedOn UnboundedHexGrid-  distance = distanceBasedOn UnboundedHexGrid--instance FiniteGrid HexHexGrid where-  type Size HexHexGrid = Int-  size (HexHexGrid s _) = s--instance BoundedGrid HexHexGrid where-  tileSideCount _ = 6-  boundary g = -    north ++ northeast ++ southeast ++ south ++ southwest ++ northwest-    where s = size g-          north = [(k,s-1) | k ← [-s+1,-s+2..0]]-          northeast = [(k,s-1-k) | k ← [1,2..s-1]]-          southeast = [(s-1,k) | k ← [-1,-2..(-s)+1]]-          south = [(k,(-s)+1) | k ← [s-2,s-3..0]]-          southwest = [(k,(-s)+1-k) | k ← [-1,-2..(-s)+1]]-          northwest = [(-s+1,k) | k ← [1,2..s-2]]-  centre _ = [(0,0)]---- | @'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 null and the list of indices will be null.-hexHexGrid ∷ Int → HexHexGrid-hexHexGrid r = HexHexGrid r [(x, y) | x ← [-r+1..r-1], y ← f x]-  where f x = if x < 0 then [1-r-x .. r-1] else [1-r .. r-1-x]------- Parallelogrammatical grids with hexagonal tiles------- | 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)] deriving Eq--instance Show ParaHexGrid where -  show (ParaHexGrid (r,c) _) = "paraHexGrid " ++ show r ++ " " ++ show c--instance Grid ParaHexGrid where-  type Index ParaHexGrid = (Int, Int)-  indices (ParaHexGrid _ xs) = xs-  neighbours = neighboursBasedOn UnboundedHexGrid-  distance = distanceBasedOn UnboundedHexGrid--instance FiniteGrid ParaHexGrid where-  type Size ParaHexGrid = (Int, Int)-  size (ParaHexGrid s _) = s--instance BoundedGrid ParaHexGrid where-  tileSideCount _ = 6-  boundary g = cartesianIndices . size $ g-  centre g = cartesianCentre . size $ g---- | @'paraHexGrid' r c@ returns a grid in the shape of a ---   parallelogram with @r@ rows and @c@ columns, using hexagonal tiles. If ---   @r@ and @c@ are both nonnegative, the resulting grid will have @r*c@ tiles.---   Otherwise, the resulting grid will be null and the list of indices will ---   be null.-paraHexGrid ∷ Int → Int → ParaHexGrid-paraHexGrid r c = -  ParaHexGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]-------- Octagonal tiles------- | An unbounded grid with octagonal tiles.---   The grid and its indexing scheme are illustrated in the user guide,---   available at <https://github.com/mhwombat/grid/wiki>.-data UnboundedOctGrid = UnboundedOctGrid deriving Show--instance Grid UnboundedOctGrid where-  type Index UnboundedOctGrid = (Int, Int)-  indices _ = undefined-  neighbours _ (x,y) = [(x-1,y+1), (x,y+1), (x+1,y+1), (x+1,y), -                        (x+1,y-1), (x,y-1), (x-1,y-1), (x-1,y)]-  distance _ (x1, y1) (x2, y2) = max (abs (x2-x1)) (abs (y2-y1))-  contains _ _ = True------- Rectangular grids with octagonal tiles------- | A rectangular grid with octagonal tiles.---   The grid and its indexing scheme are illustrated in the user guide,---   available at <https://github.com/mhwombat/grid/wiki>.-data RectOctGrid = RectOctGrid (Int, Int) [(Int, Int)] deriving Eq--instance Show RectOctGrid where -  show (RectOctGrid (r,c) _) = -    "rectOctGrid " ++ show r ++ " " ++ show c--instance Grid RectOctGrid where-  type Index RectOctGrid = (Int, Int)-  indices (RectOctGrid _ xs) = xs-  neighbours = neighboursBasedOn UnboundedOctGrid-  distance = distanceBasedOn UnboundedOctGrid--instance FiniteGrid RectOctGrid where-  type Size RectOctGrid = (Int, Int)-  size (RectOctGrid s _) = s--instance BoundedGrid RectOctGrid where-  tileSideCount _ = 4-  boundary g = cartesianIndices . size $ g-  centre g = cartesianCentre . size $ g---- | @'rectOctGrid' r c@ produces a rectangular grid with @r@ rows---   and @c@ columns, using octagonal tiles. If @r@ and @c@ are both ---   nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, ---   the resulting grid will be null and the list of indices will be ---   null.-rectOctGrid ∷ Int → Int → RectOctGrid-rectOctGrid r c = -  RectOctGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]]------- Toroidal grids with octagonal tiles.------- | A toroidal grid with octagonal tiles.---   The grid and its indexing scheme are illustrated in the user guide,---   available at <https://github.com/mhwombat/grid/wiki>.-data TorOctGrid = TorOctGrid (Int, Int) [(Int, Int)] deriving Eq--instance Show TorOctGrid where -  show (TorOctGrid (r,c) _) = "torOctGrid " ++ show r ++ " " ++ show c--instance Grid TorOctGrid where-  type Index TorOctGrid = (Int, Int)-  indices (TorOctGrid _ xs) = xs-  neighbours g = nub . map (normalise g) . neighbours UnboundedOctGrid-  distance g a b = minimum . map (distance UnboundedOctGrid a) $ bs-    where bs = denormaliseTor g b--instance FiniteGrid TorOctGrid where-  type Size TorOctGrid = (Int, Int)-  size (TorOctGrid s _) = s--instance WrappedGrid TorOctGrid where-  normalise g (x,y) = (x `mod` c, y `mod` r)-    where (r, c) = size g---- | @'torOctGrid' r c@ returns a toroidal grid with @r@ ---   rows and @c@ columns, using octagonal tiles. If @r@ and @c@ are ---   both nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, ---   the resulting grid will be null and the list of indices will be null.-torOctGrid ∷ Int → Int → TorOctGrid-torOctGrid r c = TorOctGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]] 

@@ -60,11 +60,13 @@  instance G.Grid g ⇒ G.Grid (LGridMap g v) where   type Index (LGridMap g v) = G.Index g+  type Direction (LGridMap g v) = G.Direction g   indices = G.indices . lgmGrid   distance g = G.distance (lgmGrid g)+  directionTo g = G.directionTo (lgmGrid g)   neighbours g k = lgmGrid g `G.neighbours` k   contains g k = lgmGrid g `G.contains` k-  viewpoint g k = lgmGrid g `G.viewpoint` k+--  viewpoint g k = lgmGrid g `G.viewpoint` k   tileCount  = G.tileCount . lgmGrid   null = G.null . lgmGrid   nonNull = G.nonNull . lgmGrid

@@ -1,14 +1,20 @@ {-# LANGUAGE UnicodeSyntax #-} module Main where -import Math.Geometry.GridQC ( test )+import Math.Geometry.Grid.TriangularQC ( test )+import Math.Geometry.Grid.SquareQC ( test )+import Math.Geometry.Grid.HexagonalQC ( test )+import Math.Geometry.Grid.OctagonalQC ( test )  import Test.Framework as TF ( defaultMain, Test )  tests ∷ [TF.Test] tests =    [ -    Math.Geometry.GridQC.test+    Math.Geometry.Grid.TriangularQC.test,+    Math.Geometry.Grid.SquareQC.test,+    Math.Geometry.Grid.HexagonalQC.test,+    Math.Geometry.Grid.OctagonalQC.test   ]  main ∷ IO ()

@@ -1,1059 +1,353 @@ {-# LANGUAGE UnicodeSyntax, FlexibleContexts, ExistentialQuantification,-    TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Math.Geometry.GridQC-  (-    test-  ) where--import Math.Geometry.GridInternal --import Prelude hiding (null)-import qualified Prelude as P (null)-import Data.Eq.Unicode ((≡), (≠))-import Data.List (delete, nub, sort)-import Data.Ord.Unicode ((≤))-import qualified Math.Combinatorics.Exact.Binomial as M (choose)-import Test.Framework as TF (Test, testGroup)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck -  ((==>), Gen, Arbitrary, arbitrary, sized, choose, Property, property)---- | @'isqrt' n@ returns the greatest integer not greater than the square root ---   of @n@.-isqrt ∷ Int → Int-isqrt n = (floor . sqrt) n'-  where n' = fromIntegral n ∷ Float---- Given an arbitrary integer, select a corresponding point in the grid.-pointAt ∷ Grid g ⇒ g → Int → Index g-pointAt g i = indices g !! (i `mod` n)-  where n = (length . indices) g--minPathCount-  ∷ (Eq (Index g), Grid g) ⇒ g → Index g → Index g → Int-minPathCount g a b = length . minimalPaths g a $ b--minPathCount2-  ∷ (Eq (Index g), Grid g) ⇒ g → [Index g] → Index g → Int-minPathCount2 g as b = sum . map (\x → minPathCount g x b) $ as--neighbourCount ∷ ∀ g. Grid g ⇒ g → Index g → Int-neighbourCount g x = length . neighbours g $ x------- Tests that should apply to and are identical for all grids-----prop_distance_reflexive ∷ Grid g ⇒ g → Int → Property-prop_distance_reflexive g i = nonNull g ==> distance g a a ≡ 0-  where a = g `pointAt` i--prop_distance_symmetric ∷ Grid g ⇒ g → Int → Int → Property-prop_distance_symmetric g i j = -  nonNull g ==> distance g a b ≡ distance g b a-  where a = g `pointAt` i-        b = g `pointAt` j---- "cw" = "consistent with"--prop_minDistance_cw_distance ∷ Grid g ⇒ g → Int → [Int] → Property-prop_minDistance_cw_distance g i js = -  nonNull g && (not . P.null) js ==> -    minDistance g (b:bs) a ≤ distance g b a-  where a = g `pointAt` i-        (b:bs) = map (g `pointAt`) js--prop_neighbours_cw_viewpoint -  ∷ (Grid g, Ord (Index g)) ⇒ -    g → Int → Property-prop_neighbours_cw_viewpoint g i = nonNull g ==> -  sort (delete a (neighbours g a)) ≡ sort expected-    where a = g `pointAt` i-          expected = map fst $ filter (\p → 1 ≡ snd p) $ viewpoint g a--- Note: In a small but unbounded grid, a tile can be its own neighbour.--- However, when we calculate the distance between a tile and itself, we--- get 0, not 1. That's why we have to delete the tile from its list --- before comparing to the result from the neighbours function.--prop_edges_cw_neighbours ∷ (Grid g, Ord (Index g)) ⇒ g → Int → Property-prop_edges_cw_neighbours g i = nonNull g ==> -  sort (neighbours g a) ≡ sort expected-    where a = g `pointAt` i-          nEdges = filter (`involves` a) $ edges g-          expected = map f nEdges-          f (b,c) = if a ≡ b then c else b--involves ∷ Eq a ⇒ (a, a) → a → Bool-involves (a, b) c = c ≡ a || c ≡ b--prop_edges_are_adjacent ∷ (Grid g, Ord (Index g)) ⇒ g → Property-prop_edges_are_adjacent g = property $ all f $ edges g-  where f (a, b) = isAdjacent g a b--prop_adjacentTilesToward_moves_closer -  ∷ (Grid g, Eq (Index g)) ⇒ g → Int → Int → Property-prop_adjacentTilesToward_moves_closer g i j = nonNull g && a ≠ b ==> -    ns ≡ [d-1]-  where a = g `pointAt` i-        b = g `pointAt` j-        d = distance g a b-        ns = nub $ map (\x → distance g x b) $ adjacentTilesToward g a b--prop_minimal_paths_have_min_length -  ∷ (Grid g, Eq (Index g)) ⇒ g → Int → Int → Property-prop_minimal_paths_have_min_length g i j = nonNull g ==> ns ≡ [d+1]-  where a = g `pointAt` i-        b = g `pointAt` j-        d = distance g a b-        ns = nub $ map length $ minimalPaths g a b--prop_minimal_paths_are_valid -  ∷ (Grid g, Eq (Index g)) ⇒ g → Int → Int → Property-prop_minimal_paths_are_valid g i j = nonNull g ==> -    and $ map (subsequentTilesInPathAreAdjacent g) $ minimalPaths g a b-  where a = g `pointAt` i-        b = g `pointAt` j--subsequentTilesInPathAreAdjacent -  ∷ (Grid g, Eq (Index g)) ⇒ g → [Index g] → Bool-subsequentTilesInPathAreAdjacent _ [] = True-subsequentTilesInPathAreAdjacent g [x] = x `elem` indices g-subsequentTilesInPathAreAdjacent g (a:b:xs) = -  isAdjacent g a b && subsequentTilesInPathAreAdjacent g (b:xs)------- Tests that should apply to and are identical for all bounded grids-----prop_grid_and_boundary_are_both_null_or_not -  ∷ BoundedGrid g ⇒ g → Property-prop_grid_and_boundary_are_both_null_or_not g = property $-  (P.null . boundary) g ≡ null g--prop_boundary_in_grid ∷ (BoundedGrid g, Eq (Index g)) ⇒ g → Property-prop_boundary_in_grid g = property $-  all (g `contains`) . boundary $ g--prop_boundary_tiles_have_fewer_neighbours -  ∷ BoundedGrid g ⇒ g → Int → Property-prop_boundary_tiles_have_fewer_neighbours g i = nonNull g ==>-  g `numNeighbours` b ≤ g `numNeighbours` a-  where a = g `pointAt` i-        (b:_) = boundary g--prop_centres_equidistant_from_boundary ∷ BoundedGrid g ⇒ g → Property-prop_centres_equidistant_from_boundary g = nonNull g ==>-  (length . nub . map (minDistance g bs)) cs ≡ 1-  where bs = boundary g-        cs = centre g--prop_centres_farthest_from_boundary -  ∷ (BoundedGrid g, Eq (Index g)) ⇒ g → Int → Property-prop_centres_farthest_from_boundary g i = -  nonNull g && (not . isCentre g) a ==>-    minDistance g bs a ≤ minDistance g bs c-  where a = g `pointAt` i-        (c:_) = centre g-        bs = boundary g------- Triangular grids with triangular tiles------- We want the number of tiles in a test grid to be O(n)-sizedTriTriGrid ∷ Int → Gen TriTriGrid-sizedTriTriGrid n = return $ triTriGrid (2 * isqrt n)--instance Arbitrary TriTriGrid where-  arbitrary = sized sizedTriTriGrid-  -prop_TriTriGrid_tile_count_correct ∷ TriTriGrid → Property-prop_TriTriGrid_tile_count_correct g = property $ -  (length . indices) g ≡ if s ≤ 0 then 0 else s*s-    where s = size g--prop_TriTriGrid_distance_in_bounds ∷ TriTriGrid → Int → Int → Property-prop_TriTriGrid_distance_in_bounds g i j = nonNull g ==> -  distance g a b ≤ 2*(s-1)-    where s = size g-          a = g `pointAt` i-          b = g `pointAt` j---- If the ordering produced by triTriGrid is ever changed, this property--- may need to be changed too. It relies on the first and last elements being--- at corners.-prop_TriTriGrid_distance_edge_to_edge ∷ TriTriGrid → Property-prop_TriTriGrid_distance_edge_to_edge g = s > 0 ==> distance g a b ≡ 2*(s-1)-  where ps = indices g-        a = head ps-        b = last ps-        s = size g--prop_TriTriGrid_neighbour_count_in_bounds ∷ TriTriGrid → Int → Property-prop_TriTriGrid_neighbour_count_in_bounds g i = nonNull g ==>-  neighbourCount g x ≤ 3-  where x = g `pointAt` i--prop_TriTriGrid_boundary_count_correct ∷ TriTriGrid → Property-prop_TriTriGrid_boundary_count_correct g = property $-  (length . boundary) g ≡ (f . size) g-  where f 0 = 0-        f 1 = 1-        f s = 3*(s-1)--prop_TriTriGrid_boundary_tiles_have_fewer_neighbours ∷ TriTriGrid → Property-prop_TriTriGrid_boundary_tiles_have_fewer_neighbours g = property $-  all (3>) . map (numNeighbours g) . boundary $ g------- Parallelogram-shaped grids with triangular tiles------- We want the number of tiles in a test grid to be O(n)-sizedParaTriGrid ∷ Int → Gen ParaTriGrid-sizedParaTriGrid n = do-  r ← choose (0,n)-  let c = n `div` (2*r + 1)-  return $ paraTriGrid r c--instance Arbitrary ParaTriGrid where-  arbitrary = sized sizedParaTriGrid--prop_ParaTriGrid_tile_count_correct ∷ ParaTriGrid → Property-prop_ParaTriGrid_tile_count_correct g = property $ -  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else 2*r*c-    where (r, c) = size g--prop_ParaTriGrid_distance_in_bounds ∷ ParaTriGrid → Int → Int → Property-prop_ParaTriGrid_distance_in_bounds g i j = nonNull g ==> -  distance g a b ≤ 2*(r+c) - 3-    where (r, c) = size g-          a = g `pointAt` i-          b = g `pointAt` j---- 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.-prop_ParaTriGrid_distance_corner_to_corner ∷ ParaTriGrid → Property-prop_ParaTriGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> -  distance g a b ≡ 2*(r+c) - 3-    where ps = indices g-          a = head ps-          b = last ps-          (r, c) = size g--prop_ParaTriGrid_neighbour_count_in_bounds ∷ ParaTriGrid → Int → Property-prop_ParaTriGrid_neighbour_count_in_bounds g i = nonNull g ==>-  neighbourCount g x ≤ 3-  where x = g `pointAt` i--prop_ParaTriGrid_boundary_count_correct ∷ ParaTriGrid → Property-prop_ParaTriGrid_boundary_count_correct g = property $-  (length . boundary) g ≡ (f . size) g-  where f (0,_) = 0-        f (_,0) = 0-        f (1,c) = 2*c-        f (r,1) = 2*r-        f (r,c) = 2*(r+c-1)--prop_ParaTriGrid_boundary_tiles_have_fewer_neighbours ∷ ParaTriGrid → Property-prop_ParaTriGrid_boundary_tiles_have_fewer_neighbours g = property $-  all (3>) . map (numNeighbours g) . boundary $ g------- Rectangular grids with triangular tiles------- We want the number of tiles in a test grid to be O(n)-sizedRectTriGrid ∷ Int → Gen RectTriGrid-sizedRectTriGrid n = do-  r ← choose (0,n)-  let c = n `div` (2*r + 1)-  return $ rectTriGrid r c--instance Arbitrary RectTriGrid where-  arbitrary = sized sizedRectTriGrid--prop_RectTriGrid_tile_count_correct ∷ RectTriGrid → Property-prop_RectTriGrid_tile_count_correct g = property $ -  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else 2*r*c-    where (r, c) = size g--prop_RectTriGrid_distance_in_bounds ∷ RectTriGrid → Int → Int → Property-prop_RectTriGrid_distance_in_bounds g i j = nonNull g ==> -  distance g a b ≤ 2*(r+c) - 3-    where (r, c) = size g-          a = g `pointAt` i-          b = g `pointAt` j--prop_RectTriGrid_neighbour_count_in_bounds ∷ RectTriGrid → Int → Property-prop_RectTriGrid_neighbour_count_in_bounds g i = nonNull g ==>-  neighbourCount g x ≤ 3-  where x = g `pointAt` i--prop_RectTriGrid_boundary_count_correct ∷ RectTriGrid → Property-prop_RectTriGrid_boundary_count_correct g = property $-  (length . boundary) g ≡ (f . size) g-  where f (0,_) = 0-        f (_,0) = 0-        f (1,c) = 2*c-        f (r,1) = 2*r-        f (r,c) = 2*(r+c-1)--prop_RectTriGrid_boundary_tiles_have_fewer_neighbours ∷ RectTriGrid → Property-prop_RectTriGrid_boundary_tiles_have_fewer_neighbours g = property $-  all (3>) . map (numNeighbours g) . boundary $ g------- Toroidal grids with triangular tiles------- We want the number of tiles in a test grid to be O(n)-sizedTorTriGrid ∷ Int → Gen TorTriGrid-sizedTorTriGrid n = do-  r0 ← choose (0,n `div` 2)-  let r = 2*r0-  let c = n `div` (2*r + 1)-  return $ torTriGrid r c--instance Arbitrary TorTriGrid where-  arbitrary = sized sizedTorTriGrid--prop_TorTriGrid_tile_count_correct ∷ TorTriGrid → Property-prop_TorTriGrid_tile_count_correct g = property $ -  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else 2*r*c-    where (r, c) = size g--prop_TorTriGrid_distance_in_bounds ∷ TorTriGrid → Int → Int → Property-prop_TorTriGrid_distance_in_bounds g i j = nonNull g ==> -  distance g a b ≤ 2*(r+c) - 3-    where (r, c) = size g-          a = g `pointAt` i-          b = g `pointAt` j--prop_TorTriGrid_neighbour_count_in_bounds ∷ TorTriGrid → Int → Property-prop_TorTriGrid_neighbour_count_in_bounds g i = nonNull g ==>-  neighbourCount g x ≤ 3-  where x = g `pointAt` i------- Rectangular grids with square tiles------- We want the number of tiles in a test grid to be O(n)-sizedRectSquareGrid ∷ Int → Gen RectSquareGrid-sizedRectSquareGrid n = do-  r ← choose (0,n)-  let c = n `div` (r+1)-  return $ rectSquareGrid r c--instance Arbitrary RectSquareGrid where-  arbitrary = sized sizedRectSquareGrid--prop_RectSquareGrid_tile_count_correct ∷ RectSquareGrid → Property-prop_RectSquareGrid_tile_count_correct g = property $ -  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else r*c-    where (r, c) = size g--prop_RectSquareGrid_distance_in_bounds ∷ RectSquareGrid → Int → Int → Property-prop_RectSquareGrid_distance_in_bounds g i j = nonNull g ==>-  distance g a b ≤ r + c - 2-    where (r, c) = size g-          a = g `pointAt` i-          b = g `pointAt` j---- 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.-prop_RectSquareGrid_distance_corner_to_corner ∷ RectSquareGrid → Property-prop_RectSquareGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> -  distance g a b ≡ r + c - 2-    where (r, c) = size g-          ps = indices g-          a = head ps-          b = last ps--prop_RectSquareGrid_neighbour_count_in_bounds ∷ -  RectSquareGrid → Int → Property-prop_RectSquareGrid_neighbour_count_in_bounds g i = nonNull g ==> -  neighbourCount g x ≤ 4-  where x = g `pointAt` i--prop_RectSquareGrid_num_min_paths_correct ∷ -  RectSquareGrid → Int → Int → Property-prop_RectSquareGrid_num_min_paths_correct g i j = nonNull g ==>-  minPathCount g a b ≡ M.choose (deltaX+deltaY) deltaX-    where a = g `pointAt` i-          b = g `pointAt` j-          deltaX = abs $ fst b - fst a-          deltaY = abs $ snd b - snd a--prop_RectSquareGrid_boundary_count_correct ∷ RectSquareGrid → Property-prop_RectSquareGrid_boundary_count_correct g = property $-  (length . boundary) g ≡ (cartesianBoundaryCount . size) g--cartesianBoundaryCount ∷ (Eq a, Num a) ⇒ (a, a) → a-cartesianBoundaryCount (0,_) = 0-cartesianBoundaryCount (_,0) = 0-cartesianBoundaryCount (1,c) = c-cartesianBoundaryCount (r,1) = r-cartesianBoundaryCount (r,c) = 2*(r+c) - 4--prop_RectSquareGrid_boundary_tiles_have_fewer_neighbours ∷ RectSquareGrid → Property-prop_RectSquareGrid_boundary_tiles_have_fewer_neighbours g = property $-  all (4>) . map (numNeighbours g) . boundary $ g-------- Toroidal grids with square tiles------- We want the number of tiles in a test grid to be O(n)-sizedTorSquareGrid ∷ Int → Gen TorSquareGrid-sizedTorSquareGrid n = do-  r ← choose (0,n)-  let c = n `div` (r+1)-  return $ torSquareGrid r c--instance Arbitrary TorSquareGrid where-  arbitrary = sized sizedTorSquareGrid--prop_TorSquareGrid_tile_count_correct ∷ TorSquareGrid → Property-prop_TorSquareGrid_tile_count_correct g = property $  -  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else r*c-    where (r, c) = size g--prop_TorSquareGrid_distance_in_bounds ∷ TorSquareGrid → Int → Int → Property-prop_TorSquareGrid_distance_in_bounds g i j = nonNull g ==>-  distance g a b ≤ (r+c) `div` 2-    where (r, c) = size g-          a = g `pointAt` i-          b = g `pointAt` j---- If the ordering produced by torSquareGrid is ever changed, this property--- may need to be changed too.-prop_TorSquareGrid_distance_corner_to_corner ∷ TorSquareGrid → Property-prop_TorSquareGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> -  distance g a b ≡ f-    where (r, c) = size g-          ps = indices g-          a = head ps-          b = last ps-          f | r ≡ 1 && c ≡ 1 = 0 -- single-tile torus-            | r ≡ 1 || c ≡ 1 = 1 -- a and b are the same-            | otherwise      = 2--prop_TorSquareGrid_neighbour_count_in_bounds ∷ TorSquareGrid → Int → Property-prop_TorSquareGrid_neighbour_count_in_bounds g i = nonNull g ==>-  neighbourCount g x ≤ 4-  where x = g `pointAt` i------- Circular hexagonal grids   ------- We want the number of tiles in a test grid to be O(n)-sizedHexHexGrid ∷ Int → Gen HexHexGrid-sizedHexHexGrid n = return $ hexHexGrid s-  where s = isqrt (n `div` 3)--instance Arbitrary HexHexGrid where-  arbitrary = sized sizedHexHexGrid--prop_HexHexGrid_tile_count_correct ∷ HexHexGrid → Property-prop_HexHexGrid_tile_count_correct g = property $ -  (length . indices) g ≡ if s ≤ 0 then 0 else 3*s*(s-1) + 1-    where s = size g--prop_HexHexGrid_distance_in_bounds ∷ HexHexGrid → Int → Int → Property-prop_HexHexGrid_distance_in_bounds g i j = nonNull g ==>-  distance g a b < 2*s-    where s = size g-          a = g `pointAt` i-          b = g `pointAt` j---- If the ordering produced by hexHexGrid is ever changed, this property--- may need to be changed too. It relies on the first and last elements being--- on opposite edges.-prop_HexHexGrid_distance_edge_to_edge ∷ HexHexGrid → Property-prop_HexHexGrid_distance_edge_to_edge g = s > 0 ==> distance g a b ≡ 2*s - 2-  where ps = indices g-        a = head ps-        b = last ps-        s = size g--prop_HexHexGrid_neighbour_count_in_bounds ∷ HexHexGrid → Int → Property-prop_HexHexGrid_neighbour_count_in_bounds g i = nonNull g ==> -  neighbourCount g x ≤ 6-  where x = g `pointAt` i--prop_HexHexGrid_boundary_count_correct ∷ HexHexGrid → Property-prop_HexHexGrid_boundary_count_correct g = property $-  (length . boundary) g ≡ (f . size) g-  where f 0 = 0-        f 1 = 1-        f s = 6*(s-1)--prop_HexHexGrid_boundary_tiles_have_fewer_neighbours ∷ HexHexGrid → Property-prop_HexHexGrid_boundary_tiles_have_fewer_neighbours g = property $-  all (5>) . map (numNeighbours g) . boundary $ g-------- Parallelogrammatical hexagonal grids   ------- We want the number of tiles in a test grid to be O(n)-sizedParaHexGrid ∷ Int → Gen ParaHexGrid-sizedParaHexGrid n = do-  r ← choose (0,n)-  let c = n `div` (r+1)-  return $ paraHexGrid r c--instance Arbitrary ParaHexGrid where-  arbitrary = sized sizedParaHexGrid--prop_ParaHexGrid_tile_count_correct ∷ ParaHexGrid → Property-prop_ParaHexGrid_tile_count_correct g = property $ -  tileCount g ≡ r*c-    where (r, c) = size g--prop_ParaHexGrid_distance_in_bounds ∷ ParaHexGrid → Int → Int → Property-prop_ParaHexGrid_distance_in_bounds g i j = nonNull g ==>-  property $ distance g a b ≤ r+c-2-    where (r, c) = size g-          a = g `pointAt` i-          b = g `pointAt` j---- If the ordering produced by paraHexGrid is ever changed, this property--- may need to be changed too. It relies on the first and last elements being--- at opposite corners on the longer diagonal.-prop_ParaHexGrid_distance_corner_to_corner ∷ ParaHexGrid → Property-prop_ParaHexGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> -  distance g a b ≡ r+c-2-    where ps = indices g-          a = head ps-          b = last ps-          (r, c) = size g--prop_ParaHexGrid_neighbour_count_in_bounds ∷ ParaHexGrid → Int → Property-prop_ParaHexGrid_neighbour_count_in_bounds g i = nonNull g ==>-  neighbourCount g x ≤ 6-  where x = g `pointAt` i--prop_ParaHexGrid_boundary_count_correct ∷ ParaHexGrid → Property-prop_ParaHexGrid_boundary_count_correct g = property $-  (length . boundary) g ≡ (cartesianBoundaryCount . size) g--prop_ParaHexGrid_boundary_tiles_have_fewer_neighbours ∷ HexHexGrid → Property-prop_ParaHexGrid_boundary_tiles_have_fewer_neighbours g = property $-  all (5>) . map (numNeighbours g) . boundary $ g------- Rectangular grids with octagonal tiles------- We want the number of tiles in a test grid to be O(n)-sizedRectOctGrid ∷ Int → Gen RectOctGrid-sizedRectOctGrid n = do-  let n' = min n 12 -- calculation time for these grids grows quickly!-  r ← choose (0,n')-  let c = n' `div` (r+1)-  return $ rectOctGrid r c--instance Arbitrary RectOctGrid where-  arbitrary = sized sizedRectOctGrid--prop_RectOctGrid_tile_count_correct ∷ RectOctGrid → Property-prop_RectOctGrid_tile_count_correct g = property $ -  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else r*c-    where (r, c) = size g--prop_RectOctGrid_distance_in_bounds ∷ RectOctGrid → Int → Int → Property-prop_RectOctGrid_distance_in_bounds g i j = nonNull g ==>-  distance g a b ≤ max r c-    where (r, c) = size g-          a = g `pointAt` i-          b = g `pointAt` j---- If the ordering produced by rectOctGrid is ever changed, this--- property may need to be changed too. It relies on the first and last --- elements being at opposite corners.-prop_RectOctGrid_distance_corner_to_corner ∷ RectOctGrid → Property-prop_RectOctGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> -  a ≡ b || distance g a b ≡ (max r c) - 1-    where (r, c) = size g-          ps = indices g-          a = head ps-          b = last ps--prop_RectOctGrid_neighbour_count_in_bounds ∷ -  RectOctGrid → Int → Property-prop_RectOctGrid_neighbour_count_in_bounds g i = nonNull g ==>-  neighbourCount g x ≤ 8-  where x = g `pointAt` i--prop_RectOctGrid_num_min_paths_correct ∷ -  RectOctGrid → Int → Int → Property-prop_RectOctGrid_num_min_paths_correct g i j = nonNull g ==>-  minPathCount g a b ≡-    if a ≡ b then 1 else minPathCount2 g att b-    where a = g `pointAt` i-          b = g `pointAt` j-          att = adjacentTilesToward g a b--prop_RectOctGrid_boundary_count_correct ∷ RectOctGrid → Property-prop_RectOctGrid_boundary_count_correct g = property $-  (length . boundary) g ≡ (cartesianBoundaryCount . size) g--prop_RectOctGrid_boundary_tiles_have_fewer_neighbours ∷ RectOctGrid → Property-prop_RectOctGrid_boundary_tiles_have_fewer_neighbours g = property $-  all (6>) . map (numNeighbours g) . boundary $ g-------- Toroidal grids with octagonal tiles------- We want the number of tiles in a test grid to be O(n)-sizedTorOctGrid ∷ Int → Gen TorOctGrid-sizedTorOctGrid n = do-  r ← choose (0,n)-  let c = n `div` (r+1)-  return $ torOctGrid r c--instance Arbitrary TorOctGrid where-  arbitrary = sized sizedTorOctGrid--prop_TorOctGrid_tile_count_correct ∷ TorOctGrid → Property-prop_TorOctGrid_tile_count_correct g = property $  -  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else r*c-    where (r, c) = size g--prop_TorOctGrid_distance_in_bounds ∷ TorOctGrid → Int → Int → Property-prop_TorOctGrid_distance_in_bounds g i j = nonNull g ==>-  distance g a b ≤ min r c + abs (r-c)-    where (r, c) = size g-          a = g `pointAt` i-          b = g `pointAt` j---- If the ordering produced by torOctGrid is ever changed, this property--- may need to be changed too.-prop_TorOctGrid_distance_corner_to_corner ∷ TorOctGrid → Property-prop_TorOctGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> -  distance g a b ≡ if tileCount g ≡ 1 then 0 else 1-    where (r, c) = size g-          ps = indices g-          a = head ps-          b = last ps--prop_TorOctGrid_neighbour_count_in_bounds ∷ TorOctGrid → Int → Property-prop_TorOctGrid_neighbour_count_in_bounds g i = nonNull g ==>-  neighbourCount g x ≤ 8-  where x = g `pointAt` i---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"-      (prop_distance_reflexive ∷ TriTriGrid → Int → Property),-    testProperty "prop_distance_symmetric - TriTriGrid"-      (prop_distance_symmetric ∷ TriTriGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - TriTriGrid"-      (prop_minDistance_cw_distance ∷ TriTriGrid → Int → [Int] → Property),-    testProperty "prop_grid_and_boundary_are_both_null_or_not - TriTriGrid"-      (prop_grid_and_boundary_are_both_null_or_not ∷ TriTriGrid → Property),-    testProperty "prop_boundary_in_grid - TriTriGrid"-      (prop_boundary_in_grid ∷ TriTriGrid → Property),-    testProperty "prop_boundary_tiles_have_fewer_neighbours - TriTriGrid"-      (prop_boundary_tiles_have_fewer_neighbours ∷ TriTriGrid → Int → Property),-    testProperty "prop_TriTriGrid_boundary_count_correct"-      prop_TriTriGrid_boundary_count_correct,-    testProperty "prop_TriTriGrid_boundary_tiles_have_fewer_neighbours"-      prop_TriTriGrid_boundary_tiles_have_fewer_neighbours,-    testProperty "prop_centres_equidistant_from_boundary - TriTriGrid"-      (prop_centres_equidistant_from_boundary ∷ TriTriGrid → Property),-    testProperty "prop_centres_farthest_from_boundary - TriTriGrid"-      (prop_centres_farthest_from_boundary ∷ TriTriGrid → Int → Property),-    testProperty "prop_TriTriGrid_distance_in_bounds"-      prop_TriTriGrid_distance_in_bounds,-    testProperty "prop_TriTriGrid_distance_edge_to_edge"-      prop_TriTriGrid_distance_edge_to_edge,-    testProperty "prop_TriTriGrid_neighbour_count_in_bounds"-      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),-    testProperty "prop_adjacentTilesToward_moves_closer - TriTriGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          TriTriGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_have_min_length - TriTriGrid"-      (prop_minimal_paths_have_min_length ∷ -          TriTriGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - TriTriGrid"-      (prop_minimal_paths_are_valid ∷ TriTriGrid → Int → Int → Property),--    -- ParaTriGrid tests-    testProperty "prop_ParaTriGrid_tile_count_correct"-      prop_ParaTriGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - ParaTriGrid"-      (prop_distance_reflexive ∷ ParaTriGrid → Int → Property),-    testProperty "prop_distance_symmetric - ParaTriGrid"-      (prop_distance_symmetric ∷ ParaTriGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - ParaTriGrid"-      (prop_minDistance_cw_distance ∷ ParaTriGrid → Int → [Int] → Property),-    testProperty "prop_grid_and_boundary_are_both_null_or_not - ParaTriGrid"-      (prop_grid_and_boundary_are_both_null_or_not ∷ ParaTriGrid → Property),-    testProperty "prop_boundary_in_grid - ParaTriGrid"-      (prop_boundary_in_grid ∷ ParaTriGrid → Property),-    testProperty "prop_boundary_tiles_have_fewer_neighbours - ParaTriGrid"-      (prop_boundary_tiles_have_fewer_neighbours ∷ ParaTriGrid → Int → Property),-    testProperty "prop_ParaTriGrid_boundary_count_correct"-      prop_ParaTriGrid_boundary_count_correct,-    testProperty "prop_ParaTriGrid_boundary_tiles_have_fewer_neighbours"-      prop_ParaTriGrid_boundary_tiles_have_fewer_neighbours,-    testProperty "prop_centres_equidistant_from_boundary - ParaTriGrid"-      (prop_centres_equidistant_from_boundary ∷ ParaTriGrid → Property),-    testProperty "prop_centres_farthest_from_boundary - ParaTriGrid"-      (prop_centres_farthest_from_boundary ∷ ParaTriGrid → Int → Property),-    testProperty "prop_ParaTriGrid_distance_in_bounds"-      prop_ParaTriGrid_distance_in_bounds,-    testProperty "prop_ParaTriGrid_distance_corner_to_corner"-      prop_ParaTriGrid_distance_corner_to_corner,-    testProperty "prop_ParaTriGrid_neighbour_count_in_bounds"-      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),-    testProperty "prop_adjacentTilesToward_moves_closer - ParaTriGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          ParaTriGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_have_min_length - ParaTriGrid"-      (prop_minimal_paths_have_min_length ∷ -          ParaTriGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - ParaTriGrid"-      (prop_minimal_paths_are_valid ∷ ParaTriGrid → Int → Int → Property),--    -- RectTriGrid tests-    testProperty "prop_RectTriGrid_tile_count_correct"-      prop_RectTriGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - RectTriGrid"-      (prop_distance_reflexive ∷ RectTriGrid → Int → Property),-    testProperty "prop_distance_symmetric - RectTriGrid"-      (prop_distance_symmetric ∷ RectTriGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - RectTriGrid"-      (prop_minDistance_cw_distance ∷ RectTriGrid → Int → [Int] → Property),-    testProperty "prop_grid_and_boundary_are_both_null_or_not - RectTriGrid"-      (prop_grid_and_boundary_are_both_null_or_not ∷ RectTriGrid → Property),-    testProperty "prop_boundary_in_grid - RectTriGrid"-      (prop_boundary_in_grid ∷ RectTriGrid → Property),-    testProperty "prop_boundary_tiles_have_fewer_neighbours - RectTriGrid"-      (prop_boundary_tiles_have_fewer_neighbours ∷ RectTriGrid → Int → Property),-    testProperty "prop_RectTriGrid_boundary_count_correct"-      prop_RectTriGrid_boundary_count_correct,-    testProperty "prop_RectTriGrid_boundary_tiles_have_fewer_neighbours"-      prop_RectTriGrid_boundary_tiles_have_fewer_neighbours,-    testProperty "prop_centres_equidistant_from_boundary - RectTriGrid"-      (prop_centres_equidistant_from_boundary ∷ RectTriGrid → Property),-    testProperty "prop_centres_farthest_from_boundary - RectTriGrid"-      (prop_centres_farthest_from_boundary ∷ RectTriGrid → Int → Property),-    testProperty "prop_RectTriGrid_distance_in_bounds"-      prop_RectTriGrid_distance_in_bounds,-    testProperty "prop_RectTriGrid_neighbour_count_in_bounds"-      prop_RectTriGrid_neighbour_count_in_bounds,-    testProperty "prop_neighbours_cw_viewpoint - RectTriGrid"-      (prop_neighbours_cw_viewpoint ∷ RectTriGrid → Int → Property),-    testProperty "prop_edges_cw_neighbours - RectTriGrid"-      (prop_edges_cw_neighbours ∷ RectTriGrid → Int → Property),-    testProperty "prop_edges_are_adjacent - RectTriGrid"-      (prop_edges_are_adjacent ∷ RectTriGrid → Property),-    testProperty "prop_adjacentTilesToward_moves_closer - RectTriGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          RectTriGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_have_min_length - RectTriGrid"-      (prop_minimal_paths_have_min_length ∷ -          RectTriGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - RectTriGrid"-      (prop_minimal_paths_are_valid ∷ RectTriGrid → Int → Int → Property),--    -- TorTriGrid tests-    testProperty "prop_TorTriGrid_tile_count_correct"-      prop_TorTriGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - TorTriGrid"-      (prop_distance_reflexive ∷ TorTriGrid → Int → Property),-    testProperty "prop_distance_symmetric - TorTriGrid"-      (prop_distance_symmetric ∷ TorTriGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - TorTriGrid"-      (prop_minDistance_cw_distance ∷ TorTriGrid → Int → [Int] → Property),-    testProperty "prop_TorTriGrid_distance_in_bounds"-      prop_TorTriGrid_distance_in_bounds,-    testProperty "prop_TorTriGrid_neighbour_count_in_bounds"-      prop_TorTriGrid_neighbour_count_in_bounds,-    testProperty "prop_neighbours_cw_viewpoint - TorTriGrid"-      (prop_neighbours_cw_viewpoint ∷ TorTriGrid → Int → Property),-    testProperty "prop_edges_cw_neighbours - TorTriGrid"-      (prop_edges_cw_neighbours ∷ TorTriGrid → Int → Property),-    testProperty "prop_edges_are_adjacent - TorTriGrid"-      (prop_edges_are_adjacent ∷ TorTriGrid → Property),-    testProperty "prop_adjacentTilesToward_moves_closer - TorTriGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          TorTriGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_have_min_length - TorTriGrid"-      (prop_minimal_paths_have_min_length ∷ -          TorTriGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - TorTriGrid"-      (prop_minimal_paths_are_valid ∷ TorTriGrid → Int → Int → Property),--    -- RectSquareGrid tests-    testProperty "prop_RectSquareGrid_tile_count_correct"-      prop_RectSquareGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - RectSquareGrid"-      (prop_distance_reflexive ∷ RectSquareGrid → Int → Property),-    testProperty "prop_distance_symmetric - RectSquareGrid"-      (prop_distance_symmetric ∷ RectSquareGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - RectSquareGrid"-      (prop_minDistance_cw_distance ∷ RectSquareGrid → Int → [Int] → Property),-    testProperty "prop_grid_and_boundary_are_both_null_or_not - RectSquareGrid"-      (prop_grid_and_boundary_are_both_null_or_not ∷ RectSquareGrid → Property),-    testProperty "prop_boundary_in_grid - RectSquareGrid"-      (prop_boundary_in_grid ∷ RectSquareGrid → Property),-    testProperty "prop_boundary_tiles_have_fewer_neighbours - RectSquareGrid"-      (prop_boundary_tiles_have_fewer_neighbours ∷ RectSquareGrid → Int → Property),-    testProperty "prop_RectSquareGrid_boundary_count_correct"-      prop_RectSquareGrid_boundary_count_correct,-    testProperty "prop_RectSquareGrid_boundary_tiles_have_fewer_neighbours"-      prop_RectSquareGrid_boundary_tiles_have_fewer_neighbours,-    testProperty "prop_centres_equidistant_from_boundary - RectSquareGrid"-      (prop_centres_equidistant_from_boundary ∷ RectSquareGrid → Property),-    testProperty "prop_centres_farthest_from_boundary - RectSquareGrid"-      (prop_centres_farthest_from_boundary ∷ RectSquareGrid → Int → Property),-    testProperty "prop_RectSquareGrid_distance_in_bounds"-      prop_RectSquareGrid_distance_in_bounds,-    testProperty "prop_RectSquareGrid_distance_corner_to_corner"-      prop_RectSquareGrid_distance_corner_to_corner,-    testProperty "prop_RectSquareGrid_neighbour_count_in_bounds"-      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),-    testProperty "prop_adjacentTilesToward_moves_closer - RectSquareGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          RectSquareGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_have_min_length - RectSquareGrid"-      (prop_minimal_paths_have_min_length ∷ -          RectSquareGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - RectSquareGrid"-      (prop_minimal_paths_are_valid ∷ RectSquareGrid → Int → Int → Property),-    testProperty "prop_RectSquareGrid_num_min_paths_correct"-      prop_RectSquareGrid_num_min_paths_correct,--    -- TorSquareGrid tests-    testProperty "prop_TorSquareGrid_tile_count_correct"-      prop_TorSquareGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - TorSquareGrid"-      (prop_distance_reflexive ∷ TorSquareGrid → Int → Property),-    testProperty "prop_distance_symmetric - TorSquareGrid"-      (prop_distance_symmetric ∷ TorSquareGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - TorSquareGrid"-      (prop_minDistance_cw_distance ∷ TorSquareGrid → Int → [Int] → Property),-    testProperty "prop_TorSquareGrid_distance_in_bounds"-      prop_TorSquareGrid_distance_in_bounds,-    testProperty "prop_TorSquareGrid_distance_corner_to_corner"-      prop_TorSquareGrid_distance_corner_to_corner,-    testProperty "prop_TorSquareGrid_neighbour_count_in_bounds"-      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),-    testProperty "prop_adjacentTilesToward_moves_closer - TorSquareGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          TorSquareGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_have_min_length - TorSquareGrid"-      (prop_minimal_paths_have_min_length ∷ -          TorSquareGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - TorSquareGrid"-      (prop_minimal_paths_are_valid ∷ TorSquareGrid → Int → Int → Property),--    -- HexHexGrid tests-    testProperty "prop_HexHexGrid_tile_count_correct"-      prop_HexHexGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - HexHexGrid"-      (prop_distance_reflexive ∷ HexHexGrid → Int → Property),-    testProperty "prop_distance_symmetric - HexHexGrid"-      (prop_distance_symmetric ∷ HexHexGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - HexHexGrid"-      (prop_minDistance_cw_distance ∷ HexHexGrid → Int → [Int] → Property),-    testProperty "prop_grid_and_boundary_are_both_null_or_not - HexHexGrid"-      (prop_grid_and_boundary_are_both_null_or_not ∷ HexHexGrid → Property),-    testProperty "prop_boundary_in_grid - HexHexGrid"-      (prop_boundary_in_grid ∷ HexHexGrid → Property),-    testProperty "prop_boundary_tiles_have_fewer_neighbours - HexHexGrid"-      (prop_boundary_tiles_have_fewer_neighbours ∷ HexHexGrid → Int → Property),-    testProperty "prop_HexHexGrid_boundary_count_correct"-      prop_HexHexGrid_boundary_count_correct,-    testProperty "prop_HexHexGrid_boundary_tiles_have_fewer_neighbours"-      prop_HexHexGrid_boundary_tiles_have_fewer_neighbours,-    testProperty "prop_centres_equidistant_from_boundary - HexHexGrid"-      (prop_centres_equidistant_from_boundary ∷ HexHexGrid → Property),-    testProperty "prop_centres_farthest_from_boundary - HexHexGrid"-      (prop_centres_farthest_from_boundary ∷ HexHexGrid → Int → Property),-    testProperty "prop_HexHexGrid_distance_in_bounds"-      prop_HexHexGrid_distance_in_bounds,-    testProperty "prop_HexHexGrid_distance_edge_to_edge"-      prop_HexHexGrid_distance_edge_to_edge,-    testProperty "prop_HexHexGrid_neighbour_count_in_bounds"-      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),-    testProperty "prop_adjacentTilesToward_moves_closer - HexHexGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          HexHexGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_have_min_length - HexHexGrid"-      (prop_minimal_paths_have_min_length ∷ -          HexHexGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - HexHexGrid"-      (prop_minimal_paths_are_valid ∷ HexHexGrid → Int → Int → Property),--    -- ParaHexGrid tests-    testProperty "prop_ParaHexGrid_tile_count_correct"-      prop_ParaHexGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - ParaHexGrid"-      (prop_distance_reflexive ∷ ParaHexGrid → Int → Property),-    testProperty "prop_distance_symmetric - ParaHexGrid"-      (prop_distance_symmetric ∷ ParaHexGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - ParaHexGrid"-      (prop_minDistance_cw_distance ∷ ParaHexGrid → Int → [Int] → Property),-    testProperty "prop_grid_and_boundary_are_both_null_or_not - ParaHexGrid"-      (prop_grid_and_boundary_are_both_null_or_not ∷ ParaHexGrid → Property),-    testProperty "prop_boundary_in_grid - ParaHexGrid"-      (prop_boundary_in_grid ∷ ParaHexGrid → Property),-    testProperty "prop_boundary_tiles_have_fewer_neighbours - TriTriGrid"-      (prop_boundary_tiles_have_fewer_neighbours ∷ TriTriGrid → Int → Property),-    testProperty "prop_ParaHexGrid_boundary_count_correct"-      prop_ParaHexGrid_boundary_count_correct,-    testProperty "prop_ParaHexGrid_boundary_tiles_have_fewer_neighbours"-      prop_ParaHexGrid_boundary_tiles_have_fewer_neighbours,-    testProperty "prop_centres_equidistant_from_boundary - ParaHexGrid"-      (prop_centres_equidistant_from_boundary ∷ ParaHexGrid → Property),-    testProperty "prop_centres_farthest_from_boundary - ParaHexGrid"-      (prop_centres_farthest_from_boundary ∷ ParaHexGrid → Int → Property),-    testProperty "prop_ParaHexGrid_distance_in_bounds"-      prop_ParaHexGrid_distance_in_bounds,-    testProperty "prop_ParaHexGrid_distance_corner_to_corner"-      prop_ParaHexGrid_distance_corner_to_corner,-    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),-    testProperty "prop_edges_cw_neighbours - ParaHexGrid"-      (prop_edges_cw_neighbours ∷ ParaHexGrid → Int → Property),-    testProperty "prop_adjacentTilesToward_moves_closer - ParaHexGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          ParaHexGrid → Int → Int → Property),-    testProperty "prop_edges_are_adjacent - ParaHexGrid"-      (prop_edges_are_adjacent ∷ ParaHexGrid → Property),-    testProperty "prop_minimal_paths_have_min_length - ParaHexGrid"-      (prop_minimal_paths_have_min_length ∷ -          ParaHexGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - ParaHexGrid"-      (prop_minimal_paths_are_valid ∷ ParaHexGrid → Int → Int → Property),--    -- RectOctGrid tests-    testProperty "prop_RectOctGrid_tile_count_correct"-      prop_RectOctGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - RectOctGrid"-      (prop_distance_reflexive ∷ RectOctGrid → Int → Property),-    testProperty "prop_distance_symmetric - RectOctGrid"-      (prop_distance_symmetric ∷ RectOctGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - RectOctGrid"-      (prop_minDistance_cw_distance ∷ RectOctGrid → Int → [Int] → Property),-    testProperty "prop_grid_and_boundary_are_both_null_or_not - RectOctGrid"-      (prop_grid_and_boundary_are_both_null_or_not ∷ RectOctGrid → Property),-    testProperty "prop_boundary_in_grid - RectOctGrid"-      (prop_boundary_in_grid ∷ RectOctGrid → Property),-    testProperty "prop_boundary_tiles_have_fewer_neighbours - RectOctGrid"-      (prop_boundary_tiles_have_fewer_neighbours ∷ RectOctGrid → Int → Property),-    testProperty "prop_RectOctGrid_boundary_count_correct"-      prop_RectOctGrid_boundary_count_correct,-    testProperty "prop_RectOctGrid_boundary_tiles_have_fewer_neighbours"-      prop_RectOctGrid_boundary_tiles_have_fewer_neighbours,-    testProperty "prop_centres_equidistant_from_boundary - RectOctGrid"-      (prop_centres_equidistant_from_boundary ∷ RectOctGrid → Property),-    testProperty "prop_centres_farthest_from_boundary - RectOctGrid"-      (prop_centres_farthest_from_boundary ∷ RectOctGrid → Int → Property),-    testProperty "prop_RectOctGrid_distance_in_bounds"-      prop_RectOctGrid_distance_in_bounds,-    testProperty "prop_RectOctGrid_distance_corner_to_corner"-      prop_RectOctGrid_distance_corner_to_corner,-    testProperty "prop_RectOctGrid_neighbour_count_in_bounds"-      prop_RectOctGrid_neighbour_count_in_bounds,-    testProperty "prop_neighbours_cw_viewpoint - RectOctGrid"-      (prop_neighbours_cw_viewpoint ∷ RectOctGrid → Int → Property),-    testProperty "prop_edges_cw_neighbours - RectOctGrid"-      (prop_edges_cw_neighbours ∷ RectOctGrid → Int → Property),-    testProperty "prop_edges_are_adjacent - RectOctGrid"-      (prop_edges_are_adjacent ∷ RectOctGrid → Property),-    testProperty "prop_adjacentTilesToward_moves_closer - RectOctGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          RectOctGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_have_min_length - RectOctGrid"-      (prop_minimal_paths_have_min_length ∷ -          RectOctGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - RectOctGrid"-      (prop_minimal_paths_are_valid ∷ RectOctGrid → Int → Int → Property),-    testProperty "prop_RectOctGrid_num_min_paths_correct"-      prop_RectOctGrid_num_min_paths_correct,--    -- TorOctGrid tests-    testProperty "prop_TorOctGrid_tile_count_correct"-      prop_TorOctGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - TorOctGrid"-      (prop_distance_reflexive ∷ TorOctGrid → Int → Property),-    testProperty "prop_distance_symmetric - TorOctGrid"-      (prop_distance_symmetric ∷ TorOctGrid → Int → Int → Property),-    testProperty "prop_minDistance_cw_distance - TorOctGrid"-      (prop_minDistance_cw_distance ∷ TorOctGrid → Int → [Int] → Property),-    testProperty "prop_TorOctGrid_distance_in_bounds"-      prop_TorOctGrid_distance_in_bounds,-    testProperty "prop_TorOctGrid_distance_corner_to_corner"-      prop_TorOctGrid_distance_corner_to_corner,-    testProperty "prop_TorOctGrid_neighbour_count_in_bounds"-      prop_TorOctGrid_neighbour_count_in_bounds,-    testProperty "prop_neighbours_cw_viewpoint - TorOctGrid"-      (prop_neighbours_cw_viewpoint ∷ TorOctGrid → Int → Property),-    testProperty "prop_edges_cw_neighbours - TorOctGrid"-      (prop_edges_cw_neighbours ∷ TorOctGrid → Int → Property),-    testProperty "prop_edges_are_adjacent - TorOctGrid"-      (prop_edges_are_adjacent ∷ TorOctGrid → Property),-    testProperty "prop_adjacentTilesToward_moves_closer - TorOctGrid"-      (prop_adjacentTilesToward_moves_closer ∷ -          TorOctGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_have_min_length - TorOctGrid"-      (prop_minimal_paths_have_min_length ∷ -          TorOctGrid → Int → Int → Property),-    testProperty "prop_minimal_paths_are_valid - TorOctGrid"-      (prop_minimal_paths_are_valid ∷ TorOctGrid → Int → Int → Property)- ]+    TypeFamilies, MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Math.Geometry.GridQC where++import Math.Geometry.GridInternal ++import Prelude hiding (null)+import qualified Prelude as P (null)+import Data.Eq.Unicode ((≡), (≠))+import Data.List (delete, nub, sort)+import Data.Ord.Unicode ((≤))+import Test.Framework as TF (Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck +  ((==>), Gen, Arbitrary, arbitrary, choose, Property, property,+    vectorOf, elements)++-- | @'isqrt' n@ returns the greatest integer not greater than the square root +--   of @n@.+isqrt ∷ Int → Int+isqrt n = (floor . sqrt) n'+  where n' = fromIntegral n ∷ Float++-- Given an arbitrary integer, select a corresponding point in the grid.+pointAt ∷ Grid g ⇒ g → Int → Index g+pointAt g i = indices g !! (i `mod` n)+  where n = (length . indices) g++minPathCount+  ∷ (Eq (Index g), Grid g) ⇒ g → Index g → Index g → Int+minPathCount g a b = length . minimalPaths g a $ b++minPathCount2+  ∷ (Eq (Index g), Grid g) ⇒ g → [Index g] → Index g → Int+minPathCount2 g as b = sum . map (\x → minPathCount g x b) $ as++cartesianBoundaryCount ∷ (Eq a, Num a) ⇒ (a, a) → a+cartesianBoundaryCount (0,_) = 0+cartesianBoundaryCount (_,0) = 0+cartesianBoundaryCount (1,c) = c+cartesianBoundaryCount (r,1) = r+cartesianBoundaryCount (r,c) = 2*(r+c) - 4++involves ∷ Eq a ⇒ (a, a) → a → Bool+involves (a, b) c = c ≡ a || c ≡ b++chooseIndices ∷ Grid g ⇒ g → Int → Gen [Index g]+chooseIndices g n = do+  k ← choose (0,n)+  if null g +    then return [] +    else vectorOf (k+2) (elements . indices $ g)++chooseClosePointsUnbounded ∷ Gen ((Int, Int), (Int, Int))+chooseClosePointsUnbounded = do+  (x1,y1) ← arbitrary+  x2 ← choose (x1-2,x1+2)+  y2 ← choose (y1-2,y1+2)+  return ((x1,y1), (x2,y2))++chooseClosePoints ∷ Grid g ⇒ g → Gen (Index g, Index g)+chooseClosePoints g = do+  a ← elements . indices $ g+  b ← elements . filter (\b → distance g a b < 6) . indices $ g+  return (a, b)++makeTests ∷ (Arbitrary t, Show t) ⇒ [(String, t → Property)] → [Test]+makeTests ts = map (\(s,t) → testProperty s t) ts++--+-- Tests that should apply to and are identical for all grids+--++class TestData t where+  type BaseGrid t+  grid ∷ t → BaseGrid t+  points ∷ t → [Index (BaseGrid t)]+  neighbourCountBounds ∷ t → (Int, Int)+  twoClosePoints ∷ t → (Index (BaseGrid t),Index (BaseGrid t))++prop_indices_are_contained ∷ (TestData t, Grid (BaseGrid t), +  Eq (Index (BaseGrid t))) ⇒ t → Property+prop_indices_are_contained t = nonNull g ==> g `contains` a+  where g = grid t+        (a:_) = points t++prop_distance_reflexive ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property+prop_distance_reflexive t = nonNull g ==> distance g a a ≡ 0+  where g = grid t+        (a:_) = points t++prop_distance_symmetric ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property+prop_distance_symmetric t = +  nonNull g ==> distance g a b ≡ distance g b a+  where g = grid t+        (a:b:_) = points t++prop_custom_MinDistance_eq_default +  ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property+prop_custom_MinDistance_eq_default t = nonNull g ==> +  minDistance g bs a ≡ defaultMinDistance g bs a+  where g = grid t+        (a:bs) = points t++-- "cw" = "consistent with"++prop_minDistance_cw_distance ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property+prop_minDistance_cw_distance t = +  nonNull g && (not . P.null) bs ==> +    minDistance g (b:bs) a ≤ distance g b a+  where g = grid t+        (a:b:bs) = points t++prop_neighbour_count_in_bounds+  ∷ (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_neighbour_count_in_bounds t = nonNull g ==> +  nMin ≤ n && n ≤ nMax+  where g = grid t+        (a:_) = points t+        n = length . neighbours g $ a+        (nMin, nMax) = neighbourCountBounds t++prop_neighbours_are_adjacent+  ∷ (TestData t, Grid (BaseGrid t))+    ⇒ t → Property+prop_neighbours_are_adjacent t = nonNull g  ==> +    and (map (isAdjacent g a) ns)+  where g = grid t+        (a:_) = points t+        ns = neighbours g a++prop_adjacentTilesToward_moves_closer+  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))+    ⇒ t → Property+prop_adjacentTilesToward_moves_closer t = nonNull g && a ≠ b ==> +    and (map (< d) ns)+  where g = grid t+        (a:b:_) = points t+        d = distance g a b+        ns = nub $ map (\x → distance g x b) $ adjacentTilesToward g a b++prop_minimal_paths_have_min_length+  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))+    ⇒ t → Property+prop_minimal_paths_have_min_length t = nonNull g ==> ns ≡ [d+1]+  where g = grid t+        (a,b) = twoClosePoints t+        d = distance g a b+        ns = nub . map length . minimalPaths g a $ b++prop_minimal_paths_are_valid+  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))+    ⇒ t → Property+prop_minimal_paths_are_valid t = nonNull g ==> +    and $ map (subsequentTilesInPathAreAdjacent g) $ minimalPaths g a b+  where g = grid t+        (a,b) = twoClosePoints t++subsequentTilesInPathAreAdjacent +  ∷ (Grid g, Eq (Index g)) ⇒ g → [Index g] → Bool+subsequentTilesInPathAreAdjacent _ [] = True+subsequentTilesInPathAreAdjacent g [x] = g `contains` x+subsequentTilesInPathAreAdjacent g (a:b:xs) = +  isAdjacent g a b && subsequentTilesInPathAreAdjacent g (b:xs)++prop_neighbour_cw_directionTo+  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)), +    Eq (Direction (BaseGrid t)))+    ⇒ t → Property+prop_neighbour_cw_directionTo t = nonNull g && a ≠ b ==> +    (neighbour g a d) `elem` nextSteps+  where g = grid t+        (a,b) = twoClosePoints t+        d = head . directionTo g a $ b+        nextSteps = map (!!1) . minimalPaths g a $ b++gridProperties +  ∷ (TestData t, Grid (BaseGrid t), Arbitrary t, +    Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t)), +    Eq (Direction (BaseGrid t))) +    ⇒ String → [(String, t → Property)]+gridProperties s = +  [+    ("prop_indices_are_contained: " ++ s, prop_indices_are_contained),+    ("prop_distance_reflexive: " ++ s, prop_distance_reflexive),+    ("prop_distance_symmetric: " ++ s, prop_distance_symmetric),+    ("prop_custom_MinDistance_eq_default: " ++ s, prop_custom_MinDistance_eq_default),+    ("prop_minDistance_cw_distance: " ++ s, prop_minDistance_cw_distance),+    ("prop_neighbour_count_in_bounds: " ++ s, prop_neighbour_count_in_bounds),+    ("prop_neighbours_are_adjacent: " ++ s, prop_neighbours_are_adjacent),+    ("prop_adjacentTilesToward_moves_closer: " ++ s, prop_adjacentTilesToward_moves_closer),+    ("prop_minimal_paths_have_min_length: " ++ s, prop_minimal_paths_have_min_length),+    ("prop_minimal_paths_are_valid: " ++ s, prop_minimal_paths_are_valid),+    ("prop_neighbour_cw_directionTo: " ++ s, prop_neighbour_cw_directionTo)+  ]++--+-- Tests that should apply to and are identical for all finite grids+--++class TestDataF t where+  expectedTileCount ∷ t → Int+  maxDistance ∷ t → Int++prop_tile_count_correct+  ∷ (TestData t, TestDataF t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_tile_count_correct t = nonNull g ==>+  tileCount g ≡ expectedTileCount t +  where g = grid t++prop_custom_tileCount_eq_default +  ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property+prop_custom_tileCount_eq_default t = nonNull g ==> +  tileCount g ≡ defaultTileCount g+  where g = grid t++prop_distance_in_bounds+  ∷ (TestData t, TestDataF t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_distance_in_bounds t = nonNull g ==> +  0 ≤ n && n ≤ maxDistance t+  where g = grid t+        (a:b:_) = points t+        n = distance g a b++prop_neighbours_cw_viewpoint +  ∷ (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_neighbours_cw_viewpoint t = nonNull g ==> +  sort (delete a (neighbours g a)) ≡ sort expected+  where g = grid t+        (a:_) = points t+        expected = map fst $ filter (\p → 1 ≡ snd p) $ viewpoint g a+-- Note: In a small but unbounded grid, a tile can be its own neighbour.+-- However, when we calculate the distance between a tile and itself, we+-- get 0, not 1. That's why we have to delete the tile from its list +-- before comparing to the result from the neighbours function.++prop_custom_edges_eq_default +  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)), +    Ord (Index (BaseGrid t))) ⇒ t → Property+prop_custom_edges_eq_default t = nonNull g ==> +  sort (edges g) ≡ sort (defaultEdges g)+  where g = grid t++prop_edges_cw_neighbours+  ∷ (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_edges_cw_neighbours t = nonNull g ==> +  sort (neighbours g a) ≡ sort expected+  where g = grid t+        (a:_) = points t+        nEdges = filter (`involves` a) $ edges g+        expected = map f nEdges+        f (b,c) = if a ≡ b then c else b++prop_edges_are_adjacent+  ∷ (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_edges_are_adjacent t = property $ all f $ edges g+  where g = grid t+        f (a, b) = isAdjacent g a b++finiteGridProperties +  ∷ (TestData t, TestDataF t, Grid (BaseGrid t), Arbitrary t, +    Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t))) +    ⇒ String → [(String, t → Property)]+finiteGridProperties s = +  [+    ("prop_tile_count_correct: " ++ s, prop_tile_count_correct),+    ("prop_custom_tileCount_eq_default: " ++ s, prop_custom_tileCount_eq_default),+    ("prop_distance_in_bounds: " ++ s, prop_distance_in_bounds),+    ("prop_neighbours_cw_viewpoint: " ++ s, prop_neighbours_cw_viewpoint),+    ("prop_custom_edges_eq_default: " ++ s, prop_custom_edges_eq_default),+    ("prop_edges_cw_neighbours: " ++ s, prop_edges_cw_neighbours),+    ("prop_edges_are_adjacent: " ++ s, prop_edges_are_adjacent)+  ]++--+-- Tests that should apply to and are identical for all bounded grids+--++class TestDataB t where+  expectedBoundaryCount ∷ t → Int++prop_boundary_count_correct+  ∷ (TestData t, TestDataB t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_boundary_count_correct t = nonNull g ==>+  (length . boundary) g ≡ expectedBoundaryCount t +  where g = grid t++prop_grid_and_boundary_are_both_null_or_not +  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_grid_and_boundary_are_both_null_or_not t = property $+  (P.null . boundary) g ≡ null g+  where g = grid t++prop_boundary_in_grid+  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_boundary_in_grid t = property $+  all (g `contains`) . boundary $ g+  where g = grid t++prop_boundary_tiles_have_fewer_neighbours+  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_boundary_tiles_have_fewer_neighbours t = nonNull g ==>+  g `numNeighbours` b ≤ g `numNeighbours` a+  where g = grid t+        (a:_) = points t+        (b:_) = boundary g++prop_centres_equidistant_from_boundary+  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_centres_equidistant_from_boundary t = nonNull g ==>+  (length . nub . map (minDistance g bs)) cs ≡ 1+  where g = grid t+        bs = boundary g+        cs = centre g++prop_centres_farthest_from_boundary+  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    ⇒ t → Property+prop_centres_farthest_from_boundary t = +  nonNull g && (not . isCentre g) a ==>+    minDistance g bs a ≤ minDistance g bs c+  where g = grid t+        (a:_) = points t+        (c:_) = centre g+        bs = boundary g++boundedGridProperties +  ∷ (TestData t, TestDataB t, BoundedGrid (BaseGrid t), Arbitrary t, +    Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t))) +    ⇒ String → [(String, t → Property)]+boundedGridProperties s = +  [+    ("prop_boundary_count_correct: " ++ s, prop_boundary_count_correct),+    ("prop_grid_and_boundary_are_both_null_or_not: " ++ s, prop_grid_and_boundary_are_both_null_or_not),+    ("prop_boundary_in_grid: " ++ s, prop_boundary_in_grid),+    ("prop_boundary_tiles_have_fewer_neighbours: " ++ s, prop_boundary_tiles_have_fewer_neighbours),+    ("prop_centres_equidistant_from_boundary: " ++ s, prop_centres_equidistant_from_boundary),+    ("prop_centres_farthest_from_boundary: " ++ s, prop_centres_farthest_from_boundary)+  ]