SquareQC.hs

------------------------------------------------------------------------
-- |
-- Module      :  Math.Geometry.Grid.SquareQC
-- 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.SquareQC
  (
    test
  ) where

import Math.Geometry.Grid.SquareInternal 
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 SquareDirection where
  arbitrary =
    elements [North, South, East, West]

--
-- Unbounded grids with square tiles
--

data UnboundedSquareGridTD = 
  UnboundedSquareGridTD [(Int,Int)] ((Int,Int),(Int,Int)) SquareDirection
  deriving Show

instance TestData UnboundedSquareGridTD where
  type BaseGrid UnboundedSquareGridTD = UnboundedSquareGrid
  grid _ = UnboundedSquareGrid
  points (UnboundedSquareGridTD ps _ _) = ps
  twoClosePoints (UnboundedSquareGridTD _ qs _) = qs
  neighbourCountBounds _ = (4, 4)
  direction (UnboundedSquareGridTD _ _ d) = d

sizedUnboundedSquareGridTD :: Int -> Gen UnboundedSquareGridTD
sizedUnboundedSquareGridTD n = do
  k <- choose (0,n)
  ps <- vectorOf (k+2) arbitrary :: Gen [(Int,Int)]
  qs <- chooseClosePointsUnbounded
  d <- arbitrary
  return $ UnboundedSquareGridTD ps qs d

instance Arbitrary UnboundedSquareGridTD where
  arbitrary = sized sizedUnboundedSquareGridTD

unboundedSquareGridProperties :: [(String, UnboundedSquareGridTD -> Property)]
unboundedSquareGridProperties = gridProperties "UnboundedSquareGrid"

unboundedSquareGridTests :: [Test]
unboundedSquareGridTests = makeTests unboundedSquareGridProperties


--
-- Rectangular grids with square tiles
--

data RectSquareGridTD = 
  RectSquareGridTD RectSquareGrid [(Int,Int)] ((Int,Int),(Int,Int)) SquareDirection
  deriving Show

instance TestData RectSquareGridTD where
  type BaseGrid RectSquareGridTD = RectSquareGrid
  grid (RectSquareGridTD g _ _ _) = g
  points (RectSquareGridTD _ ps _ _) = ps
  twoClosePoints (RectSquareGridTD _ _ qs _) = qs
  neighbourCountBounds _ = (0, 4)
  direction (RectSquareGridTD _ _ _ d) = d

instance TestDataF RectSquareGridTD where
  maxDistance (RectSquareGridTD g _ _ _) = r + c - 2
    where (r, c) = size g
  expectedTileCount (RectSquareGridTD g _ _ _) = r*c
    where (r,c) = size g

instance TestDataB RectSquareGridTD where
  expectedBoundaryCount (RectSquareGridTD g _ _ _) = 
    (cartesianBoundaryCount . size) g

-- We want the number of tiles in a test grid to be O(n)
sizedRectSquareGridTD :: Int -> Gen RectSquareGridTD
sizedRectSquareGridTD n = do
  r <- choose (0,n)
  let c = n `div` (r+1)
  let g = rectSquareGrid r c
  ps <- chooseIndices g n
  qs <- chooseClosePoints g
  d <- arbitrary
  return $ RectSquareGridTD g ps qs d

instance Arbitrary RectSquareGridTD where
  arbitrary = sized sizedRectSquareGridTD

rectSquareGridProperties :: [(String, RectSquareGridTD -> Property)]
rectSquareGridProperties = gridProperties "RectSquareGrid"
  ++ finiteGridProperties "RectSquareGrid"
  ++ boundedGridProperties "RectSquareGrid"
  ++ boundedGridProperties2 "RectSquareGrid"

rectSquareGridTests :: [Test]
rectSquareGridTests = makeTests rectSquareGridProperties


--
-- Toroidal grids with square tiles
--

data TorSquareGridTD = 
  TorSquareGridTD TorSquareGrid [(Int,Int)] ((Int,Int),(Int,Int)) SquareDirection
  deriving Show

instance TestData TorSquareGridTD where
  type BaseGrid TorSquareGridTD = TorSquareGrid
  grid (TorSquareGridTD g _ _ _) = g
  points (TorSquareGridTD _ ps _ _) = ps 
  twoClosePoints (TorSquareGridTD _ _ qs _) = qs
  neighbourCountBounds _ = (0, 4)
  direction (TorSquareGridTD _ _ _ d) = d

instance TestDataF TorSquareGridTD where
  maxDistance (TorSquareGridTD g _ _ _) = (r+c) `div` 2
    where (r, c) = size g
  expectedTileCount (TorSquareGridTD g _ _ _) = r*c
    where (r,c) = size g

-- We want the number of tiles in a test grid to be O(n)
sizedTorSquareGridTD :: Int -> Gen TorSquareGridTD
sizedTorSquareGridTD n = do
  r <- choose (0,n)
  let c = n `div` (r+1)
  let g = torSquareGrid r c
  ps <- chooseIndices g n
  qs <- chooseClosePoints g
  d <- arbitrary
  return $ TorSquareGridTD g ps qs d

instance Arbitrary TorSquareGridTD where
  arbitrary = sized sizedTorSquareGridTD

torSquareGridProperties :: [(String, TorSquareGridTD -> Property)]
torSquareGridProperties = gridProperties "TorSquareGrid"
  ++ finiteGridProperties "TorSquareGrid"

torSquareGridTests :: [Test]
torSquareGridTests = makeTests torSquareGridProperties

--TODO replace these
--TODO replace these
--TODO replace these

--prop_UnboundedSquareGrid_num_min_paths_correct :: 
--  UnboundedSquareGrid -> Int -> Int -> Property
--prop_UnboundedSquareGrid_num_min_paths_correct g i j = nonNull g ==>
--  minPathCount g a b == M.choose (deltaX+deltaY) deltaX
--    where a = g `pointAt` i
--          b = g `pointAt` j
--          deltaX = abs $ fst b - fst a
--          deltaY = abs $ snd b - snd a

---- If the ordering produced by rectSquareGrid is ever changed, this
---- property may need to be changed too. It relies on the first and last 
---- elements being at opposite corners.
--prop_RectSquareGrid_distance_corner_to_corner :: RectSquareGrid -> Property
--prop_RectSquareGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> 
--  distance g a b == r + c - 2
--    where (r, c) = size g
--          ps = indices g
--          a = head ps
--          b = last ps

--prop_RectSquareGrid_num_min_paths_correct :: 
--  RectSquareGrid -> Int -> Int -> Property
--prop_RectSquareGrid_num_min_paths_correct g i j = nonNull g ==>
--  minPathCount g a b == M.choose (deltaX+deltaY) deltaX
--    where a = g `pointAt` i
--          b = g `pointAt` j
--          deltaX = abs $ fst b - fst a
--          deltaY = abs $ snd b - snd a

---- If the ordering produced by torSquareGrid is ever changed, this property
---- may need to be changed too.
--prop_TorSquareGrid_distance_corner_to_corner :: TorSquareGrid -> Property
--prop_TorSquareGrid_distance_corner_to_corner g = r > 0 && c > 0 ==> 
--  distance g a b == f
--    where (r, c) = size g
--          ps = indices g
--          a = head ps
--          b = last ps
--          f | r == 1 && c == 1 = 0 -- single-tile torus
--            | r == 1 || c == 1 = 1 -- a and b are the same
--            | otherwise      = 2


test :: Test
test = testGroup "Math.Geometry.Grid.SquareQC"
  (unboundedSquareGridTests ++ rectSquareGridTests ++ torSquareGridTests)