content: ------------------------------------------------------------------------
  -- |
  -- Module      :  Math.Geometry.Grid.GridQC
  -- Copyright   :  (c) 2012-2022 Amy de Buitléir
  -- License     :  BSD-style
  -- Maintainer  :  amy@nualeargais.ie
  -- Stability   :  experimental
  -- Portability :  portable
  --
  -- QuickCheck tests.
  --
  ------------------------------------------------------------------------
  {-# LANGUAGE ExistentialQuantification #-}
  {-# LANGUAGE FlexibleContexts          #-}
  {-# LANGUAGE MultiParamTypeClasses     #-}
  {-# LANGUAGE TypeFamilies              #-}
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Math.Geometry.GridQC where
  
  import Math.Geometry.GridInternal
  
  import Data.List                            (delete, nub, sort)
  import Data.Maybe                           (fromJust, isJust)
  import Prelude                              hiding (null)
  import Prelude                              qualified as P (null)
  import Test.Framework                       (Test)
  import Test.Framework.Providers.QuickCheck2 (testProperty)
  import Test.QuickCheck                      (Arbitrary, Gen, Property,
                                               arbitrary, choose, elements,
                                               property, vectorOf, (==>))
  
  -- | @'isqrt' n@ returns the greatest integer not greater than the square root
  --   of @n@.
  isqrt :: Int -> Int
  isqrt n = (floor . sqrt) n'
    where n' = fromIntegral n :: Float
  
  -- Given an arbitrary integer, select a corresponding point in the grid.
  pointAt :: Grid g => g -> Int -> Index g
  pointAt g i = indices g !! (i `mod` n)
    where n = (length . indices) g
  
  minPathCount
    :: (Eq (Index g), Grid g) => g -> Index g -> Index g -> Int
  minPathCount g a = length . minimalPaths g a
  
  minPathCount2
    :: (Eq (Index g), Grid g) => g -> [Index g] -> Index g -> Int
  minPathCount2 g as b = sum . map (\x -> minPathCount g x b) $ as
  
  cartesianBoundaryCount :: (Eq a, Num a) => (a, a) -> a
  cartesianBoundaryCount (0,_) = 0
  cartesianBoundaryCount (_,0) = 0
  cartesianBoundaryCount (1,c) = c
  cartesianBoundaryCount (r,1) = r
  cartesianBoundaryCount (r,c) = 2*(r+c) - 4
  
  involves :: Eq a => (a, a) -> a -> Bool
  involves (a, b) c = c == a || c == b
  
  chooseIndices :: Grid g => g -> Int -> Gen [Index g]
  chooseIndices g n = do
    k <- choose (0,n)
    if null g
      then return []
      else vectorOf (k+2) (elements . indices $ g)
  
  chooseClosePointsUnbounded :: Gen ((Int, Int), (Int, Int))
  chooseClosePointsUnbounded = do
    (x1,y1) <- arbitrary
    x2 <- choose (x1-2,x1+2)
    y2 <- choose (y1-2,y1+2)
    return ((x1,y1), (x2,y2))
  
  chooseClosePoints :: Grid g => g -> Gen (Index g, Index g)
  chooseClosePoints g = do
    a <- elements . indices $ g
    b <- elements . filter (\b -> distance g a b < 6) . indices $ g
    return (a, b)
  
  makeTests :: (Arbitrary t, Show t) => [(String, t -> Property)] -> [Test]
  makeTests = map (uncurry testProperty)
  
  
  --
  -- Tests that should apply to and are identical for all grids
  --
  
  class TestData t where
    type BaseGrid t
    grid :: t -> BaseGrid t
    points :: t -> [Index (BaseGrid t)]
    neighbourCountBounds :: t -> (Int, Int)
    twoClosePoints :: t -> (Index (BaseGrid t),Index (BaseGrid t))
    direction :: t -> Direction (BaseGrid t)
  
  prop_indices_are_contained :: (TestData t, Grid (BaseGrid t),
    Eq (Index (BaseGrid t))) => t -> Property
  prop_indices_are_contained t = nonNull g ==> g `contains` a
    where g = grid t
          (a:_) = points t
  
  prop_distance_reflexive :: (TestData t, Grid (BaseGrid t)) => t -> Property
  prop_distance_reflexive t = nonNull g ==> distance g a a == 0
    where g = grid t
          (a:_) = points t
  
  prop_distance_symmetric :: (TestData t, Grid (BaseGrid t)) => t -> Property
  prop_distance_symmetric t =
    nonNull g ==> distance g a b == distance g b a
    where g = grid t
          (a:b:_) = points t
  
  prop_custom_MinDistance_eq_default
    :: (TestData t, Grid (BaseGrid t)) => t -> Property
  prop_custom_MinDistance_eq_default t = nonNull g ==>
    minDistance g bs a == defaultMinDistance g bs a
    where g = grid t
          (a:bs) = points t
  
  -- "cw" = "consistent with"
  
  prop_minDistance_cw_distance :: (TestData t, Grid (BaseGrid t)) => t -> Property
  prop_minDistance_cw_distance t =
    nonNull g && (not . P.null) bs ==>
      minDistance g (b:bs) a <= distance g b a
    where g = grid t
          (a:b:bs) = points t
  
  prop_neighbour_count_in_bounds
    :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_neighbour_count_in_bounds t = nonNull g ==>
    nMin <= n && n <= nMax
    where g = grid t
          (a:_) = points t
          n = length . neighbours g $ a
          (nMin, nMax) = neighbourCountBounds t
  
  prop_neighbours_are_adjacent
    :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))
      => t -> Property
  prop_neighbours_are_adjacent t = nonNull g  ==>
      all (isAdjacent g a) ns
    where g = grid t
          (a:_) = points t
          ns = neighbours g a
  
  prop_adjacentTilesToward_moves_closer
    :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))
      => t -> Property
  prop_adjacentTilesToward_moves_closer t = nonNull g && a /= b ==>
      all (< d) ns
    where g = grid t
          (a:b:_) = points t
          d = distance g a b
          ns = nub $ map (\x -> distance g x b) $ adjacentTilesToward g a b
  
  prop_minimal_paths_have_min_length
    :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))
      => t -> Property
  prop_minimal_paths_have_min_length t = nonNull g ==> ns == [d+1]
    where g = grid t
          (a,b) = twoClosePoints t
          d = distance g a b
          ns = nub . map length . minimalPaths g a $ b
  
  prop_minimal_paths_are_valid
    :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)))
      => t -> Property
  prop_minimal_paths_are_valid t = nonNull g ==>
      all (subsequentTilesInPathAreAdjacent g) (minimalPaths g a b)
    where g = grid t
          (a,b) = twoClosePoints t
  
  subsequentTilesInPathAreAdjacent
    :: (Grid g, Eq (Index g)) => g -> [Index g] -> Bool
  subsequentTilesInPathAreAdjacent _ [] = True
  subsequentTilesInPathAreAdjacent g [x] = g `contains` x
  subsequentTilesInPathAreAdjacent g (a:b:xs) =
    isAdjacent g a b && subsequentTilesInPathAreAdjacent g (b:xs)
  
  prop_neighbour_cw_directionTo
    :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)),
      Eq (Direction (BaseGrid t)))
      => t -> Property
  prop_neighbour_cw_directionTo t = nonNull g && a /= b && isJust n ==>
      fromJust n `elem` nextSteps
    where n = neighbour g a d
          g = grid t
          (a,b) = twoClosePoints t
          d = head . directionTo g a $ b
          nextSteps = map (!!1) . minimalPaths g a $ b
  
  prop_custom_adjacentTilesToward_eq_default
    :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_custom_adjacentTilesToward_eq_default t = nonNull g ==>
    adjacentTilesToward g a b == defaultAdjacentTilesToward g a b
    where g = grid t
          (a:b:_) = points t
  
  prop_custom_neighboursOfSet_eq_default
    :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_custom_neighboursOfSet_eq_default t = nonNull g ==>
    neighboursOfSet g as == defaultNeighboursOfSet g as
    where g = grid t
          as = points t
  
  prop_custom_neighboursOfSet_cw_minDistance
    :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_custom_neighboursOfSet_cw_minDistance t = nonNull g ==>
    (a `elem` neighboursOfSet g bs) || (minDistance g bs a /= 1)
    where g = grid t
          (a:bs) = points t
  
  gridProperties
    :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)),
      Ord (Index (BaseGrid t)), Eq (Direction (BaseGrid t)))
        => String -> [(String, t -> Property)]
  gridProperties s =
    [
      ("prop_indices_are_contained: " ++ s, prop_indices_are_contained),
      ("prop_distance_reflexive: " ++ s, prop_distance_reflexive),
      ("prop_distance_symmetric: " ++ s, prop_distance_symmetric),
      ("prop_custom_MinDistance_eq_default: " ++ s, prop_custom_MinDistance_eq_default),
      ("prop_minDistance_cw_distance: " ++ s, prop_minDistance_cw_distance),
      ("prop_neighbour_count_in_bounds: " ++ s, prop_neighbour_count_in_bounds),
      ("prop_neighbours_are_adjacent: " ++ s, prop_neighbours_are_adjacent),
      ("prop_adjacentTilesToward_moves_closer: " ++ s, prop_adjacentTilesToward_moves_closer),
      ("prop_minimal_paths_have_min_length: " ++ s, prop_minimal_paths_have_min_length),
      ("prop_minimal_paths_are_valid: " ++ s, prop_minimal_paths_are_valid),
      ("prop_neighbour_cw_directionTo: " ++ s, prop_neighbour_cw_directionTo),
      ("prop_custom_adjacentTilesToward_eq_default: " ++ s, prop_custom_adjacentTilesToward_eq_default),
      ("prop_custom_neighboursOfSet_eq_default: " ++ s, prop_custom_neighboursOfSet_eq_default),
      ("prop_custom_neighboursOfSet_cw_minDistance: " ++ s, prop_custom_neighboursOfSet_cw_minDistance)
    ]
  
  --
  -- Tests that should apply to and are identical for all finite grids
  --
  
  class TestDataF t where
    expectedTileCount :: t -> Int
    maxDistance :: t -> Int
  
  prop_tile_count_correct
    :: (TestData t, TestDataF t, Grid (BaseGrid t))
      => t -> Property
  prop_tile_count_correct t = nonNull g ==>
    tileCount g == expectedTileCount t
    where g = grid t
  
  prop_custom_tileCount_eq_default
    :: (TestData t, Grid (BaseGrid t)) => t -> Property
  prop_custom_tileCount_eq_default t = nonNull g ==>
    tileCount g == defaultTileCount g
    where g = grid t
  
  prop_distance_in_bounds
    :: (TestData t, TestDataF t, Grid (BaseGrid t))
      => t -> Property
  prop_distance_in_bounds t = nonNull g ==>
    0 <= n && n <= maxDistance t
    where g = grid t
          (a:b:_) = points t
          n = distance g a b
  
  prop_neighbours_cw_viewpoint
    :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_neighbours_cw_viewpoint t = nonNull g ==>
    sort (delete a (neighbours g a)) == sort expected
    where g = grid t
          (a:_) = points t
          expected = map fst $ filter (\p -> 1 == snd p) $ viewpoint g a
  -- Note: In a small but unbounded grid, a tile can be its own neighbour.
  -- However, when we calculate the distance between a tile and itself, we
  -- get 0, not 1. That's why we have to delete the tile from its list
  -- before comparing to the result from the neighbours function.
  
  prop_custom_edges_eq_default
    :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)),
      Ord (Index (BaseGrid t))) => t -> Property
  prop_custom_edges_eq_default t = nonNull g ==>
    sort (edges g) == sort (defaultEdges g)
    where g = grid t
  
  prop_edges_cw_neighbours
    :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_edges_cw_neighbours t = nonNull g ==>
    sort (neighbours g a) == sort expected
    where g = grid t
          (a:_) = points t
          nEdges = filter (`involves` a) $ edges g
          expected = map f nEdges
          f (b,c) = if a == b then c else b
  
  prop_edges_are_adjacent
    :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_edges_are_adjacent t = property . all f $ edges g
    where g = grid t
          f (a, b) = isAdjacent g a b
  
  -- This test is too slow, even for finite grids.
  -- TODO: Try a better implementation of defaultMinimalPaths?
  prop_custom_minimalPaths_eq_default
    :: (TestData t, Grid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_custom_minimalPaths_eq_default t = nonNull g ==>
    sort (minimalPaths g a b) == sort(defaultMinimalPaths g a b)
    where g = grid t
          (a:b:_) = points t
  
  prop_distance_le_maxPossibleDistance
    :: (TestData t, FiniteGrid (BaseGrid t))
      => t -> Property
  prop_distance_le_maxPossibleDistance t = nonNull g ==>
    distance g a b <= maxPossibleDistance g
    where g = grid t
          (a:b:_) = points t
  
  prop_maxPossibleDistance_occurs
    :: (TestData t, FiniteGrid (BaseGrid t),
        Ord (Index (BaseGrid t)))
      => t -> Property
  prop_maxPossibleDistance_occurs t = nonNull g ==>
    dMax `elem` [distance g x y | x <- indices g, y <- reverse . sort $ indices g]
    -- If we process x and y in opposite orders, we're more likely to find
    -- the furthest two points in the grid early on.
    where g = grid t
          dMax = maxPossibleDistance g
  
  finiteGridProperties
    :: (TestData t, TestDataF t, FiniteGrid (BaseGrid t),
      Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t)))
      => String -> [(String, t -> Property)]
  finiteGridProperties s =
    [
      ("prop_tile_count_correct: " ++ s, prop_tile_count_correct),
      ("prop_custom_tileCount_eq_default: " ++ s, prop_custom_tileCount_eq_default),
      ("prop_distance_in_bounds: " ++ s, prop_distance_in_bounds),
      ("prop_neighbours_cw_viewpoint: " ++ s, prop_neighbours_cw_viewpoint),
      ("prop_custom_edges_eq_default: " ++ s, prop_custom_edges_eq_default),
      ("prop_edges_cw_neighbours: " ++ s, prop_edges_cw_neighbours),
      ("prop_edges_are_adjacent: " ++ s, prop_edges_are_adjacent),
  --    ("prop_custom_minimalPaths_eq_default: " ++ s, prop_custom_minimalPaths_eq_default)
      ("prop_distance_le_maxPossibleDistance: " ++ s, prop_distance_le_maxPossibleDistance),
      ("prop_maxPossibleDistance_occurs: " ++ s, prop_maxPossibleDistance_occurs)
    ]
  
  --
  -- Tests that should apply to and are identical for all bounded grids
  --
  
  class TestDataB t where
    expectedBoundaryCount :: t -> Int
  
  prop_custom_boundary_eq_default
    :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_custom_boundary_eq_default t = nonNull g ==>
    sort (boundary g) == sort (defaultBoundary g)
    where g = grid t
  
  prop_boundary_count_correct
    :: (TestData t, TestDataB t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_boundary_count_correct t = nonNull g ==>
    (length . boundary) g == expectedBoundaryCount t
    where g = grid t
  
  -- Return Property rather than Bool so that all of the elements in
  -- boundedGridProperties will have the same type.
  prop_grid_and_boundary_are_both_null_or_not
    :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_grid_and_boundary_are_both_null_or_not t
    = property $ (P.null . boundary) g == null g
    where g = grid t
  
  -- Return Property rather than Bool so that all of the elements in
  -- boundedGridProperties will have the same type.
  prop_boundary_in_grid
    :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_boundary_in_grid t = property $
    all (g `contains`) . boundary $ g
    where g = grid t
  
  prop_boundary_tiles_have_fewer_neighbours
    :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_boundary_tiles_have_fewer_neighbours t = nonNull g ==>
    g `numNeighbours` b <= g `numNeighbours` a
    where g = grid t
          (a:_) = points t
          (b:_) = boundary g
  
  prop_custom_isBoundary_eq_default
    :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_custom_isBoundary_eq_default t = nonNull g ==>
    isBoundary g a == defaultIsBoundary g a
    where g = grid t
          (a:_) = points t
  
  prop_custom_isCentre_eq_default
    :: (TestData t, BoundedGrid (BaseGrid t), Eq (Index (BaseGrid t)))
      => t -> Property
  prop_custom_isCentre_eq_default t = nonNull g ==>
    isCentre g a == defaultIsCentre g a
    where g = grid t
          (a:_) = points t
  
  prop_custom_neighbours_eq_default
    :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)),
        Ord (Index (BaseGrid t)))
       => t -> Property
  prop_custom_neighbours_eq_default t = nonNull g ==>
    sort (neighbours g a) == sort (defaultNeighbours g a)
    where g = grid t
          (a:_) = points t
  
  prop_custom_neighbour_eq_default
    :: (TestData t, Grid (BaseGrid t), Eq (Index (BaseGrid t)), (Eq (Direction (BaseGrid t))))
       => t -> Property
  prop_custom_neighbour_eq_default t = nonNull g ==>
    neighbour g a d == defaultNeighbour g a d
    where g = grid t
          (a:_) = points t
          d = direction t
  
  prop_custom_isAdjacent_eq_default
    :: (TestData t, Grid (BaseGrid t))
      => t -> Property
  prop_custom_isAdjacent_eq_default t = nonNull g ==>
    isAdjacent g a b == defaultIsAdjacent g a b
    where g = grid t
          (a:b:_) = points t
  
  boundedGridProperties
    :: (TestData t, TestDataB t, BoundedGrid (BaseGrid t),
      Eq (Index (BaseGrid t)), Ord (Index (BaseGrid t)),
      Eq (Direction (BaseGrid t)))
      => String -> [(String, t -> Property)]
  boundedGridProperties s =
    [
      ("prop_custom_boundary_eq_default: " ++ s, prop_custom_boundary_eq_default),
      ("prop_boundary_count_correct: " ++ s, prop_boundary_count_correct),
      ("prop_grid_and_boundary_are_both_null_or_not: " ++ s, prop_grid_and_boundary_are_both_null_or_not),
      ("prop_boundary_in_grid: " ++ s, prop_boundary_in_grid),
      ("prop_boundary_tiles_have_fewer_neighbours: " ++ s, prop_boundary_tiles_have_fewer_neighbours),
      ("prop_custom_isBoundary_eq_default: " ++ s, prop_custom_isBoundary_eq_default),
      ("prop_custom_isCentre_eq_default: " ++ s, prop_custom_isBoundary_eq_default),
      ("prop_custom_neighbours_eq_default: " ++ s, prop_custom_neighbours_eq_default),
      ("prop_custom_neighbour_eq_default: " ++ s, prop_custom_neighbour_eq_default),
      ("prop_custom_isAdjacent_eq_default: " ++ s, prop_custom_isAdjacent_eq_default)
    ]
  
  --
  -- These properties won't work for triangular grids.
  -- They probably only work on grids where all the tiles have the same
  -- shape/orientation.
  --
  
  prop_custom_centre_eq_default
    :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_custom_centre_eq_default t = nonNull g ==>
    sort(centre g) == sort (defaultCentre g)
    where g = grid t
  
  prop_centres_equidistant_from_boundary
    :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_centres_equidistant_from_boundary t = nonNull g ==>
    (length . nub . map (minDistance g bs)) cs == 1
    where g = grid t
          bs = boundary g
          cs = centre g
  
  prop_centres_farthest_from_boundary
    :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => t -> Property
  prop_centres_farthest_from_boundary t =
    nonNull g && (not . isCentre g) a ==>
      minDistance g bs a <= minDistance g bs c
    where g = grid t
          (a:_) = points t
          (c:_) = centre g
          bs = boundary g
  
  boundedGridProperties2
    :: (TestData t, BoundedGrid (BaseGrid t), Ord (Index (BaseGrid t)))
      => String -> [(String, t -> Property)]
  boundedGridProperties2 s =
    [
     ("prop_custom_centre_eq_default: " ++ s, prop_custom_centre_eq_default),
     ("prop_centres_equidistant_from_boundary: " ++ s, prop_centres_equidistant_from_boundary),
     ("prop_centres_farthest_from_boundary: " ++ s, prop_centres_farthest_from_boundary)
    ]
  
  