grid 7.6.8 → 7.6.9
raw patch · 6 files changed
+1121/−3 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- grid.cabal +8/−3
- test/Math/Geometry/Grid/Hexagonal2QC.hs +172/−0
- test/Math/Geometry/Grid/HexagonalQC.hs +171/−0
- test/Math/Geometry/Grid/OctagonalQC.hs +182/−0
- test/Math/Geometry/Grid/SquareQC.hs +213/−0
- test/Math/Geometry/Grid/TriangularQC.hs +375/−0
grid.cabal view
@@ -1,5 +1,5 @@ Name: grid-Version: 7.6.8+Version: 7.6.9 Stability: experimental Synopsis: Tools for working with regular grids (graphs, lattices). Description: Provides tools for working with regular arrangements@@ -27,7 +27,7 @@ source-repository this type: git location: https://github.com/mhwombat/grid.git- tag: 7.6.8+ tag: 7.6.9 library@@ -61,5 +61,10 @@ hs-source-dirs: test ghc-options: -Wall main-is: Main.hs- other-modules: Math.Geometry.GridQC+ other-modules: Math.Geometry.GridQC,+ Math.Geometry.Grid.Hexagonal2QC,+ Math.Geometry.Grid.HexagonalQC,+ Math.Geometry.Grid.OctagonalQC,+ Math.Geometry.Grid.SquareQC,+ Math.Geometry.Grid.TriangularQC
+ test/Math/Geometry/Grid/Hexagonal2QC.hs view
@@ -0,0 +1,172 @@+------------------------------------------------------------------------+-- |+-- Module : Math.Geometry.Grid.Hexagonal2QC+-- Copyright : (c) Amy de Buitléir 2012-2014+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- QuickCheck tests.+--+------------------------------------------------------------------------+{-# LANGUAGE FlexibleContexts, ExistentialQuantification,+ TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Math.Geometry.Grid.Hexagonal2QC+ (+ test+ ) where++import Math.Geometry.Grid.HexagonalInternal2+import Math.Geometry.GridInternal +import Math.Geometry.GridQC++import Prelude hiding (null)+import Test.Framework as TF (Test, testGroup)+import Test.QuickCheck + (Gen, Arbitrary, arbitrary, sized, elements, choose, Property, vectorOf)++instance Arbitrary HexDirection where+ arbitrary =+ elements [Northwest, North, Northeast, Southeast, South, Southwest]++--+-- Unbounded grids with hexagonal tiles+--++data UnboundedHexGridTD = + UnboundedHexGridTD [(Int,Int)] ((Int,Int),(Int,Int)) HexDirection+ deriving Show++instance TestData UnboundedHexGridTD where+ type BaseGrid UnboundedHexGridTD = UnboundedHexGrid+ grid _ = UnboundedHexGrid+ points (UnboundedHexGridTD ps _ _) = ps+ twoClosePoints (UnboundedHexGridTD _ qs _) = qs+ neighbourCountBounds _ = (6, 6)+ direction (UnboundedHexGridTD _ _ d) = d++sizedUnboundedHexGridTD :: Int -> Gen UnboundedHexGridTD+sizedUnboundedHexGridTD n = do+ k <- choose (0,n)+ ps <- vectorOf (k+2) arbitrary :: Gen [(Int,Int)]+ qs <- chooseClosePointsUnbounded+ d <- arbitrary+ return $ UnboundedHexGridTD ps qs d++instance Arbitrary UnboundedHexGridTD where+ arbitrary = sized sizedUnboundedHexGridTD++unboundedHexGridProperties :: [(String, UnboundedHexGridTD -> Property)]+unboundedHexGridProperties = gridProperties "UnboundedHexGrid"++unboundedHexGridTests :: [Test]+unboundedHexGridTests = makeTests unboundedHexGridProperties++--+-- Hegagonal grids with hexagonal tiles+--++data HexHexGridTD = + HexHexGridTD HexHexGrid [(Int,Int)] ((Int,Int),(Int,Int)) HexDirection+ deriving Show++instance TestData HexHexGridTD where+ type BaseGrid HexHexGridTD = HexHexGrid+ grid (HexHexGridTD g _ _ _) = g+ points (HexHexGridTD _ ps _ _) = ps+ twoClosePoints (HexHexGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 6)+ direction (HexHexGridTD _ _ _ d) = d++instance TestDataF HexHexGridTD where+ maxDistance (HexHexGridTD g _ _ _) = 2*s - 2+ where s = size g+ expectedTileCount (HexHexGridTD g _ _ _) = 3*s*(s-1) + 1+ where s = size g++instance TestDataB HexHexGridTD where+ expectedBoundaryCount (HexHexGridTD g _ _ _) = (f . size) g+ where f 0 = 0+ f 1 = 1+ f s = 6*(s-1)++-- We want the number of tiles in a test grid to be O(n)+sizedHexHexGridTD :: Int -> Gen HexHexGridTD+sizedHexHexGridTD n = do+ let s = isqrt (n `div` 3)+ let g = hexHexGrid s+ ps <- chooseIndices g n+ qs <- chooseClosePoints g+ d <- arbitrary+ return $ HexHexGridTD g ps qs d++instance Arbitrary HexHexGridTD where+ arbitrary = sized sizedHexHexGridTD++hexHexGridProperties :: [(String, HexHexGridTD -> Property)]+hexHexGridProperties = gridProperties "HexHexGrid"+ ++ finiteGridProperties "HexHexGrid"+ ++ boundedGridProperties "HexHexGrid"+ ++ boundedGridProperties2 "HexHexGrid"++hexHexGridTests :: [Test]+hexHexGridTests = makeTests hexHexGridProperties++--+-- Rectangular hexagonal grids +--++data RectHexGridTD = + RectHexGridTD RectHexGrid [(Int,Int)] ((Int,Int),(Int,Int)) HexDirection+ deriving Show++instance TestData RectHexGridTD where+ type BaseGrid RectHexGridTD = RectHexGrid+ grid (RectHexGridTD g _ _ _) = g+ points (RectHexGridTD _ ps _ _) = ps + twoClosePoints (RectHexGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 6)+ direction (RectHexGridTD _ _ _ d) = d++instance TestDataF RectHexGridTD where+ maxDistance (RectHexGridTD g _ _ _) = r+c-2+ where (r, c) = size g+ expectedTileCount (RectHexGridTD g _ _ _) = r*c+ where (r,c) = size g++instance TestDataB RectHexGridTD where+ expectedBoundaryCount (RectHexGridTD g _ _ _) = + (cartesianBoundaryCount . size) g++-- We want the number of tiles in a test grid to be O(n)+sizedRectHexGridTD :: Int -> Gen RectHexGridTD+sizedRectHexGridTD n = do+ r <- choose (0,n)+ let c0 = n `div` (r+1)+ let c = 2*(c0 `div` 2) -- force it to be even+ let g = rectHexGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g+ d <- arbitrary+ return $ RectHexGridTD g ps qs d++instance Arbitrary RectHexGridTD where+ arbitrary = sized sizedRectHexGridTD++rectHexGridProperties :: [(String, RectHexGridTD -> Property)]+rectHexGridProperties = gridProperties "RectHexGrid"+ ++ finiteGridProperties "RectHexGrid"+ ++ boundedGridProperties "RectHexGrid"+ ++ boundedGridProperties2 "RectHexGrid"++rectHexGridTests :: [Test]+rectHexGridTests = makeTests rectHexGridProperties++test :: Test+test = testGroup "Math.Geometry.Grid.Hexagonal2QC"+ (unboundedHexGridTests ++ hexHexGridTests ++ rectHexGridTests)++
+ test/Math/Geometry/Grid/HexagonalQC.hs view
@@ -0,0 +1,171 @@+------------------------------------------------------------------------+-- |+-- Module : Math.Geometry.Grid.RectangularQC+-- Copyright : (c) Amy de Buitléir 2012-2014+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- QuickCheck tests.+--+------------------------------------------------------------------------+{-# LANGUAGE FlexibleContexts, ExistentialQuantification,+ TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Math.Geometry.Grid.HexagonalQC+ (+ test+ ) where++import Math.Geometry.Grid.HexagonalInternal +import Math.Geometry.GridInternal +import Math.Geometry.GridQC++import Prelude hiding (null)+import Test.Framework as TF (Test, testGroup)+import Test.QuickCheck + (Gen, Arbitrary, arbitrary, sized, elements, choose, Property, vectorOf)++instance Arbitrary HexDirection where+ arbitrary =+ elements [West, Northwest, Northeast, East, Southeast, Southwest]++--+-- Unbounded grids with hexagonal tiles+--++data UnboundedHexGridTD = + UnboundedHexGridTD [(Int,Int)] ((Int,Int),(Int,Int)) HexDirection+ deriving Show++instance TestData UnboundedHexGridTD where+ type BaseGrid UnboundedHexGridTD = UnboundedHexGrid+ grid _ = UnboundedHexGrid+ points (UnboundedHexGridTD ps _ _) = ps+ twoClosePoints (UnboundedHexGridTD _ qs _) = qs+ neighbourCountBounds _ = (6, 6)+ direction (UnboundedHexGridTD _ _ d) = d++sizedUnboundedHexGridTD :: Int -> Gen UnboundedHexGridTD+sizedUnboundedHexGridTD n = do+ k <- choose (0,n)+ ps <- vectorOf (k+2) arbitrary :: Gen [(Int,Int)]+ qs <- chooseClosePointsUnbounded+ d <- arbitrary+ return $ UnboundedHexGridTD ps qs d++instance Arbitrary UnboundedHexGridTD where+ arbitrary = sized sizedUnboundedHexGridTD++unboundedHexGridProperties :: [(String, UnboundedHexGridTD -> Property)]+unboundedHexGridProperties = gridProperties "UnboundedHexGrid"++unboundedHexGridTests :: [Test]+unboundedHexGridTests = makeTests unboundedHexGridProperties++--+-- Hegagonal grids with hexagonal tiles+--++data HexHexGridTD = + HexHexGridTD HexHexGrid [(Int,Int)] ((Int,Int),(Int,Int)) HexDirection+ deriving Show++instance TestData HexHexGridTD where+ type BaseGrid HexHexGridTD = HexHexGrid+ grid (HexHexGridTD g _ _ _) = g+ points (HexHexGridTD _ ps _ _) = ps+ twoClosePoints (HexHexGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 6)+ direction (HexHexGridTD _ _ _ d) = d++instance TestDataF HexHexGridTD where+ maxDistance (HexHexGridTD g _ _ _) = 2*s - 2+ where s = size g+ expectedTileCount (HexHexGridTD g _ _ _) = 3*s*(s-1) + 1+ where s = size g++instance TestDataB HexHexGridTD where+ expectedBoundaryCount (HexHexGridTD g _ _ _) = (f . size) g+ where f 0 = 0+ f 1 = 1+ f s = 6*(s-1)++-- We want the number of tiles in a test grid to be O(n)+sizedHexHexGridTD :: Int -> Gen HexHexGridTD+sizedHexHexGridTD n = do+ let s = isqrt (n `div` 3)+ let g = hexHexGrid s+ ps <- chooseIndices g n+ qs <- chooseClosePoints g+ d <- arbitrary+ return $ HexHexGridTD g ps qs d++instance Arbitrary HexHexGridTD where+ arbitrary = sized sizedHexHexGridTD++hexHexGridProperties :: [(String, HexHexGridTD -> Property)]+hexHexGridProperties = gridProperties "HexHexGrid"+ ++ finiteGridProperties "HexHexGrid"+ ++ boundedGridProperties "HexHexGrid"+ ++ boundedGridProperties2 "HexHexGrid"++hexHexGridTests :: [Test]+hexHexGridTests = makeTests hexHexGridProperties++--+-- Parallelogrammatical hexagonal grids +--++data ParaHexGridTD = + ParaHexGridTD ParaHexGrid [(Int,Int)] ((Int,Int),(Int,Int)) HexDirection+ deriving Show++instance TestData ParaHexGridTD where+ type BaseGrid ParaHexGridTD = ParaHexGrid+ grid (ParaHexGridTD g _ _ _) = g+ points (ParaHexGridTD _ ps _ _) = ps + twoClosePoints (ParaHexGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 6)+ direction (ParaHexGridTD _ _ _ d) = d++instance TestDataF ParaHexGridTD where+ maxDistance (ParaHexGridTD g _ _ _) = r+c-2+ where (r, c) = size g+ expectedTileCount (ParaHexGridTD g _ _ _) = r*c+ where (r,c) = size g++instance TestDataB ParaHexGridTD where+ expectedBoundaryCount (ParaHexGridTD g _ _ _) = + (cartesianBoundaryCount . size) g++-- We want the number of tiles in a test grid to be O(n)+sizedParaHexGridTD :: Int -> Gen ParaHexGridTD+sizedParaHexGridTD n = do+ r <- choose (0,n)+ let c = n `div` (r+1)+ let g = paraHexGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g+ d <- arbitrary+ return $ ParaHexGridTD g ps qs d++instance Arbitrary ParaHexGridTD where+ arbitrary = sized sizedParaHexGridTD++paraHexGridProperties :: [(String, ParaHexGridTD -> Property)]+paraHexGridProperties = gridProperties "ParaHexGrid"+ ++ finiteGridProperties "ParaHexGrid"+ ++ boundedGridProperties "ParaHexGrid"+ ++ boundedGridProperties2 "ParaHexGrid"++paraHexGridTests :: [Test]+paraHexGridTests = makeTests paraHexGridProperties++test :: Test+test = testGroup "Math.Geometry.Grid.HexagonalQC"+ (unboundedHexGridTests ++ hexHexGridTests ++ paraHexGridTests)++
+ test/Math/Geometry/Grid/OctagonalQC.hs view
@@ -0,0 +1,182 @@+------------------------------------------------------------------------+-- |+-- Module : Math.Geometry.Grid.OctagonalQC+-- Copyright : (c) Amy de Buitléir 2012-2014+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- QuickCheck tests.+--+------------------------------------------------------------------------+{-# LANGUAGE FlexibleContexts, ExistentialQuantification,+ TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Math.Geometry.Grid.OctagonalQC+ (+ test+ ) where++import Math.Geometry.Grid.OctagonalInternal +import Math.Geometry.GridInternal +import Math.Geometry.GridQC++import Prelude hiding (null)+import Test.Framework as TF (Test, testGroup)+import Test.QuickCheck + (Gen, Arbitrary, arbitrary, sized, choose, elements, Property, vectorOf)++instance Arbitrary OctDirection where+ arbitrary = elements [West, Northwest, North, Northeast, East,+ Southeast, South, Southwest]++--+-- Unbounded grids with octagonal tiles+--++data UnboundedOctGridTD = + UnboundedOctGridTD [(Int,Int)] ((Int,Int),(Int,Int)) OctDirection+ deriving Show++instance TestData UnboundedOctGridTD where+ type BaseGrid UnboundedOctGridTD = UnboundedOctGrid+ grid _ = UnboundedOctGrid+ points (UnboundedOctGridTD ps _ _) = ps+ twoClosePoints (UnboundedOctGridTD _ qs _) = qs+ neighbourCountBounds _ = (8, 8)+ direction (UnboundedOctGridTD _ _ d) = d++sizedUnboundedOctGridTD :: Int -> Gen UnboundedOctGridTD+sizedUnboundedOctGridTD n = do+ k <- choose (0,n)+ ps <- vectorOf (k+2) arbitrary :: Gen [(Int,Int)]+ qs <- chooseClosePointsUnbounded+ d <- arbitrary+ return $ UnboundedOctGridTD ps qs d++instance Arbitrary UnboundedOctGridTD where+ arbitrary = sized sizedUnboundedOctGridTD++unboundedOctGridProperties :: [(String, UnboundedOctGridTD -> Property)]+unboundedOctGridProperties = gridProperties "UnboundedOctGrid"++unboundedOctGridTests :: [Test]+unboundedOctGridTests = makeTests unboundedOctGridProperties++--+-- Rectangular grids with octagonal tiles+--++data RectOctGridTD = + RectOctGridTD RectOctGrid [(Int,Int)] ((Int,Int),(Int,Int)) OctDirection+ deriving Show++instance TestData RectOctGridTD where+ type BaseGrid RectOctGridTD = RectOctGrid+ grid (RectOctGridTD g _ _ _) = g+ points (RectOctGridTD _ ps _ _) = ps + twoClosePoints (RectOctGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 8)+ direction (RectOctGridTD _ _ _ d) = d++instance TestDataF RectOctGridTD where+ maxDistance (RectOctGridTD g _ _ _) = (max r c) - 1+ where (r, c) = size g+ expectedTileCount (RectOctGridTD g _ _ _) = r*c+ where (r,c) = size g++instance TestDataB RectOctGridTD where+ expectedBoundaryCount (RectOctGridTD g _ _ _) = + (cartesianBoundaryCount . size) g++-- We want the number of tiles in a test grid to be O(n)+sizedRectOctGridTD :: Int -> Gen RectOctGridTD+sizedRectOctGridTD n = do+-- let n' = min n 12 -- calculation time for these grids grows quickly!+-- r <- choose (0,n')+-- let c = n' `div` (r+1)+ r <- choose (0,n)+ let c = n `div` (r+1)+ let g = rectOctGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g+ d <- arbitrary+ return $ RectOctGridTD g ps qs d++instance Arbitrary RectOctGridTD where+ arbitrary = sized sizedRectOctGridTD++rectOctGridProperties :: [(String, RectOctGridTD -> Property)]+rectOctGridProperties = gridProperties "RectOctGrid"+ ++ finiteGridProperties "RectOctGrid"+ ++ boundedGridProperties "RectOctGrid"+ ++ boundedGridProperties2 "RectOctGrid"++rectOctGridTests :: [Test]+rectOctGridTests = makeTests rectOctGridProperties+++--+-- Toroidal grids with octagonal tiles+--++data TorOctGridTD = + TorOctGridTD TorOctGrid [(Int,Int)] ((Int,Int),(Int,Int)) OctDirection+ deriving Show++instance TestData TorOctGridTD where+ type BaseGrid TorOctGridTD = TorOctGrid+ grid (TorOctGridTD g _ _ _) = g+ points (TorOctGridTD _ ps _ _) = ps + twoClosePoints (TorOctGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 8)+ direction (TorOctGridTD _ _ _ d) = d++instance TestDataF TorOctGridTD where+ maxDistance (TorOctGridTD g _ _ _) = min r c + abs (r-c)+ where (r, c) = size g+ expectedTileCount (TorOctGridTD g _ _ _) = r*c+ where (r,c) = size g++-- We want the number of tiles in a test grid to be O(n)+sizedTorOctGridTD :: Int -> Gen TorOctGridTD+sizedTorOctGridTD n = do+ r <- choose (0,n)+ let c = n `div` (r+1)+ let g = torOctGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g+ d <- arbitrary+ return $ TorOctGridTD g ps qs d++instance Arbitrary TorOctGridTD where+ arbitrary = sized sizedTorOctGridTD++torOctGridProperties :: [(String, TorOctGridTD -> Property)]+torOctGridProperties = gridProperties "TorOctGrid"+ ++ finiteGridProperties "TorOctGrid"++torOctGridTests :: [Test]+torOctGridTests = makeTests torOctGridProperties++++--TODO redo these++--prop_RectOctGrid_num_min_paths_correct :: +-- RectOctGrid -> Int -> Int -> Property+--prop_RectOctGrid_num_min_paths_correct g i j = nonNull g ==>+-- minPathCount g a b ==+-- if a == b then 1 else minPathCount2 g att b+-- where a = g `pointAt` i+-- b = g `pointAt` j+-- att = adjacentTilesToward g a b+++test :: Test+test = testGroup "Math.Geometry.Grid.OctagonalQC"+ (unboundedOctGridTests ++ rectOctGridTests ++ torOctGridTests)++
+ test/Math/Geometry/Grid/SquareQC.hs view
@@ -0,0 +1,213 @@+------------------------------------------------------------------------+-- |+-- Module : Math.Geometry.Grid.SquareQC+-- Copyright : (c) Amy de Buitléir 2012-2014+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- QuickCheck tests.+--+------------------------------------------------------------------------+{-# LANGUAGE FlexibleContexts, ExistentialQuantification,+ TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Math.Geometry.Grid.SquareQC+ (+ test+ ) where++import Math.Geometry.Grid.SquareInternal +import Math.Geometry.GridInternal +import Math.Geometry.GridQC++import Prelude hiding (null)+import Test.Framework as TF (Test, testGroup)+import Test.QuickCheck + (Gen, Arbitrary, arbitrary, sized, choose, elements, Property, vectorOf)++instance Arbitrary SquareDirection where+ arbitrary =+ elements [North, South, East, West]++--+-- Unbounded grids with square tiles+--++data UnboundedSquareGridTD = + UnboundedSquareGridTD [(Int,Int)] ((Int,Int),(Int,Int)) SquareDirection+ deriving Show++instance TestData UnboundedSquareGridTD where+ type BaseGrid UnboundedSquareGridTD = UnboundedSquareGrid+ grid _ = UnboundedSquareGrid+ points (UnboundedSquareGridTD ps _ _) = ps+ twoClosePoints (UnboundedSquareGridTD _ qs _) = qs+ neighbourCountBounds _ = (4, 4)+ direction (UnboundedSquareGridTD _ _ d) = d++sizedUnboundedSquareGridTD :: Int -> Gen UnboundedSquareGridTD+sizedUnboundedSquareGridTD n = do+ k <- choose (0,n)+ ps <- vectorOf (k+2) arbitrary :: Gen [(Int,Int)]+ qs <- chooseClosePointsUnbounded+ d <- arbitrary+ return $ UnboundedSquareGridTD ps qs d++instance Arbitrary UnboundedSquareGridTD where+ arbitrary = sized sizedUnboundedSquareGridTD++unboundedSquareGridProperties :: [(String, UnboundedSquareGridTD -> Property)]+unboundedSquareGridProperties = gridProperties "UnboundedSquareGrid"++unboundedSquareGridTests :: [Test]+unboundedSquareGridTests = makeTests unboundedSquareGridProperties+++--+-- Rectangular grids with square tiles+--++data RectSquareGridTD = + RectSquareGridTD RectSquareGrid [(Int,Int)] ((Int,Int),(Int,Int)) SquareDirection+ deriving Show++instance TestData RectSquareGridTD where+ type BaseGrid RectSquareGridTD = RectSquareGrid+ grid (RectSquareGridTD g _ _ _) = g+ points (RectSquareGridTD _ ps _ _) = ps+ twoClosePoints (RectSquareGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 4)+ direction (RectSquareGridTD _ _ _ d) = d++instance TestDataF RectSquareGridTD where+ maxDistance (RectSquareGridTD g _ _ _) = r + c - 2+ where (r, c) = size g+ expectedTileCount (RectSquareGridTD g _ _ _) = r*c+ where (r,c) = size g++instance TestDataB RectSquareGridTD where+ expectedBoundaryCount (RectSquareGridTD g _ _ _) = + (cartesianBoundaryCount . size) g++-- We want the number of tiles in a test grid to be O(n)+sizedRectSquareGridTD :: Int -> Gen RectSquareGridTD+sizedRectSquareGridTD n = do+ r <- choose (0,n)+ let c = n `div` (r+1)+ let g = rectSquareGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g+ d <- arbitrary+ return $ RectSquareGridTD g ps qs d++instance Arbitrary RectSquareGridTD where+ arbitrary = sized sizedRectSquareGridTD++rectSquareGridProperties :: [(String, RectSquareGridTD -> Property)]+rectSquareGridProperties = gridProperties "RectSquareGrid"+ ++ finiteGridProperties "RectSquareGrid"+ ++ boundedGridProperties "RectSquareGrid"+ ++ boundedGridProperties2 "RectSquareGrid"++rectSquareGridTests :: [Test]+rectSquareGridTests = makeTests rectSquareGridProperties+++--+-- Toroidal grids with square tiles+--++data TorSquareGridTD = + TorSquareGridTD TorSquareGrid [(Int,Int)] ((Int,Int),(Int,Int)) SquareDirection+ deriving Show++instance TestData TorSquareGridTD where+ type BaseGrid TorSquareGridTD = TorSquareGrid+ grid (TorSquareGridTD g _ _ _) = g+ points (TorSquareGridTD _ ps _ _) = ps + twoClosePoints (TorSquareGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 4)+ direction (TorSquareGridTD _ _ _ d) = d++instance TestDataF TorSquareGridTD where+ maxDistance (TorSquareGridTD g _ _ _) = (r+c) `div` 2+ where (r, c) = size g+ expectedTileCount (TorSquareGridTD g _ _ _) = r*c+ where (r,c) = size g++-- We want the number of tiles in a test grid to be O(n)+sizedTorSquareGridTD :: Int -> Gen TorSquareGridTD+sizedTorSquareGridTD n = do+ r <- choose (0,n)+ let c = n `div` (r+1)+ let g = torSquareGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g+ d <- arbitrary+ return $ TorSquareGridTD g ps qs d++instance Arbitrary TorSquareGridTD where+ arbitrary = sized sizedTorSquareGridTD++torSquareGridProperties :: [(String, TorSquareGridTD -> Property)]+torSquareGridProperties = gridProperties "TorSquareGrid"+ ++ finiteGridProperties "TorSquareGrid"++torSquareGridTests :: [Test]+torSquareGridTests = makeTests torSquareGridProperties++--TODO replace these+--TODO replace these+--TODO replace these++--prop_UnboundedSquareGrid_num_min_paths_correct :: +-- UnboundedSquareGrid -> Int -> Int -> Property+--prop_UnboundedSquareGrid_num_min_paths_correct g i j = nonNull g ==>+-- minPathCount 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++---- 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 g a b == r + c - 2+-- where (r, c) = size g+-- ps = indices g+-- a = head ps+-- b = last ps++--prop_RectSquareGrid_num_min_paths_correct :: +-- RectSquareGrid -> Int -> Int -> Property+--prop_RectSquareGrid_num_min_paths_correct g i j = nonNull g ==>+-- minPathCount 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++---- 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 g a b == f+-- where (r, c) = size g+-- ps = indices g+-- a = head ps+-- b = last ps+-- f | r == 1 && c == 1 = 0 -- single-tile torus+-- | r == 1 || c == 1 = 1 -- a and b are the same+-- | otherwise = 2+++test :: Test+test = testGroup "Math.Geometry.Grid.SquareQC"+ (unboundedSquareGridTests ++ rectSquareGridTests ++ torSquareGridTests)++
+ test/Math/Geometry/Grid/TriangularQC.hs view
@@ -0,0 +1,375 @@+------------------------------------------------------------------------+-- |+-- Module : Math.Geometry.Grid.TriangularQC+-- Copyright : (c) Amy de Buitléir 2012-2014+-- License : BSD-style+-- Maintainer : amy@nualeargais.ie+-- Stability : experimental+-- Portability : portable+--+-- QuickCheck tests.+--+------------------------------------------------------------------------+{-# LANGUAGE FlexibleContexts, ExistentialQuantification, + TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Math.Geometry.Grid.TriangularQC+ (+ test+ ) where++import Math.Geometry.Grid.TriangularInternal+import Math.Geometry.GridInternal+import Math.Geometry.GridQC++import Prelude hiding (null)+import Test.Framework as TF (Test, testGroup)+import Test.QuickCheck+ (Gen, Arbitrary, arbitrary, sized, choose, elements, Property,+ vectorOf, suchThat)++instance Arbitrary TriDirection where+ arbitrary =+ elements [South, Northwest, Northeast, North, Southeast, Southwest]++--+-- Unbounded grids with triangular tiles+--++data UnboundedTriGridTD =+ UnboundedTriGridTD [(Int,Int)] ((Int,Int),(Int,Int)) TriDirection+ deriving Show++instance TestData UnboundedTriGridTD where+ type BaseGrid UnboundedTriGridTD = UnboundedTriGrid+ grid _ = UnboundedTriGrid+ points (UnboundedTriGridTD ps _ _) = ps+ twoClosePoints (UnboundedTriGridTD _ qs _) = qs+ neighbourCountBounds _ = (3, 3)+ direction (UnboundedTriGridTD _ _ d) = d+++valid :: (Int,Int) -> Bool+valid (x,y) = even (x+y)++bothValid :: ((Int,Int),(Int,Int)) -> Bool+bothValid (a,b) = valid a && valid b++sizedUnboundedTriGridTD :: Int -> Gen UnboundedTriGridTD+sizedUnboundedTriGridTD n = do+ k <- choose (0,n)+ ps <- vectorOf (k+2) (arbitrary `suchThat` valid) :: Gen [(Int,Int)]+ qs <- chooseClosePointsUnbounded `suchThat` bothValid+ d <- arbitrary+ return $ UnboundedTriGridTD ps qs d++instance Arbitrary UnboundedTriGridTD where+ arbitrary = sized sizedUnboundedTriGridTD++unboundedTriGridProperties :: [(String, UnboundedTriGridTD -> Property)]+unboundedTriGridProperties = gridProperties "UnboundedTriGrid"++unboundedTriGridTests :: [Test]+unboundedTriGridTests = makeTests unboundedTriGridProperties+++--+-- Triangular grids with triangular tiles+--++data TriTriGridTD =+ TriTriGridTD TriTriGrid [(Int,Int)] ((Int,Int),(Int,Int)) TriDirection+ deriving Show++instance TestData TriTriGridTD where+ type BaseGrid TriTriGridTD = TriTriGrid+ grid (TriTriGridTD g _ _ _) = g+ points (TriTriGridTD _ ps _ _) = ps+ twoClosePoints (TriTriGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 3)+ direction (TriTriGridTD _ _ _ d) = d++instance TestDataF TriTriGridTD where+ maxDistance (TriTriGridTD g _ _ _) = 2*(s-1)+ where s = size g+ expectedTileCount (TriTriGridTD g _ _ _) = s*s+ where s = size g++instance TestDataB TriTriGridTD where+ expectedBoundaryCount (TriTriGridTD g _ _ _) = (f . size) g+ where f 0 = 0+ f 1 = 1+ f s = 3*(s-1)++-- We want the number of tiles in a test grid to be O(n)+sizedTriTriGridTD :: Int -> Gen TriTriGridTD+sizedTriTriGridTD n = do+ let g = triTriGrid (2 * isqrt n)+ ps <- chooseIndices g n+ qs <- chooseClosePoints g `suchThat` bothValid+ d <- arbitrary+ return $ TriTriGridTD g ps qs d++instance Arbitrary TriTriGridTD where+ arbitrary = sized sizedTriTriGridTD++triTriGridProperties :: [(String, TriTriGridTD -> Property)]+triTriGridProperties = gridProperties "TriTriGrid"+ ++ finiteGridProperties "TriTriGrid"+ ++ boundedGridProperties "TriTriGrid"++triTriGridTests :: [Test]+triTriGridTests = makeTests triTriGridProperties++--+-- Parallelogram-shaped grids with triangular tiles+--++data ParaTriGridTD =+ ParaTriGridTD ParaTriGrid [(Int,Int)] ((Int,Int),(Int,Int)) TriDirection+ deriving Show++instance TestData ParaTriGridTD where+ type BaseGrid ParaTriGridTD = ParaTriGrid+ grid (ParaTriGridTD g _ _ _) = g+ points (ParaTriGridTD _ ps _ _) = ps+ twoClosePoints (ParaTriGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 3)+ direction (ParaTriGridTD _ _ _ d) = d++instance TestDataF ParaTriGridTD where+ maxDistance (ParaTriGridTD g _ _ _) = 2*(r+c) - 3+ where (r, c) = size g+ expectedTileCount (ParaTriGridTD g _ _ _) = 2*r*c+ where (r, c) = size g++instance TestDataB ParaTriGridTD where+ expectedBoundaryCount (ParaTriGridTD 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)++-- We want the number of tiles in a test grid to be O(n)+sizedParaTriGridTD :: Int -> Gen ParaTriGridTD+sizedParaTriGridTD n = do+ r <- choose (0,n)+ let c = n `div` (2*r + 1)+ let g = paraTriGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g `suchThat` bothValid+ d <- arbitrary+ return $ ParaTriGridTD g ps qs d++instance Arbitrary ParaTriGridTD where+ arbitrary = sized sizedParaTriGridTD++paraTriGridProperties :: [(String, ParaTriGridTD -> Property)]+paraTriGridProperties = gridProperties "ParaTriGrid"+ ++ finiteGridProperties "ParaTriGrid"+ ++ boundedGridProperties "ParaTriGrid"++paraTriGridTests :: [Test]+paraTriGridTests = makeTests paraTriGridProperties+++--+-- Rectangular grids with triangular tiles+--++data RectTriGridTD =+ RectTriGridTD RectTriGrid [(Int,Int)] ((Int,Int),(Int,Int)) TriDirection+ deriving Show++instance TestData RectTriGridTD where+ type BaseGrid RectTriGridTD = RectTriGrid+ grid (RectTriGridTD g _ _ _) = g+ points (RectTriGridTD _ ps _ _) = ps+ twoClosePoints (RectTriGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 3)+ direction (RectTriGridTD _ _ _ d) = d++instance TestDataF RectTriGridTD where+ maxDistance (RectTriGridTD g _ _ _) = 2*(r+c) - 3+ where (r, c) = size g+ expectedTileCount (RectTriGridTD g _ _ _) = 2*r*c+ where (r, c) = size g++instance TestDataB RectTriGridTD where+ expectedBoundaryCount (RectTriGridTD 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)++-- We want the number of tiles in a test grid to be O(n)+sizedRectTriGridTD :: Int -> Gen RectTriGridTD+sizedRectTriGridTD n = do+ r <- choose (0,n)+ let c = n `div` (2*r + 1)+ let g = rectTriGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g `suchThat`+ (\(a,b) -> bothValid (a,b) && inRectBounds r c a && inRectBounds r c b)+ d <- arbitrary+ return $ RectTriGridTD g ps qs d++inRectBounds :: Int -> Int -> (Int, Int) -> Bool+inRectBounds _ c (x, y) = xMin <= x && x <= xMax+ where xMin = if even y then w else w+1+ w = -2*((y+1) `div` 4)+ xMax = xMin + 2*(c-1)++instance Arbitrary RectTriGridTD where+ arbitrary = sized sizedRectTriGridTD++rectTriGridProperties :: [(String, RectTriGridTD -> Property)]+rectTriGridProperties = gridProperties "RectTriGrid"+ ++ finiteGridProperties "RectTriGrid"+ ++ boundedGridProperties "RectTriGrid"++rectTriGridTests :: [Test]+rectTriGridTests = makeTests rectTriGridProperties+++--+-- Toroidal grids with triangular tiles+--++data TorTriGridTD =+ TorTriGridTD TorTriGrid [(Int,Int)] ((Int,Int),(Int,Int)) TriDirection+ deriving Show++instance TestData TorTriGridTD where+ type BaseGrid TorTriGridTD = TorTriGrid+ grid (TorTriGridTD g _ _ _) = g+ points (TorTriGridTD _ ps _ _) = ps+ twoClosePoints (TorTriGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 3)+ direction (TorTriGridTD _ _ _ d) = d++instance TestDataF TorTriGridTD where+ maxDistance (TorTriGridTD g _ _ _) = 2*(r+c) - 3+ where (r, c) = size g+ expectedTileCount (TorTriGridTD g _ _ _) = 2*r*c+ where (r, c) = size g++-- We want the number of tiles in a test grid to be O(n)+sizedTorTriGridTD :: Int -> Gen TorTriGridTD+sizedTorTriGridTD n = do+ r0 <- choose (0,n `div` 2)+ let r = 2*r0+ let c = n `div` (2*r + 1)+ let g = torTriGrid r c+-- r <- choose (0,n)+-- let c = n `div` (2*r + 1)+-- let g = torTriGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g `suchThat` bothValid+ d <- arbitrary+ return $ TorTriGridTD g ps qs d++instance Arbitrary TorTriGridTD where+ arbitrary = sized sizedTorTriGridTD++torTriGridProperties :: [(String, TorTriGridTD -> Property)]+torTriGridProperties = gridProperties "TorTriGrid"+ ++ finiteGridProperties "TorTriGrid"++torTriGridTests :: [Test]+torTriGridTests = makeTests torTriGridProperties+++--+-- Toroidal grids with triangular tiles+--++data YCylTriGridTD =+ YCylTriGridTD YCylTriGrid [(Int,Int)] ((Int,Int),(Int,Int)) TriDirection+ deriving Show++instance TestData YCylTriGridTD where+ type BaseGrid YCylTriGridTD = YCylTriGrid+ grid (YCylTriGridTD g _ _ _) = g+ points (YCylTriGridTD _ ps _ _) = ps+ twoClosePoints (YCylTriGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 3)+ direction (YCylTriGridTD _ _ _ d) = d++instance TestDataF YCylTriGridTD where+ maxDistance (YCylTriGridTD g _ _ _) = 2*(r+c) - 3+ where (r, c) = size g+ expectedTileCount (YCylTriGridTD g _ _ _) = 2*r*c+ where (r, c) = size g++-- We want the number of tiles in a test grid to be O(n)+sizedYCylTriGridTD :: Int -> Gen YCylTriGridTD+sizedYCylTriGridTD n = do+ r0 <- choose (0,n `div` 2)+ let r = 2*r0+ let c = n `div` (2*r + 1)+ let g = yCylTriGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g `suchThat` bothValid+ d <- arbitrary+ return $ YCylTriGridTD g ps qs d++instance Arbitrary YCylTriGridTD where+ arbitrary = sized sizedYCylTriGridTD++yCylTriGridProperties :: [(String, YCylTriGridTD -> Property)]+yCylTriGridProperties = gridProperties "YCylTriGrid"+ ++ finiteGridProperties "YCylTriGrid"++yCylTriGridTests :: [Test]+yCylTriGridTests = makeTests yCylTriGridProperties++data XCylTriGridTD =+ XCylTriGridTD XCylTriGrid [(Int,Int)] ((Int,Int),(Int,Int)) TriDirection+ deriving Show++instance TestData XCylTriGridTD where+ type BaseGrid XCylTriGridTD = XCylTriGrid+ grid (XCylTriGridTD g _ _ _) = g+ points (XCylTriGridTD _ ps _ _) = ps+ twoClosePoints (XCylTriGridTD _ _ qs _) = qs+ neighbourCountBounds _ = (0, 3)+ direction (XCylTriGridTD _ _ _ d) = d++instance TestDataF XCylTriGridTD where+ maxDistance (XCylTriGridTD g _ _ _) = 2*(r+c) - 3+ where (r, c) = size g+ expectedTileCount (XCylTriGridTD g _ _ _) = 2*r*c+ where (r, c) = size g++-- We want the number of tiles in a test grid to be O(n)+sizedXCylTriGridTD :: Int -> Gen XCylTriGridTD+sizedXCylTriGridTD n = do+ r0 <- choose (0,n `div` 2)+ let r = 2*r0+ let c = n `div` (2*r + 1)+ let g = xCylTriGrid r c+ ps <- chooseIndices g n+ qs <- chooseClosePoints g `suchThat` bothValid+ d <- arbitrary+ return $ XCylTriGridTD g ps qs d++instance Arbitrary XCylTriGridTD where+ arbitrary = sized sizedXCylTriGridTD++xCylTriGridProperties :: [(String, XCylTriGridTD -> Property)]+xCylTriGridProperties = gridProperties "XCylTriGrid"+ ++ finiteGridProperties "XCylTriGrid"++xCylTriGridTests :: [Test]+xCylTriGridTests = makeTests xCylTriGridProperties++test :: Test+test = testGroup "Math.Geometry.Grid.TriangularQC"+ ( unboundedTriGridTests ++ triTriGridTests ++ paraTriGridTests+ ++ rectTriGridTests ++ torTriGridTests ++ yCylTriGridTests+ ++ xCylTriGridTests)+