grid 6.1 → 7.0

raw patch · 16 files changed

+757/−355 lines, 16 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• grid.cabal +3/−8
• src/Math/Geometry/Grid/Hexagonal.hs +3/−3
• src/Math/Geometry/Grid/Hexagonal2.hs +34/−0
• src/Math/Geometry/Grid/HexagonalInternal.hs +25/−14
• src/Math/Geometry/Grid/HexagonalInternal2.hs +156/−0
• src/Math/Geometry/Grid/Octagonal.hs +3/−3
• src/Math/Geometry/Grid/OctagonalInternal.hs +12/−9
• src/Math/Geometry/Grid/Square.hs +3/−3
• src/Math/Geometry/Grid/SquareInternal.hs +12/−10
• src/Math/Geometry/Grid/Triangular.hs +3/−3
• src/Math/Geometry/Grid/TriangularInternal.hs +87/−36
• src/Math/Geometry/GridInternal.hs +139/−111
• src/Math/Geometry/GridMap.hs +24/−24
• src/Math/Geometry/GridMap/Lazy.hs +12/−12
• test/Main.hs +4/−3
• test/Math/Geometry/GridQC.hs +237/−116

@@ -1,5 +1,5 @@ name:           grid-version:        6.1+version:        7.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,13 +8,6 @@                 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. category:       Math cabal-version:  >=1.8 build-type:     Simple@@ -36,11 +29,13 @@                    Math.Geometry.Grid.Triangular,                    Math.Geometry.Grid.Square,                    Math.Geometry.Grid.Hexagonal,+                   Math.Geometry.Grid.Hexagonal2,                    Math.Geometry.Grid.Octagonal,                    Math.Geometry.GridInternal,                    Math.Geometry.Grid.TriangularInternal,                    Math.Geometry.Grid.SquareInternal,                    Math.Geometry.Grid.HexagonalInternal,+                   Math.Geometry.Grid.HexagonalInternal2,                    Math.Geometry.Grid.OctagonalInternal,                    Math.Geometry.GridMap,                    Math.Geometry.GridMap.Lazy

@@ -1,4 +1,4 @@------------------------------------------------------------------------------+------------------------------------------------------------------------ -- | -- Module      :  Math.Geometry.HexGrid -- Copyright   :  (c) Amy de Buitléir 2012@@ -12,8 +12,8 @@ -- <https://github.com/mhwombat/grid/wiki>. -- Also see @Math.Geometry.Grid@ for examples of how to use this class. ---------------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, +------------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances,    FlexibleInstances #-}  module Math.Geometry.Grid.Hexagonal

@@ -0,0 +1,34 @@+------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.HexGrid+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- Same as @'Math.Geometry.Grid.Hexagonal'@, except the grids are+-- oriented so that the flat part of the hexagonal tiles is on the top.+-- The userguide, with illustrations, is available at +-- <https://github.com/mhwombat/grid/wiki>.+-- Also see @Math.Geometry.Grid@ for examples of how to use this class.+--+------------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, +  FlexibleInstances #-}++module Math.Geometry.Grid.Hexagonal2+  (+    -- * Unbounded grid with hexagonal tiles+    UnboundedHexGrid,+    -- * Hexagonal grid with hexagonal tiles+    HexHexGrid,+    hexHexGrid,+    -- * Rectangular grid with hexagonal tiles+    RectHexGrid,+    rectHexGrid+  ) where++import Math.Geometry.Grid.HexagonalInternal2 (UnboundedHexGrid, HexHexGrid, +  hexHexGrid, RectHexGrid, rectHexGrid)+

@@ -12,12 +12,14 @@ -- without notice. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}  module Math.Geometry.Grid.HexagonalInternal where  import Prelude hiding (null)-import Data.Ord.Unicode ((≤))+import Data.Function (on)+import Data.List (groupBy, sortBy)+import Data.Ord (comparing) import Math.Geometry.GridInternal  data HexDirection = West | Northwest | Northeast | East | Southeast | @@ -81,26 +83,27 @@ instance FiniteGrid HexHexGrid where   type Size HexHexGrid = Int   size (HexHexGrid s _) = s+  maxPossibleDistance g@(HexHexGrid s _) = distance g (-s+1,0) (s-1,0)  instance BoundedGrid HexHexGrid where   tileSideCount _ = 6   boundary g =      north ++ northeast ++ southeast ++ south ++ southwest ++ northwest     where s = size g-          north = [(k,s-1) | k ← [-s+1,-s+2..0]]-          northeast = [(k,s-1-k) | k ← [1,2..s-1]]-          southeast = [(s-1,k) | k ← [-1,-2..(-s)+1]]-          south = [(k,(-s)+1) | k ← [s-2,s-3..0]]-          southwest = [(k,(-s)+1-k) | k ← [-1,-2..(-s)+1]]-          northwest = [(-s+1,k) | k ← [1,2..s-2]]+          north = [(k,s-1) | k <- [-s+1,-s+2..0]]+          northeast = [(k,s-1-k) | k <- [1,2..s-1]]+          southeast = [(s-1,k) | k <- [-1,-2..(-s)+1]]+          south = [(k,(-s)+1) | k <- [s-2,s-3..0]]+          southwest = [(k,(-s)+1-k) | k <- [-1,-2..(-s)+1]]+          northwest = [(-s+1,k) | k <- [1,2..s-2]]   centre _ = [(0,0)]  -- | @'hexHexGrid' s@ returns a grid of hexagonal shape, with --   sides of length @s@, using hexagonal tiles. If @s@ is nonnegative, the  --   resulting grid will have @3*s*(s-1) + 1@ tiles. Otherwise, the resulting  --   grid will be null and the list of indices will be null.-hexHexGrid ∷ Int → HexHexGrid-hexHexGrid r = HexHexGrid r [(x, y) | x ← [-r+1..r-1], y ← f x]+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]  --@@ -122,24 +125,32 @@   neighbours = neighboursBasedOn UnboundedHexGrid   distance = distanceBasedOn UnboundedHexGrid   directionTo = directionToBasedOn UnboundedHexGrid-  contains g (x,y) = 0 ≤ x && x < c && 0 ≤ y && y < r+  contains g (x,y) = 0 <= x && x < c && 0 <= y && y < r     where (r,c) = size g  instance FiniteGrid ParaHexGrid where   type Size ParaHexGrid = (Int, Int)   size (ParaHexGrid s _) = s+  maxPossibleDistance g@(ParaHexGrid (r,c) _) = +    distance g (0,0) (c-1,r-1)  instance BoundedGrid ParaHexGrid where   tileSideCount _ = 6   boundary g = cartesianIndices . size $ g-  centre g = cartesianCentre . size $ g+  centre g | length xs == 1  = map fst . head $ xs+           | length xs == 2  = map fst . concat $ xs+           | length xs == 3  = map fst . head . drop 1 $ xs+           | otherwise      = error "logic error"+    where xs = groupBy ((==) `on` snd) . sortBy (comparing snd)+                 . map (\a -> (a,fst a + snd a))+                 . cartesianCentre . size $ g  -- | @'paraHexGrid' r c@ returns a grid in the shape of a  --   parallelogram with @r@ rows and @c@ columns, using hexagonal tiles. If  --   @r@ and @c@ are both nonnegative, the resulting grid will have @r*c@ tiles. --   Otherwise, the resulting grid will be null and the list of indices will  --   be null.-paraHexGrid ∷ Int → Int → ParaHexGrid+paraHexGrid :: Int -> Int -> ParaHexGrid paraHexGrid r c = -  ParaHexGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]+  ParaHexGrid (r,c) [(x, y) | x <- [0..c-1], y <- [0..r-1]] 

