packages feed

grid (empty) → 1.0

raw patch · 7 files changed

+804/−0 lines, 7 filesdep +QuickCheckdep +basedep +base-unicode-symbolssetup-changed

Dependencies added: QuickCheck, base, base-unicode-symbols, grid, test-framework, test-framework-quickcheck2

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2010-2012, Amy de Buitléir+All rights reserved.++Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met:++* Redistributions of source code must retain the above copyright +  notice, this list of conditions and the following disclaimer.+* Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the+  documentation and/or other materials provided with the distribution.+* Neither the name of the author nor the names of other contributors+  may be used to endorse or promote products derived from this software+  without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ grid.cabal view
@@ -0,0 +1,39 @@+name:           grid+version:        1.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.+category:       Math+cabal-version:  >=1.8+build-type:     Simple+author:         Amy de Buitléir+copyright:      (c) Amy de Buitléir 2010-2012+license:        BSD3+stability:      experimental+maintainer:     amy@nualeargais.ie+license-file:   LICENSE++library+  hs-source-dirs:  src+  build-depends:   base ==4.*,+                   base-unicode-symbols ==0.2.*+  ghc-options:     -Wall -rtsopts+  exposed-modules: Math.Geometry.Grid,+                   Math.Geometry.GridInternal++test-suite grid-tests+  type:            exitcode-stdio-1.0+  build-depends:   base ==4.*,+                   test-framework-quickcheck2 == 0.2.*,+                   QuickCheck == 2.4.*,+                   test-framework == 0.*,+                   grid,+                   base-unicode-symbols ==0.2.*+  hs-source-dirs:  test+  ghc-options:     -Wall -rtsopts+  main-is:         Main.hs+  other-modules: Math.Geometry.GridQC+
+ src/Math/Geometry/Grid.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.Grid+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- A regular arrangement of tiles. Grids have a variety of uses,+-- including games and self-organising maps.+--+-----------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, +  FlexibleInstances #-}++module Math.Geometry.Grid+  (+    -- * Generic+    Grid(..),+    -- * Grids with triangular tiles+    TriTriGrid,+    triTriGrid,+    ParaTriGrid,+    paraTriGrid,+    -- Grids with square tiles+    RectSquareGrid,+    rectSquareGrid,+    TorSquareGrid,+    torSquareGrid,+    -- * Grids with hexagonal tiles+    HexHexGrid,+    hexHexGrid,+    ParaHexGrid,+    paraHexGrid+  ) where++import Math.Geometry.GridInternal (Grid(..), TriTriGrid, triTriGrid, +  ParaTriGrid, paraTriGrid, RectSquareGrid, rectSquareGrid, TorSquareGrid, +  torSquareGrid, HexHexGrid, hexHexGrid, ParaHexGrid, paraHexGrid)
+ src/Math/Geometry/GridInternal.hs view
@@ -0,0 +1,277 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Math.Geometry.GridInternal+-- Copyright   :  (c) Amy de Buitléir 2012+-- License     :  BSD-style+-- Maintainer  :  amy@nualeargais.ie+-- Stability   :  experimental+-- Portability :  portable+--+-- 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 #-}++module Math.Geometry.GridInternal+  (+    -- * Generic+    Grid(..),+    -- * Grids with triangular tiles+    TriTriGrid,+    triTriGrid,+    ParaTriGrid,+    paraTriGrid,+    -- * Grids with square tiles+    RectSquareGrid,+    rectSquareGrid,+    TorSquareGrid,+    torSquareGrid,+    -- * Grids with hexagonal tiles+    HexHexGrid,+    hexHexGrid,+    ParaHexGrid,+    paraHexGrid+  ) where++import Data.Eq.Unicode ((≡))+import Data.List (nub)+import Data.Ord.Unicode ((≤), (≥))++-- | A regular arrangement of tiles.+--   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+  -- | Returns the dimensions of the grid. +  --   For example, if @g@ is a 4x3 rectangular grid, @'size' g@ would return +  --   @(4, 3)@, while @'tileCount' g@ would return @12@.+  size ∷ g → s+  -- | @'neighbours' 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)+  -- | Returns the number of tiles in a grid. Compare with @'size'@.+  tileCount ∷ Grid g s x ⇒ g → Int+  tileCount = length . indices+  -- | Returns @True@ if the number of tiles in a grid is zero, @False@ otherwise.+  empty ∷ Grid g s x ⇒ g → Bool+  empty g = tileCount g ≡ 0+  -- | Returns @False@ if the number of tiles in a grid is zero, @True@ otherwise.+  nonEmpty ∷ Grid g s x ⇒ g → Bool+  nonEmpty = not . empty+  +--+-- Triangular tiles+--++-- | 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+      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+    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)]++--+-- Triangular grids with triangular tiles+--++-- | A triangular grid with triangular tiles.+--   The grid and its indexing scheme are illustrated in the user guide,+--   available from +data TriTriGrid = TriTriGrid Int [(Int, Int)]++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+  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++-- | @'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.+triTriGrid ∷ Int → TriTriGrid+triTriGrid s = +  TriTriGrid s [(xx,yy) | xx ← [0..2*(s-1)], +                          yy ← [0..2*(s-1)], +                          inTriGrid (xx,yy) s]++--+-- Parallelogrammatical grids with triangular tiles+--++-- | A Parallelogrammatical grid with triangular tiles.+data ParaTriGrid = ParaTriGrid (Int, Int) [(Int, Int)]++instance Show ParaTriGrid where +  show (ParaTriGrid (r,c) _) = "paraTriGrid " ++ show r ++ " " ++ show c++instance Grid ParaTriGrid (Int, Int) (Int, Int) where+  indices (ParaTriGrid _ xs) = xs+  neighbours = triNeighbours+  distance = triDistance+  size (ParaTriGrid s _) = s++-- | @'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.+paraTriGrid ∷ Int → Int → ParaTriGrid+paraTriGrid r c = +  ParaTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]++--+-- Rectangular grids with square tiles+--++-- | A rectangular grid with square tiles.+data RectSquareGrid = RectSquareGrid (Int, Int) [(Int, Int)]++instance Show RectSquareGrid where +  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+      then abs (x2-x1) + abs (y2-y1)+      else undefined+  size (RectSquareGrid s _) = s++-- | @'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]]++--+-- Toroidal grids with square tiles.+--++-- | A toroidal grid with square tiles.+data TorSquareGrid = TorSquareGrid (Int, Int) [(Int, Int)]++instance Show TorSquareGrid where +  show (TorSquareGrid (r,c) _) = "torSquareGrid " ++ show r ++ " " ++ show c++instance Grid TorSquareGrid (Int, Int) (Int, Int) where+  indices (TorSquareGrid _ xs) = xs+  neighbours (x,y) (TorSquareGrid (r,c) _) = +    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+      then min adx (abs (c-adx)) + min ady (abs (r-ady))+      else undefined +    where adx = abs (x2 - x1)+          ady = abs (y2 - y1)+  size (TorSquareGrid s _) = s++-- | @'torSquareGrid' r c@ returns a toroidal grid with @r@ +--   rows and @c@ columns, using square tiles. If @r@ and @c@ are +--   both nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, +--   the resulting grid will be empty and the list of indices will be null.+torSquareGrid ∷ Int → Int → TorSquareGrid+torSquareGrid r c = TorSquareGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]++--+-- 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+    then maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)]+    else undefined+  where z1 = -x1 - y1+        z2 = -x2 - y2++--+-- Hexagonal grids with hexagonal tiles+--++-- | A hexagonal grid with hexagonal tiles+data HexHexGrid = HexHexGrid Int [(Int, Int)]++instance Show HexHexGrid where show (HexHexGrid s _) = "hexHexGrid " ++ show s++instance Grid HexHexGrid Int (Int, Int) where+  indices (HexHexGrid _ xs) = xs+  neighbours (x,y) g = filter (`inGrid` g) +    [(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++-- | @'hexHexGrid' s@ returns a grid of hexagonal shape, with
--   sides of length @s@, using hexagonal tiles. If @s@ is nonnegative, the +--   resulting grid will have @3*s*(s-1) + 1@ tiles. Otherwise, the resulting +--   grid will be empty and the list of indices will be null.+hexHexGrid ∷ Int → HexHexGrid+hexHexGrid r = HexHexGrid r [(x, y) | x ← [-r+1..r-1], y ← f x]+  where f x = if x < 0 then [1-r-x .. r-1] else [1-r .. r-1-x]++--+-- Parallelogrammatical grids with hexagonal tiles+--++-- | A parallelogramatical grid with hexagonal tiles+data ParaHexGrid = ParaHexGrid (Int, Int) [(Int, Int)]++instance Show ParaHexGrid where +  show (ParaHexGrid (r,c) _) = "paraHexGrid " ++ show r ++ " " ++ show c++instance Grid ParaHexGrid (Int, Int) (Int, Int) where+  indices (ParaHexGrid _ xs) = xs+  neighbours (x,y) g = filter (`inGrid` g) +    [(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++-- | @'paraHexGrid' r c@ returns a grid in the shape of a +--   parallelogram with @r@ rows and @c@ columns, using hexagonal tiles. If +--   @r@ and @c@ are both nonnegative, the resulting grid will have @r*c@ tiles.+--   Otherwise, the resulting grid will be empty and the list of indices will +--   be null.+paraHexGrid ∷ Int → Int → ParaHexGrid+paraHexGrid r c = +  ParaHexGrid (r,c) [(x, y) | x ← [0..c-1], y ← [0..r-1]]++
+ test/Main.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE UnicodeSyntax #-}+module Main where++import Math.Geometry.GridQC ( test )++import Test.Framework as TF ( defaultMain, Test )++tests ∷ [TF.Test]+tests = +  [ +    Math.Geometry.GridQC.test+  ]++main ∷ IO ()+main = defaultMain tests
+ test/Math/Geometry/GridQC.hs view
@@ -0,0 +1,404 @@+{-# LANGUAGE UnicodeSyntax, ExistentialQuantification #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Math.Geometry.GridQC+  (+    test+  ) where++import Math.Geometry.GridInternal ++import Data.Eq.Unicode ((≡))+import Data.List (sort)+import Data.Ord.Unicode ((≤))+import Test.Framework as TF (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck +  ((==>), Gen, Arbitrary, arbitrary, sized, choose, Property, property)++-- | @'isqrt' n@ returns the greatest integer not greater than the square root +--   of @n@.+isqrt ∷ Int → Int+isqrt n = (floor . sqrt) n'+  where n' = fromIntegral n ∷ Float++-- Given an arbitrary integer, select a corresponding point in the grid.+pointIn ∷ Grid g s x ⇒ Int → g → x+pointIn i g = indices g !! (i `mod` n)+  where n = (length . indices) g++--+-- Tests that should apply to and are identical for all grids+--++prop_distance_reflexive ∷ Grid g s x ⇒ g → Int → Property+prop_distance_reflexive g i = nonEmpty g ==> distance a a g ≡ 0+  where a = i `pointIn` g++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++-- "cw" = "consistent with"+prop_neighbours_cw_viewpoint ∷ +  (Grid g s x, Ord x) ⇒ g → Int → Property+prop_neighbours_cw_viewpoint g i = n > 0 ==> +  sort (a `neighbours` g) ≡ sort expected+    where n = (length . indices) g+          a = indices g !! (i `mod` n) -- make sure point is in grid+          expected = map fst $ filter (\p → 1 ≡ snd p) $ a `viewpoint` g++--+-- Triangular grids with triangular tiles+--++-- We want the number of tiles in a test grid to be ~ n+sizedTriTriGrid ∷ Int → Gen TriTriGrid+sizedTriTriGrid n = return $ triTriGrid (2 * isqrt n)++instance Arbitrary TriTriGrid where+  arbitrary = sized sizedTriTriGrid+  +prop_TriTriGrid_tile_count_correct ∷ TriTriGrid → Property+prop_TriTriGrid_tile_count_correct g = property $ +  (length . indices) g ≡ if s ≤ 0 then 0 else s*s+    where s = size g++prop_TriTriGrid_distance_in_bounds ∷ TriTriGrid → Int → Int → Property+prop_TriTriGrid_distance_in_bounds g i j = nonEmpty g ==> +  distance a b g ≤ 2*(s-1)+    where s = size g+          a = i `pointIn` g+          b = j `pointIn` g++-- 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)+  where ps = indices g+        a = head ps+        b = last ps+        s = size g++prop_TriTriGrid_neighbour_count_in_bounds ∷ TriTriGrid → Int → Property+prop_TriTriGrid_neighbour_count_in_bounds g i = 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++--+-- Parallelogram-shaped grids with triangular tiles+--++-- We want the number of tiles in a test grid to be ~ n+sizedParaTriGrid ∷ Int → Gen ParaTriGrid+sizedParaTriGrid n = do+  r ← choose (0,n)+  let c = n `div` (2*r + 1)+  return $ paraTriGrid r c++instance Arbitrary ParaTriGrid where+  arbitrary = sized sizedParaTriGrid++prop_ParaTriGrid_tile_count_correct ∷ ParaTriGrid → Property+prop_ParaTriGrid_tile_count_correct g = property $ +  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else 2*r*c+    where (r, c) = size g++prop_ParaTriGrid_distance_in_bounds ∷ ParaTriGrid → Int → Int → Property+prop_ParaTriGrid_distance_in_bounds g i j = nonEmpty g ==> +  distance a b g ≤ 2*(r+c) - 3+    where (r, c) = size g+          a = i `pointIn` g+          b = j `pointIn` g++-- If the ordering produced by paraTriGrid is ever changed, this+-- property may need to be changed too. It relies on the first and last elements+-- being at corners.+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+    where ps = indices g+          a = head ps+          b = last ps+          (r, c) = size g++prop_ParaTriGrid_neighbour_count_in_bounds ∷ ParaTriGrid → Int → Property+prop_ParaTriGrid_neighbour_count_in_bounds g i = 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++--+-- Rectangular grids with square tiles+--++-- We want the number of tiles in a test grid to be ~ n+sizedRectSquareGrid ∷ Int → Gen RectSquareGrid+sizedRectSquareGrid n = do+  r ← choose (0,n)+  let c = n `div` (r+1)+  return $ rectSquareGrid r c++instance Arbitrary RectSquareGrid where+  arbitrary = sized sizedRectSquareGrid++prop_RectSquareGrid_tile_count_correct ∷ RectSquareGrid → Property+prop_RectSquareGrid_tile_count_correct g = property $ +  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else r*c+    where (r, c) = size g++prop_RectSquareGrid_distance_in_bounds ∷ RectSquareGrid → Int → Int → Property+prop_RectSquareGrid_distance_in_bounds g i j = nonEmpty g ==>+  distance a b g ≤ r + c - 2+    where (r, c) = size g+          a = i `pointIn` g+          b = j `pointIn` g++-- If the ordering produced by rectSquareGrid is ever changed, this+-- property may need to be changed too. It relies on the first and last elements+-- being at opposite corners.+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+    where (r, c) = size g+          ps = indices g+          a = head ps+          b = last ps++prop_RectSquareGrid_neighbour_count_in_bounds ∷ RectSquareGrid → Int → Property+prop_RectSquareGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f+  where x = i `pointIn` g+        neighbourCount = length (x `neighbours` g)+        (r, c) = size g+        f | tileCount g ≡ 1 = neighbourCount ≡ 0+          | r ≡ 1 || c ≡ 1  = neighbourCount `elem` [1,2]+          | otherwise       = neighbourCount `elem` [2,3,4]++--+-- Toroidal grids with square-ish tiles+--++-- We want the number of tiles in a test grid to be ~ n+sizedTorSquareGrid ∷ Int → Gen TorSquareGrid+sizedTorSquareGrid n = do+  r ← choose (0,n)+  let c = n `div` (r+1)+  return $ torSquareGrid r c++instance Arbitrary TorSquareGrid where+  arbitrary = sized sizedTorSquareGrid++prop_TorSquareGrid_tile_count_correct ∷ TorSquareGrid → Property+prop_TorSquareGrid_tile_count_correct g = property $  +  tileCount g ≡ if r ≤ 0 || c ≤ 0 then 0 else r*c+    where (r, c) = size g++prop_TorSquareGrid_distance_in_bounds ∷ TorSquareGrid → Int → Int → Property+prop_TorSquareGrid_distance_in_bounds g i j = nonEmpty g ==>+  distance a b g ≤ (r+c) `div` 2+    where (r, c) = size g+          a = i `pointIn` g+          b = j `pointIn` g++-- 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+    where (r, c) = size g+          ps = indices g+          a = head ps+          b = last ps+          f | r ≡ 1 && c ≡ 1 = 0 -- zero-size torus+            | r ≡ 1 || c ≡ 1 = 1 -- a and b are the same+            | otherwise      = 2++prop_TorSquareGrid_neighbour_count_in_bounds ∷ TorSquareGrid → Int → Property+prop_TorSquareGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f+  where x = i `pointIn` g+        neighbourCount = length (x `neighbours` g)+        (r, c) = size g+        f | tileCount g ≡ 1 = neighbourCount ≡ 0+          | r ≡ 1 || c ≡ 1  = neighbourCount `elem` [1,2]+          | otherwise       = neighbourCount `elem` [2,3,4]++--+-- Circular hexagonal grids   +--++-- We want the number of tiles in a test grid to be ~ n+sizedHexHexGrid ∷ Int → Gen HexHexGrid+sizedHexHexGrid n = return $ hexHexGrid s+  where s = isqrt (n `div` 3)++instance Arbitrary HexHexGrid where+  arbitrary = sized sizedHexHexGrid++prop_HexHexGrid_tile_count_correct ∷ HexHexGrid → Property+prop_HexHexGrid_tile_count_correct g = property $ +  (length . indices) g ≡ if s ≤ 0 then 0 else 3*s*(s-1) + 1+    where s = size g++prop_HexHexGrid_distance_in_bounds ∷ HexHexGrid → Int → Int → Property+prop_HexHexGrid_distance_in_bounds g i j = nonEmpty g ==>+  distance a b g < 2*s+    where s = size g+          a = i `pointIn` g+          b = j `pointIn` g++-- 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+  where ps = indices g+        a = head ps+        b = last ps+        s = size g++prop_HexHexGrid_neighbour_count_in_bounds ∷ HexHexGrid → Int → Property+prop_HexHexGrid_neighbour_count_in_bounds g i = 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++--+-- Parallelogrammatical hexagonal grids   +--++-- We want the number of tiles in a test grid to be ~ n+sizedParaHexGrid ∷ Int → Gen ParaHexGrid+sizedParaHexGrid n = do+  r ← choose (0,n)+  let c = n `div` (r+1)+  return $ paraHexGrid r c++instance Arbitrary ParaHexGrid where+  arbitrary = sized sizedParaHexGrid++prop_ParaHexGrid_tile_count_correct ∷ ParaHexGrid → Property+prop_ParaHexGrid_tile_count_correct g = property $ +  tileCount g ≡ r*c+    where (r, c) = size g++prop_ParaHexGrid_distance_in_bounds ∷ ParaHexGrid → Int → Int → Property+prop_ParaHexGrid_distance_in_bounds g i j = nonEmpty g ==>+  property $ distance a b g ≤ r+c-2+    where (r, c) = size g+          a = i `pointIn` g+          b = j `pointIn` g++-- 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+    where ps = indices g+          a = head ps+          b = last ps+          (r, c) = size g++prop_ParaHexGrid_neighbour_count_in_bounds ∷ ParaHexGrid → Int → Property+prop_ParaHexGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f+  where x = i `pointIn` g+        neighbourCount = length (x `neighbours` g)+        (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]++test ∷ Test+test = testGroup "Math.Geometry.GridQC"+  [+    testProperty "prop_TriTriGrid_tile_count_correct"+      prop_TriTriGrid_tile_count_correct,+    testProperty "prop_distance_reflexive - TriTriGrid"+      (prop_distance_reflexive ∷ TriTriGrid → Int → Property),+    testProperty "prop_distance_symmetric - TriTriGrid"+      (prop_distance_symmetric ∷ TriTriGrid → Int → Int → Property),+    testProperty "prop_TriTriGrid_distance_in_bounds"+      prop_TriTriGrid_distance_in_bounds,+    testProperty "prop_TriTriGrid_distance_edge_to_edge"+      prop_TriTriGrid_distance_edge_to_edge,+    testProperty "prop_TriTriGrid_neighbour_count_in_bounds"+      prop_TriTriGrid_neighbour_count_in_bounds,+    testProperty "prop_neighbours_cw_viewpoint - TriTriGrid"+      (prop_neighbours_cw_viewpoint ∷ TriTriGrid → Int → Property),+    testProperty "prop_ParaTriGrid_tile_count_correct"+      prop_ParaTriGrid_tile_count_correct,+    testProperty "prop_distance_reflexive - ParaTriGrid"+      (prop_distance_reflexive ∷ ParaTriGrid → Int → Property),+    testProperty "prop_distance_symmetric - ParaTriGrid"+      (prop_distance_symmetric ∷ ParaTriGrid → Int → Int → Property),+    testProperty "prop_ParaTriGrid_distance_in_bounds"+      prop_ParaTriGrid_distance_in_bounds,+    testProperty "prop_ParaTriGrid_distance_corner_to_corner"+      prop_ParaTriGrid_distance_corner_to_corner,+    testProperty "prop_ParaTriGrid_neighbour_count_in_bounds"+      prop_ParaTriGrid_neighbour_count_in_bounds,+    testProperty "prop_neighbours_cw_viewpoint - ParaTriGrid"+      (prop_neighbours_cw_viewpoint ∷ ParaTriGrid → Int → Property),+    testProperty "prop_RectSquareGrid_tile_count_correct"+      prop_RectSquareGrid_tile_count_correct,+    testProperty "prop_distance_reflexive - RectTriGrid"+      (prop_distance_reflexive ∷ RectSquareGrid → Int → Property),+    testProperty "prop_distance_symmetric - RectSquareGrid"+      (prop_distance_symmetric ∷ RectSquareGrid → Int → Int → Property),+    testProperty "prop_RectSquareGrid_distance_in_bounds"+      prop_RectSquareGrid_distance_in_bounds,+    testProperty "prop_RectSquareGrid_distance_corner_to_corner"+      prop_RectSquareGrid_distance_corner_to_corner,+    testProperty "prop_RectSquareGrid_neighbour_count_in_bounds"+      prop_RectSquareGrid_neighbour_count_in_bounds,+    testProperty "prop_neighbours_cw_viewpoint - RectSquareGrid"+      (prop_neighbours_cw_viewpoint ∷ RectSquareGrid → Int → Property),+    testProperty "prop_TorSquareGrid_tile_count_correct"+      prop_TorSquareGrid_tile_count_correct,+    testProperty "prop_distance_reflexive - TorSquareGrid"+      (prop_distance_reflexive ∷ TorSquareGrid → Int → Property),+    testProperty "prop_distance_symmetric - TorSquareGrid"+      (prop_distance_symmetric ∷ TorSquareGrid → Int → Int → Property),+    testProperty "prop_TorSquareGrid_distance_in_bounds"+      prop_TorSquareGrid_distance_in_bounds,+    testProperty "prop_TorSquareGrid_distance_corner_to_corner"+      prop_TorSquareGrid_distance_corner_to_corner,+    testProperty "prop_TorSquareGrid_neighbour_count_in_bounds"+      prop_TorSquareGrid_neighbour_count_in_bounds,+    testProperty "prop_neighbours_cw_viewpoint - TorSquareGrid"+      (prop_neighbours_cw_viewpoint ∷ TorSquareGrid → Int → Property),+    testProperty "prop_HexHexGrid_tile_count_correct"+      prop_HexHexGrid_tile_count_correct,+    testProperty "prop_distance_reflexive - HexHexGrid"+      (prop_distance_reflexive ∷ HexHexGrid → Int → Property),+    testProperty "prop_distance_symmetric - HexHexGrid"+      (prop_distance_symmetric ∷ HexHexGrid → Int → Int → Property),+    testProperty "prop_HexHexGrid_distance_in_bounds"+      prop_HexHexGrid_distance_in_bounds,+    testProperty "prop_HexHexGrid_distance_edge_to_edge"+      prop_HexHexGrid_distance_edge_to_edge,+    testProperty "prop_HexHexGrid_neighbour_count_in_bounds"+      prop_HexHexGrid_neighbour_count_in_bounds,+    testProperty "prop_neighbours_cw_viewpoint - HexHexGrid"+      (prop_neighbours_cw_viewpoint ∷ HexHexGrid → Int → Property),+    testProperty "prop_ParaHexGrid_tile_count_correct"+      prop_ParaHexGrid_tile_count_correct,+    testProperty "prop_distance_reflexive - HexHexGrid"+      (prop_distance_reflexive ∷ ParaHexGrid → Int → Property),+    testProperty "prop_distance_symmetric - ParaHexGrid"+      (prop_distance_symmetric ∷ ParaHexGrid → Int → Int → Property),+    testProperty "prop_ParaHexGrid_distance_in_bounds"+      prop_ParaHexGrid_distance_in_bounds,+    testProperty "prop_ParaHexGrid_distance_corner_to_corner"+      prop_ParaHexGrid_distance_corner_to_corner,+    testProperty "prop_ParaHexGrid_neighbour_count_in_bounds"+      prop_ParaHexGrid_neighbour_count_in_bounds,+    testProperty "prop_neighbours_cw_viewpoint - ParaHexGrid"+      (prop_neighbours_cw_viewpoint ∷ ParaHexGrid → Int → Property)+  ]