grid 2.1.1 → 3.0
raw patch · 5 files changed
+540/−159 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Math.Geometry.Grid: inGrid :: Grid g s x => x -> g -> Bool
- Math.Geometry.GridInternal: inGrid :: Grid g s x => x -> g -> Bool
- Math.Geometry.GridMap: inGrid :: Grid g s x => x -> g -> Bool
+ Math.Geometry.Grid: adjacentTilesToward :: Grid g s x => g -> x -> x -> [x]
+ Math.Geometry.Grid: boundary :: BoundedGrid g s x => g -> [x]
+ Math.Geometry.Grid: centre :: BoundedGrid g s x => g -> [x]
+ Math.Geometry.Grid: class Grid g s x => BoundedGrid g s x where isBoundary g x = x `elem` boundary g centre g = map fst . head . reverse . groupBy ((==) `on` snd) . sortBy (comparing snd) $ xds where xds = map (\ y -> (y, minDistance g bs y)) $ indices g bs = boundary g isCentre g x = x `elem` centre g
+ Math.Geometry.Grid: contains :: Grid g s x => g -> x -> Bool
+ Math.Geometry.Grid: isAdjacent :: (Grid g s x, Grid g s x) => g -> x -> x -> Bool
+ Math.Geometry.Grid: isBoundary :: BoundedGrid g s x => g -> x -> Bool
+ Math.Geometry.Grid: isCentre :: BoundedGrid g s x => g -> x -> Bool
+ Math.Geometry.Grid: minDistance :: Grid g s x => g -> [x] -> x -> Int
+ Math.Geometry.Grid: numNeighbours :: Grid g s x => g -> x -> Int
+ Math.Geometry.GridInternal: adjacentTilesToward :: Grid g s x => g -> x -> x -> [x]
+ Math.Geometry.GridInternal: boundary :: BoundedGrid g s x => g -> [x]
+ Math.Geometry.GridInternal: centre :: BoundedGrid g s x => g -> [x]
+ Math.Geometry.GridInternal: class Grid g s x => BoundedGrid g s x where isBoundary g x = x `elem` boundary g centre g = map fst . head . reverse . groupBy ((==) `on` snd) . sortBy (comparing snd) $ xds where xds = map (\ y -> (y, minDistance g bs y)) $ indices g bs = boundary g isCentre g x = x `elem` centre g
+ Math.Geometry.GridInternal: contains :: Grid g s x => g -> x -> Bool
+ Math.Geometry.GridInternal: instance BoundedGrid HexHexGrid Int (Int, Int)
+ Math.Geometry.GridInternal: instance BoundedGrid ParaHexGrid (Int, Int) (Int, Int)
+ Math.Geometry.GridInternal: instance BoundedGrid ParaTriGrid (Int, Int) (Int, Int)
+ Math.Geometry.GridInternal: instance BoundedGrid RectSquareGrid (Int, Int) (Int, Int)
+ Math.Geometry.GridInternal: instance BoundedGrid TriTriGrid Int (Int, Int)
+ Math.Geometry.GridInternal: isAdjacent :: (Grid g s x, Grid g s x) => g -> x -> x -> Bool
+ Math.Geometry.GridInternal: isBoundary :: BoundedGrid g s x => g -> x -> Bool
+ Math.Geometry.GridInternal: isCentre :: BoundedGrid g s x => g -> x -> Bool
+ Math.Geometry.GridInternal: minDistance :: Grid g s x => g -> [x] -> x -> Int
+ Math.Geometry.GridInternal: numNeighbours :: Grid g s x => g -> x -> Int
+ Math.Geometry.GridMap: contains :: Grid g s x => g -> x -> Bool
- Math.Geometry.Grid: class Eq x => Grid g s x | g -> s, g -> x where neighbours x g = filter (\ a -> distance x a g ≡ 1) $ indices g inGrid x g = x `elem` indices g viewpoint p g = map f (indices g) where f x = (x, distance p x g) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g minimalPaths a b g | a ≡ b = [[a]] | distance a b g ≡ 1 = [[a, b]] | otherwise = map (a :) xs where xs = concatMap (\ x -> minimalPaths x b g) ys ys = filter f $ neighbours a g f x = distance x b g ≡ distance a b g - 1
+ Math.Geometry.Grid: class Eq x => Grid g s x | g -> s, g -> x where minDistance g xs x = minimum . map (distance g x) $ xs neighbours g x = filter (\ a -> distance g x a ≡ 1) $ indices g numNeighbours g = length . neighbours g contains g x = x `elem` indices g viewpoint g p = map f (indices g) where f x = (x, distance g p x) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g isAdjacent g a b = distance g a b ≡ 1 adjacentTilesToward g a b | a ≡ b = [] | otherwise = filter f $ neighbours g a where f x = distance g x b ≡ distance g a b - 1 minimalPaths g a b | a ≡ b = [[a]] | distance g a b ≡ 1 = [[a, b]] | otherwise = map (a :) xs where xs = concatMap (\ x -> minimalPaths g x b) ys ys = adjacentTilesToward g a b
- Math.Geometry.Grid: distance :: Grid g s x => x -> x -> g -> Int
+ Math.Geometry.Grid: distance :: Grid g s x => g -> x -> x -> Int
- Math.Geometry.Grid: minimalPaths :: Grid g s x => x -> x -> g -> [[x]]
+ Math.Geometry.Grid: minimalPaths :: Grid g s x => g -> x -> x -> [[x]]
- Math.Geometry.Grid: neighbours :: Grid g s x => x -> g -> [x]
+ Math.Geometry.Grid: neighbours :: Grid g s x => g -> x -> [x]
- Math.Geometry.Grid: viewpoint :: Grid g s x => x -> g -> [(x, Int)]
+ Math.Geometry.Grid: viewpoint :: Grid g s x => g -> x -> [(x, Int)]
- Math.Geometry.GridInternal: class Eq x => Grid g s x | g -> s, g -> x where neighbours x g = filter (\ a -> distance x a g ≡ 1) $ indices g inGrid x g = x `elem` indices g viewpoint p g = map f (indices g) where f x = (x, distance p x g) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g minimalPaths a b g | a ≡ b = [[a]] | distance a b g ≡ 1 = [[a, b]] | otherwise = map (a :) xs where xs = concatMap (\ x -> minimalPaths x b g) ys ys = filter f $ neighbours a g f x = distance x b g ≡ distance a b g - 1
+ Math.Geometry.GridInternal: class Eq x => Grid g s x | g -> s, g -> x where minDistance g xs x = minimum . map (distance g x) $ xs neighbours g x = filter (\ a -> distance g x a ≡ 1) $ indices g numNeighbours g = length . neighbours g contains g x = x `elem` indices g viewpoint g p = map f (indices g) where f x = (x, distance g p x) tileCount = length . indices empty g = tileCount g ≡ 0 nonEmpty = not . empty edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g isAdjacent g a b = distance g a b ≡ 1 adjacentTilesToward g a b | a ≡ b = [] | otherwise = filter f $ neighbours g a where f x = distance g x b ≡ distance g a b - 1 minimalPaths g a b | a ≡ b = [[a]] | distance g a b ≡ 1 = [[a, b]] | otherwise = map (a :) xs where xs = concatMap (\ x -> minimalPaths g x b) ys ys = adjacentTilesToward g a b
- Math.Geometry.GridInternal: distance :: Grid g s x => x -> x -> g -> Int
+ Math.Geometry.GridInternal: distance :: Grid g s x => g -> x -> x -> Int
- Math.Geometry.GridInternal: minimalPaths :: Grid g s x => x -> x -> g -> [[x]]
+ Math.Geometry.GridInternal: minimalPaths :: Grid g s x => g -> x -> x -> [[x]]
- Math.Geometry.GridInternal: neighbours :: Grid g s x => x -> g -> [x]
+ Math.Geometry.GridInternal: neighbours :: Grid g s x => g -> x -> [x]
- Math.Geometry.GridInternal: viewpoint :: Grid g s x => x -> g -> [(x, Int)]
+ Math.Geometry.GridInternal: viewpoint :: Grid g s x => g -> x -> [(x, Int)]
- Math.Geometry.GridMap: distance :: Grid g s x => x -> x -> g -> Int
+ Math.Geometry.GridMap: distance :: Grid g s x => g -> x -> x -> Int
- Math.Geometry.GridMap: neighbours :: Grid g s x => x -> g -> [x]
+ Math.Geometry.GridMap: neighbours :: Grid g s x => g -> x -> [x]
- Math.Geometry.GridMap: viewpoint :: Grid g s x => x -> g -> [(x, Int)]
+ Math.Geometry.GridMap: viewpoint :: Grid g s x => g -> x -> [(x, Int)]
Files
- grid.cabal +7/−4
- src/Math/Geometry/Grid.hs +15/−9
- src/Math/Geometry/GridInternal.hs +248/−74
- src/Math/Geometry/GridMap.hs +5/−5
- test/Math/Geometry/GridQC.hs +265/−67
grid.cabal view
@@ -1,11 +1,14 @@ name: grid-version: 2.1.1-synopsis: Tools for working with regular grids\/graphs\/lattices.+version: 3.0+synopsis: Tools for working with regular grids (graphs, lattices). description: Provides tools for working with regular arrangements of tiles, such as might be used in a board game or some other type of grid map. Currently supports triangular, square, and hexagonal tiles, with various 2D and toroidal layouts.+ NOTE: Version 3.0 changed the order of parameters+ for many functions. This makes it easier for the user+ to write mapping and folding operations. category: Math cabal-version: >=1.8 build-type: Simple@@ -21,7 +24,7 @@ build-depends: base ==4.*, base-unicode-symbols ==0.2.*, containers ==0.4.2.*- ghc-options: -Wall -rtsopts+ ghc-options: -Wall exposed-modules: Math.Geometry.Grid, Math.Geometry.GridInternal, Math.Geometry.GridMap@@ -36,7 +39,7 @@ grid, base-unicode-symbols ==0.2.* hs-source-dirs: test- ghc-options: -Wall -rtsopts+ ghc-options: -Wall main-is: Main.hs other-modules: Math.Geometry.GridQC
src/Math/Geometry/Grid.hs view
@@ -10,6 +10,10 @@ -- A regular arrangement of tiles. Grids have a variety of uses, -- including games and self-organising maps. --+-- NOTE: Version 3.0 changed the order of parameters for many functions.+-- This makes it easier for the user to write mapping and folding+-- operations.+-- ----------------------------------------------------------------------------- {-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-}@@ -18,6 +22,7 @@ ( -- * The Grid class Grid(..),+ BoundedGrid(..), -- * Grids with triangular tiles TriTriGrid, triTriGrid,@@ -37,9 +42,10 @@ -- $Example ) where -import Math.Geometry.GridInternal (Grid(..), TriTriGrid, triTriGrid, - ParaTriGrid, paraTriGrid, RectSquareGrid, rectSquareGrid, TorSquareGrid, - torSquareGrid, HexHexGrid, hexHexGrid, ParaHexGrid, paraHexGrid)+import Math.Geometry.GridInternal (Grid(..), BoundedGrid(..), + TriTriGrid, triTriGrid, ParaTriGrid, paraTriGrid, RectSquareGrid, + rectSquareGrid, TorSquareGrid, torSquareGrid, HexHexGrid, hexHexGrid, + ParaHexGrid, paraHexGrid) {- $Example Create a grid.@@ -51,25 +57,25 @@ Find out the minimum number of moves to go from one tile in a grid to another tile, moving between adjacent tiles at each step. ->ghci> distance (0,-2) (0,2) g+>ghci> distance g (0,-2) (0,2) >4 Find out the minimum number of moves to go from one tile in a grid to any other tile, moving between adjacent tiles at each step. ->ghci> viewpoint (1,-2) g+>ghci> viewpoint g (1,-2) >[((-2,0),3),((-2,1),3),((-2,2),4),((-1,-1),2),((-1,0),2),((-1,1),3),((-1,2),4),((0,-2),1),((0,-1),1),((0,0),2),((0,1),3),((0,2),4),((1,-2),0),((1,-1),1),((1,0),2),((1,1),3),((2,-2),1),((2,-1),2),((2,0),3)] Find out which tiles are adjacent to a particular tile. ->ghci> neighbours (-1,1) g+>ghci> neighbours g (-1,1) >[(-2,1),(-2,2),(-1,2),(0,1),(0,0),(-1,0)] Find out if a tile is within the grid boundary. ->ghci> inGrid (0,0) g+>ghci> g `contains` (0,0) >True->ghci> inGrid (0,12) g+>ghci> g `contains` (0,12) >False Find out the physical dimensions of the grid.@@ -92,7 +98,7 @@ Find all of the minimal paths between two points. ghci> let g = hexHexGrid 3-ghci> minimalPaths (0,0) (2,-1) g+ghci> minimalPaths g (0,0) (2,-1) [[(0,0),(1,0),(2,-1)],[(0,0),(1,-1),(2,-1)]] -}
src/Math/Geometry/GridInternal.hs view
@@ -1,4 +1,4 @@------------------------------------------------------------------------------+------------------------------------------------------------------------ -- | -- Module : Math.Geometry.GridInternal -- Copyright : (c) Amy de Buitléir 2012@@ -10,14 +10,16 @@ -- A module containing private @Grid@ internals. Most developers should -- use @Grid@ instead. This module is subject to change without notice. ---------------------------------------------------------------------------------{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FunctionalDependencies, - TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}+------------------------------------------------------------------------+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, + FunctionalDependencies, TypeSynonymInstances, FlexibleInstances, + FlexibleContexts #-} module Math.Geometry.GridInternal ( -- * Generic Grid(..),+ BoundedGrid(..), -- * Grids with triangular tiles TriTriGrid, triTriGrid,@@ -36,90 +38,174 @@ ) where import Data.Eq.Unicode ((≡), (≠))-import Data.List (nub, nubBy)+import Data.Function (on)+import Data.List (groupBy, nub, nubBy, sortBy)+import Data.Ord (comparing) import Data.Ord.Unicode ((≤), (≥)) -- | A regular arrangement of tiles.--- Minimal complete definition: @indices@, @distance@, and @size@.+-- Minimal complete definition: @indices@, @distance@ and @size@. class Eq x ⇒ Grid g s x | g → s, g → x where+ -- | Returns the indices of all tiles in a grid. indices ∷ g → [x]- -- | @'distance' a b@ returns the minimum number of moves required to get- -- from @a@ to @b@, moving between adjacent tiles at each step. (Two tiles- -- are adjacent if they share an edge.) If @a@ or @b@ are not contained- -- within @g@, the result is undefined.- distance ∷ x → x → g → Int++ -- | @'distance' g a b@ returns the minimum number of moves required+ -- to get from the tile at index @a@ to the tile at index @b@ in+ -- grid @g@, moving between adjacent tiles at each step. (Two tiles+ -- are adjacent if they share an edge.) If @a@ or @b@ are not+ -- contained within @g@, the result is undefined.+ distance ∷ g → x → x → Int++ -- | @'minDistance' g bs a@ returns the minimum number of moves + -- required to get from any of the tiles at indices @bs@ to the tile+ -- at index @a@ in grid @g@, moving between adjacent tiles at each+ -- step. (Two tiles are adjacent if they share an edge.) If @a@ or+ -- any of @bs@ are not contained within @g@, the result is + -- undefined.+ minDistance ∷ g → [x] → x → Int+ minDistance g xs x = minimum . map (distance g x) $ xs+ -- | Returns the dimensions of the grid. - -- For example, if @g@ is a 4x3 rectangular grid, @'size' g@ would return - -- @(4, 3)@, while @'tileCount' g@ would return @12@.+ -- For example, if @g@ is a 4x3 rectangular grid, @'size' g@ would+ -- return @(4, 3)@, while @'tileCount' g@ would return @12@. size ∷ g → s- -- | @'neighbours' x g@ returns the indices of the tiles in the grid @g@- -- which are adjacent to the tile at @x@.- neighbours ∷ x → g → [x]- neighbours x g = filter (\a → distance x a g ≡ 1 ) $ indices g- -- | @x 'inGrid' g@ returns true if the index @x@ is contained within @g@,- -- otherwise it returns false.- inGrid ∷ x → g → Bool- inGrid x g = x `elem` indices g- -- | @'viewpoint' x g@ returns a list of pairs associating the index of each- -- tile in @g@ with its distance to the tile with index @x@. If @x@ is not- -- contained within @g@, the result is undefined.- viewpoint ∷ x → g → [(x, Int)]- viewpoint p g = map f (indices g)- where f x = (x, distance p x g)++ -- | @'neighbours' g x@ returns the indices of the tiles in the grid+ -- @g@ which are adjacent to the tile with index @x@.+ neighbours ∷ g → x → [x]+ neighbours g x = filter (\a → distance g x a ≡ 1 ) $ indices g++ -- | @'numNeighbours' g x@ returns the number of tiles in the grid+ -- @g@ which are adjacent to the tile with index @x@.+ numNeighbours ∷ g → x → Int+ numNeighbours g = length . neighbours g++ -- | @g `'contains'` x@ returns @True@ if the index @x@ is contained + -- within the grid @g@, otherwise it returns false.+ contains ∷ g → x → Bool+ contains g x = x `elem` indices g++ -- | @'viewpoint' g x@ returns a list of pairs associating the index+ -- of each tile in @g@ with its distance to the tile with index @x@.+ -- If @x@ is not contained within @g@, the result is undefined.+ viewpoint ∷ g → x → [(x, Int)]+ viewpoint g p = map f (indices g)+ where f x = (x, distance g p x)+ -- | Returns the number of tiles in a grid. Compare with @'size'@. tileCount ∷ g → Int tileCount = length . indices+ -- | Returns @True@ if the number of tiles in a grid is zero, @False@ -- otherwise. empty ∷ g → Bool empty g = tileCount g ≡ 0+ -- | Returns @False@ if the number of tiles in a grid is zero, @True@ -- otherwise. nonEmpty ∷ g → Bool nonEmpty = not . empty- -- | A list of all edges in a Grid, where the edges are represented by a- -- pair of adjacent tiles.++ -- | A list of all edges in a grid, where the edges are represented by+ -- a pair of indices of adjacent tiles. edges ∷ g → [(x,x)] edges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g- -- | @'minimalPaths' a b@ returns a list of all minimal paths from - -- @a@ to @b@. A path is a sequence of tiles, where each tile in the- -- sequence is adjacent to the previous one. (Two tiles are adjacent- -- if they share an edge.) If @a@ or @b@ are not contained- -- within @g@, the result is undefined.- minimalPaths ∷ x → x → g → [[x]]- minimalPaths a b g | a ≡ b = [[a]]- | distance a b g ≡ 1 = [[a,b]]++ -- | @'isAdjacent' g a b@ returns @True@ if the tile at index @a@ is+ -- adjacent to the tile at index @b@ in @g@. (Two tiles are adjacent+ -- if they share an edge.) If @a@ or @b@ are not contained within+ -- @g@, the result is undefined.+ isAdjacent ∷ Grid g s x ⇒ g → x → x → Bool+ isAdjacent g a b = distance g a b ≡ 1++ -- | @'adjacentTilesToward' g a b@ returns the indices of all tiles+ -- which are neighbours of the tile at index @a@, and which are+ -- closer to the tile at @b@ than @a@ is. In other words, it returns+ -- the possible next steps on a minimal path from @a@ to @b@. If @a@+ -- or @b@ are not contained within @g@, or if there is no path from + -- @a@ to @b@ (e.g., a disconnected grid), the result is undefined.+ adjacentTilesToward ∷ g → x → x → [x]+ adjacentTilesToward g a b+ | a ≡ b = []+ | otherwise = filter f $ neighbours g a+ where f x = distance g x b ≡ distance g a b - 1++ -- | @'minimalPaths' g a b@ returns a list of all minimal paths from + -- the tile at index @a@ to the tile at index @b@ in grid @g@. A+ -- path is a sequence of tiles where each tile in the sequence is+ -- adjacent to the previous one. (Two tiles are adjacent if they+ -- share an edge.) If @a@ or @b@ are not contained within @g@, the+ -- result is undefined.+ --+ -- Tip: The default implementation of this function calls+ -- @'adjacentTilesToward'@. If you want to use a custom algorithm,+ -- consider modifying @'adjacentTilesToward'@ instead of + -- @'minimalPaths'@.+ minimalPaths ∷ g → x → x → [[x]]+ minimalPaths g a b | a ≡ b = [[a]]+ | distance g a b ≡ 1 = [[a,b]] | otherwise = map (a:) xs- where xs = concatMap (\x → minimalPaths x b g) ys- ys = filter f $ neighbours a g- f x = distance x b g ≡ distance a b g - 1+ where xs = concatMap (\x → minimalPaths g x b) ys+ ys = adjacentTilesToward g a b sameEdge ∷ Eq t ⇒ (t, t) → (t, t) → Bool sameEdge (a,b) (c,d) = (a,b) ≡ (c,d) || (a,b) ≡ (d,c) adjacentEdges ∷ Grid g s t ⇒ t → g → [(t, t)]-adjacentEdges i g = map (\j → (i,j)) $ i `neighbours` g+adjacentEdges i g = map (\j → (i,j)) $ neighbours g i ++-- | A regular arrangement of tiles with an edge.+-- Minimal complete definition: @boundary@.+class Grid g s x ⇒ BoundedGrid g s x where+ -- | Returns a the indices of all the tiles at the boundary of a grid, + -- including corner tiles.+ boundary ∷ g → [x]++ -- | @'isBoundary' g x@' returns @True@ if the tile with index @x@ is+ -- on a boundary of @g@, @False@ otherwise. (Corner tiles are also+ -- boundary tiles.)+ isBoundary ∷ g → x → Bool+ isBoundary g x = x `elem` boundary g++ -- | Returns the index of the tile(s) that require the maximum number + -- of moves to reach the nearest boundary tile. A grid may have more+ -- than one central tile (e.g., a rectangular grid with an even + -- number of rows and columns will have four central tiles).+ centre ∷ g → [x]+ centre g = map fst . head . reverse . groupBy ((==) `on` snd) . + sortBy (comparing snd) $ xds+ where xds = map (\y -> (y, minDistance g bs y)) $ indices g+ bs = boundary g+++ -- | @'isCentre' g x@' returns @True@ if the tile with index @x@ is+ -- a centre tile of @g@, @False@ otherwise.+ isCentre ∷ g → x → Bool+ isCentre g x = x `elem` centre g++ -- -- Triangular tiles -- --- | For triangular tiles, it is convenient to define a third component z.+-- | For triangular tiles, it is convenient to define a third component +-- z. triZ ∷ Int → Int → Int triZ x y | even y = -x - y | otherwise = -x - y + 1 -triDistance ∷ Grid g s (Int, Int) ⇒ (Int, Int) → (Int, Int) → g → Int-triDistance (x1, y1) (x2, y2) g = - if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g+triDistance ∷ Grid g s (Int, Int) ⇒ g → (Int, Int) → (Int, Int) → Int+triDistance g (x1, y1) (x2, y2) = + if g `contains` (x1, y1) && g `contains` (x2, y2) then maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)] else undefined where z1 = triZ x1 y1 z2 = triZ x2 y2 -triNeighbours ∷ Grid g s (Int, Int) ⇒ (Int, Int) → g → [(Int, Int)]-triNeighbours (x,y) g = filter (`inGrid` g) xs+triNeighbours ∷ Grid g s (Int, Int) ⇒ g → (Int, Int) → [(Int, Int)]+triNeighbours g (x,y) = filter (g `contains`) xs where xs | even y = [(x-1,y+1), (x+1,y+1), (x+1,y-1)] | otherwise = [(x-1,y-1), (x-1,y+1), (x+1,y-1)] @@ -132,28 +218,49 @@ -- available at <https://github.com/mhwombat/grid/wiki>. data TriTriGrid = TriTriGrid Int [(Int, Int)] deriving Eq -instance Show TriTriGrid where show (TriTriGrid s _) = "triTriGrid " ++ show s+instance Show TriTriGrid where + show (TriTriGrid s _) = "triTriGrid " ++ show s instance Grid TriTriGrid Int (Int, Int) where indices (TriTriGrid _ xs) = xs neighbours = triNeighbours distance = triDistance- inGrid (x, y) (TriTriGrid s _) = inTriGrid (x,y) s+ contains (TriTriGrid s _) (x, y) = inTriGrid (x,y) s size (TriTriGrid s _) = s inTriGrid ∷ (Int, Int) → Int → Bool inTriGrid (x, y) s = x ≥ 0 && y ≥ 0 && even (x+y) && abs z ≤ 2*s-2 where z = triZ x y +instance BoundedGrid TriTriGrid Int (Int, Int) where+-- corners g = if empty g +-- then [] +-- else nub [(0,0), (0,2*s-2), (2*s-2, 0)] +-- where s = size g+ boundary g = west ++ east ++ south+ where s = size g+ west = [(0,k) | k ← [0,2..2*s-2]]+ east = [(k,2*s-2-k) | k ← [2,4..2*s-2]]+ south = [(k,0) | k ← [2*s-4,2*s-6..2]]+ centre g = case s `mod` 3 of+ 0 → trefoilWithTop (k-1,k+1) where k = (2*s) `div` 3+ 1 → [(k,k)] where k = (2*(s-1)) `div` 3+ 2 → [(k+1,k+1)] where k = (2*(s-2)) `div` 3+ _ → error "This will never happen."+ where s = size g++trefoilWithTop ∷ (Int, Int) → [(Int,Int)]+trefoilWithTop (i,j) = [(i,j), (i+2, j-2), (i,j-2)]+ -- | @'triTriGrid' s@ returns a triangular grid with sides of --- length @s@, using triangular tiles. If @s@ is nonnegative, the resulting --- grid will have @s^2@ tiles. Otherwise, the resulting grid will be empty --- and the list of indices will be null.+-- length @s@, using triangular tiles. If @s@ is nonnegative, the +-- resulting grid will have @s^2@ tiles. Otherwise, the resulting grid+-- will be empty and the list of indices will be null. triTriGrid ∷ Int → TriTriGrid triTriGrid s = TriTriGrid s [(xx,yy) | xx ← [0..2*(s-1)], yy ← [0..2*(s-1)], - inTriGrid (xx,yy) s]+ (xx,yy) `inTriGrid` s] -- -- Parallelogrammatical grids with triangular tiles@@ -173,11 +280,33 @@ distance = triDistance size (ParaTriGrid s _) = s +instance BoundedGrid ParaTriGrid (Int, Int) (Int, Int) where+ boundary g = west ++ north ++ east ++ south+ where (r,c) = size g+ west = [(0,k) | k ← [0,2..2*r-2], c>0]+ north = [(k,2*r-1) | k ← [1,3..2*c-1], r>0]+ east = [(2*c-1,k) | k ← [2*r-3,2*r-5..1], c>0]+ south = [(k,0) | k ← [2*c-2,2*c-4..2], r>0]+ centre g = paraTriGridCentre . size $ g++paraTriGridCentre ∷ (Int, Int) → [(Int, Int)]+paraTriGridCentre (r,c)+ | odd r && odd c = [(c-1,r-1), (c,r)]+ | even r && even c && r == c = bowtie (c-1,r-1)+ | even r && even c && r > c + = bowtie (c-1,r-3) ++ bowtie (c-1,r-1) ++ bowtie (c-1,r+1)+ | even r && even c && r < c + = bowtie (c-3,r-1) ++ bowtie (c-1,r-1) ++ bowtie (c+1,r-1)+ | otherwise = [(c-1,r), (c,r-1)]++bowtie :: (Int,Int) -> [(Int,Int)]+bowtie (i,j) = [(i,j), (i+1,j+1)]+ -- | @'paraTriGrid' r c@ returns a grid in the shape of a --- parallelogram with @r@ rows and @c@ columns, using triangular tiles. --- If @r@ and @c@ are both nonnegative, the resulting grid will have @2*r*c@--- tiles. Otherwise, the resulting grid will be empty and the list of indices--- will be null.+-- parallelogram with @r@ rows and @c@ columns, using triangular +-- tiles. If @r@ and @c@ are both nonnegative, the resulting grid will+-- have @2*r*c@ tiles. Otherwise, the resulting grid will be empty and+-- the list of indices will be null. paraTriGrid ∷ Int → Int → ParaTriGrid paraTriGrid r c = ParaTriGrid (r,c) [(x,y) | x ← [0..2*c-1], y ← [0..2*r-1], even (x+y)]@@ -192,23 +321,52 @@ data RectSquareGrid = RectSquareGrid (Int, Int) [(Int, Int)] deriving Eq instance Show RectSquareGrid where - show (RectSquareGrid (r,c) _) = "rectSquareGrid " ++ show r ++ " " ++ show c+ show (RectSquareGrid (r,c) _) = + "rectSquareGrid " ++ show r ++ " " ++ show c instance Grid RectSquareGrid (Int, Int) (Int, Int) where indices (RectSquareGrid _ xs) = xs- neighbours (x, y) g = filter (`inGrid` g) [(x-1,y), (x,y+1), (x+1,y), (x,y-1)]- distance (x1, y1) (x2, y2) g = - if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g+ neighbours g (x, y) = + filter (g `contains`) [(x-1,y), (x,y+1), (x+1,y), (x,y-1)]+ distance g (x1, y1) (x2, y2) = + if g `contains` (x1, y1) && g `contains` (x2, y2) then abs (x2-x1) + abs (y2-y1) else undefined size (RectSquareGrid s _) = s+ adjacentTilesToward g a@(x1, y1) (x2, y2) = + filter (\i → g `contains` i && i ≠ a) $ nub [(x1,y1+dy),(x1+dx,y1)]+ where dx = signum (x2-x1)+ dy = signum (y2-y1) --- | @'rectSquareGrid' r c@ produces a rectangular grid with @r@ rows and @c@ --- columns, using square tiles. If @r@ and @c@ are both nonnegative, the --- resulting grid will have @r*c@ tiles. Otherwise, the resulting grid will --- be empty and the list of indices will be null.+instance BoundedGrid RectSquareGrid (Int, Int) (Int, Int) where+ boundary g = cartesianIndices . size $ g+ centre g = cartesianCentre . size $ g++cartesianIndices+ ∷ (Enum r, Enum c, Num r, Num c, Ord r, Ord c) ⇒+ (r, c) → [(c, r)]+cartesianIndices (r, c) = west ++ north ++ east ++ south+ where west = [(0,k) | k ← [0,1..r-1], c>0]+ north = [(k,r-1) | k ← [1,2..c-1], r>0]+ east = [(c-1,k) | k ← [r-2,r-3..0], c>1]+ south = [(k,0) | k ← [c-2,c-3..1], r>1]++cartesianCentre ∷ (Int, Int) → [(Int, Int)]+cartesianCentre (r,c) = [(i,j) | i ← midpoints c, j ← midpoints r]++midpoints ∷ Int → [Int]+midpoints k = if even k then [m-1,m] else [m]+ where m = floor (k'/2.0)+ k' = fromIntegral k ∷ Double++-- | @'rectSquareGrid' r c@ produces a rectangular grid with @r@ rows+-- and @c@ columns, using square tiles. If @r@ and @c@ are both +-- nonnegative, the resulting grid will have @r*c@ tiles. Otherwise, +-- the resulting grid will be empty and the list of indices will be +-- null. rectSquareGrid ∷ Int → Int → RectSquareGrid-rectSquareGrid r c = RectSquareGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]]+rectSquareGrid r c = + RectSquareGrid (r,c) [(x,y) | x ← [0..c-1], y ← [0..r-1]] -- -- Toroidal grids with square tiles.@@ -224,12 +382,12 @@ instance Grid TorSquareGrid (Int, Int) (Int, Int) where indices (TorSquareGrid _ xs) = xs- neighbours (x,y) (TorSquareGrid (r,c) _) = + neighbours (TorSquareGrid (r,c) _) (x,y) = nub $ filter (\(xx,yy) → xx ≠ x || yy ≠ y) [((x-1) `mod` c,y), (x,(y+1) `mod` r), ((x+1) `mod` c,y), (x,(y-1) `mod` r)]- distance (x1, y1) (x2, y2) g@(TorSquareGrid (r,c) _) =- if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g+ distance g@(TorSquareGrid (r,c) _) (x1, y1) (x2, y2) =+ if g `contains` (x1, y1) && g `contains` (x2, y2) then min adx (abs (c-adx)) + min ady (abs (r-ady)) else undefined where adx = abs (x2 - x1)@@ -247,9 +405,9 @@ -- Hexagonal tiles -- -hexDistance ∷ Grid g s (Int, Int) ⇒ (Int, Int) → (Int, Int) → g → Int-hexDistance (x1, y1) (x2, y2) g = - if (x1, y1) `inGrid` g && (x2, y2) `inGrid` g+hexDistance ∷ Grid g s (Int, Int) ⇒ g → (Int, Int) → (Int, Int) → Int+hexDistance g (x1, y1) (x2, y2) = + if g `contains` (x1, y1) && g `contains` (x2, y2) then maximum [abs (x2-x1), abs (y2-y1), abs(z2-z1)] else undefined where z1 = -x1 - y1@@ -268,11 +426,23 @@ instance Grid HexHexGrid Int (Int, Int) where indices (HexHexGrid _ xs) = xs- neighbours (x,y) g = filter (`inGrid` g) + neighbours g (x,y) = filter (g `contains`) [(x-1,y), (x-1,y+1), (x,y+1), (x+1,y), (x+1,y-1), (x,y-1)] distance = hexDistance size (HexHexGrid s _) = s +instance BoundedGrid HexHexGrid Int (Int, Int) where+ boundary g = + north ++ northeast ++ southeast ++ south ++ southwest ++ northwest+ where s = size g+ north = [(k,s-1) | k ← [-s+1,-s+2..0]]+ northeast = [(k,s-1-k) | k ← [1,2..s-1]]+ southeast = [(s-1,k) | k ← [-1,-2..(-s)+1]]+ south = [(k,(-s)+1) | k ← [s-2,s-3..0]]+ southwest = [(k,(-s)+1-k) | k ← [-1,-2..(-s)+1]]+ northwest = [(-s+1,k) | k ← [1,2..s-2]]+ centre _ = [(0,0)]+ -- | @'hexHexGrid' s@ returns a grid of hexagonal shape, with -- sides of length @s@, using hexagonal tiles. If @s@ is nonnegative, the -- resulting grid will have @3*s*(s-1) + 1@ tiles. Otherwise, the resulting @@ -295,10 +465,14 @@ instance Grid ParaHexGrid (Int, Int) (Int, Int) where indices (ParaHexGrid _ xs) = xs- neighbours (x,y) g = filter (`inGrid` g) + neighbours g (x,y) = filter (g `contains`) [(x-1,y), (x-1,y+1), (x,y+1), (x+1,y), (x+1,y-1), (x,y-1)] distance = hexDistance size (ParaHexGrid s _) = s++instance BoundedGrid ParaHexGrid (Int, Int) (Int, Int) where+ boundary g = cartesianIndices . size $ g+ centre g = cartesianCentre . size $ g -- | @'paraHexGrid' r c@ returns a grid in the shape of a -- parallelogram with @r@ rows and @c@ columns, using hexagonal tiles. If
src/Math/Geometry/GridMap.hs view
@@ -31,7 +31,7 @@ distance, size, neighbours,- inGrid,+ contains, viewpoint, tileCount, empty,@@ -94,11 +94,11 @@ instance (Eq k, Grid g s k) ⇒ Grid (GridMap g k v) s k where indices = indices . toGrid- distance x y = distance x y . toGrid+ distance g = distance (toGrid g) size = size . toGrid- neighbours k = (k `neighbours`) . toGrid- inGrid k = (k `inGrid`) . toGrid- viewpoint k = (k `viewpoint`) . toGrid+ neighbours g k = toGrid g `neighbours` k+ contains g k = toGrid g `contains` k+ viewpoint g k = toGrid g `viewpoint` k tileCount = tileCount . toGrid empty = empty . toGrid nonEmpty = nonEmpty . toGrid
test/Math/Geometry/GridQC.hs view
@@ -24,8 +24,8 @@ where n' = fromIntegral n ∷ Float -- Given an arbitrary integer, select a corresponding point in the grid.-pointIn ∷ Grid g s x ⇒ Int → g → x-pointIn i g = indices g !! (i `mod` n)+pointAt ∷ Grid g s x ⇒ g → Int → x+pointAt g i = indices g !! (i `mod` n) where n = (length . indices) g --@@ -33,26 +33,34 @@ -- prop_distance_reflexive ∷ Grid g s x ⇒ g → Int → Property-prop_distance_reflexive g i = nonEmpty g ==> distance a a g ≡ 0- where a = i `pointIn` g+prop_distance_reflexive g i = nonEmpty g ==> distance g a a ≡ 0+ where a = g `pointAt` i prop_distance_symmetric ∷ Grid g s x ⇒ g → Int → Int → Property-prop_distance_symmetric g i j = nonEmpty g ==> distance a b g ≡ distance b a g- where a = i `pointIn` g- b = j `pointIn` g+prop_distance_symmetric g i j = + nonEmpty g ==> distance g a b ≡ distance g b a+ where a = g `pointAt` i+ b = g `pointAt` j -- "cw" = "consistent with" +prop_minDistance_cw_distance ∷ Grid g s x ⇒ g → Int → [Int] → Property+prop_minDistance_cw_distance g i js = + nonEmpty g && (not . null) js ==> + minDistance g (b:bs) a ≤ distance g b a+ where a = g `pointAt` i+ (b:bs) = map (g `pointAt`) js+ prop_neighbours_cw_viewpoint ∷ (Grid g s x, Ord x) ⇒ g → Int → Property prop_neighbours_cw_viewpoint g i = n > 0 ==> - sort (a `neighbours` g) ≡ sort expected+ sort (neighbours g a) ≡ sort expected where n = (length . indices) g a = indices g !! (i `mod` n) -- make sure point is in grid- expected = map fst $ filter (\p → 1 ≡ snd p) $ a `viewpoint` g+ expected = map fst $ filter (\p → 1 ≡ snd p) $ viewpoint g a prop_edges_cw_neighbours ∷ (Grid g s x, Ord x) ⇒ g → Int → Property prop_edges_cw_neighbours g i = n > 0 ==> - sort (a `neighbours` g) ≡ sort expected+ sort (neighbours g a) ≡ sort expected where n = (length . indices) g a = indices g !! (i `mod` n) -- make sure point is in grid nEdges = filter (`involves` a) $ edges g@@ -62,32 +70,66 @@ involves (a, b) c = c ≡ a || c ≡ b prop_edges_are_adjacent ∷ (Grid g s x, Ord x) ⇒ g → Property-prop_edges_are_adjacent g = property $ and $ map f $ edges g- where f (a, b) = isAdjacent a b g+prop_edges_are_adjacent g = property $ all f $ edges g+ where f (a, b) = isAdjacent g a b -isAdjacent ∷ Grid g s x ⇒ x → x → g → Bool-isAdjacent a b g = (distance a b g) ≡ 1+prop_adjacentTilesToward_moves_closer ∷ Grid g s x ⇒ g → Int → Int → Property+prop_adjacentTilesToward_moves_closer g i j = nonEmpty g && a ≠ b ==> + ns ≡ [d-1]+ where a = g `pointAt` i+ b = g `pointAt` j+ d = distance g a b+ ns = nub $ map (\x → distance g x b) $ adjacentTilesToward g a b prop_minimal_paths_have_min_length ∷ Grid g s x ⇒ g → Int → Int → Property prop_minimal_paths_have_min_length g i j = nonEmpty g ==> ns ≡ [d+1]- where a = i `pointIn` g- b = j `pointIn` g- d = distance a b g- ns = nub $ map length $ minimalPaths a b g+ where a = g `pointAt` i+ b = g `pointAt` j+ d = distance g a b+ ns = nub $ map length $ minimalPaths g a b prop_minimal_paths_are_valid ∷ Grid g s x ⇒ g → Int → Int → Property prop_minimal_paths_are_valid g i j = nonEmpty g ==> - and $ map (subsequentTilesInPathAreAdjacent g) $ minimalPaths a b g- where a = i `pointIn` g- b = j `pointIn` g+ and $ map (subsequentTilesInPathAreAdjacent g) $ minimalPaths g a b+ where a = g `pointAt` i+ b = g `pointAt` j subsequentTilesInPathAreAdjacent ∷ Grid g s x ⇒ g → [x] → Bool subsequentTilesInPathAreAdjacent _ [] = True-subsequentTilesInPathAreAdjacent g [x] = x `elem` (indices g)+subsequentTilesInPathAreAdjacent g [x] = x `elem` indices g subsequentTilesInPathAreAdjacent g (a:b:xs) = - isAdjacent a b g && subsequentTilesInPathAreAdjacent g (b:xs)+ isAdjacent g a b && subsequentTilesInPathAreAdjacent g (b:xs) --+-- Tests that should apply to and are identical for all bounded grids+--++prop_grid_and_boundary_are_both_null_or_not + ∷ BoundedGrid g s x ⇒ g → Property+prop_grid_and_boundary_are_both_null_or_not g = property $+ (null . boundary) g ≡ empty g++prop_boundary_in_grid ∷ BoundedGrid g s x ⇒ g → Property+prop_boundary_in_grid g = property $+ all (g `contains`) . boundary $ g++prop_centres_equidistant_from_boundary ∷ BoundedGrid g s x ⇒ g → Property+prop_centres_equidistant_from_boundary g = nonEmpty g ==>+ (length . nub . map (minDistance g bs)) cs ≡ 1+ where bs = boundary g+ cs = centre g++-- Note: We only need to test one of the centres, because the previous+-- test proves they are all equidistant from the boundary.+prop_centres_farthest_from_boundary ∷ BoundedGrid g s x ⇒ g → Int → Property+prop_centres_farthest_from_boundary g i = + nonEmpty g && (not . isCentre g) a ==>+ minDistance g bs a ≤ minDistance g bs c+ where a = g `pointAt` i+ (c:_) = centre g+ bs = boundary g++-- -- Triangular grids with triangular tiles -- @@ -105,16 +147,16 @@ prop_TriTriGrid_distance_in_bounds ∷ TriTriGrid → Int → Int → Property prop_TriTriGrid_distance_in_bounds g i j = nonEmpty g ==> - distance a b g ≤ 2*(s-1)+ distance g a b ≤ 2*(s-1) where s = size g- a = i `pointIn` g- b = j `pointIn` g+ a = g `pointAt` i+ b = g `pointAt` j -- If the ordering produced by triTriGrid is ever changed, this property -- may need to be changed too. It relies on the first and last elements being -- at corners. prop_TriTriGrid_distance_edge_to_edge ∷ TriTriGrid → Property-prop_TriTriGrid_distance_edge_to_edge g = s > 0 ==> distance a b g ≡ 2*(s-1)+prop_TriTriGrid_distance_edge_to_edge g = s > 0 ==> distance g a b ≡ 2*(s-1) where ps = indices g a = head ps b = last ps@@ -123,10 +165,21 @@ prop_TriTriGrid_neighbour_count_in_bounds ∷ TriTriGrid → Int → Property prop_TriTriGrid_neighbour_count_in_bounds g i = nonEmpty g ==> if tileCount g ≡ 1- then length (x `neighbours` g) ≡ 0- else length (x `neighbours` g) `elem` [1,2,3]- where x = i `pointIn` g+ then length (neighbours g x) ≡ 0+ else length (neighbours g x) `elem` [1,2,3]+ where x = g `pointAt` i +prop_TriTriGrid_boundary_count_correct ∷ TriTriGrid → Property+prop_TriTriGrid_boundary_count_correct g = property $+ (length . boundary) g ≡ (f . size) g+ where f 0 = 0+ f 1 = 1+ f s = 3*(s-1)++prop_TriTriGrid_boundary_tiles_have_fewer_neighbours ∷ TriTriGrid → Property+prop_TriTriGrid_boundary_tiles_have_fewer_neighbours g = property $+ all (3>) . map (numNeighbours g) . boundary $ g+ -- -- Parallelogram-shaped grids with triangular tiles --@@ -148,17 +201,17 @@ prop_ParaTriGrid_distance_in_bounds ∷ ParaTriGrid → Int → Int → Property prop_ParaTriGrid_distance_in_bounds g i j = nonEmpty g ==> - distance a b g ≤ 2*(r+c) - 3+ distance g a b ≤ 2*(r+c) - 3 where (r, c) = size g- a = i `pointIn` g- b = j `pointIn` g+ a = g `pointAt` i+ b = g `pointAt` j -- If the ordering produced by paraTriGrid is ever changed, this -- property may need to be changed too. It relies on the first and last -- elements being at corners. prop_ParaTriGrid_distance_corner_to_corner ∷ ParaTriGrid → Property prop_ParaTriGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> - distance a b g ≡ 2*(r+c) - 3+ distance g a b ≡ 2*(r+c) - 3 where ps = indices g a = head ps b = last ps@@ -167,10 +220,23 @@ prop_ParaTriGrid_neighbour_count_in_bounds ∷ ParaTriGrid → Int → Property prop_ParaTriGrid_neighbour_count_in_bounds g i = nonEmpty g ==> if tileCount g ≡ 1- then length (x `neighbours` g) ≡ 0- else length (x `neighbours` g) `elem` [1,2,3]- where x = i `pointIn` g+ then length (neighbours g x) ≡ 0+ else length (neighbours g x) `elem` [1,2,3]+ where x = g `pointAt` i +prop_ParaTriGrid_boundary_count_correct ∷ ParaTriGrid → Property+prop_ParaTriGrid_boundary_count_correct g = property $+ (length . boundary) g ≡ (f . size) g+ where f (0,_) = 0+ f (_,0) = 0+ f (1,c) = 2*c+ f (r,1) = 2*r+ f (r,c) = 2*(r+c-1)++prop_ParaTriGrid_boundary_tiles_have_fewer_neighbours ∷ ParaTriGrid → Property+prop_ParaTriGrid_boundary_tiles_have_fewer_neighbours g = property $+ all (3>) . map (numNeighbours g) . boundary $ g+ -- -- Rectangular grids with square tiles --@@ -192,17 +258,17 @@ prop_RectSquareGrid_distance_in_bounds ∷ RectSquareGrid → Int → Int → Property prop_RectSquareGrid_distance_in_bounds g i j = nonEmpty g ==>- distance a b g ≤ r + c - 2+ distance g a b ≤ r + c - 2 where (r, c) = size g- a = i `pointIn` g- b = j `pointIn` g+ a = g `pointAt` i+ b = g `pointAt` j -- If the ordering produced by rectSquareGrid is ever changed, this -- property may need to be changed too. It relies on the first and last -- elements being at opposite corners. prop_RectSquareGrid_distance_corner_to_corner ∷ RectSquareGrid → Property prop_RectSquareGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> - distance a b g ≡ r + c - 2+ distance g a b ≡ r + c - 2 where (r, c) = size g ps = indices g a = head ps@@ -211,8 +277,8 @@ prop_RectSquareGrid_neighbour_count_in_bounds ∷ RectSquareGrid → Int → Property prop_RectSquareGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f- where x = i `pointIn` g- neighbourCount = length (x `neighbours` g)+ where x = g `pointAt` i+ neighbourCount = length (neighbours g x) (r, c) = size g f | tileCount g ≡ 1 = neighbourCount ≡ 0 | r ≡ 1 || c ≡ 1 = neighbourCount `elem` [1,2]@@ -221,12 +287,28 @@ prop_RectSquareGrid_num_min_paths_correct ∷ RectSquareGrid → Int → Int → Property prop_RectSquareGrid_num_min_paths_correct g i j = nonEmpty g ==>- length (minimalPaths a b g) ≡ M.choose (deltaX+deltaY) deltaX- where a = i `pointIn` g- b = j `pointIn` g+ length (minimalPaths g a b) ≡ M.choose (deltaX+deltaY) deltaX+ where a = g `pointAt` i+ b = g `pointAt` j deltaX = abs $ fst b - fst a deltaY = abs $ snd b - snd a +prop_RectSquareGrid_boundary_count_correct ∷ RectSquareGrid → Property+prop_RectSquareGrid_boundary_count_correct g = property $+ (length . boundary) g ≡ (cartesianBoundaryCount . size) g++cartesianBoundaryCount ∷ (Eq a, Num a) ⇒ (a, a) → a+cartesianBoundaryCount (0,_) = 0+cartesianBoundaryCount (_,0) = 0+cartesianBoundaryCount (1,c) = c+cartesianBoundaryCount (r,1) = r+cartesianBoundaryCount (r,c) = 2*(r+c) - 4++prop_RectSquareGrid_boundary_tiles_have_fewer_neighbours ∷ RectSquareGrid → Property+prop_RectSquareGrid_boundary_tiles_have_fewer_neighbours g = property $+ all (4>) . map (numNeighbours g) . boundary $ g++ -- -- Toroidal grids with square-ish tiles --@@ -248,16 +330,16 @@ prop_TorSquareGrid_distance_in_bounds ∷ TorSquareGrid → Int → Int → Property prop_TorSquareGrid_distance_in_bounds g i j = nonEmpty g ==>- distance a b g ≤ (r+c) `div` 2+ distance g a b ≤ (r+c) `div` 2 where (r, c) = size g- a = i `pointIn` g- b = j `pointIn` g+ a = g `pointAt` i+ b = g `pointAt` j -- If the ordering produced by torSquareGrid is ever changed, this property -- may need to be changed too. prop_TorSquareGrid_distance_corner_to_corner ∷ TorSquareGrid → Property prop_TorSquareGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> - distance a b g ≡ f+ distance g a b ≡ f where (r, c) = size g ps = indices g a = head ps@@ -268,8 +350,8 @@ prop_TorSquareGrid_neighbour_count_in_bounds ∷ TorSquareGrid → Int → Property prop_TorSquareGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f- where x = i `pointIn` g- neighbourCount = length (x `neighbours` g)+ where x = g `pointAt` i+ neighbourCount = length (neighbours g x) (r, c) = size g f | tileCount g ≡ 1 = neighbourCount ≡ 0 | r ≡ 1 || c ≡ 1 = neighbourCount `elem` [1,2]@@ -294,16 +376,16 @@ prop_HexHexGrid_distance_in_bounds ∷ HexHexGrid → Int → Int → Property prop_HexHexGrid_distance_in_bounds g i j = nonEmpty g ==>- distance a b g < 2*s+ distance g a b < 2*s where s = size g- a = i `pointIn` g- b = j `pointIn` g+ a = g `pointAt` i+ b = g `pointAt` j -- If the ordering produced by hexHexGrid is ever changed, this property -- may need to be changed too. It relies on the first and last elements being -- on opposite edges. prop_HexHexGrid_distance_edge_to_edge ∷ HexHexGrid → Property-prop_HexHexGrid_distance_edge_to_edge g = s > 0 ==> distance a b g ≡ 2*s - 2+prop_HexHexGrid_distance_edge_to_edge g = s > 0 ==> distance g a b ≡ 2*s - 2 where ps = indices g a = head ps b = last ps@@ -312,10 +394,22 @@ prop_HexHexGrid_neighbour_count_in_bounds ∷ HexHexGrid → Int → Property prop_HexHexGrid_neighbour_count_in_bounds g i = nonEmpty g ==> if tileCount g ≡ 1- then length (x `neighbours` g) ≡ 0- else length (x `neighbours` g) `elem` [2,3,4,5,6]- where x = i `pointIn` g+ then length (neighbours g x) ≡ 0+ else length (neighbours g x) `elem` [2,3,4,5,6]+ where x = g `pointAt` i +prop_HexHexGrid_boundary_count_correct ∷ HexHexGrid → Property+prop_HexHexGrid_boundary_count_correct g = property $+ (length . boundary) g ≡ (f . size) g+ where f 0 = 0+ f 1 = 1+ f s = 6*(s-1)++prop_HexHexGrid_boundary_tiles_have_fewer_neighbours ∷ HexHexGrid → Property+prop_HexHexGrid_boundary_tiles_have_fewer_neighbours g = property $+ all (5>) . map (numNeighbours g) . boundary $ g++ -- -- Parallelogrammatical hexagonal grids --@@ -337,17 +431,17 @@ prop_ParaHexGrid_distance_in_bounds ∷ ParaHexGrid → Int → Int → Property prop_ParaHexGrid_distance_in_bounds g i j = nonEmpty g ==>- property $ distance a b g ≤ r+c-2+ property $ distance g a b ≤ r+c-2 where (r, c) = size g- a = i `pointIn` g- b = j `pointIn` g+ a = g `pointAt` i+ b = g `pointAt` j -- If the ordering produced by paraHexGrid is ever changed, this property -- may need to be changed too. It relies on the first and last elements being -- at opposite corners on the longer diagonal. prop_ParaHexGrid_distance_corner_to_corner ∷ ParaHexGrid → Property prop_ParaHexGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> - distance a b g ≡ r+c-2+ distance g a b ≡ r+c-2 where ps = indices g a = head ps b = last ps@@ -355,13 +449,22 @@ prop_ParaHexGrid_neighbour_count_in_bounds ∷ ParaHexGrid → Int → Property prop_ParaHexGrid_neighbour_count_in_bounds g i = nonEmpty g ==> f- where x = i `pointIn` g- neighbourCount = length (x `neighbours` g)+ where x = g `pointAt` i+ neighbourCount = length (neighbours g x) (r, c) = size g f | tileCount g ≡ 1 = neighbourCount ≡ 0 | r ≡ 1 || c ≡ 1 = neighbourCount `elem` [1,2] | otherwise = neighbourCount `elem` [2,3,4,5,6] +prop_ParaHexGrid_boundary_count_correct ∷ ParaHexGrid → Property+prop_ParaHexGrid_boundary_count_correct g = property $+ (length . boundary) g ≡ (cartesianBoundaryCount . size) g++prop_ParaHexGrid_boundary_tiles_have_fewer_neighbours ∷ HexHexGrid → Property+prop_ParaHexGrid_boundary_tiles_have_fewer_neighbours g = property $+ all (5>) . map (numNeighbours g) . boundary $ g++ test ∷ Test test = testGroup "Math.Geometry.GridQC" [@@ -372,6 +475,20 @@ (prop_distance_reflexive ∷ TriTriGrid → Int → Property), testProperty "prop_distance_symmetric - TriTriGrid" (prop_distance_symmetric ∷ TriTriGrid → Int → Int → Property),+ testProperty "prop_minDistance_cw_distance - TriTriGrid"+ (prop_minDistance_cw_distance ∷ TriTriGrid → Int → [Int] → Property),+ testProperty "prop_grid_and_boundary_are_both_null_or_not - TriTriGrid"+ (prop_grid_and_boundary_are_both_null_or_not ∷ TriTriGrid → Property),+ testProperty "prop_boundary_in_grid - TriTriGrid"+ (prop_boundary_in_grid ∷ TriTriGrid → Property),+ testProperty "prop_TriTriGrid_boundary_count_correct"+ prop_TriTriGrid_boundary_count_correct,+ testProperty "prop_TriTriGrid_boundary_tiles_have_fewer_neighbours"+ prop_TriTriGrid_boundary_tiles_have_fewer_neighbours,+ testProperty "prop_centres_equidistant_from_boundary - TriTriGrid"+ (prop_centres_equidistant_from_boundary ∷ TriTriGrid → Property),+ testProperty "prop_centres_farthest_from_boundary - TriTriGrid"+ (prop_centres_farthest_from_boundary ∷ TriTriGrid → Int → Property), testProperty "prop_TriTriGrid_distance_in_bounds" prop_TriTriGrid_distance_in_bounds, testProperty "prop_TriTriGrid_distance_edge_to_edge"@@ -384,11 +501,15 @@ ( prop_edges_cw_neighbours ∷ TriTriGrid → Int → Property), testProperty "prop_edges_are_adjacent - TriTriGrid" ( prop_edges_are_adjacent ∷ TriTriGrid → Property),+ testProperty "prop_adjacentTilesToward_moves_closer - TriTriGrid"+ ( prop_adjacentTilesToward_moves_closer ∷ + TriTriGrid → Int → Int → Property), testProperty "prop_minimal_paths_have_min_length - TriTriGrid" ( prop_minimal_paths_have_min_length ∷ TriTriGrid → Int → Int → Property), testProperty "prop_minimal_paths_are_valid - TriTriGrid" ( prop_minimal_paths_are_valid ∷ TriTriGrid → Int → Int → Property),+ -- ParaTriGrid tests testProperty "prop_ParaTriGrid_tile_count_correct" prop_ParaTriGrid_tile_count_correct,@@ -396,6 +517,20 @@ (prop_distance_reflexive ∷ ParaTriGrid → Int → Property), testProperty "prop_distance_symmetric - ParaTriGrid" (prop_distance_symmetric ∷ ParaTriGrid → Int → Int → Property),+ testProperty "prop_minDistance_cw_distance - ParaTriGrid"+ (prop_minDistance_cw_distance ∷ ParaTriGrid → Int → [Int] → Property),+ testProperty "prop_grid_and_boundary_are_both_null_or_not - ParaTriGrid"+ (prop_grid_and_boundary_are_both_null_or_not ∷ ParaTriGrid → Property),+ testProperty "prop_boundary_in_grid - ParaTriGrid"+ (prop_boundary_in_grid ∷ ParaTriGrid → Property),+ testProperty "prop_ParaTriGrid_boundary_count_correct"+ prop_ParaTriGrid_boundary_count_correct,+ testProperty "prop_ParaTriGrid_boundary_tiles_have_fewer_neighbours"+ prop_ParaTriGrid_boundary_tiles_have_fewer_neighbours,+ testProperty "prop_centres_equidistant_from_boundary - ParaTriGrid"+ (prop_centres_equidistant_from_boundary ∷ ParaTriGrid → Property),+ testProperty "prop_centres_farthest_from_boundary - ParaTriGrid"+ (prop_centres_farthest_from_boundary ∷ ParaTriGrid → Int → Property), testProperty "prop_ParaTriGrid_distance_in_bounds" prop_ParaTriGrid_distance_in_bounds, testProperty "prop_ParaTriGrid_distance_corner_to_corner"@@ -408,18 +543,36 @@ ( prop_edges_cw_neighbours ∷ ParaTriGrid → Int → Property), testProperty "prop_edges_are_adjacent - ParaTriGrid" ( prop_edges_are_adjacent ∷ ParaTriGrid → Property),+ testProperty "prop_adjacentTilesToward_moves_closer - ParaTriGrid"+ ( prop_adjacentTilesToward_moves_closer ∷ + ParaTriGrid → Int → Int → Property), testProperty "prop_minimal_paths_have_min_length - ParaTriGrid" ( prop_minimal_paths_have_min_length ∷ ParaTriGrid → Int → Int → Property), testProperty "prop_minimal_paths_are_valid - ParaTriGrid" ( prop_minimal_paths_are_valid ∷ ParaTriGrid → Int → Int → Property),+ -- RectSquareGrid tests testProperty "prop_RectSquareGrid_tile_count_correct" prop_RectSquareGrid_tile_count_correct,- testProperty "prop_distance_reflexive - RectTriGrid"+ testProperty "prop_distance_reflexive - RectSquareGrid" (prop_distance_reflexive ∷ RectSquareGrid → Int → Property), testProperty "prop_distance_symmetric - RectSquareGrid" (prop_distance_symmetric ∷ RectSquareGrid → Int → Int → Property),+ testProperty "prop_minDistance_cw_distance - RectSquareGrid"+ (prop_minDistance_cw_distance ∷ RectSquareGrid → Int → [Int] → Property),+ testProperty "prop_grid_and_boundary_are_both_null_or_not - RectSquareGrid"+ (prop_grid_and_boundary_are_both_null_or_not ∷ RectSquareGrid → Property),+ testProperty "prop_boundary_in_grid - RectSquareGrid"+ (prop_boundary_in_grid ∷ RectSquareGrid → Property),+ testProperty "prop_RectSquareGrid_boundary_count_correct"+ prop_RectSquareGrid_boundary_count_correct,+ testProperty "prop_RectSquareGrid_boundary_tiles_have_fewer_neighbours"+ prop_RectSquareGrid_boundary_tiles_have_fewer_neighbours,+ testProperty "prop_centres_equidistant_from_boundary - RectSquareGrid"+ (prop_centres_equidistant_from_boundary ∷ RectSquareGrid → Property),+ testProperty "prop_centres_farthest_from_boundary - RectSquareGrid"+ (prop_centres_farthest_from_boundary ∷ RectSquareGrid → Int → Property), testProperty "prop_RectSquareGrid_distance_in_bounds" prop_RectSquareGrid_distance_in_bounds, testProperty "prop_RectSquareGrid_distance_corner_to_corner"@@ -432,6 +585,9 @@ ( prop_edges_cw_neighbours ∷ RectSquareGrid → Int → Property), testProperty "prop_edges_are_adjacent - RectSquareGrid" ( prop_edges_are_adjacent ∷ RectSquareGrid → Property),+ testProperty "prop_adjacentTilesToward_moves_closer - RectSquareGrid"+ ( prop_adjacentTilesToward_moves_closer ∷ + RectSquareGrid → Int → Int → Property), testProperty "prop_minimal_paths_have_min_length - RectSquareGrid" ( prop_minimal_paths_have_min_length ∷ RectSquareGrid → Int → Int → Property),@@ -439,6 +595,7 @@ ( prop_minimal_paths_are_valid ∷ RectSquareGrid → Int → Int → Property), testProperty "prop_RectSquareGrid_num_min_paths_correct" prop_RectSquareGrid_num_min_paths_correct,+ -- TorSquareGrid tests testProperty "prop_TorSquareGrid_tile_count_correct" prop_TorSquareGrid_tile_count_correct,@@ -446,6 +603,8 @@ (prop_distance_reflexive ∷ TorSquareGrid → Int → Property), testProperty "prop_distance_symmetric - TorSquareGrid" (prop_distance_symmetric ∷ TorSquareGrid → Int → Int → Property),+ testProperty "prop_minDistance_cw_distance - TorSquareGrid"+ (prop_minDistance_cw_distance ∷ TorSquareGrid → Int → [Int] → Property), testProperty "prop_TorSquareGrid_distance_in_bounds" prop_TorSquareGrid_distance_in_bounds, testProperty "prop_TorSquareGrid_distance_corner_to_corner"@@ -458,11 +617,15 @@ ( prop_edges_cw_neighbours ∷ TorSquareGrid → Int → Property), testProperty "prop_edges_are_adjacent - TorSquareGrid" ( prop_edges_are_adjacent ∷ TorSquareGrid → Property),+ testProperty "prop_adjacentTilesToward_moves_closer - TorSquareGrid"+ ( prop_adjacentTilesToward_moves_closer ∷ + TorSquareGrid → Int → Int → Property), testProperty "prop_minimal_paths_have_min_length - TorSquareGrid" ( prop_minimal_paths_have_min_length ∷ TorSquareGrid → Int → Int → Property), testProperty "prop_minimal_paths_are_valid - TorSquareGrid" ( prop_minimal_paths_are_valid ∷ TorSquareGrid → Int → Int → Property),+ -- HexHexGrid tests testProperty "prop_HexHexGrid_tile_count_correct" prop_HexHexGrid_tile_count_correct,@@ -470,6 +633,20 @@ (prop_distance_reflexive ∷ HexHexGrid → Int → Property), testProperty "prop_distance_symmetric - HexHexGrid" (prop_distance_symmetric ∷ HexHexGrid → Int → Int → Property),+ testProperty "prop_minDistance_cw_distance - HexHexGrid"+ (prop_minDistance_cw_distance ∷ HexHexGrid → Int → [Int] → Property),+ testProperty "prop_grid_and_boundary_are_both_null_or_not - HexHexGrid"+ (prop_grid_and_boundary_are_both_null_or_not ∷ HexHexGrid → Property),+ testProperty "prop_boundary_in_grid - HexHexGrid"+ (prop_boundary_in_grid ∷ HexHexGrid → Property),+ testProperty "prop_HexHexGrid_boundary_count_correct"+ prop_HexHexGrid_boundary_count_correct,+ testProperty "prop_HexHexGrid_boundary_tiles_have_fewer_neighbours"+ prop_HexHexGrid_boundary_tiles_have_fewer_neighbours,+ testProperty "prop_centres_equidistant_from_boundary - HexHexGrid"+ (prop_centres_equidistant_from_boundary ∷ HexHexGrid → Property),+ testProperty "prop_centres_farthest_from_boundary - HexHexGrid"+ (prop_centres_farthest_from_boundary ∷ HexHexGrid → Int → Property), testProperty "prop_HexHexGrid_distance_in_bounds" prop_HexHexGrid_distance_in_bounds, testProperty "prop_HexHexGrid_distance_edge_to_edge"@@ -482,18 +659,36 @@ ( prop_edges_cw_neighbours ∷ HexHexGrid → Int → Property), testProperty "prop_edges_are_adjacent - HexHexGrid" ( prop_edges_are_adjacent ∷ HexHexGrid → Property),+ testProperty "prop_adjacentTilesToward_moves_closer - HexHexGrid"+ ( prop_adjacentTilesToward_moves_closer ∷ + HexHexGrid → Int → Int → Property), testProperty "prop_minimal_paths_have_min_length - HexHexGrid" ( prop_minimal_paths_have_min_length ∷ HexHexGrid → Int → Int → Property), testProperty "prop_minimal_paths_are_valid - HexHexGrid" ( prop_minimal_paths_are_valid ∷ HexHexGrid → Int → Int → Property),+ -- ParaHexGrid tests testProperty "prop_ParaHexGrid_tile_count_correct" prop_ParaHexGrid_tile_count_correct,- testProperty "prop_distance_reflexive - HexHexGrid"+ testProperty "prop_distance_reflexive - ParaHexGrid" (prop_distance_reflexive ∷ ParaHexGrid → Int → Property), testProperty "prop_distance_symmetric - ParaHexGrid" (prop_distance_symmetric ∷ ParaHexGrid → Int → Int → Property),+ testProperty "prop_minDistance_cw_distance - ParaHexGrid"+ (prop_minDistance_cw_distance ∷ ParaHexGrid → Int → [Int] → Property),+ testProperty "prop_grid_and_boundary_are_both_null_or_not - ParaHexGrid"+ (prop_grid_and_boundary_are_both_null_or_not ∷ ParaHexGrid → Property),+ testProperty "prop_boundary_in_grid - ParaHexGrid"+ (prop_boundary_in_grid ∷ ParaHexGrid → Property),+ testProperty "prop_ParaHexGrid_boundary_count_correct"+ prop_ParaHexGrid_boundary_count_correct,+ testProperty "prop_ParaHexGrid_boundary_tiles_have_fewer_neighbours"+ prop_ParaHexGrid_boundary_tiles_have_fewer_neighbours,+ testProperty "prop_centres_equidistant_from_boundary - ParaHexGrid"+ (prop_centres_equidistant_from_boundary ∷ ParaHexGrid → Property),+ testProperty "prop_centres_farthest_from_boundary - ParaHexGrid"+ (prop_centres_farthest_from_boundary ∷ ParaHexGrid → Int → Property), testProperty "prop_ParaHexGrid_distance_in_bounds" prop_ParaHexGrid_distance_in_bounds, testProperty "prop_ParaHexGrid_distance_corner_to_corner"@@ -504,6 +699,9 @@ (prop_neighbours_cw_viewpoint ∷ ParaHexGrid → Int → Property), testProperty "prop_edges_cw_neighbours - ParaHexGrid" ( prop_edges_cw_neighbours ∷ ParaHexGrid → Int → Property),+ testProperty "prop_adjacentTilesToward_moves_closer - ParaHexGrid"+ ( prop_adjacentTilesToward_moves_closer ∷ + ParaHexGrid → Int → Int → Property), testProperty "prop_edges_are_adjacent - ParaHexGrid" ( prop_edges_are_adjacent ∷ ParaHexGrid → Property), testProperty "prop_minimal_paths_have_min_length - ParaHexGrid"