@@ -0,0 +1,156 @@+------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.HexGridInternal+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A module containing private @HexGrid2@ internals. Most developers +-- should use @HexGrid2@ instead. This module is subject to change +-- without notice.+--+------------------------------------------------------------------------+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}++module Math.Geometry.Grid.HexagonalInternal2 where++import Prelude hiding (null)+import Math.Geometry.GridInternal++data HexDirection = Northwest | North | Northeast | Southeast | South |+                      Southwest deriving (Show, Eq)++-- | An unbounded grid with hexagonal tiles+--   The grid and its indexing scheme are illustrated in the user guide,+--   available at <https://github.com/mhwombat/grid/wiki>.+data UnboundedHexGrid = UnboundedHexGrid deriving Show++instance Grid UnboundedHexGrid where+  type Index UnboundedHexGrid = (Int, Int)+  type Direction UnboundedHexGrid = HexDirection+  indices _ = undefined+  neighbours _ (x,y) = +    [(x-1,y), (x-1,y+1), (x,y+1), (x+1,y), (x+1,y-1), (x,y-1)]+  distance _ (x1, y1) (x2, y2) = +    maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]+    where z1 = -x1 - y1+          z2 = -x2 - y2+  directionTo _ (x1, y1) (x2, y2) = f1 . f2 . f3 . f4 . f5 . f6 $ []+    where f1 ds =  if dy > 0 && dz < 0 then North:ds else ds+          f2 ds =  if dy < 0 && dz > 0 then South:ds else ds+          f3 ds =  if dx > 0 && dz < 0 then Northeast:ds else ds+          f4 ds =  if dx < 0 && dy > 0 then Northwest:ds else ds+          f5 ds =  if dx > 0 && dy < 0 then Southeast:ds else ds+          f6 ds =  if dx < 0 && dz > 0 then Southwest:ds else ds+          dx = x2 - x1+          dy = y2 - y1+          z1 = -x1 - y1+          z2 = -x2 - y2+          dz = z2 - z1+  contains _ _ = True+  null _ = False+  nonNull _ = True++--+-- Hexagonal grids with hexagonal tiles+--++-- | A hexagonal grid with hexagonal tiles+--   The grid and its indexing scheme are illustrated in the user guide,+--   available at <https://github.com/mhwombat/grid/wiki>.+data HexHexGrid = HexHexGrid Int [(Int, Int)] deriving Eq++instance Show HexHexGrid where show (HexHexGrid s _) = "hexHexGrid " ++ show s++instance Grid HexHexGrid where+  type Index HexHexGrid = (Int, Int)+  type Direction HexHexGrid = HexDirection+  indices (HexHexGrid _ xs) = xs+  neighbours = neighboursBasedOn UnboundedHexGrid+  distance = distanceBasedOn UnboundedHexGrid+  directionTo = directionToBasedOn UnboundedHexGrid+  contains g (x,y) = -s < x && x < s && check+    where s = size g+          check = if x < 0+                    then -s-x < y && y < s+                    else -s < y && y < s-x++instance FiniteGrid HexHexGrid where+  type Size HexHexGrid = Int+  size (HexHexGrid s _) = s+  maxPossibleDistance g@(HexHexGrid s _) = distance g (-s+1,0) (s-1,0)++instance BoundedGrid HexHexGrid where+  tileSideCount _ = 6+  boundary g = +    northwest ++ northeast ++ east ++ southeast ++ southwest ++ west+    where s = size g+          northwest = [(k,s-1) | k <- [-s+1,-s+2..0]]+          northeast = [(k,s-1-k) | k <- [1,2..s-1]]+          east = [(s-1,k) | k <- [-1,-2..(-s)+1]]+          southeast = [(k,(-s)+1) | k <- [s-2,s-3..0]]+          southwest = [(k,(-s)+1-k) | k <- [-1,-2..(-s)+1]]+          west = [(-s+1,k) | k <- [1,2..s-2]]+  centre _ = [(0,0)]++-- | @'hexHexGrid' s@ returns a grid of hexagonal shape, with+--   sides of length @s@, using hexagonal tiles. If @s@ is nonnegative, the +--   resulting grid will have @3*s*(s-1) + 1@ tiles. Otherwise, the resulting +--   grid will be null and the list of indices will be null.+hexHexGrid :: Int -> HexHexGrid+hexHexGrid r = HexHexGrid r [(x, y) | x <- [-r+1..r-1], y <- f x]+  where f x = if x < 0 then [1-r-x .. r-1] else [1-r .. r-1-x]++--+-- Rectangular grids with hexagonal tiles+--++-- | A rectangular 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 RectHexGrid = RectHexGrid (Int, Int) [(Int, Int)] deriving Eq++instance Show RectHexGrid where +  show (RectHexGrid (r,c) _) = "rectHexGrid " ++ show r ++ " " ++ show c++instance Grid RectHexGrid where+  type Index RectHexGrid = (Int, Int)+  type Direction RectHexGrid = HexDirection+  indices (RectHexGrid _ xs) = xs+  neighbours = neighboursBasedOn UnboundedHexGrid+  distance = distanceBasedOn UnboundedHexGrid+  directionTo = directionToBasedOn UnboundedHexGrid+  contains g (x,y) = 0 <= x && x < c && y0 <= y && y <= y1+    where (r,c) = size g+          y0 = rectHexGridY x 0+          y1 = rectHexGridY x (r-1)+--          (y0,y1) = rectHexGridYEndpoints r x++instance FiniteGrid RectHexGrid where+  type Size RectHexGrid = (Int, Int)+  size (RectHexGrid s _) = s+  maxPossibleDistance g@(RectHexGrid (r,c) _) = +    distance g (0,0) (c-1,r-(c `div` 2))++instance BoundedGrid RectHexGrid where+  tileSideCount _ = 6+  boundary g =+    [(0,rectHexGridY 0 j) | j <- [0..r-1], c>0]                -- West+      ++ [(x,rectHexGridY x (r-1)) | x <- [1..c-1], r>0]       -- North+      ++ [(c-1,rectHexGridY (c-1) j) | j <- [r-2,r-3..0], c>1] -- East+      ++ [(x,rectHexGridY x 0) | x <- [c-2,c-3..1], r>1]       -- South+    where (r,c) = size g++-- | @'rectHexGrid' r c@ returns a grid in the shape of a +--   parallelogram with @r@ rows and @c@ columns, using hexagonal tiles.+--   If @r@ and @c@ are both nonnegative, the resulting grid will have+--   @r*c@ tiles. Otherwise, the resulting grid will be null and the+--   list of indices will be null.+rectHexGrid :: Int -> Int -> RectHexGrid+rectHexGrid r c = +  RectHexGrid (r,c) [(x,rectHexGridY x j) | x <- [0..c-1], j <- [0..r-1]]++rectHexGridY :: Int -> Int -> Int+rectHexGridY x j = j - x `div` 2

@@ -1,4 +1,4 @@------------------------------------------------------------------------------+------------------------------------------------------------------------ -- | -- Module      :  Math.Geometry.OctGrid -- Copyright   :  (c) Amy de Buitléir 2012@@ -16,8 +16,8 @@ -- <https://github.com/mhwombat/grid/wiki>. -- Also see @Math.Geometry.Grid@ for examples of how to use this class. ---------------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, +------------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances,    FlexibleInstances #-}  module Math.Geometry.Grid.Octagonal

@@ -12,14 +12,13 @@ -- without notice. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}  module Math.Geometry.Grid.OctagonalInternal where  import Prelude hiding (null)  import Data.List (nub)-import Data.Ord.Unicode ((≤)) import Math.Geometry.GridInternal  data OctDirection = West | Northwest | North | Northeast | East | @@ -73,15 +72,17 @@   neighbours = neighboursBasedOn UnboundedOctGrid   distance = distanceBasedOn UnboundedOctGrid   directionTo = directionToBasedOn UnboundedOctGrid-  contains g (x,y) = 0 ≤ x && x < c && 0 ≤ y && y < r+  contains g (x,y) = 0 <= x && x < c && 0 <= y && y < r     where (r,c) = size g  instance FiniteGrid RectOctGrid where   type Size RectOctGrid = (Int, Int)   size (RectOctGrid s _) = s+  maxPossibleDistance g@(RectOctGrid (r,c) _) = +    distance g (0,0) (c-1,r-1)  instance BoundedGrid RectOctGrid where-  tileSideCount _ = 4+  tileSideCount _ = 8   boundary g = cartesianIndices . size $ g   centre g = cartesianCentre . size $ g @@ -90,9 +91,9 @@ --   nonnegative, the resulting grid will have @r*c@ tiles. Otherwise,  --   the resulting grid will be null and the list of indices will be  --   null.-rectOctGrid ∷ Int → Int → RectOctGrid+rectOctGrid :: Int -> Int -> RectOctGrid rectOctGrid r c = -  RectOctGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]]+  RectOctGrid (r,c) [(x,y) | x <- [0..c-1], y <- [0..r-1]]  -- -- Toroidal grids with octagonal tiles.@@ -114,12 +115,14 @@   neighbour = neighbourWrappedBasedOn UnboundedOctGrid   distance = distanceWrappedBasedOn UnboundedOctGrid   directionTo = directionToWrappedBasedOn UnboundedOctGrid-  isAdjacent g a b = distance g a b ≤ 1+  isAdjacent g a b = distance g a b <= 1   contains _ _ = True  instance FiniteGrid TorOctGrid where   type Size TorOctGrid = (Int, Int)   size (TorOctGrid s _) = s+  maxPossibleDistance g@(TorOctGrid (r,c) _) =+    distance g (0,0) (c `div` 2, r `div` 2)  instance WrappedGrid TorOctGrid where   normalise g (x,y) = (x `mod` c, y `mod` r)@@ -134,6 +137,6 @@ --   rows and @c@ columns, using octagonal tiles. If @r@ and @c@ are  --   both nonnegative, the resulting grid will have @r*c@ tiles. Otherwise,  --   the resulting grid will be null and the list of indices will be null.-torOctGrid ∷ Int → Int → TorOctGrid-torOctGrid r c = TorOctGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]+torOctGrid :: Int -> Int -> TorOctGrid+torOctGrid r c = TorOctGrid (r,c) [(x, y) | x <- [0..c-1], y <- [0..r-1]] 

@@ -1,4 +1,4 @@------------------------------------------------------------------------------+------------------------------------------------------------------------ -- | -- Module      :  Math.Geometry.SquareGrid -- Copyright   :  (c) Amy de Buitléir 2012@@ -12,8 +12,8 @@ -- <https://github.com/mhwombat/grid/wiki>. -- Also see @Math.Geometry.Grid@ for examples of how to use this class. ---------------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, +------------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances,    FlexibleInstances #-}  module Math.Geometry.Grid.Square

