------------------------------------------------------------------------
-- |
-- Module      :  Math.Geometry.GridInternal
-- Copyright   :  (c) Amy de Buitléir 2012-2019
-- 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 TypeFamilies, FlexibleContexts, ConstrainedClassMethods #-}

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 = g -> [Index g] -> Index g -> Int
forall g. Grid g => g -> [Index g] -> Index g -> Int
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 = g -> Index g -> [Index g]
forall g. Grid g => g -> Index g -> [Index g]
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 = g -> [Index g] -> [Index g]
forall g. (Grid g, Eq (Index g)) => g -> [Index g] -> [Index g]
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 = g -> Index g -> Direction g -> Maybe (Index g)
forall g.
(Grid g, Eq (Index g), Eq (Direction g)) =>
g -> Index g -> Direction g -> Maybe (Index g)
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
g = [Index g] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Index g] -> Int) -> (Index g -> [Index g]) -> Index g -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Index g -> [Index g]
forall g. (Grid g, Eq (Index g)) => g -> Index g -> [Index g]
neighbours g
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
g Index g
a = Index g
a Index g -> [Index g] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` g -> [Index g]
forall g. Grid g => g -> [Index g]
indices g
g

  -- | Returns the number of tiles in a grid. Compare with @'size'@.
  tileCount :: g -> Int
  tileCount = [Index g] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Index g] -> Int) -> (g -> [Index g]) -> g -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> [Index g]
forall g. Grid g => g -> [Index g]
indices

  -- | Returns @True@ if the number of tiles in a grid is zero, @False@
  --   otherwise.
  null :: g -> Bool
  null g
g = g -> Int
forall g. Grid g => g -> Int
tileCount g
g Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

  -- | Returns @False@ if the number of tiles in a grid is zero, @True@
  --   otherwise.
  nonNull :: g -> Bool
  nonNull = Bool -> Bool
not (Bool -> Bool) -> (g -> Bool) -> g -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Bool
forall g. Grid g => g -> Bool
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 = g -> [(Index g, Index g)]
forall g. (Grid g, Eq (Index g)) => g -> [(Index g, Index g)]
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
g Index g
p = (Index g -> (Index g, Int)) -> [Index g] -> [(Index g, Int)]
forall a b. (a -> b) -> [a] -> [b]
map Index g -> (Index g, Int)
f (g -> [Index g]
forall g. Grid g => g -> [Index g]
indices g
g)
    where f :: Index g -> (Index g, Int)
f Index g
a = (Index g
a, g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance g
g Index g
p Index g
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 = g -> Index g -> Index g -> Bool
forall g. Grid g => g -> Index g -> Index g -> Bool
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 = g -> Index g -> Index g -> [Index g]
forall g.
(Grid g, Eq (Index g)) =>
g -> Index g -> Index g -> [Index g]
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 = g -> Index g -> Index g -> [[Index g]]
forall g.
(Grid g, Eq (Index g)) =>
g -> Index g -> Index g -> [[Index g]]
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
g [Index g]
xs Index g
a = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> ([Index g] -> [Int]) -> [Index g] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index g -> Int) -> [Index g] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance g
g Index g
a) ([Index g] -> Int) -> [Index g] -> Int
forall a b. (a -> b) -> a -> b
$ [Index g]
xs

  -- WARNING: this implementation won't work for wrapped grids
  defaultNeighbours :: g -> Index g -> [Index g]
  defaultNeighbours g
g Index g
a = (Index g -> Bool) -> [Index g] -> [Index g]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Index g
b -> g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance g
g Index g
a Index g
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ) ([Index g] -> [Index g]) -> [Index g] -> [Index g]
forall a b. (a -> b) -> a -> b
$ g -> [Index g]
forall g. Grid g => g -> [Index g]
indices g
g

  -- This should work for wrapped grids, though.
  defaultNeighboursOfSet :: Eq (Index g) => g -> [Index g] -> [Index g]
  defaultNeighboursOfSet g
g [Index g]
as = [Index g]
ns [Index g] -> [Index g] -> [Index g]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Index g]
as
    where ns :: [Index g]
ns = [Index g] -> [Index g]
forall a. Eq a => [a] -> [a]
nub ([Index g] -> [Index g])
-> ([Index g] -> [Index g]) -> [Index g] -> [Index g]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index g -> [Index g]) -> [Index g] -> [Index g]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (g -> Index g -> [Index g]
forall g. (Grid g, Eq (Index g)) => g -> Index g -> [Index g]
neighbours g
g) ([Index g] -> [Index g]) -> [Index g] -> [Index g]
forall a b. (a -> b) -> a -> b
$ [Index 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
g Index g
a Direction g
d =
    [Index g] -> Maybe (Index g)
forall a. [a] -> Maybe a
maybeHead ([Index g] -> Maybe (Index g))
-> (Index g -> [Index g]) -> Index g -> Maybe (Index g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index g -> Bool) -> [Index g] -> [Index g]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Index g
b -> [Direction g
d] [Direction g] -> [Direction g] -> Bool
forall a. Eq a => a -> a -> Bool
== g -> Index g -> Index g -> [Direction g]
forall g. Grid g => g -> Index g -> Index g -> [Direction g]
directionTo g
g Index g
a Index g
b) ([Index g] -> [Index g])
-> (Index g -> [Index g]) -> Index g -> [Index g]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Index g -> [Index g]
forall g. (Grid g, Eq (Index g)) => g -> Index g -> [Index g]
neighbours g
g (Index g -> Maybe (Index g)) -> Index g -> Maybe (Index g)
forall a b. (a -> b) -> a -> b
$ Index g
a
    where maybeHead :: [a] -> Maybe a
maybeHead (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
          maybeHead [a]
_ = Maybe a
forall a. Maybe a
Nothing

  defaultTileCount :: g -> Int
  defaultTileCount = [Index g] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Index g] -> Int) -> (g -> [Index g]) -> g -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> [Index g]
forall g. Grid g => g -> [Index g]
indices

  -- WARNING: this implementation won't work for wrapped grids
  defaultEdges :: Eq (Index g) => g -> [(Index g,Index g)]
  defaultEdges g
g = ((Index g, Index g) -> (Index g, Index g) -> Bool)
-> [(Index g, Index g)] -> [(Index g, Index g)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Index g, Index g) -> (Index g, Index g) -> Bool
forall t. Eq t => (t, t) -> (t, t) -> Bool
sameEdge ([(Index g, Index g)] -> [(Index g, Index g)])
-> [(Index g, Index g)] -> [(Index g, Index g)]
forall a b. (a -> b) -> a -> b
$ (Index g -> [(Index g, Index g)])
-> [Index g] -> [(Index g, Index g)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Index g -> g -> [(Index g, Index g)]
forall g.
(Grid g, Eq (Index g)) =>
Index g -> g -> [(Index g, Index g)]
`adjacentEdges` g
g) ([Index g] -> [(Index g, Index g)])
-> [Index g] -> [(Index g, Index g)]
forall a b. (a -> b) -> a -> b
$ g -> [Index g]
forall g. Grid g => g -> [Index g]
indices g
g

  -- WARNING: this implementation won't work for wrapped grids
  defaultIsAdjacent :: g -> Index g -> Index g -> Bool
  defaultIsAdjacent g
g Index g
a Index g
b = g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance g
g Index g
a Index g
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

  defaultAdjacentTilesToward
    :: Eq (Index g) => g -> Index g -> Index g -> [Index g]
  defaultAdjacentTilesToward g
g Index g
a Index g
b = (Index g -> Bool) -> [Index g] -> [Index g]
forall a. (a -> Bool) -> [a] -> [a]
filter Index g -> Bool
f ([Index g] -> [Index g]) -> [Index g] -> [Index g]
forall a b. (a -> b) -> a -> b
$ g -> Index g -> [Index g]
forall g. (Grid g, Eq (Index g)) => g -> Index g -> [Index g]
neighbours g
g Index g
a
    where f :: Index g -> Bool
f Index g
c = g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance g
g Index g
c Index g
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance g
g Index g
a Index g
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

  defaultMinimalPaths :: Eq (Index g)
    => g -> Index g -> Index g -> [[Index g]]
  defaultMinimalPaths g
g Index g
a Index g
b
    | Index g
a Index g -> Index g -> Bool
forall a. Eq a => a -> a -> Bool
== Index g
b              = [[Index g
a]]
    | g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance g
g Index g
a Index g
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [[Index g
a,Index g
b]]
    | Bool
otherwise          = ([Index g] -> [Index g]) -> [[Index g]] -> [[Index g]]
forall a b. (a -> b) -> [a] -> [b]
map (Index g
aIndex g -> [Index g] -> [Index g]
forall a. a -> [a] -> [a]
:) [[Index g]]
xs
    where xs :: [[Index g]]
xs = (Index g -> [[Index g]]) -> [Index g] -> [[Index g]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Index g
c -> g -> Index g -> Index g -> [[Index g]]
forall g.
(Grid g, Eq (Index g)) =>
g -> Index g -> Index g -> [[Index g]]
minimalPaths g
g Index g
c Index g
b) [Index g]
ys
          ys :: [Index g]
ys = g -> Index g -> Index g -> [Index g]
forall g.
(Grid g, Eq (Index g)) =>
g -> Index g -> Index g -> [Index g]
adjacentTilesToward g
g Index g
a Index g
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 = g -> [Index g]
forall g. (BoundedGrid g, Eq (Index g)) => g -> [Index g]
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 = g -> Index g -> Bool
forall g. (BoundedGrid g, Eq (Index g)) => g -> Index g -> Bool
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 = g -> [Index g]
forall g. (BoundedGrid g, Eq (Index g)) => g -> [Index g]
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 = g -> Index g -> Bool
forall g. (BoundedGrid g, Eq (Index g)) => g -> Index g -> Bool
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
g = ((Index g, Int) -> Index g) -> [(Index g, Int)] -> [Index g]
forall a b. (a -> b) -> [a] -> [b]
map (Index g, Int) -> Index g
forall a b. (a, b) -> a
fst ([(Index g, Int)] -> [Index g])
-> ([(Index g, Int)] -> [(Index g, Int)])
-> [(Index g, Int)]
-> [Index g]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Index g, Int) -> Bool) -> [(Index g, Int)] -> [(Index g, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Index g, Int) -> Bool
f ([(Index g, Int)] -> [Index g]) -> [(Index g, Int)] -> [Index g]
forall a b. (a -> b) -> a -> b
$ [(Index g, Int)]
xds
    where xds :: [(Index g, Int)]
xds = (Index g -> (Index g, Int)) -> [Index g] -> [(Index g, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\Index g
b -> (Index g
b, g -> Index g -> Int
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Int
numNeighbours g
g Index g
b)) ([Index g] -> [(Index g, Int)]) -> [Index g] -> [(Index g, Int)]
forall a b. (a -> b) -> a -> b
$ g -> [Index g]
forall g. Grid g => g -> [Index g]
indices g
g
          f :: (Index g, Int) -> Bool
f (Index g
_,Int
n) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< g -> Int
forall g. BoundedGrid g => g -> Int
tileSideCount g
g

  defaultIsBoundary :: Eq (Index g) => g -> Index g -> Bool
  defaultIsBoundary g
g Index g
a = Index g
a Index g -> [Index g] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` g -> [Index g]
forall g. (BoundedGrid g, Eq (Index g)) => g -> [Index g]
boundary g
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
g = ((Index g, Int) -> Index g) -> [(Index g, Int)] -> [Index g]
forall a b. (a -> b) -> [a] -> [b]
map (Index g, Int) -> Index g
forall a b. (a, b) -> a
fst ([(Index g, Int)] -> [Index g])
-> ([(Index g, Int)] -> [(Index g, Int)])
-> [(Index g, Int)]
-> [Index g]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Index g, Int)]] -> [(Index g, Int)]
forall a. [a] -> a
head ([[(Index g, Int)]] -> [(Index g, Int)])
-> ([(Index g, Int)] -> [[(Index g, Int)]])
-> [(Index g, Int)]
-> [(Index g, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Index g, Int) -> (Index g, Int) -> Bool)
-> [(Index g, Int)] -> [[(Index g, Int)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((Index g, Int) -> Int)
-> (Index g, Int)
-> (Index g, Int)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Index g, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Index g, Int)] -> [[(Index g, Int)]])
-> ([(Index g, Int)] -> [(Index g, Int)])
-> [(Index g, Int)]
-> [[(Index g, Int)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                ((Index g, Int) -> (Index g, Int) -> Ordering)
-> [(Index g, Int)] -> [(Index g, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Index g, Int) -> Int)
-> (Index g, Int) -> (Index g, Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Index g, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Index g, Int)] -> [Index g]) -> [(Index g, Int)] -> [Index g]
forall a b. (a -> b) -> a -> b
$ [(Index g, Int)]
xds
    where xds :: [(Index g, Int)]
