content: ------------------------------------------------------------------------
  -- |
  -- Module      :  Math.Geometry.GridInternal
  -- Copyright   :  (c) 2012-2022 Amy de Buitléir
  -- License     :  BSD-style
  -- Maintainer  :  amy@nualeargais.ie
  -- Stability   :  experimental
  -- Portability :  portable
  --
  -- A module containing private @Grid@ internals. Most developers should
  -- use @Grid@ instead. This module is subject to change without notice.
  --
  ------------------------------------------------------------------------
  {-# LANGUAGE ConstrainedClassMethods #-}
  {-# LANGUAGE FlexibleContexts        #-}
  {-# LANGUAGE TypeFamilies            #-}
  
  module Math.Geometry.GridInternal where
  
  import Prelude       hiding (null)
  
  import Data.Function (on)
  import Data.List     (groupBy, nub, nubBy, sortBy, (\\))
  import Data.Ord      (comparing)
  
  -- | A regular arrangement of tiles.
  --   Minimal complete definition: @'Index'@, @'Direction'@, @'indices'@,
  --   @'distance'@, @'directionTo'@.
  class Grid g where
    type Index g
    type Direction g
  
    -- | Returns the indices of all tiles in a grid.
    indices :: g -> [Index g]
  
    -- | @'distance' g a b@ returns the minimum number of moves required
    --   to get from the tile at index @a@ to the tile at index @b@ in
    --   grid @g@, moving between adjacent tiles at each step. (Two tiles
    --   are adjacent if they share an edge.) If @a@ or @b@ are not
    --   contained within @g@, the result is undefined.
    distance :: g -> Index g -> Index g -> Int
  
    -- | @'minDistance' g bs a@ returns the minimum number of moves
    --   required to get from any of the tiles at indices @bs@ to the tile
    --   at index @a@ in grid @g@, moving between adjacent tiles at each
    --   step. (Two tiles are adjacent if they share an edge.) If @a@ or
    --   any of @bs@ are not contained within @g@, the result is
    --   undefined.
    minDistance :: g -> [Index g] -> Index g -> Int
    minDistance = defaultMinDistance
  
    -- | @'neighbours' g a@ returns the indices of the tiles in the grid
    --   @g@ which are adjacent to the tile with index @a@.
    neighbours :: Eq (Index g) => g -> Index g -> [Index g]
    neighbours = defaultNeighbours
  
    -- | @'neighboursOfSet' g as@ returns the indices of the tiles in the
    --   grid @g@ which are adjacent to any of the tiles with index in
    --   @as@.
    neighboursOfSet :: Eq (Index g) => g -> [Index g] -> [Index g]
    neighboursOfSet = defaultNeighboursOfSet
  
    -- | @'neighbour' g d a@ returns the indices of the tile in the grid
    --   @g@ which is adjacent to the tile with index @a@, in the
    --   direction @d@.
    neighbour
      :: (Eq (Index g), Eq (Direction g))
         => g -> Index g -> Direction g -> Maybe (Index g)
    neighbour = defaultNeighbour
  
    -- | @'numNeighbours' g a@ returns the number of tiles in the grid
    --   @g@ which are adjacent to the tile with index @a@.
    numNeighbours :: Eq (Index g) => g -> Index g -> Int
    numNeighbours g = length . neighbours g
  
    -- | @g `'contains'` a@ returns @True@ if the index @a@ is contained
    --   within the grid @g@, otherwise it returns false.
    contains :: Eq (Index g) => g -> Index g -> Bool
    contains g a = a `elem` indices g
  
    -- | Returns the number of tiles in a grid. Compare with @'size'@.
    tileCount :: g -> Int
    tileCount = length . indices
  
    -- | Returns @True@ if the number of tiles in a grid is zero, @False@
    --   otherwise.
    null :: g -> Bool
    null g = tileCount g == 0
  
    -- | Returns @False@ if the number of tiles in a grid is zero, @True@
    --   otherwise.
    nonNull :: g -> Bool
    nonNull = not . null
  
    -- | A list of all edges in a grid, where the edges are represented by
    --   a pair of indices of adjacent tiles.
    edges :: Eq (Index g) => g -> [(Index g,Index g)]
    edges = defaultEdges
  
    -- | @'viewpoint' g a@ returns a list of pairs associating the index
    --   of each tile in @g@ with its distance to the tile with index @a@.
    --   If @a@ is not contained within @g@, the result is undefined.
    viewpoint :: g -> Index g -> [(Index g, Int)]
    viewpoint g p = map f (indices g)
      where f a = (a, distance g p a)
  
    -- | @'isAdjacent' g a b@ returns @True@ if the tile at index @a@ is
    --   adjacent to the tile at index @b@ in @g@. (Two tiles are adjacent
    --   if they share an edge.) If @a@ or @b@ are not contained within
    --   @g@, the result is undefined.
    isAdjacent :: g -> Index g -> Index g -> Bool
    isAdjacent = defaultIsAdjacent
  
    -- | @'adjacentTilesToward' g a b@ returns the indices of all tiles
    --   which are neighbours of the tile at index @a@, and which are
    --   closer to the tile at @b@ than @a@ is. In other words, it returns
    --   the possible next steps on a minimal path from @a@ to @b@. If @a@
    --   or @b@ are not contained within @g@, or if there is no path from
    --   @a@ to @b@ (e.g., a disconnected grid), the result is undefined.
    adjacentTilesToward :: Eq (Index g) => g -> Index g -> Index g -> [Index g]
    adjacentTilesToward = defaultAdjacentTilesToward
  
    -- | @'minimalPaths' g a b@ returns a list of all minimal paths from
    --   the tile at index @a@ to the tile at index @b@ in grid @g@. A
    --   path is a sequence of tiles where each tile in the sequence is
    --   adjacent to the previous one. (Two tiles are adjacent if they
    --   share an edge.) If @a@ or @b@ are not contained within @g@, the
    --   result is undefined.
    --
    --   Tip: The default implementation of this function calls
    --   @'adjacentTilesToward'@. If you want to use a custom algorithm,
    --   consider modifying @'adjacentTilesToward'@ instead of
    --   @'minimalPaths'@.
    minimalPaths :: Eq (Index g) => g -> Index g -> Index g -> [[Index g]]
    minimalPaths = defaultMinimalPaths
  
    -- | @'directionTo' g a b@ returns the direction(s) of the next
    --   tile(s) in a /minimal/ path from the tile at index @a@ to the
    --   tile at index @b@ in grid @g@.
    directionTo :: g -> Index g -> Index g -> [Direction g]
  
    --
    -- These default implementations are broken out to make it easier to
    -- compare the results with custom implementations (for testing).
    --
  
    defaultMinDistance :: g -> [Index g] -> Index g -> Int
    defaultMinDistance g xs a = minimum . map (distance g a) $ xs
  
    -- WARNING: this implementation won't work for wrapped grids
    defaultNeighbours :: g -> Index g -> [Index g]
    defaultNeighbours g a = filter (\b -> distance g a b == 1 ) $ indices g
  
    -- This should work for wrapped grids, though.
    defaultNeighboursOfSet :: Eq (Index g) => g -> [Index g] -> [Index g]
    defaultNeighboursOfSet g as = ns \\ as
      where ns = nub . concatMap (neighbours g) $ as
  
    -- WARNING: this implementation won't work for wrapped grids
    defaultNeighbour :: (Eq (Index g), Eq (Direction g))
      => g -> Index g -> Direction g -> Maybe (Index g)
    defaultNeighbour g a d =
      maybeHead . filter (\b -> [d] == directionTo g a b) . neighbours g $ a
      where maybeHead (x:_) = Just x
            maybeHead _     = Nothing
  
    defaultTileCount :: g -> Int
    defaultTileCount = length . indices
  
    -- WARNING: this implementation won't work for wrapped grids
    defaultEdges :: Eq (Index g) => g -> [(Index g,Index g)]
    defaultEdges g = nubBy sameEdge $ concatMap (`adjacentEdges` g) $ indices g
  
    -- WARNING: this implementation won't work for wrapped grids
    defaultIsAdjacent :: g -> Index g -> Index g -> Bool
    defaultIsAdjacent g a b = distance g a b == 1
  
    defaultAdjacentTilesToward
      :: Eq (Index g) => g -> Index g -> Index g -> [Index g]
    defaultAdjacentTilesToward g a b = filter f $ neighbours g a
      where f c = distance g c b == distance g a b - 1
  
    defaultMinimalPaths :: Eq (Index g)
      => g -> Index g -> Index g -> [[Index g]]
    defaultMinimalPaths g a b
      | a == b              = [[a]]
      | distance g a b == 1 = [[a,b]]
      | otherwise          = map (a:) xs
      where xs = concatMap (\c -> minimalPaths g c b) ys
            ys = adjacentTilesToward g a b
  
  -- | A regular arrangement of tiles where the number of tiles is finite.
  --   Minimal complete definition: @'size'@, @'maxPossibleDistance'@.
  class Grid g => FiniteGrid g where
    type Size g
    -- | Returns the dimensions of the grid.
    --   For example, if @g@ is a 4x3 rectangular grid, @'size' g@ would
    --   return @(4, 3)@, while @'tileCount' g@ would return @12@.
    size :: g -> Size g
    -- | Returns the largest possible distance between two tiles in the
    --   grid.
    maxPossibleDistance :: g -> Int
  
  
  -- | A regular arrangement of tiles with an edge.
  --   Minimal complete definition: @'tileSideCount'@.
  class Grid g => BoundedGrid g where
    -- | Returns the number of sides a tile has
    tileSideCount :: g -> Int
  
    -- | Returns a the indices of all the tiles at the boundary of a grid.
    boundary :: Eq (Index g) => g -> [Index g]
    boundary = defaultBoundary
  
    -- | @'isBoundary' g a@' returns @True@ if the tile with index @a@ is
    --   on a boundary of @g@, @False@ otherwise. (Corner tiles are also
    --   boundary tiles.)
    isBoundary :: Eq (Index g) => g -> Index g -> Bool
    isBoundary = defaultIsBoundary
  
    -- | Returns the index of the tile(s) that require the maximum number
    --   of moves to reach the nearest boundary tile. A grid may have more
    --   than one central tile (e.g., a rectangular grid with an even
    --   number of rows and columns will have four central tiles).
    centre :: Eq (Index g) => g -> [Index g]
    centre = defaultCentre
  
    -- | @'isCentre' g a@' returns @True@ if the tile with index @a@ is
    --   a centre tile of @g@, @False@ otherwise.
    isCentre :: Eq (Index g) => g -> Index g -> Bool
    isCentre = defaultIsCentre
  
    --
    -- These default implementations are broken out to make it easier to
    -- compare the results with custom implementations (for testing).
    --
  
    defaultBoundary :: Eq (Index g) => g -> [Index g]
    defaultBoundary g = map fst . filter f $ xds
      where xds = map (\b -> (b, numNeighbours g b)) $ indices g
            f (_,n) = n < tileSideCount g
  
    defaultIsBoundary :: Eq (Index g) => g -> Index g -> Bool
    defaultIsBoundary g a = a `elem` boundary g
  
    -- WARNING: this implementation won't work for triangular grids.
    -- It probably only works on grids where all the tiles have the same
    -- shape/orientation.
    defaultCentre :: Eq (Index g) => g -> [Index g]
    defaultCentre g = map fst . head . groupBy ((==) `on` snd) .
                  sortBy (comparing snd) $ xds
      where xds = map (\b -> (b, f b)) $ indices g
            bs = boundary g
            f x = sum . map (distance g x) $ bs
  
    defaultIsCentre :: Eq (Index g) => g -> Index g -> Bool
    defaultIsCentre g a = a `elem` centre g
  
  -- | A regular arrangement of tiles where the boundaries are joined.
  --   Minimal complete definition: @'normalise'@ and @'denormalise'@.
  class (Grid g) => WrappedGrid g where
    -- | @'normalise' g a@ returns the "normal" indices for @a@.
    --   TODO: need a clearer description and an illustration.
    normalise :: g -> Index g -> Index g
    -- | @'denormalise' g a@ returns all of the indices in @a@'s
    --   translation group. In other words, it returns @a@ plus the
    --   indices obtained by translating @a@ in each direction by the
    --   extent of the grid along that direction.
    --   TODO: need a clearer description and an illustration.
    denormalise :: g -> Index g -> [Index g]
  
  neighboursBasedOn
    :: (Eq (Index u), Grid g, Grid u, Index g ~ Index u) =>
      u -> g -> Index g -> [Index g]
  neighboursBasedOn u g = filter (g `contains`) . neighbours u
  
  distanceBasedOn
    :: (Eq (Index g), Grid g, Grid u, Index g ~ Index u) =>
      u -> g -> Index g -> Index g -> Int
  distanceBasedOn u g a b =
    if g `contains` a && g `contains` b
      then distance u a b
      else undefined
  
  directionToBasedOn
    :: (Eq (Index g), Eq (Direction g), Grid g, Grid u, Index g ~ Index u,
      Direction g ~ Direction u) =>
      u -> g -> Index g -> Index g -> [Direction g]
  directionToBasedOn u g a b =
    if g `contains` a && g `contains` b
      then nub . concatMap (directionTo u a) . adjacentTilesToward g a $ b
      else undefined
  
  neighboursWrappedBasedOn
    :: (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
      u -> g -> Index g -> [Index g]
  neighboursWrappedBasedOn u g =
    filter (g `contains`) . nub . map (normalise g) . neighbours u
  
  neighbourWrappedBasedOn
    :: (Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u,
      Index g ~ Index u, Direction g ~ Direction u) =>
      u -> g -> Index g -> Direction g -> Maybe (Index g)
  neighbourWrappedBasedOn u g a d =
    if g `contains` a
      then neighbour u a d >>= return . normalise g
      else Nothing
  
  distanceWrappedBasedOn
    :: (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
      u -> g -> Index g -> Index g -> Int
  distanceWrappedBasedOn u g a b =
    if g `contains` a && g `contains` b
      then minimum . map (distance u a') $ bs
      else undefined
    where a' = normalise g a
          bs = denormalise g b
  
  directionToWrappedBasedOn
    :: (Eq (Index g), Eq (Direction g), WrappedGrid g, Grid u,
      Index g ~ Index u, Direction g ~ Direction u) =>
      u -> g -> Index g -> Index g -> [Direction g]
  directionToWrappedBasedOn u g a b =
    if g `contains` a && g `contains` b
      then nub . concatMap (directionTo u a') $ ys'
      else undefined
    where a' = normalise g a
          ys = denormalise g b
          minD = distance g a b
          ys' = filter (\c -> distance u a' c == minD) ys
  
  --
  -- Helper functions
  --
  
  sameEdge :: Eq t => (t, t) -> (t, t) -> Bool
  sameEdge (a,b) (c,d) = (a,b) == (c,d) || (a,b) == (d,c)
  
  adjacentEdges :: (Grid g, Eq (Index g)) => Index g -> g -> [(Index g, Index g)]
  adjacentEdges i g = map (\j -> (i,j)) $ neighbours g i
  
  cartesianIndices
    :: (Enum r, Enum c, Num r, Num c, Ord r, Ord c) =>
       (r, c) -> [(c, r)]
  cartesianIndices (r, c) = west ++ north ++ east ++ south
    where west = [(0,k) | c>0, k <- [0,1..r-1]]
          north = [(k,r-1) | r>0, k <- [1,2..c-1]]
          east = [(c-1,k) | c>1, k <- [r-2,r-3..0]]
          south = [(k,0) | r>1, k <- [c-2,c-3..1]]
  
  cartesianCentre :: (Int, Int) -> [(Int, Int)]
  cartesianCentre (r,c) = [(i,j) | i <- cartesianMidpoints c, j <- cartesianMidpoints r]
  
  cartesianMidpoints :: Int -> [Int]
  cartesianMidpoints k = if even k then [m-1,m] else [m]
    where m = k `div` 2
  