OctagonalQC.hs

------------------------------------------------------------------------
-- |
-- Module      :  Math.Geometry.Grid.OctagonalQC
-- 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.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)