xds = (Index g -> (Index g, Int)) -> [Index g] -> [(Index g, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\Index g
b -> (Index g
b, Index g -> Int
f Index g
b)) ([Index g] -> [(Index g, Int)]) -> [Index g] -> [(Index g, Int)]
forall a b. (a -> b) -> a -> b
$ g -> [Index g]
forall g. Grid g => g -> [Index g]
indices g
g
          bs :: [Index g]
bs = g -> [Index g]
forall g. (BoundedGrid g, Eq (Index g)) => g -> [Index g]
boundary g
g
          f :: Index g -> Int
f Index g
x = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([Index g] -> [Int]) -> [Index g] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index g -> Int) -> [Index g] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance g
g Index g
x) ([Index g] -> Int) -> [Index g] -> Int
forall a b. (a -> b) -> a -> b
$ [Index g]
bs

  defaultIsCentre :: Eq (Index g) => g -> Index g -> Bool
  defaultIsCentre g
g Index g
a = Index g
a Index g -> [Index g] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` g -> [Index g]
forall g. (BoundedGrid g, Eq (Index g)) => g -> [Index g]
centre g
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 -> Index g -> [Index g]
neighboursBasedOn u
u g
g = (Index u -> Bool) -> [Index u] -> [Index u]
forall a. (a -> Bool) -> [a] -> [a]
filter (g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains`) ([Index u] -> [Index u])
-> (Index u -> [Index u]) -> Index u -> [Index u]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> Index u -> [Index u]
forall g. (Grid g, Eq (Index g)) => g -> Index g -> [Index g]
neighbours u
u