@@ -12,15 +12,13 @@ -- without notice. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}  module Math.Geometry.Grid.SquareInternal where  import Prelude hiding (null) -import Data.Eq.Unicode ((≠)) import Data.List (nub)-import Data.Ord.Unicode ((≤)) import Math.Geometry.GridInternal  data SquareDirection = North | East | South | West deriving (Show, Eq)@@ -65,18 +63,20 @@   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)]+    filter (\i -> g `contains` i && i /= a) $ nub [(x1,y1+dy),(x1+dx,y1)]       where dx = signum (x2-x1)             dy = signum (y2-y1)   directionTo g x y = if g `contains` x && g `contains` y                         then directionTo UnboundedSquareGrid x y                         else []-  contains g (x,y) = 0 ≤ x && x < c && 0 ≤ y && y < r+  contains g (x,y) = 0 <= x && x < c && 0 <= y && y < r     where (r, c) = size g  instance FiniteGrid RectSquareGrid where   type Size RectSquareGrid = (Int, Int)   size (RectSquareGrid s _) = s+  maxPossibleDistance g@(RectSquareGrid (r,c) _) = +    distance g (0,0) (c-1,r-1)  instance BoundedGrid RectSquareGrid where   tileSideCount _ = 4@@ -88,9 +88,9 @@ --   nonnegative, the resulting grid will have @r*c@ tiles. Otherwise,  --   the resulting grid will be null and the list of indices will be  --   null.-rectSquareGrid ∷ Int → Int → RectSquareGrid+rectSquareGrid :: Int -> Int -> RectSquareGrid rectSquareGrid r c = -  RectSquareGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]]+  RectSquareGrid (r,c) [(x,y) | x <- [0..c-1], y <- [0..r-1]]  -- -- Toroidal grids with square tiles.@@ -112,12 +112,14 @@   neighbour = neighbourWrappedBasedOn UnboundedSquareGrid   distance = distanceWrappedBasedOn UnboundedSquareGrid   directionTo = directionToWrappedBasedOn UnboundedSquareGrid-  isAdjacent g a b = distance g a b ≤ 1+  isAdjacent g a b = distance g a b <= 1   contains _ _ = True  instance FiniteGrid TorSquareGrid where   type Size TorSquareGrid = (Int, Int)   size (TorSquareGrid s _) = s+  maxPossibleDistance g@(TorSquareGrid (r,c) _) =+    distance g (0,0) (c `div` 2, r `div` 2)  instance WrappedGrid TorSquareGrid where   normalise g (x,y) = (x `mod` c, y `mod` r)@@ -132,6 +134,6 @@ --   rows and @c@ columns, using square tiles. If @r@ and @c@ are  --   both nonnegative, the resulting grid will have @r*c@ tiles. Otherwise,  --   the resulting grid will be null and the list of indices will be null.-torSquareGrid ∷ Int → Int → TorSquareGrid-torSquareGrid r c = TorSquareGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]+torSquareGrid :: Int -> Int -> TorSquareGrid+torSquareGrid r c = TorSquareGrid (r,c) [(x, y) | x <- [0..c-1], y <- [0..r-1]] 

@@ -1,4 +1,4 @@------------------------------------------------------------------------------+------------------------------------------------------------------------ -- | -- Module      :  Math.Geometry.TriGrid -- Copyright   :  (c) Amy de Buitléir 2012@@ -12,8 +12,8 @@ -- <https://github.com/mhwombat/grid/wiki>. -- Also see @Math.Geometry.Grid@ for examples of how to use this class. ---------------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, +------------------------------------------------------------------------+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances,    FlexibleInstances #-}  module Math.Geometry.Grid.Triangular

@@ -12,15 +12,13 @@ -- without notice. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}  module Math.Geometry.Grid.TriangularInternal where  import Prelude hiding (null) -import Data.Eq.Unicode ((≡)) import Data.List (nub)-import Data.Ord.Unicode ((≤), (≥)) import Math.Geometry.GridInternal  data TriDirection = South | Northwest | Northeast | @@ -38,7 +36,7 @@   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) = +  distance _ (x1, y1) (x2, y2) =     maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]       where z1 = triZ x1 y1             z2 = triZ x2 y2@@ -61,7 +59,7 @@  -- | For triangular tiles, it is convenient to define a third component  --   z.-triZ ∷ Int → Int → Int            +triZ :: Int -> Int -> Int             triZ x y = if even y then -x - y else -x - y + 1  --@@ -85,26 +83,27 @@   contains (TriTriGrid s _) (x, y) = inTriTriGrid (x,y) s   directionTo = directionToBasedOn UnboundedTriGrid -inTriTriGrid ∷ (Int, Int) → Int → Bool-inTriTriGrid (x, y) s = x ≥ 0 && y ≥ 0 && even (x+y) && abs z ≤ 2*s-2+inTriTriGrid :: (Int, Int) -> Int -> Bool+inTriTriGrid (x, y) s = x >= 0 && y >= 0 && even (x+y) && abs z <= 2*s-2   where z = triZ x y  instance FiniteGrid TriTriGrid where   type Size TriTriGrid = Int   size (TriTriGrid s _) = s+  maxPossibleDistance g@(TriTriGrid s _) = distance g (0,0) (2*s-2,0)  instance BoundedGrid TriTriGrid where   tileSideCount _ = 3   boundary g = west ++ east ++ south     where s = size g-          west = [(0,k) | k ← [0,2..2*s-2]]-          east = [(k,2*s-2-k) | k ← [2,4..2*s-2]]-          south = [(k,0) | k ← [2*s-4,2*s-6..2]]+          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."+    0 -> trefoilWithTop (k-1,k+1) where k = (2*s) `div` 3+    1 -> [(k,k)] where k = (2*(s-1)) `div` 3+    2 -> [(k+1,k+1)] where k = (2*(s-2)) `div` 3+    _ -> error "This will never happen."     where s = size g           trefoilWithTop (i,j) = [(i,j), (i+2, j-2), (i,j-2)] @@ -112,10 +111,10 @@ --   length @s@, using triangular tiles. If @s@ is nonnegative, the  --   resulting grid will have @s^2@ tiles. Otherwise, the resulting grid --   will be null and the list of indices will be null.-triTriGrid ∷ Int → TriTriGrid+triTriGrid :: Int -> TriTriGrid triTriGrid s = -  TriTriGrid s [(xx,yy) | xx ← [0..2*(s-1)], -                          yy ← [0..2*(s-1)], +  TriTriGrid s [(xx,yy) | xx <- [0..2*(s-1)], +                          yy <- [0..2*(s-1)],                            (xx,yy) `inTriTriGrid` s]  --@@ -137,26 +136,28 @@   neighbours = neighboursBasedOn UnboundedTriGrid   distance = distanceBasedOn UnboundedTriGrid   directionTo = directionToBasedOn UnboundedTriGrid-  contains g (x,y) = 0 ≤ x && x < 2*c && 0 ≤ y && y < 2*r && even (x+y)+  contains g (x,y) = 0 <= x && x < 2*c && 0 <= y && y < 2*r && even (x+y)     where (r,c) = size g  instance FiniteGrid ParaTriGrid where   type Size ParaTriGrid = (Int, Int)   size (ParaTriGrid s _) = s+  maxPossibleDistance g@(ParaTriGrid (r,c) _) =+    distance g (0,0) (2*c-1,2*r-1)  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]+          west = [(0,k) | k <- [0,2..2*r-2], c>0]+          north = [(k,2*r-1) | k <- [1,3..2*c-1], r>0]+          east = [(2*c-1,k) | k <- [2*r-3,2*r-5..1], c>0]+          south = [(k,0) | k <- [2*c-2,2*c-4..2], r>0]   centre g = f . size $ g     where f (r,c)             | odd r && odd c                              = [(c-1,r-1), (c,r)]-            | even r && even c && r ≡ c +            | 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)@@ -171,10 +172,13 @@ --   tiles. If @r@ and @c@ are both nonnegative, the resulting grid will --   have @2*r*c@ tiles. Otherwise, the resulting grid will be null and --   the list of indices will be null.-paraTriGrid ∷ Int → Int → ParaTriGrid+paraTriGrid :: Int -> Int -> ParaTriGrid paraTriGrid r c = -  ParaTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]+  ParaTriGrid (r,c) (parallelogramIndices r c) +parallelogramIndices :: Int -> Int -> [(Int, Int)]+parallelogramIndices r c = +  [(x,y) | x <- [0..2*c-1], y <- [0..2*r-1], even (x+y)]  -- -- Rectangular grids with triangular tiles@@ -200,6 +204,8 @@ instance FiniteGrid RectTriGrid where   type Size RectTriGrid = (Int, Int)   size (RectTriGrid s _) = s+  maxPossibleDistance g = -- TODO: make more efficient+    maximum . map (distance g (0,0)) . indices $ g  instance BoundedGrid RectTriGrid where   tileSideCount _ = 3@@ -209,8 +215,8 @@ --   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)]+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)@@ -236,12 +242,14 @@   neighbour = neighbourWrappedBasedOn UnboundedTriGrid   distance = distanceWrappedBasedOn UnboundedTriGrid   directionTo = directionToWrappedBasedOn UnboundedTriGrid-  isAdjacent g a b = distance g a b ≤ 1+  isAdjacent g a b = distance g a b <= 1   contains _ _ = True  instance FiniteGrid TorTriGrid where   type Size TorTriGrid = (Int, Int)   size (TorTriGrid s _) = s+  maxPossibleDistance g = -- TODO: make more efficient+    maximum . map (distance g (0,0)) . indices $ g  instance WrappedGrid TorTriGrid where   normalise g (x,y) | y < 0     = normalise g (x,y+2*r)@@ -261,9 +269,8 @@ --   for @ParaTriGrid@. If @r@ and @c@ are both nonnegative, the  --   resulting grid will have @2*r*c@ tiles. Otherwise, the resulting --   grid will be null and the list of indices will be null.-torTriGrid ∷ Int → Int → TorTriGrid-torTriGrid r c = -  TorTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]+torTriGrid :: Int -> Int -> TorTriGrid+torTriGrid r c = TorTriGrid (r,c) (parallelogramIndices r c)  -- -- Cylindrical grids with triangular tiles@@ -286,13 +293,15 @@   neighbour = neighbourWrappedBasedOn UnboundedTriGrid   distance = distanceWrappedBasedOn UnboundedTriGrid   directionTo = directionToWrappedBasedOn UnboundedTriGrid-  isAdjacent g a b = distance g a b ≤ 1-  contains g (x, y) = 0 ≤ y && y ≤ 2*r-1 && even (x+y) +  isAdjacent g a b = distance g a b <= 1+  contains g (x, y) = 0 <= y && y <= 2*r-1 && even (x+y)      where (r, _) = size g  instance FiniteGrid YCylTriGrid where   type Size YCylTriGrid = (Int, Int)   size (YCylTriGrid s _) = s+  maxPossibleDistance g = -- TODO: make more efficient+    maximum . map (distance g (0,0)) . indices $ g  instance WrappedGrid YCylTriGrid where   normalise g (x,y) | x < 0     = normalise g (x+2*c,y)@@ -309,9 +318,51 @@ --   If @r@ and @c@ are both nonnegative, the resulting grid will have  --   @2*r*c@ tiles. Otherwise, the resulting grid will be null and the  --   list of indices will be null.-yCylTriGrid ∷ Int → Int → YCylTriGrid-yCylTriGrid r c = -  YCylTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]+yCylTriGrid :: Int -> Int -> YCylTriGrid+yCylTriGrid r c = YCylTriGrid (r,c) (parallelogramIndices r c) +-- -- | A cylindrical grid with triangular tiles, where the cylinder is+-- --   along the x-axis.+-- --   The grid and its indexing scheme are illustrated in the user guide,+-- --   available at <https://github.com/mhwombat/grid/wiki>.+-- data XCylTriGrid = XCylTriGrid (Int, Int) [(Int, Int)] deriving Eq +-- instance Show XCylTriGrid where +--   show (XCylTriGrid (r,c) _) = "yCylTriGrid " ++ show r ++ " " ++ show c++-- instance Grid XCylTriGrid where+--   type Index XCylTriGrid = (Int, Int)+--   type Direction XCylTriGrid = TriDirection+--   indices (XCylTriGrid _ xs) = xs+--   neighbours = neighboursWrappedBasedOn UnboundedTriGrid+--   neighbour = neighbourWrappedBasedOn UnboundedTriGrid+--   distance = distanceWrappedBasedOn UnboundedTriGrid+--   directionTo = directionToWrappedBasedOn UnboundedTriGrid+--   isAdjacent g a b = distance g a b <= 1+--   contains g (x, y) = 0 <= x && x <= 2*c-1 && even (x+y) +--     where (_, c) = size g++-- instance FiniteGrid XCylTriGrid where+--   type Size XCylTriGrid = (Int, Int)+--   size (XCylTriGrid s _) = s+--   maxPossibleDistance g = -- TODO: make more efficient+--     maximum . map (distance g (0,0)) . indices $ g++-- instance WrappedGrid XCylTriGrid where+--   normalise g (x,y) | y < 0     = normalise g (x,y+2*r)+--                     | y > 2*r-1 = normalise g (x,y-2*r)+--                     | otherwise = (x,y)+--     where (r, _) = size g+--   denormalise g a = nub [ (x,y-2*r), (x,y), (x,y+2*r) ]+--     where (r, _) = size g+--           (x, y) = normalise g a++-- -- | @'xCylTriGrid' r c@ returns a cylindrical grid with @r@ rows and +-- --   @c@ columns, using triangular tiles, where the cylinder is along +-- --   the y-axis. The indexing method is the same as for @ParaTriGrid@. +-- --   If @r@ and @c@ are both nonnegative, the resulting grid will have +-- --   @2*r*c@ tiles. Otherwise, the resulting grid will be null and the +-- --   list of indices will be null.+-- xCylTriGrid :: Int -> Int -> XCylTriGrid+-- xCylTriGrid r c = XCylTriGrid (r,c) (parallelogramIndices r c) 

