grid 3.1 → 4.0

raw patch · 6 files changed

+940/−414 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• grid.cabal +7/−3
• src/Math/Geometry/Grid.hs +65/−15
• src/Math/Geometry/GridInternal.hs +310/−146
• src/Math/Geometry/GridMap.hs +226/−191
• src/Math/Geometry/GridMap/Lazy.hs +92/−0
• test/Math/Geometry/GridQC.hs +240/−59

@@ -1,5 +1,5 @@ name:           grid-version:        3.1+version:        4.0 synopsis:       Tools for working with regular grids (graphs, lattices). description:    Provides tools for working with regular arrangements                 of tiles, such as might be used in a board game or some@@ -8,7 +8,10 @@                 toroidal layouts.                 The userguide is available at                  <https://github.com/mhwombat/grid/wiki>.-+                .+                NOTE: Version 4.0 uses associated (type) synonyms+                instead of multi-parameter type classes.+                .                 NOTE: Version 3.0 changed the order of parameters                 for many functions. This makes it easier for the user                 to write mapping and folding operations.@@ -31,7 +34,8 @@   ghc-options:     -Wall   exposed-modules: Math.Geometry.Grid,                    Math.Geometry.GridInternal,-                   Math.Geometry.GridMap+                   Math.Geometry.GridMap,+                   Math.Geometry.GridMap.Lazy  test-suite grid-tests   type:            exitcode-stdio-1.0

@@ -12,6 +12,9 @@ -- The userguide is available at  -- <https://github.com/mhwombat/grid/wiki>. --+-- NOTE: Version 4.0 uses associated (type) synonyms instead of +-- multi-parameter type classes.+ -- NOTE: Version 3.0 changed the order of parameters for many functions. -- This makes it easier for the user to write mapping and folding -- operations.@@ -24,18 +27,26 @@   (     -- * The Grid class     Grid(..),+    FiniteGrid(..),     BoundedGrid(..),     -- * Grids with triangular tiles+    UnboundedTriGrid,     TriTriGrid,     triTriGrid,     ParaTriGrid,     paraTriGrid,+    RectTriGrid,+    rectTriGrid,+    TorTriGrid,+    torTriGrid,     -- * Grids with square tiles+    UnboundedSquareGrid,     RectSquareGrid,     rectSquareGrid,     TorSquareGrid,     torSquareGrid,     -- * Grids with hexagonal tiles+    UnboundedHexGrid,     HexHexGrid,     hexHexGrid,     ParaHexGrid,@@ -44,10 +55,12 @@     -- $Example   ) where -import Math.Geometry.GridInternal (Grid(..), BoundedGrid(..), -  TriTriGrid, triTriGrid, ParaTriGrid, paraTriGrid, RectSquareGrid, -  rectSquareGrid, TorSquareGrid, torSquareGrid, HexHexGrid, hexHexGrid, -  ParaHexGrid, paraHexGrid)+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)  {- $Example    Create a grid.@@ -56,14 +69,21 @@ >ghci> indices g >[(-2,0),(-2,1),(-2,2),(-1,-1),(-1,0),(-1,1),(-1,2),(0,-2),(0,-1),(0,0),(0,1),(0,2),(1,-2),(1,-1),(1,0),(1,1),(2,-2),(2,-1),(2,0)] -   Find out the minimum number of moves to go from one tile in a grid to another-   tile, moving between adjacent tiles at each step.+   Find out if the specified index is contained within the grid. +>ghci> g `contains` (0,-2)+>True+>ghci> g `contains` (99,99)+>False++   Find out the minimum number of moves to go from one tile in a grid to+   another tile, moving between adjacent tiles at each step.+ >ghci> distance g (0,-2) (0,2) >4 -   Find out the minimum number of moves to go from one tile in a grid to any -   other tile, moving between adjacent tiles at each step.+   Find out the minimum number of moves to go from one tile in a grid to+   any other tile, moving between adjacent tiles at each step.  >ghci> viewpoint g (1,-2) >[((-2,0),3),((-2,1),3),((-2,2),4),((-1,-1),2),((-1,0),2),((-1,1),3),((-1,2),4),((0,-2),1),((0,-1),1),((0,0),2),((0,1),3),((0,2),4),((1,-2),0),((1,-1),1),((1,0),2),((1,1),3),((2,-2),1),((2,-1),2),((2,0),3)]@@ -73,8 +93,15 @@ >ghci> neighbours g (-1,1) >[(-2,1),(-2,2),(-1,2),(0,1),(0,0),(-1,0)] -   Find out if a tile is within the grid boundary.+   Find how many tiles are adjacent to a particular tile.+   (Note that the result is consistent with the result from the previous+   step.) +>ghci> numNeighbours g (-1,1)+>6++   Find out if an index is valid for the grid.+ >ghci> g `contains` (0,0) >True >ghci> g `contains` (0,12)@@ -85,22 +112,45 @@ >ghci> size g >3 +   Get the list of boundary tiles for a grid.++>ghci> boundary g+>[(-2,2),(-1,2),(0,2),(1,1),(2,0),(2,-1),(2,-2),(1,-2),(0,-2),(-1,-1),(-2,0),(-2,1)]+    Find out the number of tiles in the grid.  >ghci> tileCount g >19 -   Check if a grid is empty (contains no tiles).+   Check if a grid is null (contains no tiles). ->ghci> empty g+>ghci> null g >False->ghci> nonEmpty g+>ghci> nonNull g >True +   Find the central tile(s) (the tile(s) furthest from the boundary).++>ghci> centre g+>[(0,0)]+    Find all of the minimal paths between two points. -ghci> let g = hexHexGrid 3-ghci> minimalPaths g (0,0) (2,-1)-[[(0,0),(1,0),(2,-1)],[(0,0),(1,-1),(2,-1)]]+>ghci> let g = hexHexGrid 3+>ghci> minimalPaths g (0,0) (2,-1)+>[[(0,0),(1,0),(2,-1)],[(0,0),(1,-1),(2,-1)]] +   Find all of the pairs of tiles that are adjacent.++>ghci> edges g+>[((-2,0),(-2,1)),((-2,0),(-1,0)),((-2,0),(-1,-1)),((-2,1),(-2,2)),((-2,1),(-1,1)),((-2,1),(-1,0)),((-2,2),(-1,2)),((-2,2),(-1,1)),((-1,-1),(-1,0)),((-1,-1),(0,-1)),((-1,-1),(0,-2)),((-1,0),(-1,1)),((-1,0),(0,0)),((-1,0),(0,-1)),((-1,1),(-1,2)),((-1,1),(0,1)),((-1,1),(0,0)),((-1,2),(0,2)),((-1,2),(0,1)),((0,-2),(0,-1)),((0,-2),(1,-2)),((0,-1),(0,0)),((0,-1),(1,-1)),((0,-1),(1,-2)),((0,0),(0,1)),((0,0),(1,0)),((0,0),(1,-1)),((0,1),(0,2)),((0,1),(1,1)),((0,1),(1,0)),((0,2),(1,1)),((1,-2),(1,-1)),((1,-2),(2,-2)),((1,-1),(1,0)),((1,-1),(2,-1)),((1,-1),(2,-2)),((1,0),(1,1)),((1,0),(2,0)),((1,0),(2,-1)),((1,1),(2,0)),((2,-2),(2,-1)),((2,-1),(2,0))]++   Find out if two tiles are adjacent.++>ghci> isAdjacent g (-2,0) (-2,1)+>True+>ghci> isAdjacent g (-2,0) (0,1)+>False+ -}+