distanceBasedOn
  :: (Eq (Index g), Grid g, Grid u, Index g ~ Index u) =>
    u -> g -> Index g -> Index g -> Int
distanceBasedOn :: u -> g -> Index g -> Index g -> Int
distanceBasedOn u
u g
g Index g
a Index g
b =
  if g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index g
a Bool -> Bool -> Bool
&& g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index g
b
    then u -> Index u -> Index u -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance u
u Index g
Index u
a Index g
Index u
b
    else Int
forall a. HasCallStack => a
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 -> Index g -> Index g -> [Direction g]
directionToBasedOn u
u g
g Index g
a Index g
b =
  if g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index g
a Bool -> Bool -> Bool
&& g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index g
b
    then [Direction u] -> [Direction u]
forall a. Eq a => [a] -> [a]
nub ([Direction u] -> [Direction u])
-> (Index u -> [Direction u]) -> Index u -> [Direction u]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index u -> [Direction u]) -> [Index u] -> [Direction u]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (u -> Index u -> Index u -> [Direction u]
forall g. Grid g => g -> Index g -> Index g -> [Direction g]
directionTo u
u Index g
Index u
a) ([Index u] -> [Direction u])
-> (Index u -> [Index u]) -> Index u -> [Direction u]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Index g -> Index g -> [Index g]
forall g.
(Grid g, Eq (Index g)) =>
g -> Index g -> Index g -> [Index g]
adjacentTilesToward g
g Index g
a (Index u -> [Direction u]) -> Index u -> [Direction u]
forall a b. (a -> b) -> a -> b
$ Index g
Index u
b
    else [Direction g]
