HexagonalQC.hs

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