@@ -11,53 +11,61 @@ -- use @Grid@ instead. This module is subject to change without notice. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, -    FunctionalDependencies, TypeSynonymInstances, FlexibleInstances, -    FlexibleContexts, DeriveGeneric #-}+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}  module Math.Geometry.GridInternal   (     -- * Generic     Grid(..),+    FiniteGrid(..),     BoundedGrid(..),+    WrappedGrid(..),     -- * Grids with triangular tiles+    UnboundedTriGrid,     TriTriGrid,     triTriGrid,     ParaTriGrid,     paraTriGrid,+    RectTriGrid,+    rectTriGrid,+    TorTriGrid,+    torTriGrid,     -- * Grids with square tiles+    UnboundedSquareGrid,     RectSquareGrid,     rectSquareGrid,     TorSquareGrid,     torSquareGrid,     -- * Grids with hexagonal tiles+    UnboundedHexGrid,     HexHexGrid,     hexHexGrid,     ParaHexGrid,     paraHexGrid   ) where +import Prelude hiding (null)+ import Data.Eq.Unicode ((≡), (≠)) import Data.Function (on) import Data.List (groupBy, nub, nubBy, sortBy) import Data.Ord (comparing) import Data.Ord.Unicode ((≤), (≥))-import Data.Serialize (Serialize)-import GHC.Generics (Generic)  -- | A regular arrangement of tiles.---   Minimal complete definition: @indices@, @distance@ and @size@.-class Eq x ⇒ Grid g s x | g → s, g → x where+--   Minimal complete definition: @indices@ and @distance@.+class Grid g where+  type Index g    -- | Returns the indices of all tiles in a grid.-  indices ∷ g → [x]+  indices ∷ g → [Index g]    -- | @'distance' g a b@ returns the minimum number of moves required   --   to get from the tile at index @a@ to the tile at index @b@ in   --   grid @g@, moving between adjacent tiles at each step. (Two tiles   --   are adjacent if they share an edge.) If @a@ or @b@ are not   --   contained within @g@, the result is undefined.-  distance ∷ g → x → x → Int+  distance ∷ g → Index g → Index g → Int    -- | @'minDistance' g bs a@ returns the minimum number of moves    --   required to get from any of the tiles at indices @bs@ to the tile@@ -65,33 +73,28 @@   --   step. (Two tiles are adjacent if they share an edge.) If @a@ or   --   any of @bs@ are not contained within @g@, the result is    --   undefined.-  minDistance ∷ g → [x] → x → Int+  minDistance ∷ g → [Index g] → Index g → Int   minDistance g xs x = minimum . map (distance g x) $ xs -  -- | Returns the dimensions of the grid. -  --   For example, if @g@ is a 4x3 rectangular grid, @'size' g@ would-  --   return @(4, 3)@, while @'tileCount' g@ would return @12@.-  size ∷ g → s-   -- | @'neighbours' g x@ returns the indices of the tiles in the grid   --   @g@ which are adjacent to the tile with index @x@.-  neighbours ∷ g → x → [x]+  neighbours ∷ g → Index g → [Index g]   neighbours g x = filter (\a → distance g x a ≡ 1 ) $ indices g    -- | @'numNeighbours' g x@ returns the number of tiles in the grid   --   @g@ which are adjacent to the tile with index @x@.-  numNeighbours ∷ g → x → Int+  numNeighbours ∷ g → Index g → Int   numNeighbours g = length . neighbours g    -- | @g `'contains'` x@ returns @True@ if the index @x@ is contained    --   within the grid @g@, otherwise it returns false.-  contains ∷ g → x → Bool+  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 → x → [(x, Int)]+  viewpoint ∷ g → Index g → [(Index g, Int)]   viewpoint g p = map f (indices g)     where f x = (x, distance g p x) @@ -101,25 +104,25 @@    -- | Returns @True@ if the number of tiles in a grid is zero, @False@    --   otherwise.-  empty ∷ g → Bool-  empty g = tileCount g ≡ 0+  null ∷ g → Bool+  null g = tileCount g ≡ 0    -- | Returns @False@ if the number of tiles in a grid is zero, @True@    --   otherwise.-  nonEmpty ∷ g → Bool-  nonEmpty = not . empty+  nonNull ∷ g → Bool+  nonNull = not . null    -- | A list of all edges in a grid, where the edges are represented by   --   a pair of indices of adjacent tiles.-  edges ∷ g → [(x,x)]+  edges ∷ Eq (Index g) ⇒ g → [(Index g,Index g)]   edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g    -- | @'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 ∷ Grid g s x ⇒ g → x → x → Bool-  isAdjacent g a b = distance g a b ≡ 1+  isAdjacent ∷ Eq (Index g) ⇒ g → Index g → Index g → Bool+  isAdjacent g a b = a `elem` (neighbours g b)    -- | @'adjacentTilesToward' g a b@ returns the indices of all tiles   --   which are neighbours of the tile at index @a@, and which are@@ -127,10 +130,8 @@   --   the possible next steps on a minimal path from @a@ to @b@. If @a@   --   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 → x → x → [x]-  adjacentTilesToward g a b-    | a ≡ b            = []-    | otherwise        = filter f $ neighbours g a+  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    -- | @'minimalPaths' g a b@ returns a list of all minimal paths from @@ -144,7 +145,7 @@   --   @'adjacentTilesToward'@. If you want to use a custom algorithm,   --   consider modifying @'adjacentTilesToward'@ instead of    --   @'minimalPaths'@.-  minimalPaths ∷ g → x → x → [[x]]+  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@@ -154,62 +155,98 @@ sameEdge ∷ Eq t ⇒ (t, t) → (t, t) → Bool sameEdge (a,b) (c,d) = (a,b) ≡ (c,d) || (a,b) ≡ (d,c) -adjacentEdges ∷ Grid g s t ⇒ t → g → [(t, t)]+adjacentEdges ∷ Grid g ⇒ Index g → g → [(Index g, Index g)] adjacentEdges i g = map (\j → (i,j)) $ neighbours g i  +-- | A regular arrangement of tiles where the number of tiles is finite.+--   Minimal complete definition: @size@.+class Grid g ⇒ FiniteGrid g where+  type Size s+  -- | Returns the dimensions of the grid. +  --   For example, if @g@ is a 4x3 rectangular grid, @'size' g@ would+  --   return @(4, 3)@, while @'tileCount' g@ would return @12@.+  size ∷ g → Size g++ -- | A regular arrangement of tiles with an edge.---   Minimal complete definition: @boundary@.-class Grid g s x ⇒ BoundedGrid g s x where-  -- | Returns a the indices of all the tiles at the boundary of a grid, -  --   including corner tiles.-  boundary ∷ g → [x]+--   Minimal complete definition: @tileSideCount@.+class Grid g ⇒ BoundedGrid g where+  -- | Returns the number of sides a tile has+  tileSideCount ∷ g → Int +  -- | 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+          f (_,n) = n < tileSideCount g ++   -- | @'isBoundary' g x@' returns @True@ if the tile with index @x@ is   --   on a boundary of @g@, @False@ otherwise. (Corner tiles are also   --   boundary tiles.)-  isBoundary ∷ g → x → Bool+  isBoundary ∷ Eq (Index g) ⇒ g → Index g → Bool   isBoundary g x = x `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 → [x]-  centre g = map fst . head . reverse . groupBy ((==) `on` snd) . +  centre ∷ g → [Index g]+  centre g = map fst . head . reverse . groupBy ((≡) `on` snd) .                  sortBy (comparing snd) $ xds-    where xds = map (\y -> (y, minDistance g bs y)) $ indices g+    where xds = map (\y → (y, minDistance g bs y)) $ indices g           bs = boundary g     -- | @'isCentre' g x@' returns @True@ if the tile with index @x@ is   --   a centre tile of @g@, @False@ otherwise.-  isCentre ∷ g → x → Bool+  isCentre ∷ Eq (Index g) ⇒ g → Index g → Bool   isCentre g x = x `elem` centre g +class (Grid g) ⇒ WrappedGrid g where+  normalise ∷ 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]+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+distanceBasedOn u g a b = +  if g `contains` a && g `contains` b+    then distance u a b+    else undefined+ -- -- Triangular tiles -- +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 | even y    = -x - y-         | otherwise = -x - y + 1--triDistance ∷ Grid g s (Int, Int) ⇒ g → (Int, Int) → (Int, Int) → Int-triDistance g (x1, y1) (x2, y2) = -    if g `contains` (x1, y1) && g `contains` (x2, y2)-      then maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]-      else undefined-        where z1 = triZ x1 y1-              z2 = triZ x2 y2--triNeighbours ∷ Grid g s (Int, Int) ⇒ g → (Int, Int) → [(Int, Int)]-triNeighbours g (x,y) = filter (g `contains`) xs-    where xs | even y    = [(x-1,y+1), (x+1,y+1), (x+1,y-1)]-             | otherwise = [(x-1,y-1), (x-1,y+1), (x+1,y-1)]+triZ x y = if even y then -x - y else -x - y + 1  -- -- Triangular grids with triangular tiles@@ -218,29 +255,28 @@ -- | 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, Generic)+data TriTriGrid = TriTriGrid Int [(Int, Int)] deriving Eq  instance Show TriTriGrid where    show (TriTriGrid s _) = "triTriGrid " ++ show s -instance Serialize TriTriGrid--instance Grid TriTriGrid Int (Int, Int) where+instance Grid TriTriGrid where+  type Index TriTriGrid = (Int, Int)   indices (TriTriGrid _ xs) = xs-  neighbours = triNeighbours-  distance = triDistance-  contains (TriTriGrid s _) (x, y) = inTriGrid (x,y) s-  size (TriTriGrid s _) = s+  neighbours = neighboursBasedOn UnboundedTriGrid+  distance = distanceBasedOn UnboundedTriGrid+  contains (TriTriGrid s _) (x, y) = inTriTriGrid (x,y) s -inTriGrid ∷ (Int, Int) → Int → Bool-inTriGrid (x, y) s = x ≥ 0 && y ≥ 0 && even (x+y) && abs z ≤ 2*s-2+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 BoundedGrid TriTriGrid Int (Int, Int) where---  corners g = if empty g ---                then [] ---                else nub [(0,0), (0,2*s-2), (2*s-2, 0)] ---    where s = size g+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]]@@ -252,19 +288,17 @@     2 → [(k+1,k+1)] where k = (2*(s-2)) `div` 3     _ → error "This will never happen."     where s = size g--trefoilWithTop ∷ (Int, Int) → [(Int,Int)]-trefoilWithTop (i,j) = [(i,j), (i+2, j-2), (i,j-2)]+          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 empty and the list of indices will be null.+--   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) `inTriGrid` s]+                          (xx,yy) `inTriTriGrid` s]  -- -- Parallelogrammatical grids with triangular tiles@@ -273,80 +307,194 @@ -- | 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, Generic)+data ParaTriGrid = ParaTriGrid (Int, Int) [(Int, Int)] deriving Eq  instance Show ParaTriGrid where    show (ParaTriGrid (r,c) _) = "paraTriGrid " ++ show r ++ " " ++ show c -instance Serialize ParaTriGrid--instance Grid ParaTriGrid (Int, Int) (Int, Int) where+instance Grid ParaTriGrid where+  type Index ParaTriGrid = (Int, Int)   indices (ParaTriGrid _ xs) = xs-  neighbours = triNeighbours-  distance = triDistance+  neighbours = neighboursBasedOn UnboundedTriGrid+  distance = distanceBasedOn UnboundedTriGrid++instance FiniteGrid ParaTriGrid where+  type Size ParaTriGrid = (Int, Int)   size (ParaTriGrid s _) = s -instance BoundedGrid ParaTriGrid (Int, Int) (Int, Int) where+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 = paraTriGridCentre . size $ g--paraTriGridCentre ∷ (Int, Int) → [(Int, Int)]-paraTriGridCentre (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 :: (Int,Int) -> [(Int,Int)]-bowtie (i,j) = [(i,j), (i+1,j+1)]+  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 empty and+--   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)+++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-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++-- | @'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)]+    else undefined+  where xMax c2 y = xMinTorTri y + 2*(c2-1)+++--+-- Square tiles+--++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, Generic)+data RectSquareGrid = RectSquareGrid (Int, Int) [(Int, Int)] deriving Eq  instance Show RectSquareGrid where    show (RectSquareGrid (r,c) _) =      "rectSquareGrid " ++ show r ++ " " ++ show c -instance Serialize RectSquareGrid--instance Grid RectSquareGrid (Int, Int) (Int, Int) where+instance Grid RectSquareGrid where+  type Index RectSquareGrid = (Int, Int)   indices (RectSquareGrid _ xs) = xs-  neighbours g (x, y) = -    filter (g `contains`) [(x-1,y), (x,y+1), (x+1,y), (x,y-1)]-  distance g (x1, y1) (x2, y2) = -    if g `contains` (x1, y1) && g `contains` (x2, y2)-      then abs (x2-x1) + abs (y2-y1)-      else undefined-  size (RectSquareGrid s _) = s+  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 BoundedGrid RectSquareGrid (Int, Int) (Int, Int) where+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 @@ -370,7 +518,7 @@ -- | @'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 empty and the list of indices will be +--   the resulting grid will be null and the list of indices will be  --   null. rectSquareGrid ∷ Int → Int → RectSquareGrid rectSquareGrid r c = @@ -383,31 +531,38 @@ -- | 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, Generic)+data TorSquareGrid = TorSquareGrid (Int, Int) [(Int, Int)] deriving Eq  instance Show TorSquareGrid where    show (TorSquareGrid (r,c) _) = "torSquareGrid " ++ show r ++ " " ++ show c -instance Serialize TorSquareGrid--instance Grid TorSquareGrid (Int, Int) (Int, Int) where+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 (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) =     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+ -- | @'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 empty and the list of indices will be null.+--   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]] @@ -415,14 +570,19 @@ -- Hexagonal tiles -- -hexDistance ∷ Grid g s (Int, Int) ⇒ g → (Int, Int) → (Int, Int) → Int-hexDistance g (x1, y1) (x2, y2) = -  if g `contains` (x1, y1) && g `contains` (x2, y2)-    then maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]-    else undefined-  where z1 = -x1 - y1-        z2 = -x2 - y2+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 --@@ -430,20 +590,22 @@ -- | 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, Generic)+data HexHexGrid = HexHexGrid Int [(Int, Int)] deriving Eq  instance Show HexHexGrid where show (HexHexGrid s _) = "hexHexGrid " ++ show s -instance Serialize HexHexGrid--instance Grid HexHexGrid Int (Int, Int) where+instance Grid HexHexGrid where+  type Index HexHexGrid = (Int, Int)   indices (HexHexGrid _ xs) = xs-  neighbours g (x,y) = filter (g `contains`) -    [(x-1,y), (x-1,y+1), (x,y+1), (x+1,y), (x+1,y-1), (x,y-1)]-  distance = hexDistance+  neighbours = neighboursBasedOn UnboundedHexGrid+  distance = distanceBasedOn UnboundedHexGrid++instance FiniteGrid HexHexGrid where+  type Size HexHexGrid = Int   size (HexHexGrid s _) = s -instance BoundedGrid HexHexGrid Int (Int, Int) where+instance BoundedGrid HexHexGrid where+  tileSideCount _ = 6   boundary g =      north ++ northeast ++ southeast ++ south ++ southwest ++ northwest     where s = size g@@ -458,7 +620,7 @@ -- | @'hexHexGrid' s@ returns a grid of hexagonal shape, with --   sides of length @s@, using hexagonal tiles. If @s@ is nonnegative, the  --   resulting grid will have @3*s*(s-1) + 1@ tiles. Otherwise, the resulting ---   grid will be empty and the list of indices will be null.+--   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]@@ -470,28 +632,30 @@ -- | 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, Generic)+data ParaHexGrid = ParaHexGrid (Int, Int) [(Int, Int)] deriving Eq  instance Show ParaHexGrid where    show (ParaHexGrid (r,c) _) = "paraHexGrid " ++ show r ++ " " ++ show c -instance Serialize ParaHexGrid--instance Grid ParaHexGrid (Int, Int) (Int, Int) where+instance Grid ParaHexGrid where+  type Index ParaHexGrid = (Int, Int)   indices (ParaHexGrid _ xs) = xs-  neighbours g (x,y) = filter (g `contains`) -    [(x-1,y), (x-1,y+1), (x,y+1), (x+1,y), (x+1,y-1), (x,y-1)]-  distance = hexDistance+  neighbours = neighboursBasedOn UnboundedHexGrid+  distance = distanceBasedOn UnboundedHexGrid++instance FiniteGrid ParaHexGrid where+  type Size ParaHexGrid = (Int, Int)   size (ParaHexGrid s _) = s -instance BoundedGrid ParaHexGrid (Int, Int) (Int, Int) where+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 empty and the list of indices will +--   Otherwise, the resulting grid will be null and the list of indices will  --   be null. paraHexGrid ∷ Int → Int → ParaHexGrid paraHexGrid r c = 

