packages feed

grid 2.1.1 → 3.0

raw patch · 5 files changed

+540/−159 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Math.Geometry.Grid: inGrid :: Grid g s x => x -> g -> Bool
- Math.Geometry.GridInternal: inGrid :: Grid g s x => x -> g -> Bool
- Math.Geometry.GridMap: inGrid :: Grid g s x => x -> g -> Bool
+ Math.Geometry.Grid: adjacentTilesToward :: Grid g s x => g -> x -> x -> [x]
+ Math.Geometry.Grid: boundary :: BoundedGrid g s x => g -> [x]
+ Math.Geometry.Grid: centre :: BoundedGrid g s x => g -> [x]
+ Math.Geometry.Grid: class Grid g s x => BoundedGrid g s x where isBoundary g x = x `elem` boundary 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 bs = boundary g isCentre g x = x `elem` centre g
+ Math.Geometry.Grid: contains :: Grid g s x => g -> x -> Bool
+ Math.Geometry.Grid: isAdjacent :: (Grid g s x, Grid g s x) => g -> x -> x -> Bool
+ Math.Geometry.Grid: isBoundary :: BoundedGrid g s x => g -> x -> Bool
+ Math.Geometry.Grid: isCentre :: BoundedGrid g s x => g -> x -> Bool
+ Math.Geometry.Grid: minDistance :: Grid g s x => g -> [x] -> x -> Int
+ Math.Geometry.Grid: numNeighbours :: Grid g s x => g -> x -> Int
+ Math.Geometry.GridInternal: adjacentTilesToward :: Grid g s x => g -> x -> x -> [x]
+ Math.Geometry.GridInternal: boundary :: BoundedGrid g s x => g -> [x]
+ Math.Geometry.GridInternal: centre :: BoundedGrid g s x => g -> [x]
+ Math.Geometry.GridInternal: class Grid g s x => BoundedGrid g s x where isBoundary g x = x `elem` boundary 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 bs = boundary g isCentre g x = x `elem` centre g
+ Math.Geometry.GridInternal: contains :: Grid g s x => g -> x -> Bool
+ Math.Geometry.GridInternal: instance BoundedGrid HexHexGrid Int (Int, Int)
+ Math.Geometry.GridInternal: instance BoundedGrid ParaHexGrid (Int, Int) (Int, Int)
+ Math.Geometry.GridInternal: instance BoundedGrid ParaTriGrid (Int, Int) (Int, Int)
+ Math.Geometry.GridInternal: instance BoundedGrid RectSquareGrid (Int, Int) (Int, Int)
+ Math.Geometry.GridInternal: instance BoundedGrid TriTriGrid Int (Int, Int)
+ Math.Geometry.GridInternal: isAdjacent :: (Grid g s x, Grid g s x) => g -> x -> x -> Bool
+ Math.Geometry.GridInternal: isBoundary :: BoundedGrid g s x => g -> x -> Bool
+ Math.Geometry.GridInternal: isCentre :: BoundedGrid g s x => g -> x -> Bool
+ Math.Geometry.GridInternal: minDistance :: Grid g s x => g -> [x] -> x -> Int
+ Math.Geometry.GridInternal: numNeighbours :: Grid g s x => g -> x -> Int
+ Math.Geometry.GridMap: contains :: Grid g s x => g -> x -> Bool
- Math.Geometry.Grid: class Eq x => Grid g s x | g -> s, g -> x where neighbours x g = filter (\ a -> distance x a g ≡ 1) $ indices g inGrid x g = x `elem` indices g viewpoint p g = map f (indices g) where f x = (x, distance p x g) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g minimalPaths a b g | a ≡ b = [[a]] | distance a b g ≡ 1 = [[a, b]] | otherwise = map (a :) xs where xs = concatMap (\ x -> minimalPaths x b g) ys ys = filter f $ neighbours a g f x = distance x b g ≡ distance a b g - 1
+ Math.Geometry.Grid: class Eq x => Grid g s x | g -> s, g -> x where minDistance g xs x = minimum . map (distance g x) $ xs neighbours g x = filter (\ a -> distance g x a ≡ 1) $ indices g numNeighbours g = length . neighbours g contains g x = x `elem` indices g viewpoint g p = map f (indices g) where f x = (x, distance g p x) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g isAdjacent g a b = distance g a b ≡ 1 adjacentTilesToward g a b | a ≡ b = [] | otherwise = filter f $ neighbours g a where f x = distance g x b ≡ distance g a b - 1 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 ys = adjacentTilesToward g a b
- Math.Geometry.Grid: distance :: Grid g s x => x -> x -> g -> Int
+ Math.Geometry.Grid: distance :: Grid g s x => g -> x -> x -> Int
- Math.Geometry.Grid: minimalPaths :: Grid g s x => x -> x -> g -> [[x]]
+ Math.Geometry.Grid: minimalPaths :: Grid g s x => g -> x -> x -> [[x]]
- Math.Geometry.Grid: neighbours :: Grid g s x => x -> g -> [x]
+ Math.Geometry.Grid: neighbours :: Grid g s x => g -> x -> [x]
- Math.Geometry.Grid: viewpoint :: Grid g s x => x -> g -> [(x, Int)]
+ Math.Geometry.Grid: viewpoint :: Grid g s x => g -> x -> [(x, Int)]
- Math.Geometry.GridInternal: class Eq x => Grid g s x | g -> s, g -> x where neighbours x g = filter (\ a -> distance x a g ≡ 1) $ indices g inGrid x g = x `elem` indices g viewpoint p g = map f (indices g) where f x = (x, distance p x g) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g minimalPaths a b g | a ≡ b = [[a]] | distance a b g ≡ 1 = [[a, b]] | otherwise = map (a :) xs where xs = concatMap (\ x -> minimalPaths x b g) ys ys = filter f $ neighbours a g f x = distance x b g ≡ distance a b g - 1
+ Math.Geometry.GridInternal: class Eq x => Grid g s x | g -> s, g -> x where minDistance g xs x = minimum . map (distance g x) $ xs neighbours g x = filter (\ a -> distance g x a ≡ 1) $ indices g numNeighbours g = length . neighbours g contains g x = x `elem` indices g viewpoint g p = map f (indices g) where f x = (x, distance g p x) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g isAdjacent g a b = distance g a b ≡ 1 adjacentTilesToward g a b | a ≡ b = [] | otherwise = filter f $ neighbours g a where f x = distance g x b ≡ distance g a b - 1 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 ys = adjacentTilesToward g a b
- Math.Geometry.GridInternal: distance :: Grid g s x => x -> x -> g -> Int
+ Math.Geometry.GridInternal: distance :: Grid g s x => g -> x -> x -> Int
- Math.Geometry.GridInternal: minimalPaths :: Grid g s x => x -> x -> g -> [[x]]
+ Math.Geometry.GridInternal: minimalPaths :: Grid g s x => g -> x -> x -> [[x]]
- Math.Geometry.GridInternal: neighbours :: Grid g s x => x -> g -> [x]
+ Math.Geometry.GridInternal: neighbours :: Grid g s x => g -> x -> [x]
- Math.Geometry.GridInternal: viewpoint :: Grid g s x => x -> g -> [(x, Int)]
+ Math.Geometry.GridInternal: viewpoint :: Grid g s x => g -> x -> [(x, Int)]
- Math.Geometry.GridMap: distance :: Grid g s x => x -> x -> g -> Int
+ Math.Geometry.GridMap: distance :: Grid g s x => g -> x -> x -> Int
- Math.Geometry.GridMap: neighbours :: Grid g s x => x -> g -> [x]
+ Math.Geometry.GridMap: neighbours :: Grid g s x => g -> x -> [x]
- Math.Geometry.GridMap: viewpoint :: Grid g s x => x -> g -> [(x, Int)]
+ Math.Geometry.GridMap: viewpoint :: Grid g s x => g -> x -> [(x, Int)]

