------------------------------------------------------------------------ -- | -- Module : Math.Geometry.Grid.OctagonalQC -- Copyright : (c) Amy de Buitléir 2012-2017 -- 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 (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)