------------------------------------------------------------------------ -- | -- 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)