@@ -1,42 +1,57 @@------------------------------------------------------------------------------+------------------------------------------------------------------------ -- | -- Module      :  Math.Geometry.GridMap--- Copyright   :  (c) Amy de Buitléir 2012+-- Copyright   :  (c) Amy de Buitléir 2012-2013 -- License     :  BSD-style -- Maintainer  :  amy@nualeargais.ie -- Stability   :  experimental -- Portability :  portable -- -- Ordered maps from tiles on a grid to values.--- This module is a wrapper around @'Math.Geometry.Grid'@ and @'Data.Map'@,--- in order to combine the functionality of grids and maps into a single type.+-- This module is a wrapper around @'Math.Geometry.Grid'@ and +-- @'Data.Map'@, in order to combine the functionality of grids and maps+-- into a single type. ---------------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FlexibleInstances, -    UndecidableInstances #-}+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts, +    MultiParamTypeClasses, UndecidableInstances #-}  module Math.Geometry.GridMap   (     -- * Differences between @GridMap@ and @Map@.     -- $Compare -    -- * Map type+    -- * Map classes and types     GridMap,+    BaseGrid,+    G.Index,+    G.Grid, -    -- * Construction-    lazyGridMap,+    -- * Deconstruction+    toMap,+    toGrid,+    toList,      -- * Grid functions-    indices,-    distance,-    size,-    neighbours,-    contains,-    viewpoint,-    tileCount,-    empty,-    nonEmpty,-    +    G.indices,+    G.distance,+    G.minDistance,+    G.neighbours,+    G.numNeighbours,+    G.contains,+    G.viewpoint,+    G.tileCount,+    G.null,+    G.nonNull,+    G.edges,+    G.isAdjacent,+    G.adjacentTilesToward,+    G.minimalPaths,+    G.size,+    G.boundary,+    G.isBoundary,+    G.centre,+    G.isCentre,          -- * Map functions     -- ** Operators@@ -50,209 +65,229 @@     adjust,     adjustWithKey, -    -- ** Map+    -- ** Traversal     map,     mapWithKey,-    mapAccum,-    mapAccumWithKey,      -- ** Folds-    fold,-    foldWithKey,-    fold',-    foldWithKey',+--    fold,+--    foldMap,+    M.foldr,+    M.foldr',+    M.foldl,+    M.foldl',      -- ** Conversion-    elems,-    keysSet,--    -- ** Lists-    toList+    elems   ) where -import Prelude hiding (lookup, map)+import Prelude hiding (lookup, map, foldr, foldl, foldr1, foldl1, null)++import qualified Prelude as P (map)+import Data.Foldable (Foldable) import qualified Data.Map as M --import qualified Data.Map.Strict as Strict (Map)-import Data.Maybe (fromMaybe)-import Data.Set (Set)-import Math.Geometry.Grid (Grid(..))---- | A Map from tile positions in a grid to values. -data GridMap g k v = LGridMap { toGrid ∷ g, toMap ∷ M.Map k v }-  deriving Eq--- Future: add alternative constructor for strict maps--instance (Show g, Show v) ⇒ Show (GridMap g k v) where-  show (LGridMap g m) = "lazyGridMap (" ++ show g ++ ") " ++ show (M.elems m)---- | Construct a grid map which is strict in the keys (tile positions), but---   lazy in the values.-lazyGridMap ∷ (Ord k, Grid g s k) ⇒ g → [v] → GridMap g k v-lazyGridMap g vs = LGridMap g (M.fromList kvs)-  where kvs = zip ks vs-        ks = indices g--instance (Eq k, Grid g s k) ⇒ Grid (GridMap g k v) s k where-  indices = indices . toGrid-  distance g = distance (toGrid g)-  size = size . toGrid-  neighbours g k = toGrid g `neighbours` k-  contains g k = toGrid g `contains` k-  viewpoint g k = toGrid g `viewpoint` k-  tileCount  = tileCount . toGrid-  empty = empty . toGrid-  nonEmpty = nonEmpty . toGrid---- | /O(min(n,W))/. Find the value at a tile position in the grid.--- Calls 'error' when the element can not be found.-(!) ∷ Ord k ⇒ GridMap g k v → k → v-(!) m k = toMap m M.! k--modifyMap ∷ (M.Map k a → M.Map k b) → GridMap g k a → GridMap g k b-modifyMap f m = m { toMap = f (toMap m)}--applyToMap ∷ (M.Map k v → c) → GridMap g k v → c-applyToMap f = f . toMap---- | /O(min(n,W))/. Lookup the value at a tile position in the grid map.-lookup ∷ Ord k ⇒ k → GridMap g k v → Maybe v-lookup k = applyToMap $ M.lookup k---- | /O(min(n,W))/. Adjust a value at a specific tile position. When the tile--- is not within the bounds of the grid map, the original grid map is--- returned.-adjust ∷ Ord k ⇒ (v → v) → k → GridMap g k v → GridMap g k v-adjust f k = modifyMap (M.adjust f k)---- | /O(min(n,W))/. Adjust a value at a specific key. When the tile--- is not within the bounds of the grid map, the original grid map is--- returned.-adjustWithKey ∷ Ord k ⇒ (k → v → v) → k → GridMap g k v → GridMap g k v-adjustWithKey f k = modifyMap (M.adjustWithKey f k)+import qualified Math.Geometry.Grid as G --- | /O(min(n,W))/. The expression @('findWithDefault' def k map)@--- returns the value at tile position @k@ or returns @def@ when the tile--- is not within the bounds of the grid map.-findWithDefault ∷ Ord k ⇒ v → k → GridMap g k v → v-findWithDefault v k m = fromMaybe v $ applyToMap (M.lookup k) m+-- | A regular arrangement of tiles, having a value associated with+--   each tile.+--   Minimal complete definition: @toMap@, @toGrid@, @adjustWithKey@,+--   @mapWithKey.+--+--   Note: Some of the methods have an @Ord@ constraint on the grid +--   index. This is purely to make it easier to write implementations.+--   While tile positions can be ordered (e.g., @(1,2) < (2,1)@), the+--   ordering may not be particularly meaningful. (Comparisons such as +--   /east of/ or /south of/ may be more sensible.) However, it is+--   convenient to write implementations of this class using+--   @Data.Map@, with the grid indices as keys. Many of the functions+--   in @Data.Map@ impose the @Ord@ constraint on map keys, so we'll+--   live with it. In summary, to use some methods in this class, your+--   grid indices must be orderable.+class (G.Grid (BaseGrid gm v), Foldable gm) ⇒ +    GridMap (gm ∷ * → *) v where+  type BaseGrid gm v --- | /O(n)/. Map a function over all values in the grid map.-map ∷ (a → b) → GridMap g k a → GridMap g k b-map f = modifyMap (M.map f)+  -- | Find the value at a tile position in the grid.+  (!) ∷ (k ~ (G.Index (BaseGrid gm v)), Ord k) ⇒ gm v → k → v+  (!) gm k = toMap gm M.! k --- | /O(n)/. Map a function over all values in the grid map.-mapWithKey ∷ (k → a → b) → GridMap g k a → GridMap g k b-mapWithKey f = modifyMap (M.mapWithKey f)+  -- | Returns a map of grid indices to values.+  toMap ∷ k ~ (G.Index (BaseGrid gm v)) ⇒ gm v → M.Map k v --- | /O(n)/. The function @'mapAccum'@ threads an accumulating--- argument through the grid map.--- WARNING: The order in which the elements are processed is not guaranteed.-mapAccum ∷ (a → b → (a, c)) → a → GridMap g k b → (a, GridMap g k c)-mapAccum f = mapAccumWithKey (\a _ x → f a x)+  -- | Returns the grid on which this map is based.+  toGrid ∷ gm v → BaseGrid gm v --- | /O(n)/. The function @'mapAccumWithKey'@ threads an accumulating--- argument through the grid map.--- WARNING: The order in which the elements are processed is not guaranteed.-mapAccumWithKey ∷ -  (a → k → b → (a, c)) → a → GridMap g k b → (a, GridMap g k c)-mapAccumWithKey f a gm = (b, gm {toMap=m'})-  where (b, m') = applyToMap (M.mapAccumWithKey f a) gm+  -- | Convert the map to a list of key/value pairs.+  toList ∷ k ~ (G.Index (BaseGrid gm v)) ⇒ gm v → [(k, v)]+  toList = M.toList . toMap --- | /O(n)/. Fold the values in the grid map using the given left-associative--- binary operator.--- WARNING: The order in which the elements are processed is not guaranteed.-fold ∷ (a → b → a) → a → GridMap g k b → a-fold f x = applyToMap (M.foldl f x)+  -- | Lookup the value at a tile position in the grid map.+  lookup ∷ (k ~ (G.Index (BaseGrid gm v)), Ord k) ⇒ k → gm v → Maybe v+  lookup k = M.lookup k . toMap --- | /O(n)/. Fold the keys and values in the grid map using the given --- left-associative binary operator.--- WARNING: The order in which the elements are processed is not guaranteed.-foldWithKey ∷ (a → k → b → a) → a → GridMap g k b → a-foldWithKey f x = applyToMap (M.foldlWithKey f x)+  -- | Adjust a value at a specific tile position. When the tile is not+  --   within the bounds of the grid map, the original grid map is+  --   returned.+  adjust ∷ (k ~ (G.Index (BaseGrid gm v)), Ord k) ⇒ +    (v → v) → k → gm v → gm v+  adjust f = adjustWithKey (\_ v → f v) --- | /O(n)/. A strict version of 'fold'.-fold' ∷ (a → b → a) → a → GridMap g k b → a-fold' f x = applyToMap (M.foldl' f x)+  -- | Adjust a value at a specific tile position. When the tile is not+  --   within the bounds of the grid map, the original grid map is+  --   returned.+  adjustWithKey ∷ (k ~ (G.Index (BaseGrid gm v)), Ord k) ⇒ +    (k → v → v) → k → gm v → gm v --- | /O(n)/. A strict version of 'foldWithKey'.-foldWithKey' ∷ (a → k → b → a) → a → GridMap g k b → a-foldWithKey' f x = applyToMap (M.foldlWithKey' f x)+  -- | The expression @('findWithDefault' def k map)@ returns the value+  --   at tile position @k@ or returns @def@ when the tile is not within+  --   the bounds of the grid map.+  findWithDefault ∷ (k ~ (G.Index (BaseGrid gm v)), Ord k) ⇒ +    v → k → gm v → v+  findWithDefault v k = M.findWithDefault v k . toMap --- | /O(n)/.--- Return all elements of the grid map. The order is not guaranteed.-elems ∷ GridMap g k a → [a]-elems = applyToMap M.elems+  -- | Returns all values in the map +  elems ∷ gm v → [v]+  elems = M.elems . toMap --- | /O(n*min(n,W))/. The set of all tile positions in the grid map.-keysSet ∷ GridMap g k a → Set k-keysSet = applyToMap M.keysSet+  -- | Map a function over all values in the map.+  map ∷ GridMap gm b ⇒ (v → b) → gm v → gm b+  map f = mapWithKey (\_ v → f v) --- | /O(n)/. Returns all key (tile position)\/value pairs in the grid map.-toList ∷ GridMap g k a → [(k, a)]-toList = applyToMap M.toList+  -- | Map a function over all values in the map.+  mapWithKey +    ∷ (k ~ G.Index (BaseGrid gm v), GridMap gm v2) ⇒ +      (k → v → v2) → gm v → gm v2  {- $Compare Some functions in @Data.Map@ have been replaced in @GridMap@. These changes are listed in the table below.  @-Map function    | corresponding GridMap function-----------------+--------------------------------assocs          | 'toList'-empty           | 'lazyGridMap' g []-foldl           | 'fold'-foldl'          | 'fold''-foldlWithKey    | 'foldWithKey'-foldlWithKey'   | 'foldWithKey''-foldr           | 'fold'-foldr'          | 'fold''-foldrWithKey    | 'foldWithKey'-foldrWithKey'   | 'foldWithKey''-fromList        | 'lazyGridMap'-fromListWithKey | 'lazyGridMap'-fromListWith    | 'lazyGridMap'-fromSet         | 'lazyGridMap'-keys            | 'indices'-member          | 'inGrid'-notMember       | not 'inGrid'-null            | 'empty'-singleton       | 'lazyGridMap' g [v]-size            | 'size', 'tileCount'+Map function        | corresponding GridMap function+--------------------+----------------------------------------------+!                   | !+\\                  | See note 1+empty               | 'lazyGridMap' g []+findWithDefault     | 'findWithDefault'+insert              | See notes 1, 2+lookup              | 'lookup'+lookupLE            | See notes 1, 3+lookupLT            | See notes 1, 3+lookupGE            | See notes 1, 3+lookupGT            | See notes 1, 3+member              | 'inGrid'+notMember           | not 'inGrid'+null                | 'null'+singleton           | 'lazyGridMap' g [v]+size                | 'size', 'tileCount'*+insert              | See notes 1, 2+insertWith          | See notes 1, 2+insertWithKey       | See notes 1, 2+insertLookupWithKey | See notes 1, 2+delete              | See notes 1, 2+adjust              | 'adjust'+adjustWithKey       | 'adjustWithKey'+update              | See notes 1, 2+updateWithKey       | See notes 1, 2+updateLookupWithKey | See notes 1, 2+alter               | See notes 1, 2+union               | See notes 1, 2+unionWith           | See notes 1, 2+unionWithKey        | See notes 1, 2+unions              | See notes 1, 2+unionsWith          | See notes 1, 2+difference          | See notes 1, 2+differenceWith      | See notes 1, 2+differenceWithKey   | See notes 1, 2+intersection        | See notes 1, 2+intersectionWith    | See notes 1, 2+intersectionWithKey | See notes 1, 2+mergeWithKey        | See notes 1, 2+M.map               | fmap, or see note 1+mapWithKey          | See note 1+traverseWithKey     | See notes 1, 2+mapAccum            | See note 1+mapAccumWithKey     | See note 1+mapAccumRWithKey    | See note 1+mapKeys             | See note 1+mapKeysWith         | See note 1+mapKeysMonotonic    | See note 1+foldr               | See note 1+foldl               | See note 1+foldrWithKey        | See note 1+foldlWithKey        | See note 1+foldr'              | See note 1+foldl'              | See note 1+foldrWithKey'       | See note 1+foldlWithKey'       | See note 1+elems               | 'elems'+keys                | 'indices'+assocs              | See note 1+keysSet             | See note 1+fromSet             | 'lazyGridMap' (constructor)+toList              | See note 1+fromList            | 'lazyGridMap' (constructor)+fromListWithKey     | 'lazyGridMap' (constructor)+fromListWith        | 'lazyGridMap' (constructor)+toAscList           | See notes 1, 3+toDescList          | See notes 1, 3+fromAscList         | See notes 1, 3+fromAscListWith     | See notes 1, 3+fromAscListWithKey  | See notes 1, 3+fromDistinctAscList | See notes 1, 3+filter              | See notes 1, 2+filterWithKey       | See notes 1, 2+partition           | See notes 1, 2+partitionWithKey    | See notes 1, 2+mapMaybe            | See notes 1, 2+mapMaybeWithKey     | See notes 1, 2+mapEither           | See notes 1, 2+mapEitherWithKey    | See notes 1, 2+split               | See notes 1, 2+splitLookup         | See notes 1, 2+isSubmapOf          | See note 1+isSubmapOfBy        | See note 1+isProperSubmapOf    | See note 1+isProperSubmapOfBy  | See note 1+lookupIndex         | See note 1+findIndex           | See note 1+elemAt              | See note 1+updateAt            | See note 1+deleteAt            | See notes 1, 2+findMin             | See notes 1, 3+findMax             | See notes 1, 3+deleteMin           | See notes 1, 2, 3+deleteMax           | See notes 1, 2, 3+deleteFindMin       | See notes 1, 2, 3+deleteFindMax       | See notes 1, 2, 3+updateMin           | See notes 1, 2, 3+updateMax           | See notes 1, 2, 3+updateMinWithKey    | See notes 1, 2, 3+updateMaxWithKey    | See notes 1, 2, 3+minView             | See notes 1, 3+maxView             | See notes 1, 3+minViewWithKey      | See notes 1, 2, 3+maxViewWithKey      | See notes 1, 2, 3+showTree            | See note 1+showTreeWith        | See note 1+valid               | See note 1 @ -The functions (\\), @alter@, @delete@, @deleteFindMax@, @deleteFindMin@,-@deleteMax@, @deleteMin@, @difference@, @differenceWith@, @differenceWithKey@,-@filter@, @filterWithKey@, @insert@, @insertLookupWithKey@, @insertWith@,-@insertWithKey@, @intersection@, @intersectionWith@, @intersectionWithKey@,-@isProperSubmapOf@, @isProperSubmapOfBy@, @isSubmapOf@, @isSubmapOf@,-@isSubmapOfBy@, @mapEither@, @mapEitherWithKey@, @mapKeys@, @mapKeysWith@,-@mapMaybe@, @mapMaybeWithKey@, @mergeWithKey@, @partition@,-@partitionWithKey@, @split@, @splitLookup@, @traverseWithKey@, @union@,-@unions@, @unionsWith@, @unionWith@, @unionWithKey@, @update@,-@updateLookupWithKey@ and @updateWithKey@ are not implemented because the-resulting map might have different dimensions than the original, or because-they combine maps of different dimensions. -As a result, these functions may not be as useful for grid maps.-If you need one of these functions, you can extract the map using @toMap@-and apply the function from @Data.Map@ to the result.+Notes:+1. You can extract the map using @'toMap'@ and apply the function from+@Data.Map@ to the result. -The functions @deleteAt@, @elemAt@, @findIndex@, @findMax@, @findMin@, -@fromAscList@, @fromAscListWith@, @fromAscListWithKey@, @fromDistinctAscList@,-@lookupGE@, @lookupGT@, @lookupIndex@, @lookupLE@, @lookupLT@, -@mapAccumRWithKey@, @mapKeysMonotonic@, @maxView@, @maxViewWithKey@, -@minView@, @minViewWithKey@, @toAscList@, @toDescList@, @updateAt@, -@updateMax@, @updateMaxWithKey@, @updateMin@ and @updateMinWithKey@ are not-implemented because they rely on a meaningful ordering of keys.-While tile positions can be ordered (e.g., @(1,2) < (2,1)@), the ordering-may not be relevant to grid maps.-(Comparisons such as /east of/ or /south of/ may be more meaningful.)-If you need one of these functions, you can extract the map using @toMap@-and apply the function from @Data.Map@ to the result.+2. Not implemented because the resulting map might have different +dimensions than the original input @GridMap@(s). However, you can+extract the map using @'toMap'@ and apply the function from @Data.Map@+to the result. -The debugging functions @showTree@, @showTreeWith@ and @valid@ are not-implemented.-If you need one of these functions, you can extract the map using @toMap@-and apply the function from @Data.Map@ to the result.+3. Not implemented because, although tile positions can be ordered+(e.g., @(1,2) < (2,1)@), the ordering may not be meaningful for grid +maps. Comparisons such as /east of/ or /south of/ may be more useful.+However, you can extract the map using @'toMap'@ and apply the function+from @Data.Map@ to the result. -}  

