grid-7.8.6: test/Math/Geometry/Grid/TriangularQC.hs

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