@@ -11,33 +11,32 @@ -- use @Grid@ instead. This module is subject to change without notice. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}  module Math.Geometry.GridInternal where  import Prelude hiding (null) -import Data.Eq.Unicode ((≡)) import Data.Function (on) import Data.List (groupBy, nub, nubBy, sortBy) import Data.Ord (comparing)  -- | A regular arrangement of tiles.---   Minimal complete definition: @Index@, @Direction@, @indices@,---   @distance@, @directionTo@.+--   Minimal complete definition: @'Index'@, @'Direction'@, @'indices'@,+--   @'distance'@, @'directionTo'@. class Grid g where   type Index g   type Direction g    -- | Returns the indices of all tiles in a grid.-  indices ∷ g → [Index g]+  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 → Index g → Index g → 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@@ -45,53 +44,55 @@   --   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 → [Index g] → Index g → Int+  minDistance :: g -> [Index g] -> Index g -> Int   minDistance = defaultMinDistance    -- | @'neighbours' g a@ returns the indices of the tiles in the grid   --   @g@ which are adjacent to the tile with index @a@.-  neighbours ∷ g → Index g → [Index g]+  neighbours :: Eq (Index g) => g -> Index g -> [Index g]   neighbours = defaultNeighbours    -- | @'neighbour' g d a@ returns the indices of the tile in the grid   --   @g@ which is adjacent to the tile with index @a@, in the   --   direction @d@.-  neighbour ∷ Eq (Direction g) ⇒ g → Index g → Direction g → Index g+  neighbour+    :: (Eq (Index g), Eq (Direction g))+       => g -> Index g -> Direction g -> Maybe (Index g)   neighbour = defaultNeighbour    -- | @'numNeighbours' g a@ returns the number of tiles in the grid   --   @g@ which are adjacent to the tile with index @a@.-  numNeighbours ∷ g → Index g → Int+  numNeighbours :: Eq (Index g) => g -> Index g -> Int   numNeighbours g = length . neighbours g    -- | @g `'contains'` a@ returns @True@ if the index @a@ is contained   --   within the grid @g@, otherwise it returns false.-  contains ∷ Eq (Index g) ⇒ g → Index g → Bool+  contains :: Eq (Index g) => g -> Index g -> Bool   contains g a = a `elem` indices g    -- | Returns the number of tiles in a grid. Compare with @'size'@.-  tileCount ∷ g → Int+  tileCount :: g -> Int   tileCount = length . indices    -- | Returns @True@ if the number of tiles in a grid is zero, @False@   --   otherwise.-  null ∷ g → Bool-  null 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.-  nonNull ∷ g → Bool+  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 ∷ Eq (Index g) ⇒ g → [(Index g,Index g)]+  edges :: Eq (Index g) => g -> [(Index g,Index g)]   edges = defaultEdges    -- | @'viewpoint' g a@ returns a list of pairs associating the index   --   of each tile in @g@ with its distance to the tile with index @a@.   --   If @a@ is not contained within @g@, the result is undefined.-  viewpoint ∷ g → Index g → [(Index g, Int)]+  viewpoint :: g -> Index g -> [(Index g, Int)]   viewpoint g p = map f (indices g)     where f a = (a, distance g p a) @@ -99,7 +100,7 @@   --   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 ∷ g → Index g → Index g → Bool+  isAdjacent :: g -> Index g -> Index g -> Bool   isAdjacent = defaultIsAdjacent    -- | @'adjacentTilesToward' g a b@ returns the indices of all tiles@@ -108,7 +109,7 @@   --   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 → Index g → Index g → [Index g]+  adjacentTilesToward :: Eq (Index g) => g -> Index g -> Index g -> [Index g]   adjacentTilesToward = defaultAdjacentTilesToward    -- | @'minimalPaths' g a b@ returns a list of all minimal paths from@@ -122,178 +123,179 @@   --   @'adjacentTilesToward'@. If you want to use a custom algorithm,   --   consider modifying @'adjacentTilesToward'@ instead of   --   @'minimalPaths'@.-  minimalPaths ∷ Eq (Index g) ⇒ g → Index g → Index g → [[Index g]]+  minimalPaths :: Eq (Index g) => g -> Index g -> Index g -> [[Index g]]   minimalPaths = defaultMinimalPaths    -- | @'directionTo' g a b@ returns the direction(s) of the next   --   tile(s) in a /minimal/ path from the tile at index @a@ to the   --   tile at index @b@ in grid @g@.-  directionTo ∷ g → Index g → Index g → [Direction g]+  directionTo :: g -> Index g -> Index g -> [Direction g]    --   -- These default implementations are broken out to make it easier to   -- compare the results with custom implementations (for testing).   ----  defaultMinDistance ∷ g → [Index g] → Index g → Int+  +  defaultMinDistance :: g -> [Index g] -> Index g -> Int   defaultMinDistance g xs a = minimum . map (distance g a) $ xs -  defaultNeighbours ∷ g → Index g → [Index g]-  defaultNeighbours g a = filter (\b → distance g a b ≡ 1 ) $ indices g+  -- WARNING: this implementation won't work for wrapped grids+  defaultNeighbours :: g -> Index g -> [Index g]+  defaultNeighbours g a = filter (\b -> distance g a b == 1 ) $ indices g -  defaultNeighbour ∷ Eq (Direction g)-    ⇒ g → Index g → Direction g → Index g+  -- WARNING: this implementation won't work for wrapped grids+  defaultNeighbour :: (Eq (Index g), Eq (Direction g))+    => g -> Index g -> Direction g -> Maybe (Index g)   defaultNeighbour g a d =-    head . filter (\b → [d] ≡ directionTo g a b) . neighbours g $ a+    maybeHead . filter (\b -> [d] == directionTo g a b) . neighbours g $ a+    where maybeHead (x:_) = Just x+          maybeHead _ = Nothing -  defaultTileCount ∷ g → Int+  defaultTileCount :: g -> Int   defaultTileCount = length . indices -  defaultEdges ∷ Eq (Index g) ⇒ g → [(Index g,Index g)]+  -- WARNING: this implementation won't work for wrapped grids+  defaultEdges :: Eq (Index g) => g -> [(Index g,Index g)]   defaultEdges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g -  defaultIsAdjacent ∷ g → Index g → Index g → Bool-  defaultIsAdjacent g a b = distance g a b ≡ 1+  -- WARNING: this implementation won't work for wrapped grids+  defaultIsAdjacent :: g -> Index g -> Index g -> Bool+  defaultIsAdjacent g a b = distance g a b == 1 -  defaultAdjacentTilesToward ∷ g → Index g → Index g → [Index g]+  defaultAdjacentTilesToward+    :: Eq (Index g) => g -> Index g -> Index g -> [Index g]   defaultAdjacentTilesToward g a b = filter f $ neighbours g a-    where f c = distance g c b ≡ distance g a b - 1+    where f c = distance g c b == distance g a b - 1 -  defaultMinimalPaths ∷ Eq (Index g)-    ⇒ g → Index g → Index g → [[Index g]]+  defaultMinimalPaths :: Eq (Index g)+    => g -> Index g -> Index g -> [[Index g]]   defaultMinimalPaths g a b-    | a ≡ b              = [[a]]-    | distance g a b ≡ 1 = [[a,b]]+    | a == b              = [[a]]+    | distance g a b == 1 = [[a,b]]     | otherwise          = map (a:) xs-    where xs = concatMap (\c → minimalPaths g c b) ys+    where xs = concatMap (\c -> minimalPaths g c b) ys           ys = adjacentTilesToward g a b ------ Helper functions-----sameEdge ∷ Eq t ⇒ (t, t) → (t, t) → Bool-sameEdge (a,b) (c,d) = (a,b) ≡ (c,d) || (a,b) ≡ (d,c)--adjacentEdges ∷ Grid g ⇒ Index g → g → [(Index g, Index g)]-adjacentEdges i g = map (\j → (i,j)) $ neighbours g i--cartesianIndices-  ∷ (Enum r, Enum c, Num r, Num c, Ord r, Ord c) ⇒-     (r, c) → [(c, r)]-cartesianIndices (r, c) = west ++ north ++ east ++ south-  where west = [(0,k) | k ← [0,1..r-1], c>0]-        north = [(k,r-1) | k ← [1,2..c-1], r>0]-        east = [(c-1,k) | k ← [r-2,r-3..0], c>1]-        south = [(k,0) | k ← [c-2,c-3..1], r>1]--cartesianCentre ∷ (Int, Int) → [(Int, Int)]-cartesianCentre (r,c) = [(i,j) | i ← cartesianMidpoints c, j ← cartesianMidpoints r]--cartesianMidpoints ∷ Int → [Int]-cartesianMidpoints k = if even k then [m-1,m] else [m]-  where m = floor (k'/2.0)-        k' = fromIntegral k ∷ Double-- -- | A regular arrangement of tiles where the number of tiles is finite.---   Minimal complete definition: @size@.-class Grid g ⇒ FiniteGrid g where+--   Minimal complete definition: @'size'@, @'maxPossibleDistance'@.+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+  size :: g -> Size g+  -- | Returns the largest possible distance between two tiles in the+  --   grid.+  maxPossibleDistance :: g -> Int   -- | A regular arrangement of tiles with an edge.---   Minimal complete definition: @tileSideCount@.-class Grid g ⇒ BoundedGrid g where+--   Minimal complete definition: @'tileSideCount'@.+class Grid g => BoundedGrid g where   -- | Returns the number of sides a tile has-  tileSideCount ∷ g → Int+  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 (\b → (b, numNeighbours g b)) $ indices g-          f (_,n) = n < tileSideCount g-+  boundary :: Eq (Index g) => g -> [Index g]+  boundary = defaultBoundary    -- | @'isBoundary' g a@' returns @True@ if the tile with index @a@ is   --   on a boundary of @g@, @False@ otherwise. (Corner tiles are also   --   boundary tiles.)-  isBoundary ∷ Eq (Index g) ⇒ g → Index g → Bool-  isBoundary g a = a `elem` boundary g+  isBoundary :: Eq (Index g) => g -> Index g -> Bool+  isBoundary = defaultIsBoundary    -- | Returns the index of the tile(s) that require the maximum number   --   of moves to reach the nearest boundary tile. A grid may have more   --   than one central tile (e.g., a rectangular grid with an even   --   number of rows and columns will have four central tiles).-  centre ∷ g → [Index g]-  centre g = map fst . last . groupBy ((≡) `on` snd) .-                sortBy (comparing snd) $ xds-    where xds = map (\b → (b, minDistance g bs b)) $ indices g-          bs = boundary g-+  centre :: Eq (Index g) => g -> [Index g]+  centre = defaultCentre    -- | @'isCentre' g a@' returns @True@ if the tile with index @a@ is   --   a centre tile of @g@, @False@ otherwise.-  isCentre ∷ Eq (Index g) ⇒ g → Index g → Bool-  isCentre g a = a `elem` centre g+  isCentre :: Eq (Index g) => g -> Index g -> Bool+  isCentre = defaultIsCentre +  --+  -- These default implementations are broken out to make it easier to+  -- compare the results with custom implementations (for testing).+  --++  defaultBoundary :: Eq (Index g) => g -> [Index g]+  defaultBoundary g = map fst . filter f $ xds+    where xds = map (\b -> (b, numNeighbours g b)) $ indices g+          f (_,n) = n < tileSideCount g++  defaultIsBoundary :: Eq (Index g) => g -> Index g -> Bool+  defaultIsBoundary g a = a `elem` boundary g++  -- WARNING: this implementation won't work for triangular grids.+  -- It probably only works on grids where all the tiles have the same+  -- shape/orientation.+  defaultCentre :: Eq (Index g) => g -> [Index g]+  defaultCentre g = map fst . head . groupBy ((==) `on` snd) .+                sortBy (comparing snd) $ xds+    where xds = map (\b -> (b, f b)) $ indices g+          bs = boundary g+          f x = sum . map (distance g x) $ bs++  defaultIsCentre :: Eq (Index g) => g -> Index g -> Bool+  defaultIsCentre g a = a `elem` centre g+   -- | A regular arrangement of tiles where the boundaries are joined.---   Minimal complete definition: @normalise@.-class (Grid g) ⇒ WrappedGrid g where+--   Minimal complete definition: @'normalise'@ and @'denormalise'@.+class (Grid g) => WrappedGrid g where   -- | @'normalise' g a@ returns the "normal" indices for @a@.   --   TODO: need a clearer description and an illustration.-  normalise ∷ g → Index g → Index g+  normalise :: g -> Index g -> Index g   -- | @'denormalise' g a@ returns all of the indices in @a@'s   --   translation group. In other words, it returns @a@ plus the   --   indices obtained by translating @a@ in each direction by the   --   extent of the grid along that direction.   --   TODO: need a clearer description and an illustration.-  denormalise ∷ g → Index g → [Index g]+  denormalise :: g -> Index g -> [Index g]  neighboursBasedOn-  ∷ (Eq (Index u), Grid g, Grid u, Index g ~ Index u) ⇒-    u → g → Index g → [Index g]+  :: (Eq (Index u), Grid g, Grid u, Index g ~ Index u) =>+    u -> g -> Index g -> [Index g] neighboursBasedOn u g = filter (g `contains`) . neighbours u  distanceBasedOn-  ∷ (Eq (Index g), Grid g, Grid u, Index g ~ Index u) ⇒-    u → g → Index g → Index g → Int+  :: (Eq (Index g), Grid g, Grid u, Index g ~ Index u) =>+    u -> g -> Index g -> Index g -> Int distanceBasedOn u g a b =   if g `contains` a && g `contains` b     then distance u a b     else undefined  directionToBasedOn-  ∷ (Eq (Index g), Eq (Direction g), Grid g, Grid u, Index g ~ Index u,-    Direction g ~ Direction u) ⇒-    u → g → Index g → Index g → [Direction g]+  :: (Eq (Index g), Eq (Direction g), Grid g, Grid u, Index g ~ Index u,+    Direction g ~ Direction u) =>+    u -> g -> Index g -> Index g -> [Direction g] directionToBasedOn u g a b =   if g `contains` a && g `contains` b     then nub . concatMap (directionTo u a) . adjacentTilesToward g a $ b     else undefined  neighboursWrappedBasedOn-  ∷ (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) ⇒-    u → g → Index g → [Index g]+  :: (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>+    u -> g -> Index g -> [Index g] neighboursWrappedBasedOn u g =   filter (g `contains`) . nub . map (normalise g) . neighbours u  neighbourWrappedBasedOn-  ∷ (Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u,-    Index g ~ Index u, Direction g ~ Direction u) ⇒-    u → g → Index g → Direction g → Index g+  :: (Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u,+    Index g ~ Index u, Direction g ~ Direction u) =>+    u -> g -> Index g -> Direction g -> Maybe (Index g) neighbourWrappedBasedOn u g a d =   if g `contains` a-    then normalise g . neighbour u a $ d-    else undefined+    then neighbour u a d >>= return . normalise g+    else Nothing  distanceWrappedBasedOn-  ∷ (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) ⇒-    u → g → Index g → Index g → Int+  :: (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>+    u -> g -> Index g -> Index g -> Int distanceWrappedBasedOn u g a b =   if g `contains` a && g `contains` b     then minimum . map (distance u a') $ bs@@ -302,9 +304,9 @@         bs = denormalise g b  directionToWrappedBasedOn-  ∷ (Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u,-    Index g ~ Index u, Direction g ~ Direction u) ⇒-    u → g → Index g → Index g → [Direction g]+  :: (Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u,+    Index g ~ Index u, Direction g ~ Direction u) =>+    u -> g -> Index g -> Index g -> [Direction g] directionToWrappedBasedOn u g a b =   if g `contains` a && g `contains` b     then nub . concatMap (directionTo u a') $ ys'@@ -313,3 +315,29 @@         ys = denormalise g b         minD = distance g a b         ys' = filter (\c -> distance u a' c == minD) ys++--+-- Helper functions+--++sameEdge :: Eq t => (t, t) -> (t, t) -> Bool+sameEdge (a,b) (c,d) = (a,b) == (c,d) || (a,b) == (d,c)++adjacentEdges :: (Grid g, Eq (Index g)) => Index g -> g -> [(Index g, Index g)]+adjacentEdges i g = map (\j -> (i,j)) $ neighbours g i++cartesianIndices+  :: (Enum r, Enum c, Num r, Num c, Ord r, Ord c) =>+     (r, c) -> [(c, r)]+cartesianIndices (r, c) = west ++ north ++ east ++ south+  where west = [(0,k) | k <- [0,1..r-1], c>0]+        north = [(k,r-1) | k <- [1,2..c-1], r>0]+        east = [(c-1,k) | k <- [r-2,r-3..0], c>1]+        south = [(k,0) | k <- [c-2,c-3..1], r>1]++cartesianCentre :: (Int, Int) -> [(Int, Int)]+cartesianCentre (r,c) = [(i,j) | i <- cartesianMidpoints c, j <- cartesianMidpoints r]++cartesianMidpoints :: Int -> [Int]+cartesianMidpoints k = if even k then [m-1,m] else [m]+  where m = k `div` 2

@@ -13,8 +13,8 @@ -- into a single type. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts, -    MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, MultiParamTypeClasses,+    UndecidableInstances #-}  module Math.Geometry.GridMap   (@@ -54,64 +54,64 @@ --   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+class (G.Grid (BaseGrid gm v), Foldable gm) => +    GridMap (gm :: * -> *) v where   type BaseGrid gm v    -- | Find the value at a tile position in the grid.-  (!) ∷ (k ~ (G.Index (BaseGrid gm v)), Ord k) ⇒ gm v → k → v+  (!) :: (k ~ (G.Index (BaseGrid gm v)), Ord k) => gm v -> k -> v   (!) gm k = toMap gm M.! k    -- | Returns a map of grid indices to values.-  toMap ∷ k ~ (G.Index (BaseGrid gm v)) ⇒ gm v → M.Map k v+  toMap :: k ~ (G.Index (BaseGrid gm v)) => gm v -> M.Map k v    -- | Returns the grid on which this map is based.-  toGrid ∷ gm v → BaseGrid gm v+  toGrid :: gm v -> BaseGrid gm v    -- | Convert the map to a list of key/value pairs.-  toList ∷ k ~ (G.Index (BaseGrid gm v)) ⇒ gm v → [(k, v)]+  toList :: k ~ (G.Index (BaseGrid gm v)) => gm v -> [(k, v)]   toList = M.toList . toMap    -- | 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 ~ (G.Index (BaseGrid gm v)), Ord k) => k -> gm v -> Maybe v   lookup k = M.lookup k . toMap    -- | 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)+  adjust :: (k ~ (G.Index (BaseGrid gm v)), Ord k) => +    (v -> v) -> k -> gm v -> gm v+  adjust f = adjustWithKey (\_ v -> f v)    -- | 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+  adjustWithKey :: (k ~ (G.Index (BaseGrid gm v)), Ord k) => +    (k -> v -> v) -> k -> gm v -> gm v    -- | 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 :: (k ~ (G.Index (BaseGrid gm v)), Ord k) => +    v -> k -> gm v -> v   findWithDefault v k = M.findWithDefault v k . toMap    -- | Returns all values in the map -  elems ∷ gm v → [v]+  elems :: gm v -> [v]   elems = M.elems . toMap    -- | Map a function over all values in the map.   map -    ∷ (GridMap gm v2, -        G.Index (BaseGrid gm v) ~ G.Index (BaseGrid gm v2)) ⇒ -    (v → v2) → gm v → gm v2-  map f = mapWithKey (\_ v → f v)+    :: (GridMap gm v2, +        G.Index (BaseGrid gm v) ~ G.Index (BaseGrid gm v2)) => +    (v -> v2) -> gm v -> gm v2+  map f = mapWithKey (\_ v -> f v)    -- | Map a function over all values in the map.   mapWithKey -    ∷ (k ~ G.Index (BaseGrid gm v), k ~ G.Index (BaseGrid gm v2), -        GridMap gm v2) ⇒ -      (k → v → v2) → gm v → gm v2+    :: (k ~ G.Index (BaseGrid gm v), k ~ G.Index (BaseGrid gm v2), +        GridMap gm v2) => +      (k -> v -> v2) -> gm v -> gm v2  {- $Compare Some functions in @Data.Map@ have been replaced in @GridMap@.

@@ -13,8 +13,8 @@ -- into a single type. -- -------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, TypeFamilies, FlexibleContexts,-    FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances,+    MultiParamTypeClasses, UndecidableInstances #-}  module Math.Geometry.GridMap.Lazy   (@@ -25,7 +25,6 @@ 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)@@ -35,16 +34,16 @@  -- | A map from tile positions in a grid to values. data LGridMap g v =-  LGridMap { lgmGrid ∷ g, lgmMap ∷ M.Map (G.Index 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 :: (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+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) @@ -58,7 +57,7 @@ --  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+instance G.Grid g => G.Grid (LGridMap g v) where   type Index (LGridMap g v) = G.Index g   type Direction (LGridMap g v) = G.Direction g   indices = G.indices . lgmGrid@@ -71,11 +70,12 @@   null = G.null . lgmGrid   nonNull = G.nonNull . lgmGrid -instance G.FiniteGrid g ⇒ G.FiniteGrid (LGridMap g v) where+instance G.FiniteGrid g => G.FiniteGrid (LGridMap g v) where   type Size (LGridMap g v) = G.Size g   size (LGridMap g _) = G.size g+  maxPossibleDistance (LGridMap g _) = G.maxPossibleDistance g -instance (G.Grid g) ⇒ GridMap (LGridMap g) v where+instance (G.Grid g) => GridMap (LGridMap g) v where   type BaseGrid (LGridMap g) v = g   (!) gm k = toMap gm M.! k   toMap = lgmMap@@ -86,8 +86,8 @@   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 (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+instance (Show g, Show v) => Show (LGridMap g v) where   show (LGridMap g m) = "lazyGridMap (" ++ show g ++ ") " ++ show (M.elems m)

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

@@ -1,5 +1,5 @@-{-# LANGUAGE UnicodeSyntax, FlexibleContexts, ExistentialQuantification,-    TypeFamilies, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts, ExistentialQuantification, TypeFamilies,+    MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Math.Geometry.GridQC where@@ -8,9 +8,8 @@  import Prelude hiding (null) import qualified Prelude as P (null)-import Data.Eq.Unicode ((≡), (≠)) import Data.List (delete, nub, sort)-import Data.Ord.Unicode ((≤))+import Data.Maybe (isJust, fromJust) import Test.Framework as TF (Test) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck @@ -19,55 +18,55 @@  -- | @'isqrt' n@ returns the greatest integer not greater than the square root  --   of @n@.-isqrt ∷ Int → Int+isqrt :: Int -> Int isqrt n = (floor . sqrt) n'-  where n' = fromIntegral n ∷ Float+  where n' = fromIntegral n :: Float  -- Given an arbitrary integer, select a corresponding point in the grid.-pointAt ∷ Grid g ⇒ g → Int → Index g+pointAt :: Grid g => g -> Int -> Index g pointAt g i = indices g !! (i `mod` n)   where n = (length . indices) g  minPathCount-  ∷ (Eq (Index g), Grid g) ⇒ g → Index g → Index g → Int+  :: (Eq (Index g), Grid g) => g -> Index g -> Index g -> Int minPathCount g a b = length . minimalPaths g a $ b  minPathCount2-  ∷ (Eq (Index g), Grid g) ⇒ g → [Index g] → Index g → Int-minPathCount2 g as b = sum . map (\x → minPathCount g x b) $ as+  :: (Eq (Index g), Grid g) => g -> [Index g] -> Index g -> Int+minPathCount2 g as b = sum . map (\x -> minPathCount g x b) $ as -cartesianBoundaryCount ∷ (Eq a, Num a) ⇒ (a, a) → a+cartesianBoundaryCount :: (Eq a, Num a) => (a, a) -> a cartesianBoundaryCount (0,_) = 0 cartesianBoundaryCount (_,0) = 0 cartesianBoundaryCount (1,c) = c cartesianBoundaryCount (r,1) = r cartesianBoundaryCount (r,c) = 2*(r+c) - 4 -involves ∷ Eq a ⇒ (a, a) → a → Bool-involves (a, b) c = c ≡ a || c ≡ b+involves :: Eq a => (a, a) -> a -> Bool+involves (a, b) c = c == a || c == b -chooseIndices ∷ Grid g ⇒ g → Int → Gen [Index g]+chooseIndices :: Grid g => g -> Int -> Gen [Index g] chooseIndices g n = do-  k ← choose (0,n)+  k <- choose (0,n)   if null g      then return []      else vectorOf (k+2) (elements . indices $ g) -chooseClosePointsUnbounded ∷ Gen ((Int, Int), (Int, Int))+chooseClosePointsUnbounded :: Gen ((Int, Int), (Int, Int)) chooseClosePointsUnbounded = do-  (x1,y1) ← arbitrary-  x2 ← choose (x1-2,x1+2)-  y2 ← choose (y1-2,y1+2)+  (x1,y1) <- arbitrary+  x2 <- choose (x1-2,x1+2)+  y2 <- choose (y1-2,y1+2)   return ((x1,y1), (x2,y2)) -chooseClosePoints ∷ Grid g ⇒ g → Gen (Index g, Index g)+chooseClosePoints :: Grid g => g -> Gen (Index g, Index g) chooseClosePoints g = do-  a ← elements . indices $ g-  b ← elements . filter (\b → distance g a b < 6) . indices $ g+  a <- elements . indices $ g+  b <- elements . filter (\b -> distance g a b < 6) . indices $ g   return (a, b) -makeTests ∷ (Arbitrary t, Show t) ⇒ [(String, t → Property)] → [Test]-makeTests ts = map (\(s,t) → testProperty s t) ts+makeTests :: (Arbitrary t, Show t) => [(String, t -> Property)] -> [Test]+makeTests ts = map (\(s,t) -> testProperty s t) ts  -- -- Tests that should apply to and are identical for all grids@@ -75,57 +74,58 @@  class TestData t where   type BaseGrid t-  grid ∷ t → BaseGrid t-  points ∷ t → [Index (BaseGrid t)]-  neighbourCountBounds ∷ t → (Int, Int)-  twoClosePoints ∷ t → (Index (BaseGrid t),Index (BaseGrid t))+  grid :: t -> BaseGrid t+  points :: t -> [Index (BaseGrid t)]+  neighbourCountBounds :: t -> (Int, Int)+  twoClosePoints :: t -> (Index (BaseGrid t),Index (BaseGrid t))+  direction :: t -> Direction (BaseGrid t) -prop_indices_are_contained ∷ (TestData t, Grid (BaseGrid t), -  Eq (Index (BaseGrid t))) ⇒ t → Property+prop_indices_are_contained :: (TestData t, Grid (BaseGrid t), +  Eq (Index (BaseGrid t))) => t -> Property prop_indices_are_contained t = nonNull g ==> g `contains` a   where g = grid t         (a:_) = points t -prop_distance_reflexive ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property-prop_distance_reflexive t = nonNull g ==> distance g a a ≡ 0+prop_distance_reflexive :: (TestData t, Grid (BaseGrid t)) => t -> Property+prop_distance_reflexive t = nonNull g ==> distance g a a == 0   where g = grid t         (a:_) = points t -prop_distance_symmetric ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property+prop_distance_symmetric :: (TestData t, Grid (BaseGrid t)) => t -> Property prop_distance_symmetric t = -  nonNull g ==> distance g a b ≡ distance g b a+  nonNull g ==> distance g a b == distance g b a   where g = grid t         (a:b:_) = points t  prop_custom_MinDistance_eq_default -  ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property+  :: (TestData t, Grid (BaseGrid t)) => t -> Property prop_custom_MinDistance_eq_default t = nonNull g ==> -  minDistance g bs a ≡ defaultMinDistance g bs a+  minDistance g bs a == defaultMinDistance g bs a   where g = grid t         (a:bs) = points t  -- "cw" = "consistent with" -prop_minDistance_cw_distance ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property+prop_minDistance_cw_distance :: (TestData t, Grid (BaseGrid t)) => t -> Property prop_minDistance_cw_distance t =    nonNull g && (not . P.null) bs ==> -    minDistance g (b:bs) a ≤ distance g b a+    minDistance g (b:bs) a <= distance g b a   where g = grid t         (a:b:bs) = points t  prop_neighbour_count_in_bounds-  ∷ (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_neighbour_count_in_bounds t = nonNull g ==> -  nMin ≤ n && n ≤ nMax+  nMin <= n && n <= nMax   where g = grid t         (a:_) = points t         n = length . neighbours g $ a         (nMin, nMax) = neighbourCountBounds t  prop_neighbours_are_adjacent-  ∷ (TestData t, Grid (BaseGrid t))-    ⇒ t → Property+  :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))+    => t -> Property prop_neighbours_are_adjacent t = nonNull g  ==>      and (map (isAdjacent g a) ns)   where g = grid t@@ -133,55 +133,64 @@         ns = neighbours g a  prop_adjacentTilesToward_moves_closer-  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))-    ⇒ t → Property-prop_adjacentTilesToward_moves_closer t = nonNull g && a ≠ b ==> +  :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))+    => t -> Property+prop_adjacentTilesToward_moves_closer t = nonNull g && a /= b ==>      and (map (< d) ns)   where g = grid t         (a:b:_) = points t         d = distance g a b-        ns = nub $ map (\x → distance g x b) $ adjacentTilesToward g a b+        ns = nub $ map (\x -> distance g x b) $ adjacentTilesToward g a b  prop_minimal_paths_have_min_length-  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))-    ⇒ t → Property-prop_minimal_paths_have_min_length t = nonNull g ==> ns ≡ [d+1]+  :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))+    => t -> Property+prop_minimal_paths_have_min_length t = nonNull g ==> ns == [d+1]   where g = grid t         (a,b) = twoClosePoints t         d = distance g a b         ns = nub . map length . minimalPaths g a $ b  prop_minimal_paths_are_valid-  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))+    => t -> Property prop_minimal_paths_are_valid t = nonNull g ==>      and $ map (subsequentTilesInPathAreAdjacent g) $ minimalPaths g a b   where g = grid t         (a,b) = twoClosePoints t  subsequentTilesInPathAreAdjacent -  ∷ (Grid g, Eq (Index g)) ⇒ g → [Index g] → Bool+  :: (Grid g, Eq (Index g)) => g -> [Index g] -> Bool subsequentTilesInPathAreAdjacent _ [] = True subsequentTilesInPathAreAdjacent g [x] = g `contains` x subsequentTilesInPathAreAdjacent g (a:b:xs) =    isAdjacent g a b && subsequentTilesInPathAreAdjacent g (b:xs)  prop_neighbour_cw_directionTo-  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)), +  :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)),      Eq (Direction (BaseGrid t)))-    ⇒ t → Property-prop_neighbour_cw_directionTo t = nonNull g && a ≠ b ==> -    (neighbour g a d) `elem` nextSteps-  where g = grid t+    => t -> Property+prop_neighbour_cw_directionTo t = nonNull g && a /= b && isJust n ==> +    (fromJust n) `elem` nextSteps+  where n = neighbour g a d+        g = grid t         (a,b) = twoClosePoints t         d = head . directionTo g a $ b         nextSteps = map (!!1) . minimalPaths g a $ b +prop_custom_adjacentTilesToward_eq_default+  :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property+prop_custom_adjacentTilesToward_eq_default t = nonNull g ==>+  adjacentTilesToward g a b == defaultAdjacentTilesToward g a b+  where g = grid t+        (a:b:_) = points t+ gridProperties -  ∷ (TestData t, Grid (BaseGrid t), Arbitrary t, +  :: (TestData t, Grid (BaseGrid t), Arbitrary t,      Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t)),      Eq (Direction (BaseGrid t))) -    ⇒ String → [(String, t → Property)]+    => String -> [(String, t -> Property)] gridProperties s =    [     ("prop_indices_are_contained: " ++ s, prop_indices_are_contained),@@ -194,7 +203,8 @@     ("prop_adjacentTilesToward_moves_closer: " ++ s, prop_adjacentTilesToward_moves_closer),     ("prop_minimal_paths_have_min_length: " ++ s, prop_minimal_paths_have_min_length),     ("prop_minimal_paths_are_valid: " ++ s, prop_minimal_paths_are_valid),-    ("prop_neighbour_cw_directionTo: " ++ s, prop_neighbour_cw_directionTo)+    ("prop_neighbour_cw_directionTo: " ++ s, prop_neighbour_cw_directionTo),+    ("prop_custom_adjacentTilesToward_eq_default: " ++ s, prop_custom_adjacentTilesToward_eq_default)   ]  --@@ -202,73 +212,102 @@ --  class TestDataF t where-  expectedTileCount ∷ t → Int-  maxDistance ∷ t → Int+  expectedTileCount :: t -> Int+  maxDistance :: t -> Int  prop_tile_count_correct-  ∷ (TestData t, TestDataF t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, TestDataF t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_tile_count_correct t = nonNull g ==>-  tileCount g ≡ expectedTileCount t +  tileCount g == expectedTileCount t    where g = grid t  prop_custom_tileCount_eq_default -  ∷ (TestData t, Grid (BaseGrid t)) ⇒ t → Property+  :: (TestData t, Grid (BaseGrid t)) => t -> Property prop_custom_tileCount_eq_default t = nonNull g ==> -  tileCount g ≡ defaultTileCount g+  tileCount g == defaultTileCount g   where g = grid t  prop_distance_in_bounds-  ∷ (TestData t, TestDataF t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, TestDataF t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_distance_in_bounds t = nonNull g ==> -  0 ≤ n && n ≤ maxDistance t+  0 <= n && n <= maxDistance t   where g = grid t         (a:b:_) = points t         n = distance g a b  prop_neighbours_cw_viewpoint -  ∷ (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_neighbours_cw_viewpoint t = nonNull g ==> -  sort (delete a (neighbours g a)) ≡ sort expected+  sort (delete a (neighbours g a)) == sort expected   where g = grid t         (a:_) = points t-        expected = map fst $ filter (\p → 1 ≡ snd p) $ viewpoint g a+        expected = map fst $ filter (\p -> 1 == snd p) $ viewpoint g a -- Note: In a small but unbounded grid, a tile can be its own neighbour. -- However, when we calculate the distance between a tile and itself, we -- get 0, not 1. That's why we have to delete the tile from its list  -- before comparing to the result from the neighbours function.  prop_custom_edges_eq_default -  ∷ (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)), -    Ord (Index (BaseGrid t))) ⇒ t → Property+  :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)), +    Ord (Index (BaseGrid t))) => t -> Property prop_custom_edges_eq_default t = nonNull g ==> -  sort (edges g) ≡ sort (defaultEdges g)+  sort (edges g) == sort (defaultEdges g)   where g = grid t  prop_edges_cw_neighbours-  ∷ (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_edges_cw_neighbours t = nonNull g ==> -  sort (neighbours g a) ≡ sort expected+  sort (neighbours g a) == sort expected   where g = grid t         (a:_) = points t         nEdges = filter (`involves` a) $ edges g         expected = map f nEdges-        f (b,c) = if a ≡ b then c else b+        f (b,c) = if a == b then c else b  prop_edges_are_adjacent-  ∷ (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_edges_are_adjacent t = property $ all f $ edges g   where g = grid t         f (a, b) = isAdjacent g a b +-- This test is too slow, even for finite grids.+-- TODO: Try a better implementation of defaultMinimalPaths?+prop_custom_minimalPaths_eq_default+  :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property+prop_custom_minimalPaths_eq_default t = nonNull g ==>+  sort (minimalPaths g a b) == sort(defaultMinimalPaths g a b)+  where g = grid t+        (a:b:_) = points t++prop_distance_le_maxPossibleDistance+  :: (TestData t, TestDataF t, FiniteGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property+prop_distance_le_maxPossibleDistance t = nonNull g ==>+  distance g a b <= maxPossibleDistance g+  where g = grid t+        (a:b:_) = points t++prop_maxPossibleDistance_occurs+  :: (TestData t, FiniteGrid (BaseGrid t),+      Ord (Index (BaseGrid t)))+    => t -> Property+prop_maxPossibleDistance_occurs t = nonNull g ==>+  dMax `elem` [distance g x y | x <- indices g, y <- (reverse . sort $ indices g)]+  -- If we process x and y in opposite orders, we're more likely to find+  -- the furthest two points in the grid early on.+  where g = grid t+        dMax = maxPossibleDistance g+ finiteGridProperties -  ∷ (TestData t, TestDataF t, Grid (BaseGrid t), Arbitrary t, +  :: (TestData t, TestDataF t, FiniteGrid (BaseGrid t), Arbitrary t,      Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t))) -    ⇒ String → [(String, t → Property)]+    => String -> [(String, t -> Property)] finiteGridProperties s =    [     ("prop_tile_count_correct: " ++ s, prop_tile_count_correct),@@ -277,7 +316,10 @@     ("prop_neighbours_cw_viewpoint: " ++ s, prop_neighbours_cw_viewpoint),     ("prop_custom_edges_eq_default: " ++ s, prop_custom_edges_eq_default),     ("prop_edges_cw_neighbours: " ++ s, prop_edges_cw_neighbours),-    ("prop_edges_are_adjacent: " ++ s, prop_edges_are_adjacent)+    ("prop_edges_are_adjacent: " ++ s, prop_edges_are_adjacent),+--    ("prop_custom_minimalPaths_eq_default: " ++ s, prop_custom_minimalPaths_eq_default)+    ("prop_distance_le_maxPossibleDistance: " ++ s, prop_distance_le_maxPossibleDistance),+    ("prop_maxPossibleDistance_occurs: " ++ s, prop_maxPossibleDistance_occurs)   ]  --@@ -285,69 +327,148 @@ --  class TestDataB t where-  expectedBoundaryCount ∷ t → Int+  expectedBoundaryCount :: t -> Int +prop_custom_boundary_eq_default+  :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property+prop_custom_boundary_eq_default t = nonNull g ==>+  sort (boundary g) == sort (defaultBoundary g)+  where g = grid t+ prop_boundary_count_correct-  ∷ (TestData t, TestDataB t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, TestDataB t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_boundary_count_correct t = nonNull g ==>-  (length . boundary) g ≡ expectedBoundaryCount t +  (length . boundary) g == expectedBoundaryCount t    where g = grid t  prop_grid_and_boundary_are_both_null_or_not -  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_grid_and_boundary_are_both_null_or_not t = property $-  (P.null . boundary) g ≡ null g+  (P.null . boundary) g == null g   where g = grid t  prop_boundary_in_grid-  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_boundary_in_grid t = property $   all (g `contains`) . boundary $ g   where g = grid t  prop_boundary_tiles_have_fewer_neighbours-  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_boundary_tiles_have_fewer_neighbours t = nonNull g ==>-  g `numNeighbours` b ≤ g `numNeighbours` a+  g `numNeighbours` b <= g `numNeighbours` a   where g = grid t         (a:_) = points t         (b:_) = boundary g +prop_custom_isBoundary_eq_default+  :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property+prop_custom_isBoundary_eq_default t = nonNull g ==>+  isBoundary g a == defaultIsBoundary g a+  where g = grid t+        (a:_) = points t++prop_custom_isCentre_eq_default+  :: (TestData t, BoundedGrid (BaseGrid t), Eq (Index (BaseGrid t)))+    => t -> Property+prop_custom_isCentre_eq_default t = nonNull g ==>+  isCentre g a == defaultIsCentre g a+  where g = grid t+        (a:_) = points t++prop_custom_neighbours_eq_default +  :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)),+      Ord (Index (BaseGrid t)))+     => t -> Property+prop_custom_neighbours_eq_default t = nonNull g ==> +  sort (neighbours g a) == sort (defaultNeighbours g a)+  where g = grid t+        (a:_) = points t++prop_custom_neighbour_eq_default +  :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)), (Eq (Direction (BaseGrid t))))+     => t -> Property+prop_custom_neighbour_eq_default t = nonNull g ==> +  neighbour g a d == defaultNeighbour g a d+  where g = grid t+        (a:_) = points t+        d = direction t++prop_custom_isAdjacent_eq_default+  :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property+prop_custom_isAdjacent_eq_default t = nonNull g ==>+  isAdjacent g a b == defaultIsAdjacent g a b+  where g = grid t+        (a:b:_) = points t++boundedGridProperties +  :: (TestData t, TestDataB t, BoundedGrid (BaseGrid t), Arbitrary t, +    Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t)),+    Eq (Direction (BaseGrid t))) +    => String -> [(String, t -> Property)]+boundedGridProperties s = +  [+    ("prop_custom_boundary_eq_default: " ++ s, prop_custom_boundary_eq_default),+    ("prop_boundary_count_correct: " ++ s, prop_boundary_count_correct),+    ("prop_grid_and_boundary_are_both_null_or_not: " ++ s, prop_grid_and_boundary_are_both_null_or_not),+    ("prop_boundary_in_grid: " ++ s, prop_boundary_in_grid),+    ("prop_boundary_tiles_have_fewer_neighbours: " ++ s, prop_boundary_tiles_have_fewer_neighbours),+    ("prop_custom_isBoundary_eq_default: " ++ s, prop_custom_isBoundary_eq_default),+    ("prop_custom_isCentre_eq_default: " ++ s, prop_custom_isBoundary_eq_default),+    ("prop_custom_neighbours_eq_default: " ++ s, prop_custom_neighbours_eq_default),+    ("prop_custom_neighbour_eq_default: " ++ s, prop_custom_neighbour_eq_default),+    ("prop_custom_isAdjacent_eq_default: " ++ s, prop_custom_isAdjacent_eq_default)+  ]++--+-- These properties won't work for triangular grids.+-- They probably only work on grids where all the tiles have the same+-- shape/orientation.+--++prop_custom_centre_eq_default+  :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property+prop_custom_centre_eq_default t = nonNull g ==>+  sort(centre g) == sort (defaultCentre g)+  where g = grid t+ prop_centres_equidistant_from_boundary-  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_centres_equidistant_from_boundary t = nonNull g ==>-  (length . nub . map (minDistance g bs)) cs ≡ 1+  (length . nub . map (minDistance g bs)) cs == 1   where g = grid t         bs = boundary g         cs = centre g  prop_centres_farthest_from_boundary-  ∷ (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))-    ⇒ t → Property+  :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))+    => t -> Property prop_centres_farthest_from_boundary t =    nonNull g && (not . isCentre g) a ==>-    minDistance g bs a ≤ minDistance g bs c+    minDistance g bs a <= minDistance g bs c   where g = grid t         (a:_) = points t         (c:_) = centre g         bs = boundary g -boundedGridProperties -  ∷ (TestData t, TestDataB t, BoundedGrid (BaseGrid t), Arbitrary t, -    Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t))) -    ⇒ String → [(String, t → Property)]-boundedGridProperties s = +boundedGridProperties2+  :: (TestData t, TestDataB t, BoundedGrid (BaseGrid t), Arbitrary t, +    Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t)),+    Eq (Direction (BaseGrid t))) +    => String -> [(String, t -> Property)]+boundedGridProperties2 s =    [-    ("prop_boundary_count_correct: " ++ s, prop_boundary_count_correct),-    ("prop_grid_and_boundary_are_both_null_or_not: " ++ s, prop_grid_and_boundary_are_both_null_or_not),-    ("prop_boundary_in_grid: " ++ s, prop_boundary_in_grid),-    ("prop_boundary_tiles_have_fewer_neighbours: " ++ s, prop_boundary_tiles_have_fewer_neighbours),-    ("prop_centres_equidistant_from_boundary: " ++ s, prop_centres_equidistant_from_boundary),-    ("prop_centres_farthest_from_boundary: " ++ s, prop_centres_farthest_from_boundary)+   ("prop_custom_centre_eq_default: " ++ s, prop_custom_centre_eq_default),+   ("prop_centres_equidistant_from_boundary: " ++ s, prop_centres_equidistant_from_boundary),+   ("prop_centres_farthest_from_boundary: " ++ s, prop_centres_farthest_from_boundary)   ]