grid 2.0 → 2.1.1

raw patch · 4 files changed

+93/−13 lines, 4 filesdep +exact-combinatoricsdep ~test-framework-quickcheck2PVP ok

version bump matches the API change (PVP)

Dependencies added: exact-combinatorics

Dependency ranges changed: test-framework-quickcheck2

API changes (from Hackage documentation)

Files

• grid.cabal +3/−2
• src/Math/Geometry/Grid.hs +6/−0
• src/Math/Geometry/GridInternal.hs +21/−9
• test/Math/Geometry/GridQC.hs +63/−2

@@ -1,5 +1,5 @@ name:           grid-version:        2.0+version:        2.1.1 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@@ -29,7 +29,8 @@ test-suite grid-tests   type:            exitcode-stdio-1.0   build-depends:   base ==4.*,-                   test-framework-quickcheck2 == 0.2.*,+                   exact-combinatorics ==0.2.*,+                   test-framework-quickcheck2 == 0.3.*,                    QuickCheck == 2.4.*,                    test-framework == 0.*,                    grid,

@@ -89,4 +89,10 @@ >ghci> nonEmpty g >True +   Find all of the minimal paths between two points.++ghci> let g = hexHexGrid 3+ghci> minimalPaths (0,0) (2,-1) g+[[(0,0),(1,0),(2,-1)],[(0,0),(1,-1),(2,-1)]]+ -}

@@ -35,7 +35,7 @@     paraHexGrid   ) where -import Data.Eq.Unicode ((≡))+import Data.Eq.Unicode ((≡), (≠)) import Data.List (nub, nubBy) import Data.Ord.Unicode ((≤), (≥)) @@ -56,8 +56,8 @@   -- | @'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@,+  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@@ -82,12 +82,24 @@   --   pair 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]]+                     | 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 -sameEdge :: Eq t => (t, t) -> (t, t) -> Bool-sameEdge (a,b) (c,d) = (a,b) == (c,d) || (a,b) == (d,c)+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 ∷ Grid g s t ⇒ t → g → [(t, t)]+adjacentEdges i g = map (\j → (i,j)) $ i `neighbours` g  -- -- Triangular tiles@@ -106,7 +118,7 @@         where z1 = triZ x1 y1               z2 = triZ x2 y2 -triNeighbours :: Grid g s (Int, Int) ⇒ (Int, Int) → g → [(Int, Int)]+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)]@@ -213,7 +225,7 @@ 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) +    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) _) =

@@ -11,6 +11,7 @@ import Data.Eq.Unicode ((≡), (≠)) import Data.List (nub, sort) import Data.Ord.Unicode ((≤))+import qualified Math.Combinatorics.Exact.Binomial as M (choose) import Test.Framework as TF (Test, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck @@ -64,9 +65,28 @@ prop_edges_are_adjacent g = property $ and $ map f $ edges g   where f (a, b) = isAdjacent a b g -isAdjacent :: Grid g s x => x -> x -> g -> Bool+isAdjacent ∷ Grid g s x ⇒ x → x → g → Bool isAdjacent a b g = (distance a b g) ≡ 1 +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++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++subsequentTilesInPathAreAdjacent ∷ Grid g s x ⇒ g → [x] → Bool+subsequentTilesInPathAreAdjacent _ [] = True+subsequentTilesInPathAreAdjacent g [x] = x `elem` (indices g)+subsequentTilesInPathAreAdjacent g (a:b:xs) = +  isAdjacent a b g && subsequentTilesInPathAreAdjacent g (b:xs)+ -- -- Triangular grids with triangular tiles --@@ -198,6 +218,15 @@           | r ≡ 1 || c ≡ 1  = neighbourCount `elem` [1,2]           | otherwise       = neighbourCount `elem` [2,3,4] +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+          deltaX = abs $ fst b - fst a+          deltaY = abs $ snd b - snd a+ -- -- Toroidal grids with square-ish tiles --@@ -355,6 +384,11 @@       ( prop_edges_cw_neighbours ∷ TriTriGrid → Int → Property),     testProperty "prop_edges_are_adjacent - TriTriGrid"       ( prop_edges_are_adjacent ∷ TriTriGrid → 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,@@ -374,6 +408,11 @@       ( prop_edges_cw_neighbours ∷ ParaTriGrid → Int → Property),     testProperty "prop_edges_are_adjacent - ParaTriGrid"       ( prop_edges_are_adjacent ∷ ParaTriGrid → 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,@@ -393,6 +432,13 @@       ( prop_edges_cw_neighbours ∷ RectSquareGrid → Int → Property),     testProperty "prop_edges_are_adjacent - RectSquareGrid"       ( prop_edges_are_adjacent ∷ RectSquareGrid → Property),+    testProperty "prop_minimal_paths_have_min_length - RectSquareGrid"+      ( prop_minimal_paths_have_min_length ∷ +          RectSquareGrid → Int → Int → Property),+    testProperty "prop_minimal_paths_are_valid - RectSquareGrid"+      ( 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,@@ -412,6 +458,11 @@       ( prop_edges_cw_neighbours ∷ TorSquareGrid → Int → Property),     testProperty "prop_edges_are_adjacent - TorSquareGrid"       ( prop_edges_are_adjacent ∷ TorSquareGrid → 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,@@ -431,6 +482,11 @@       ( prop_edges_cw_neighbours ∷ HexHexGrid → Int → Property),     testProperty "prop_edges_are_adjacent - HexHexGrid"       ( prop_edges_are_adjacent ∷ HexHexGrid → 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,@@ -449,6 +505,11 @@     testProperty "prop_edges_cw_neighbours - ParaHexGrid"       ( prop_edges_cw_neighbours ∷ ParaHexGrid → Int → Property),     testProperty "prop_edges_are_adjacent - ParaHexGrid"-      ( prop_edges_are_adjacent ∷ ParaHexGrid → Property)+      ( prop_edges_are_adjacent ∷ ParaHexGrid → Property),+    testProperty "prop_minimal_paths_have_min_length - ParaHexGrid"+      ( prop_minimal_paths_have_min_length ∷ +          ParaHexGrid → Int → Int → Property),+    testProperty "prop_minimal_paths_are_valid - ParaHexGrid"+      ( prop_minimal_paths_are_valid ∷ ParaHexGrid → Int → Int → Property)  ]