Files

grid.cabal view
@@ -1,11 +1,14 @@ name:           grid-version:        2.1.1-synopsis:       Tools for working with regular grids\/graphs\/lattices.+version:        3.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                 other type of grid map. Currently supports triangular,                 square, and hexagonal tiles, with various 2D and                  toroidal layouts.+                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. category:       Math cabal-version:  >=1.8 build-type:     Simple@@ -21,7 +24,7 @@   build-depends:   base ==4.*,                    base-unicode-symbols ==0.2.*,                    containers ==0.4.2.*-  ghc-options:     -Wall -rtsopts+  ghc-options:     -Wall   exposed-modules: Math.Geometry.Grid,                    Math.Geometry.GridInternal,                    Math.Geometry.GridMap@@ -36,7 +39,7 @@                    grid,                    base-unicode-symbols ==0.2.*   hs-source-dirs:  test-  ghc-options:     -Wall -rtsopts+  ghc-options:     -Wall   main-is:         Main.hs   other-modules: Math.Geometry.GridQC 
src/Math/Geometry/Grid.hs view
@@ -10,6 +10,10 @@ -- A regular arrangement of tiles. Grids have a variety of uses, -- including games and self-organising maps. --+-- 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.+-- ----------------------------------------------------------------------------- {-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances,    FlexibleInstances #-}@@ -18,6 +22,7 @@   (     -- * The Grid class     Grid(..),+    BoundedGrid(..),     -- * Grids with triangular tiles     TriTriGrid,     triTriGrid,@@ -37,9 +42,10 @@     -- $Example   ) where -import Math.Geometry.GridInternal (Grid(..), TriTriGrid, triTriGrid, -  ParaTriGrid, paraTriGrid, RectSquareGrid, rectSquareGrid, TorSquareGrid, -  torSquareGrid, HexHexGrid, hexHexGrid, ParaHexGrid, paraHexGrid)+import Math.Geometry.GridInternal (Grid(..), BoundedGrid(..), +  TriTriGrid, triTriGrid, ParaTriGrid, paraTriGrid, RectSquareGrid, +  rectSquareGrid, TorSquareGrid, torSquareGrid, HexHexGrid, hexHexGrid, +  ParaHexGrid, paraHexGrid)  {- $Example    Create a grid.@@ -51,25 +57,25 @@    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 (0,-2) (0,2) g+>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. ->ghci> viewpoint (1,-2) g+>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)]     Find out which tiles are adjacent to a particular tile. ->ghci> neighbours (-1,1) g+>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. ->ghci> inGrid (0,0) g+>ghci> g `contains` (0,0) >True->ghci> inGrid (0,12) g+>ghci> g `contains` (0,12) >False     Find out the physical dimensions of the grid.@@ -92,7 +98,7 @@    Find all of the minimal paths between two points.  ghci> let g = hexHexGrid 3-ghci> minimalPaths (0,0) (2,-1) g+ghci> minimalPaths g (0,0) (2,-1) [[(0,0),(1,0),(2,-1)],[(0,0),(1,-1),(2,-1)]]  -}
src/Math/Geometry/GridInternal.hs view
@@ -1,4 +1,4 @@------------------------------------------------------------------------------+------------------------------------------------------------------------ -- | -- Module      :  Math.Geometry.GridInternal -- Copyright   :  (c) Amy de Buitléir 2012@@ -10,14 +10,16 @@ -- A module containing private @Grid@ internals. Most developers should -- use @Grid@ instead. This module is subject to change without notice. ---------------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FunctionalDependencies, -    TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, +    FunctionalDependencies, TypeSynonymInstances, FlexibleInstances, +    FlexibleContexts #-}  module Math.Geometry.GridInternal   (     -- * Generic     Grid(..),+    BoundedGrid(..),     -- * Grids with triangular tiles     TriTriGrid,     triTriGrid,@@ -36,90 +38,174 @@   ) where  import Data.Eq.Unicode ((≡), (≠))-import Data.List (nub, nubBy)+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: @indices@, @distance@, and @size@.+--   Minimal complete definition: @indices@, @distance@ and @size@. class Eq x ⇒ Grid g s x | g → s, g → x where+   -- | Returns the indices of all tiles in a grid.   indices ∷ g → [x]-  -- | @'distance' a b@ returns the minimum number of moves required to get-  --   from @a@ to @b@, moving between adjacent tiles at each step. (Two tiles-  --   are adjacent if they share an edge.) If @a@ or @b@ are not contained-  --   within @g@, the result is undefined.-  distance ∷ x → x → g → Int++  -- | @'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++  -- | @'minDistance' g bs a@ returns the minimum number of moves +  --   required to get from any of the tiles at indices @bs@ to the tile+  --   at index @a@ in grid @g@, moving between adjacent tiles at each+  --   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 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@.+  --   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' x g@ returns the indices of the tiles in the grid @g@-  --   which are adjacent to the tile at @x@.-  neighbours ∷ x → g → [x]-  neighbours x g = filter (\a → distance x a g ≡ 1 ) $ indices g-  -- | @x 'inGrid' g@ returns true if the index @x@ is contained within @g@,-  --   otherwise it returns false.-  inGrid ∷ x → g → Bool-  inGrid x g = x `elem` indices g-  -- | @'viewpoint' x g@ 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 ∷ x → g → [(x, Int)]-  viewpoint p g = map f (indices g)-    where f x = (x, distance p x g)++  -- | @'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 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 = 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 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 p = map f (indices g)+    where f x = (x, distance g p x)+   -- | Returns the number of tiles in a grid. Compare with @'size'@.   tileCount ∷ g → Int   tileCount = length . indices+   -- | Returns @True@ if the number of tiles in a grid is zero, @False@    --   otherwise.   empty ∷ g → Bool   empty g = tileCount g ≡ 0+   -- | Returns @False@ if the number of tiles in a grid is zero, @True@    --   otherwise.   nonEmpty ∷ g → Bool   nonEmpty = not . empty-  -- | A list of all edges in a Grid, where the edges are represented by a-  --   pair of adjacent tiles.++  -- | 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 g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g-  -- | @'minimalPaths' a b@ returns a list of all minimal paths from -  --   @a@ to @b@. A path is a sequence of tiles, where each tile in the-  --   sequence is adjacent to the previous one. (Two tiles are adjacent-  --   if they share an edge.) If @a@ or @b@ are not contained-  --   within @g@, the result is undefined.-  minimalPaths ∷ x → x → g → [[x]]-  minimalPaths a b g | a ≡ b              = [[a]]-                     | distance a b g ≡ 1 = [[a,b]]++  -- | @'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++  -- | @'adjacentTilesToward' g a b@ returns the indices of all tiles+  --   which are neighbours of the tile at index @a@, and which are+  --   closer to the tile at @b@ than @a@ is. In other words, it returns+  --   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+    where f x = distance g x b ≡ distance g a b - 1++  -- | @'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+  --   path is a sequence of tiles where each tile in the sequence is+  --   adjacent to the previous one. (Two tiles are adjacent if they+  --   share an edge.) If @a@ or @b@ are not contained within @g@, the+  --   result is undefined.+  --+  --   Tip: The default implementation of this function calls+  --   @'adjacentTilesToward'@. If you want to use a custom algorithm,+  --   consider modifying @'adjacentTilesToward'@ instead of +  --   @'minimalPaths'@.+  minimalPaths ∷ g → x → x → [[x]]+  minimalPaths g a b | a ≡ b              = [[a]]+                     | distance g a b ≡ 1 = [[a,b]]                      | otherwise          = map (a:) xs-    where xs = concatMap (\x → minimalPaths x b g) ys-          ys = filter f $ neighbours a g-          f x = distance x b g ≡ distance a b g - 1+    where xs = concatMap (\x → minimalPaths g x b) ys+          ys = adjacentTilesToward g a b  sameEdge ∷ Eq t ⇒ (t, t) → (t, t) → Bool sameEdge (a,b) (c,d) = (a,b) ≡ (c,d) || (a,b) ≡ (d,c)  adjacentEdges ∷ Grid g s t ⇒ t → g → [(t, t)]-adjacentEdges i g = map (\j → (i,j)) $ i `neighbours` g+adjacentEdges i g = map (\j → (i,j)) $ neighbours g i ++-- | 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]++  -- | @'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 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) . +                sortBy (comparing snd) $ xds+    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 g x = x `elem` centre g++ -- -- Triangular tiles -- --- | For triangular tiles, it is convenient to define a third component z.+-- | 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) ⇒ (Int, Int) → (Int, Int) → g → Int-triDistance (x1, y1) (x2, y2) g = -    if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g+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) ⇒ (Int, Int) → g → [(Int, Int)]-triNeighbours (x,y) g = filter (`inGrid` g) xs+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)] @@ -132,28 +218,49 @@ --   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 Show TriTriGrid where +  show (TriTriGrid s _) = "triTriGrid " ++ show s  instance Grid TriTriGrid Int (Int, Int) where   indices (TriTriGrid _ xs) = xs   neighbours = triNeighbours   distance = triDistance-  inGrid (x, y) (TriTriGrid s _) = inTriGrid (x,y) s+  contains (TriTriGrid s _) (x, y) = inTriGrid (x,y) s   size (TriTriGrid s _) = s  inTriGrid ∷ (Int, Int) → Int → Bool inTriGrid (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+  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 ∷ (Int, Int) → [(Int,Int)]+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.+--   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. triTriGrid ∷ Int → TriTriGrid triTriGrid s =    TriTriGrid s [(xx,yy) | xx ← [0..2*(s-1)],                            yy ← [0..2*(s-1)], -                          inTriGrid (xx,yy) s]+                          (xx,yy) `inTriGrid` s]  -- -- Parallelogrammatical grids with triangular tiles@@ -173,11 +280,33 @@   distance = triDistance   size (ParaTriGrid s _) = s +instance BoundedGrid ParaTriGrid (Int, Int) (Int, Int) where+  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)]+ -- | @'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 the list of indices---   will be null.+--   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+--   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)]@@ -192,23 +321,52 @@ data RectSquareGrid = RectSquareGrid (Int, Int) [(Int, Int)] deriving Eq  instance Show RectSquareGrid where -  show (RectSquareGrid (r,c) _) = "rectSquareGrid " ++ show r ++ " " ++ show c+  show (RectSquareGrid (r,c) _) = +    "rectSquareGrid " ++ show r ++ " " ++ show c  instance Grid RectSquareGrid (Int, Int) (Int, Int) where   indices (RectSquareGrid _ xs) = xs-  neighbours (x, y) g = filter (`inGrid` g) [(x-1,y), (x,y+1), (x+1,y), (x,y-1)]-  distance (x1, y1) (x2, y2) g = -    if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g+  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+  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) --- | @'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 null.+instance BoundedGrid RectSquareGrid (Int, Int) (Int, Int) where+  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 empty 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]]+rectSquareGrid r c = +  RectSquareGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]]  -- -- Toroidal grids with square tiles.@@ -224,12 +382,12 @@  instance Grid TorSquareGrid (Int, Int) (Int, Int) where   indices (TorSquareGrid _ xs) = xs-  neighbours (x,y) (TorSquareGrid (r,c) _) = +  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)]-  distance (x1, y1) (x2, y2) g@(TorSquareGrid (r,c) _) =-    if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g+  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)@@ -247,9 +405,9 @@ -- Hexagonal tiles -- -hexDistance ∷ Grid g s (Int, Int) ⇒ (Int, Int) → (Int, Int) → g → Int-hexDistance (x1, y1) (x2, y2) g = -  if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g+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@@ -268,11 +426,23 @@  instance Grid HexHexGrid Int (Int, Int) where   indices (HexHexGrid _ xs) = xs-  neighbours (x,y) g = filter (`inGrid` g) +  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   size (HexHexGrid s _) = s +instance BoundedGrid HexHexGrid Int (Int, Int) where+  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 @@ -295,10 +465,14 @@  instance Grid ParaHexGrid (Int, Int) (Int, Int) where   indices (ParaHexGrid _ xs) = xs-  neighbours (x,y) g = filter (`inGrid` g) +  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   size (ParaHexGrid s _) = s++instance BoundedGrid ParaHexGrid (Int, Int) (Int, Int) where+  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 
src/Math/Geometry/GridMap.hs view
@@ -31,7 +31,7 @@     distance,     size,     neighbours,-    inGrid,+    contains,     viewpoint,     tileCount,     empty,@@ -94,11 +94,11 @@  instance (Eq k, Grid g s k) ⇒ Grid (GridMap g k v) s k where   indices = indices . toGrid-  distance x y = distance x y . toGrid+  distance g = distance (toGrid g)   size = size . toGrid-  neighbours k = (k `neighbours`) . toGrid-  inGrid k = (k `inGrid`) . toGrid-  viewpoint k = (k `viewpoint`) . 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
test/Math/Geometry/GridQC.hs view
@@ -24,8 +24,8 @@   where n' = fromIntegral n ∷ Float  -- Given an arbitrary integer, select a corresponding point in the grid.-pointIn ∷ Grid g s x ⇒ Int → g → x-pointIn i g = indices g !! (i `mod` n)+pointAt ∷ Grid g s x ⇒ g → Int → x+pointAt g i = indices g !! (i `mod` n)   where n = (length . indices) g  --@@ -33,26 +33,34 @@ --  prop_distance_reflexive ∷ Grid g s x ⇒ g → Int → Property-prop_distance_reflexive g i = nonEmpty g ==> distance a a g ≡ 0-  where a = i `pointIn` g+prop_distance_reflexive g i = nonEmpty 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 g i j = nonEmpty g ==> distance a b g ≡ distance b a g-  where a = i `pointIn` g-        b = j `pointIn` g+prop_distance_symmetric g i j = +  nonEmpty 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 g i js = +  nonEmpty g && (not . 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 (a `neighbours` g) ≡ sort expected+  sort (neighbours g a) ≡ sort expected     where n = (length . indices) g           a = indices g !! (i `mod` n) -- make sure point is in grid-          expected = map fst $ filter (\p → 1 ≡ snd p) $ a `viewpoint` g+          expected = map fst $ filter (\p → 1 ≡ snd p) $ viewpoint g a  prop_edges_cw_neighbours ∷ (Grid g s x, Ord x) ⇒ g → Int → Property prop_edges_cw_neighbours g i = n > 0 ==> -  sort (a `neighbours` g) ≡ sort expected+  sort (neighbours g a) ≡ sort expected     where n = (length . indices) g           a = indices g !! (i `mod` n) -- make sure point is in grid           nEdges = filter (`involves` a) $ edges g@@ -62,32 +70,66 @@ involves (a, b) c = c ≡ a || c ≡ b  prop_edges_are_adjacent ∷ (Grid g s x, Ord x) ⇒ g → Property-prop_edges_are_adjacent g = property $ and $ map f $ edges g-  where f (a, b) = isAdjacent a b g+prop_edges_are_adjacent g = property $ all f $ edges g+  where f (a, b) = isAdjacent g a b -isAdjacent ∷ Grid g s x ⇒ x → x → g → Bool-isAdjacent a b g = (distance a b g) ≡ 1+prop_adjacentTilesToward_moves_closer ∷ Grid g s x ⇒ g → Int → Int → Property+prop_adjacentTilesToward_moves_closer g i j = nonEmpty 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]-  where a = i `pointIn` g-        b = j `pointIn` g-        d = distance a b g-        ns = nub $ map length $ minimalPaths a b g+  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 ==> -    and $ map (subsequentTilesInPathAreAdjacent g) $ minimalPaths a b g-  where a = i `pointIn` g-        b = j `pointIn` 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 _ [] = True-subsequentTilesInPathAreAdjacent g [x] = x `elem` (indices g)+subsequentTilesInPathAreAdjacent g [x] = x `elem` indices g subsequentTilesInPathAreAdjacent g (a:b:xs) = -  isAdjacent a b g && subsequentTilesInPathAreAdjacent g (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 s x ⇒ g → Property+prop_grid_and_boundary_are_both_null_or_not g = property $+  (null . boundary) g ≡ empty g++prop_boundary_in_grid ∷ BoundedGrid g s x ⇒ 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 ==>+  (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 g i = +  nonEmpty 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 -- @@ -105,16 +147,16 @@  prop_TriTriGrid_distance_in_bounds ∷ TriTriGrid → Int → Int → Property prop_TriTriGrid_distance_in_bounds g i j = nonEmpty g ==> -  distance a b g ≤ 2*(s-1)+  distance g a b ≤ 2*(s-1)     where s = size g-          a = i `pointIn` g-          b = j `pointIn` 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 a b g ≡ 2*(s-1)+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@@ -123,10 +165,21 @@ prop_TriTriGrid_neighbour_count_in_bounds ∷ TriTriGrid → Int → Property prop_TriTriGrid_neighbour_count_in_bounds g i = nonEmpty g ==>   if tileCount g ≡ 1-    then length (x `neighbours` g) ≡ 0-    else length (x `neighbours` g) `elem` [1,2,3]-  where x = i `pointIn` g+    then length (neighbours g x) ≡ 0+    else length (neighbours g x) `elem` [1,2,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 --@@ -148,17 +201,17 @@  prop_ParaTriGrid_distance_in_bounds ∷ ParaTriGrid → Int → Int → Property prop_ParaTriGrid_distance_in_bounds g i j = nonEmpty g ==> -  distance a b g ≤ 2*(r+c) - 3+  distance g a b ≤ 2*(r+c) - 3     where (r, c) = size g-          a = i `pointIn` g-          b = j `pointIn` 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 a b g ≡ 2*(r+c) - 3+  distance g a b ≡ 2*(r+c) - 3     where ps = indices g           a = head ps           b = last ps@@ -167,10 +220,23 @@ prop_ParaTriGrid_neighbour_count_in_bounds ∷ ParaTriGrid → Int → Property prop_ParaTriGrid_neighbour_count_in_bounds g i = nonEmpty g ==>   if tileCount g ≡ 1-    then length (x `neighbours` g) ≡ 0-    else length (x `neighbours` g) `elem` [1,2,3]-  where x = i `pointIn` g+    then length (neighbours g x) ≡ 0+    else length (neighbours g x) `elem` [1,2,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 square tiles --@@ -192,17 +258,17 @@  prop_RectSquareGrid_distance_in_bounds ∷ RectSquareGrid → Int → Int → Property prop_RectSquareGrid_distance_in_bounds g i j = nonEmpty g ==>-  distance a b g ≤ r + c - 2+  distance g a b ≤ r + c - 2     where (r, c) = size g-          a = i `pointIn` g-          b = j `pointIn` 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 a b g ≡ r + c - 2+  distance g a b ≡ r + c - 2     where (r, c) = size g           ps = indices g           a = head ps@@ -211,8 +277,8 @@ prop_RectSquareGrid_neighbour_count_in_bounds ∷    RectSquareGrid → Int → Property prop_RectSquareGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f-  where x = i `pointIn` g-        neighbourCount = length (x `neighbours` g)+  where x = g `pointAt` i+        neighbourCount = length (neighbours g x)         (r, c) = size g         f | tileCount g ≡ 1 = neighbourCount ≡ 0           | r ≡ 1 || c ≡ 1  = neighbourCount `elem` [1,2]@@ -221,12 +287,28 @@ prop_RectSquareGrid_num_min_paths_correct ∷    RectSquareGrid → Int → Int → Property prop_RectSquareGrid_num_min_paths_correct g i j = nonEmpty g ==>-  length (minimalPaths a b g) ≡ M.choose (deltaX+deltaY) deltaX-    where a = i `pointIn` g-          b = j `pointIn` g+  length (minimalPaths 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-ish tiles --@@ -248,16 +330,16 @@  prop_TorSquareGrid_distance_in_bounds ∷ TorSquareGrid → Int → Int → Property prop_TorSquareGrid_distance_in_bounds g i j = nonEmpty g ==>-  distance a b g ≤ (r+c) `div` 2+  distance g a b ≤ (r+c) `div` 2     where (r, c) = size g-          a = i `pointIn` g-          b = j `pointIn` 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 a b g ≡ f+  distance g a b ≡ f     where (r, c) = size g           ps = indices g           a = head ps@@ -268,8 +350,8 @@  prop_TorSquareGrid_neighbour_count_in_bounds ∷ TorSquareGrid → Int → Property prop_TorSquareGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f-  where x = i `pointIn` g-        neighbourCount = length (x `neighbours` g)+  where x = g `pointAt` i+        neighbourCount = length (neighbours g x)         (r, c) = size g         f | tileCount g ≡ 1 = neighbourCount ≡ 0           | r ≡ 1 || c ≡ 1  = neighbourCount `elem` [1,2]@@ -294,16 +376,16 @@  prop_HexHexGrid_distance_in_bounds ∷ HexHexGrid → Int → Int → Property prop_HexHexGrid_distance_in_bounds g i j = nonEmpty g ==>-  distance a b g < 2*s+  distance g a b < 2*s     where s = size g-          a = i `pointIn` g-          b = j `pointIn` 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 a b g ≡ 2*s - 2+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@@ -312,10 +394,22 @@ prop_HexHexGrid_neighbour_count_in_bounds ∷ HexHexGrid → Int → Property prop_HexHexGrid_neighbour_count_in_bounds g i = nonEmpty g ==>    if tileCount g ≡ 1-    then length (x `neighbours` g) ≡ 0-    else length (x `neighbours` g) `elem` [2,3,4,5,6]-  where x = i `pointIn` g+    then length (neighbours g x) ≡ 0+    else length (neighbours g x) `elem` [2,3,4,5,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    --@@ -337,17 +431,17 @@  prop_ParaHexGrid_distance_in_bounds ∷ ParaHexGrid → Int → Int → Property prop_ParaHexGrid_distance_in_bounds g i j = nonEmpty g ==>-  property $ distance a b g ≤ r+c-2+  property $ distance g a b ≤ r+c-2     where (r, c) = size g-          a = i `pointIn` g-          b = j `pointIn` 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 a b g ≡ r+c-2+  distance g a b ≡ r+c-2     where ps = indices g           a = head ps           b = last ps@@ -355,13 +449,22 @@  prop_ParaHexGrid_neighbour_count_in_bounds ∷ ParaHexGrid → Int → Property prop_ParaHexGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f-  where x = i `pointIn` g-        neighbourCount = length (x `neighbours` g)+  where x = g `pointAt` i+        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,5,6] +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++ test ∷ Test test = testGroup "Math.Geometry.GridQC"   [@@ -372,6 +475,20 @@       (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_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"@@ -384,11 +501,15 @@       ( 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,@@ -396,6 +517,20 @@       (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_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"@@ -408,18 +543,36 @@       ( 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),+     -- RectSquareGrid tests     testProperty "prop_RectSquareGrid_tile_count_correct"       prop_RectSquareGrid_tile_count_correct,-    testProperty "prop_distance_reflexive - RectTriGrid"+    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_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"@@ -432,6 +585,9 @@       ( 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),@@ -439,6 +595,7 @@       ( 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,@@ -446,6 +603,8 @@       (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"@@ -458,11 +617,15 @@       ( 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,@@ -470,6 +633,20 @@       (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_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"@@ -482,18 +659,36 @@       ( 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 - HexHexGrid"+    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_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"@@ -504,6 +699,9 @@       (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"