@@ -0,0 +1,92 @@+------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.GridMap+-- Copyright   :  (c) Amy de Buitléir 2012-2013+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- Ordered maps from tiles on a grid to values.+-- This module is a wrapper around @'Math.Geometry.Grid'@ and +-- @'Data.Map'@, in order to combine the functionality of grids and maps+-- into a single type.+--+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts,+    FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}++module Math.Geometry.GridMap.Lazy+  (+    LGridMap,+    lazyGridMap+  ) where++import Prelude hiding (lookup, map, foldr, foldl, foldr1, foldl1, null)++import qualified Prelude as P (map)+import Data.Eq.Unicode ((≡))+import qualified Data.Foldable as F (Foldable(..))+import qualified Data.Map as M+--import qualified Data.Map.Strict as Strict (Map)+import Data.Maybe (fromMaybe)+import qualified Math.Geometry.Grid as G+import Math.Geometry.GridMap++-- | A map from tile positions in a grid to values. +data LGridMap g v = +  LGridMap { lgmGrid ∷ g, lgmMap ∷ M.Map (G.Index g) v }++-- | Construct a grid map which is strict in the keys (tile positions), but+--   lazy in the values.+lazyGridMap ∷ (Ord (G.Index g), G.Grid g) ⇒ g → [v] → LGridMap g v+lazyGridMap g vs = LGridMap g (M.fromList kvs)+  where kvs = zip ks vs+        ks = G.indices g++instance (G.Grid g, Ord (G.Index g)) ⇒ Functor (LGridMap g) where+  fmap f gm = lazyGridMap (lgmGrid gm) (P.map f vs)+    where vs = M.elems (lgmMap gm)++instance F.Foldable (LGridMap g) where+  fold = F.fold . lgmMap+  foldMap f g = F.foldMap f (lgmMap g)+  foldr f x g = F.foldr f x (lgmMap g)+  foldr' f x g = F.foldr' f x (lgmMap g)+  foldl f x g = F.foldl f x (lgmMap g)+  foldl' f x g = F.foldl' f x (lgmMap g)+--  foldr1 f x g = foldr1 f x (lgmMap g)+--  foldl1 f x g = foldl1 f x (lgmMap g)++instance G.Grid g ⇒ G.Grid (LGridMap g v) where+  type Index (LGridMap g v) = G.Index g+  indices = G.indices . lgmGrid+  distance g = G.distance (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+  tileCount  = G.tileCount . lgmGrid+  null = G.null . lgmGrid+  nonNull = G.nonNull . lgmGrid++instance G.FiniteGrid g ⇒ G.FiniteGrid (LGridMap g v) where+  type Size (LGridMap g v) = G.Size g+  size (LGridMap g _) = G.size g++instance (G.Grid g) ⇒ GridMap (LGridMap g) v where+  type BaseGrid (LGridMap g) v = g+  (!) gm k = toMap gm M.! k+  toMap = lgmMap+  toGrid = lgmGrid+  lookup k = M.lookup k . toMap+  adjustWithKey f k gm = gm { lgmMap = M.adjustWithKey f k (lgmMap gm)}+  findWithDefault v k = fromMaybe v . lookup k+  map f (LGridMap g m) = LGridMap g (M.map f m)+  mapWithKey f (LGridMap g m) = LGridMap g (M.mapWithKey f m)++instance (Eq g, Eq (G.Index g), Eq v) ⇒ Eq (LGridMap g v) where+  (==) (LGridMap g1 gm1) (LGridMap g2 gm2) = g1 ≡ g2 && gm1 ≡ gm2++instance (Show g, Show v) ⇒ Show (LGridMap g v) where+  show (LGridMap g m) = "lazyGridMap (" ++ show g ++ ") " ++ show (M.elems m)+

@@ -1,4 +1,5 @@-{-# LANGUAGE UnicodeSyntax, ExistentialQuantification #-}+{-# LANGUAGE UnicodeSyntax, FlexibleContexts, ExistentialQuantification,+    TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Math.Geometry.GridQC@@ -8,8 +9,10 @@  import Math.Geometry.GridInternal  +import Prelude hiding (null)+import qualified Prelude as P (null) import Data.Eq.Unicode ((≡), (≠))-import Data.List (nub, sort)+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)@@ -24,7 +27,7 @@   where n' = fromIntegral n ∷ Float  -- Given an arbitrary integer, select a corresponding point in the grid.-pointAt ∷ Grid g s x ⇒ g → Int → x+pointAt ∷ Grid g ⇒ g → Int → Index g pointAt g i = indices g !! (i `mod` n)   where n = (length . indices) g @@ -32,69 +35,78 @@ -- Tests that should apply to and are identical for all grids -- -prop_distance_reflexive ∷ Grid g s x ⇒ g → Int → Property-prop_distance_reflexive g i = nonEmpty g ==> distance g a a ≡ 0+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 s x ⇒ g → Int → Int → Property+prop_distance_symmetric ∷ Grid g ⇒ g → Int → Int → Property prop_distance_symmetric g i j = -  nonEmpty g ==> distance g a b ≡ distance g b a+  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 s x ⇒ g → Int → [Int] → Property+prop_minDistance_cw_distance ∷ Grid g ⇒ g → Int → [Int] → Property prop_minDistance_cw_distance g i js = -  nonEmpty g && (not . null) 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 s x, Ord x) ⇒ g → Int → Property-prop_neighbours_cw_viewpoint g i = n > 0 ==> -  sort (neighbours g a) ≡ sort expected-    where n = (length . indices) g-          a = indices g !! (i `mod` n) -- make sure point is in grid+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 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 s x, Ord x) ⇒ g → Int → Property-prop_edges_cw_neighbours g i = n > 0 ==> +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 n = (length . indices) g-          a = indices g !! (i `mod` n) -- make sure point is in grid+    where a = g `pointAt` i           nEdges = filter (`involves` a) $ edges g-          expected = filter (≠ a) $ nub $ map fst nEdges ++ map snd nEdges+          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 s x, Ord x) ⇒ g → Property+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 s x ⇒ g → Int → Int → Property-prop_adjacentTilesToward_moves_closer g i j = nonEmpty 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 s x ⇒ g → Int → Int → Property-prop_minimal_paths_have_min_length g i j = nonEmpty g ==> ns ≡ [d+1]+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 s x ⇒ g → Int → Int → Property-prop_minimal_paths_are_valid g i j = nonEmpty g ==> +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 s x ⇒ g → [x] → Bool+subsequentTilesInPathAreAdjacent +  ∷ (Grid g, Eq (Index g)) ⇒ g → [Index g] → Bool subsequentTilesInPathAreAdjacent _ [] = True subsequentTilesInPathAreAdjacent g [x] = x `elem` indices g subsequentTilesInPathAreAdjacent g (a:b:xs) = @@ -105,25 +117,31 @@ --  prop_grid_and_boundary_are_both_null_or_not -  ∷ BoundedGrid g s x ⇒ g → Property+  ∷ BoundedGrid g ⇒ g → Property prop_grid_and_boundary_are_both_null_or_not g = property $-  (null . boundary) g ≡ empty g+  (P.null . boundary) g ≡ null g -prop_boundary_in_grid ∷ BoundedGrid g s x ⇒ g → Property+prop_boundary_in_grid ∷ (BoundedGrid g, Eq (Index g)) ⇒ g → Property prop_boundary_in_grid g = property $   all (g `contains`) . boundary $ g -prop_centres_equidistant_from_boundary ∷ BoundedGrid g s x ⇒ g → Property-prop_centres_equidistant_from_boundary g = nonEmpty 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 --- Note: We only need to test one of the centres, because the previous--- test proves they are all equidistant from the boundary.-prop_centres_farthest_from_boundary ∷ BoundedGrid g s x ⇒ g → Int → Property+prop_centres_farthest_from_boundary +  ∷ (BoundedGrid g, Eq (Index g)) ⇒ g → Int → Property prop_centres_farthest_from_boundary g i = -  nonEmpty g && (not . isCentre g) a ==>+  nonNull g && (not . isCentre g) a ==>     minDistance g bs a ≤ minDistance g bs c   where a = g `pointAt` i         (c:_) = centre g@@ -133,7 +151,7 @@ -- Triangular grids with triangular tiles -- --- We want the number of tiles in a test grid to be ~ n+-- 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) @@ -146,7 +164,7 @@     where s = size g  prop_TriTriGrid_distance_in_bounds ∷ TriTriGrid → Int → Int → Property-prop_TriTriGrid_distance_in_bounds g i j = nonEmpty g ==> +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@@ -163,7 +181,7 @@         s = size g  prop_TriTriGrid_neighbour_count_in_bounds ∷ TriTriGrid → Int → Property-prop_TriTriGrid_neighbour_count_in_bounds g i = nonEmpty g ==>+prop_TriTriGrid_neighbour_count_in_bounds g i = nonNull g ==>   if tileCount g ≡ 1     then length (neighbours g x) ≡ 0     else length (neighbours g x) `elem` [1,2,3]@@ -184,7 +202,7 @@ -- Parallelogram-shaped grids with triangular tiles -- --- We want the number of tiles in a test grid to be ~ n+-- 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)@@ -200,7 +218,7 @@     where (r, c) = size g  prop_ParaTriGrid_distance_in_bounds ∷ ParaTriGrid → Int → Int → Property-prop_ParaTriGrid_distance_in_bounds g i j = nonEmpty g ==> +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@@ -218,7 +236,7 @@           (r, c) = size g  prop_ParaTriGrid_neighbour_count_in_bounds ∷ ParaTriGrid → Int → Property-prop_ParaTriGrid_neighbour_count_in_bounds g i = nonEmpty g ==>+prop_ParaTriGrid_neighbour_count_in_bounds g i = nonNull g ==>   if tileCount g ≡ 1     then length (neighbours g x) ≡ 0     else length (neighbours g x) `elem` [1,2,3]@@ -238,10 +256,90 @@   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 ==>+  if tileCount g ≡ 1+    then length (neighbours g x) ≡ 0+    else length (neighbours g x) `elem` [1,2,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 ==>+  if tileCount g ≡ 1+    then length (neighbours g x) ≡ 0+    else length (neighbours g x) `elem` [1,2,3]+  where x = g `pointAt` i++-- -- Rectangular grids with square tiles -- --- We want the number of tiles in a test grid to be ~ n+-- 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)@@ -257,7 +355,7 @@     where (r, c) = size g  prop_RectSquareGrid_distance_in_bounds ∷ RectSquareGrid → Int → Int → Property-prop_RectSquareGrid_distance_in_bounds g i j = nonEmpty g ==>+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@@ -276,7 +374,7 @@  prop_RectSquareGrid_neighbour_count_in_bounds ∷    RectSquareGrid → Int → Property-prop_RectSquareGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f+prop_RectSquareGrid_neighbour_count_in_bounds g i = nonNull g ==> f   where x = g `pointAt` i         neighbourCount = length (neighbours g x)         (r, c) = size g@@ -286,7 +384,7 @@  prop_RectSquareGrid_num_min_paths_correct ∷    RectSquareGrid → Int → Int → Property-prop_RectSquareGrid_num_min_paths_correct g i j = nonEmpty g ==>+prop_RectSquareGrid_num_min_paths_correct g i j = nonNull g ==>   length (minimalPaths g a b) ≡ M.choose (deltaX+deltaY) deltaX     where a = g `pointAt` i           b = g `pointAt` j@@ -313,7 +411,7 @@ -- Toroidal grids with square-ish tiles -- --- We want the number of tiles in a test grid to be ~ n+-- 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)@@ -329,7 +427,7 @@     where (r, c) = size g  prop_TorSquareGrid_distance_in_bounds ∷ TorSquareGrid → Int → Int → Property-prop_TorSquareGrid_distance_in_bounds g i j = nonEmpty g ==>+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@@ -349,19 +447,22 @@             | otherwise      = 2  prop_TorSquareGrid_neighbour_count_in_bounds ∷ TorSquareGrid → Int → Property-prop_TorSquareGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f+prop_TorSquareGrid_neighbour_count_in_bounds g i = nonNull g ==> f   where x = g `pointAt` i-        neighbourCount = length (neighbours g x)+        neighbourCount = length . neighbours g $ x         (r, c) = size g-        f | tileCount g ≡ 1 = neighbourCount ≡ 0-          | r ≡ 1 || c ≡ 1  = neighbourCount `elem` [1,2]-          | otherwise       = neighbourCount `elem` [2,3,4]+        f | tileCount g ≡ 1                = neighbourCount ≡ 1+          | (r,c) ≡ (1,2) || (r,c) ≡ (2,1) = neighbourCount ≡ 2+          | (r,c) ≡ (2,2)                  = neighbourCount ≡ 2+          | r ≡ 1 || c ≡ 1                 = neighbourCount ≡ 3+          | r ≡ 2 || c ≡ 2                 = neighbourCount ≡ 3+          | otherwise                      = neighbourCount ≡ 4  -- -- Circular hexagonal grids    -- --- We want the number of tiles in a test grid to be ~ n+-- 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)@@ -375,7 +476,7 @@     where s = size g  prop_HexHexGrid_distance_in_bounds ∷ HexHexGrid → Int → Int → Property-prop_HexHexGrid_distance_in_bounds g i j = nonEmpty g ==>+prop_HexHexGrid_distance_in_bounds g i j = nonNull g ==>   distance g a b < 2*s     where s = size g           a = g `pointAt` i@@ -392,7 +493,7 @@         s = size g  prop_HexHexGrid_neighbour_count_in_bounds ∷ HexHexGrid → Int → Property-prop_HexHexGrid_neighbour_count_in_bounds g i = nonEmpty g ==> +prop_HexHexGrid_neighbour_count_in_bounds g i = nonNull g ==>    if tileCount g ≡ 1     then length (neighbours g x) ≡ 0     else length (neighbours g x) `elem` [2,3,4,5,6]@@ -414,7 +515,7 @@ -- Parallelogrammatical hexagonal grids    -- --- We want the number of tiles in a test grid to be ~ n+-- 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)@@ -430,7 +531,7 @@     where (r, c) = size g  prop_ParaHexGrid_distance_in_bounds ∷ ParaHexGrid → Int → Int → Property-prop_ParaHexGrid_distance_in_bounds g i j = nonEmpty g ==>+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@@ -448,7 +549,7 @@           (r, c) = size g  prop_ParaHexGrid_neighbour_count_in_bounds ∷ ParaHexGrid → Int → Property-prop_ParaHexGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f+prop_ParaHexGrid_neighbour_count_in_bounds g i = nonNull g ==> f   where x = g `pointAt` i         neighbourCount = length (neighbours g x)         (r, c) = size g@@ -481,6 +582,8 @@       (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"@@ -523,6 +626,8 @@       (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"@@ -552,6 +657,76 @@     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,@@ -565,6 +740,8 @@       (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"@@ -639,6 +816,8 @@       (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"@@ -681,6 +860,8 @@       (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"