forall a. HasCallStack => a
undefined

neighboursWrappedBasedOn
  :: (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
    u -> g -> Index g -> [Index g]
neighboursWrappedBasedOn :: u -> g -> Index g -> [Index g]
neighboursWrappedBasedOn u
u g
g =
  (Index u -> Bool) -> [Index u] -> [Index u]
forall a. (a -> Bool) -> [a] -> [a]
filter (g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains`) ([Index u] -> [Index u])
-> (Index u -> [Index u]) -> Index u -> [Index u]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Index u] -> [Index u]
forall a. Eq a => [a] -> [a]
nub ([Index u] -> [Index u])
-> (Index u -> [Index u]) -> Index u -> [Index u]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index u -> Index u) -> [Index u] -> [Index u]
forall a b. (a -> b) -> [a] -> [b]
map (g -> Index g -> Index g
forall g. WrappedGrid g => g -> Index g -> Index g
normalise g
g) ([Index u] -> [Index u])
-> (Index u -> [Index u]) -> Index u -> [Index u]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> Index u -> [Index u]
forall g. (Grid g, Eq (Index g)) => g -> Index g -> [Index g]
neighbours u
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 -> Index g -> Direction g -> Maybe (Index g)
neighbourWrappedBasedOn u
u g
g Index g
a Direction g
d =
  if g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index g
a
    then u -> Index u -> Direction u -> Maybe (Index u)
forall g.
(Grid g, Eq (Index g), Eq (Direction g)) =>
g -> Index g -> Direction g -> Maybe (Index g)
neighbour u
u Index g
Index u
a Direction g
Direction u
d Maybe (Index u) -> (Index u -> Maybe (Index u)) -> Maybe (Index u)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Index u -> Maybe (Index u)
forall (m :: * -> *) a. Monad m => a -> m a
return (Index u -> Maybe (Index u))
-> (Index u -> Index u) -> Index u -> Maybe (Index u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> Index g -> Index g
forall g. WrappedGrid g => g -> Index g -> Index g
normalise g
g
    else Maybe (Index g)
forall a. Maybe a
Nothing

distanceWrappedBasedOn
  :: (Eq (Index g), WrappedGrid g, Grid u, Index g ~ Index u) =>
    u -> g -> Index g -> Index g -> Int
distanceWrappedBasedOn :: u -> g -> Index g -> Index g -> Int
distanceWrappedBasedOn u
u g
g Index g
a Index g
b =
  if g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index g
a Bool -> Bool -> Bool
&& g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index g
b
    then [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> ([Index u] -> [Int]) -> [Index u] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index u -> Int) -> [Index u] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (u -> Index u -> Index u -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance u
u Index g
Index u
a') ([Index u] -> Int) -> [Index u] -> Int
forall a b. (a -> b) -> a -> b
$ [Index g]
[Index u]
bs
    else Int
forall a. HasCallStack => a
undefined
  where a' :: Index g
a' = g -> Index g -> Index g
forall g. WrappedGrid g => g -> Index g -> Index g
normalise g
g Index g
a
        bs :: [Index g]
bs = g -> Index g -> [Index g]
forall g. WrappedGrid g => g -> Index g -> [Index g]
denormalise g
g Index 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 -> Index g -> Index g -> [Direction g]
directionToWrappedBasedOn u
u g
g Index g
a Index g
b =
  if g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index g
a Bool -> Bool -> Bool
&& g
g g -> Index g -> Bool
forall g. (Grid g, Eq (Index g)) => g -> Index g -> Bool
`contains` Index g
b
    then [Direction u] -> [Direction u]
forall a. Eq a => [a] -> [a]
nub ([Direction u] -> [Direction u])
-> ([Index u] -> [Direction u]) -> [Index u] -> [Direction u]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Index u -> [Direction u]) -> [Index u] -> [Direction u]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (u -> Index u -> Index u -> [Direction u]
forall g. Grid g => g -> Index g -> Index g -> [Direction g]
directionTo u
u Index g
Index u
a') ([Index u] -> [Direction u]) -> [Index u] -> [Direction u]
forall a b. (a -> b) -> a -> b
$ [Index u]
ys'
    else [Direction g]
forall a. HasCallStack => a
undefined
  where a' :: Index g
a' = g -> Index g -> Index g
forall g. WrappedGrid g => g -> Index g -> Index g
normalise g
g Index g
a
        ys :: [Index g]
ys = g -> Index g -> [Index g]
forall g. WrappedGrid g => g -> Index g -> [Index g]
denormalise g
g Index g
b
        minD :: Int
minD = g -> Index g -> Index g -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance g
g Index g
a Index g
b
        ys' :: [Index u]
ys' = (Index u -> Bool) -> [Index u] -> [Index u]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Index u
c -> u -> Index u -> Index u -> Int
forall g. Grid g => g -> Index g -> Index g -> Int
distance u
u Index g
Index u
a' Index u
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
minD) [Index g]
[Index u]
ys

--
-- Helper functions
--

sameEdge :: Eq t => (t, t) -> (t, t) -> Bool
sameEdge :: (t, t) -> (t, t) -> Bool
sameEdge (t
a,t
b) (t
c,t
d) = (t
a,t
b) (t, t) -> (t, t) -> Bool
forall a. Eq a => a -> a -> Bool
== (t
c,t
d) Bool -> Bool -> Bool
|| (t
a,t
b) (t, t) -> (t, t) -> Bool
forall a. Eq a => a -> a -> Bool
== (t
d,t
c)

adjacentEdges :: (Grid g, Eq (Index g)) => Index g -> g -> [(Index g, Index g)]
adjacentEdges :: Index g -> g -> [(Index g, Index g)]
adjacentEdges Index g
i g
g = (Index g -> (Index g, Index g))
-> [Index g] -> [(Index g, Index g)]
forall a b. (a -> b) -> [a] -> [b]
map (\Index g
j -> (Index g
i,Index g
j)) ([Index g] -> [(Index g, Index g)])
-> [Index g] -> [(Index g, Index g)]
forall a b. (a -> b) -> a -> b
$ g -> Index g -> [Index g]
forall g. (Grid g, Eq (Index g)) => g -> Index g -> [Index g]
neighbours g
g Index g
i

cartesianIndices
  :: (Enum r, Enum c, Num r, Num c, Ord r, Ord c) =>
     (r, c) -> [(c, r)]
cartesianIndices :: (r, c) -> [(c, r)]
cartesianIndices (r
r, c
c) = [(c, r)]
west [(c, r)] -> [(c, r)] -> [(c, r)]
forall a. [a] -> [a] -> [a]
++ [(c, r)]
north [(c, r)] -> [(c, r)] -> [(c, r)]
forall a. [a] -> [a] -> [a]
++ [(c, r)]
east [(c, r)] -> [(c, r)] -> [(c, r)]
forall a. [a] -> [a] -> [a]
++ [(c, r)]
south
  where west :: [(c, r)]
west = [(c
0,r
k) | r
k <- [r
0,r
1..r
rr -> r -> r
forall a. Num a => a -> a -> a
-r
1], c
cc -> c -> Bool
forall a. Ord a => a -> a -> Bool
>c
0]
        north :: [(c, r)]
north = [(c
k,r
rr -> r -> r
forall a. Num a => a -> a -> a
-r
1) | c
k <- [c
1,c
2..c
cc -> c -> c
forall a. Num a => a -> a -> a
-c
1], r
rr -> r -> Bool
forall a. Ord a => a -> a -> Bool
>r
0]
        east :: [(c, r)]
east = [(c
cc -> c -> c
forall a. Num a => a -> a -> a
-c
1,r
k) | r
k <- [r
rr -> r -> r
forall a. Num a => a -> a -> a
-r
2,r
rr -> r -> r
forall a. Num a => a -> a -> a
-r
3..r
0], c
cc -> c -> Bool
forall a. Ord a => a -> a -> Bool
>c
1]
        south :: [(c, r)]
south = [(c
k,r
0) | c
k <- [c
cc -> c -> c
forall a. Num a => a -> a -> a
-c
2,c
cc -> c -> c
forall a. Num a => a -> a -> a
-c
3..c
1], r
rr -> r -> Bool
forall a. Ord a => a -> a -> Bool
>r
1]

cartesianCentre :: (Int, Int) -> [(Int, Int)]
cartesianCentre :: (Int, Int) -> [(Int, Int)]
cartesianCentre (Int
r,Int
c) = [(Int
i,Int
j) | Int
i <- Int -> [Int]
cartesianMidpoints Int
c, Int
j <- Int -> [Int]
cartesianMidpoints Int
r]

cartesianMidpoints :: Int -> [Int]
cartesianMidpoints :: Int -> [Int]
cartesianMidpoints Int
k = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
k then [Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
m] else [Int
m]
  where m :: Int
m = Int
k Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2