{-|
Module      : Data.Graph.AdjacencyList.Grid
Description : d-dimensional cubic lattices with periodic boundary conditions
Copyright   : Thodoris Papakonstantinou, 2017-2026
License     : LGPL-3
Maintainer  : dev@tpapak.com
Stability   : experimental
Portability : POSIX

Generators for d-dimensional cubic lattices with periodic boundary conditions
(toroidal topology).  A 'PBCSquareLattice' @L D@ is the Cartesian product of
@D@ cycle graphs of length @L@: \( C_L \square^D \).

Provides both directed ('graphCubicPBC', forward edges only) and undirected
('undirectedGraphCubicPBC', forward + backward edges) variants, plus coordinate
conversion between flat vertex IDs and Cartesian coordinates.
 -}

module Data.Graph.AdjacencyList.Grid
    ( L
    , D
    , CVertex
    , fromTuple
    , toTuple
    , adjacentEdges
    , vertexToCVertex
    , cVertexToVertex
    , PBCSquareLattice (..)
    , pbcEdgeIx
    , gridSize
    , gridNumEdges
    , pbcForwardEdges
    , pbcBackwardEdges
-- * Undirected cubic graph with PBC
    , undirectedGraphCubicPBC
-- * Directed cubic graph with PBC
    , graphCubicPBC
    ) where

import Data.List
import qualified Data.Map.Lazy as M
import Numeric.Natural

import Data.Graph.AdjacencyList

-- | Linear size of the lattice (number of vertices per dimension).
type L = Natural

-- | Dimensionality of the lattice (2 = square, 3 = cubic, etc.).
type D = Natural

-- | Cartesian coordinates of a lattice vertex: a list of per-dimension indices.
type CVertex = [Vertex]
data CEdge = CEdge CVertex CVertex -- ^ Cartesian representation of a Lattice Vertex

data Direction = Forward | Backward deriving (Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq, Eq Direction
Eq Direction =>
(Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Direction -> Direction -> Ordering
compare :: Direction -> Direction -> Ordering
$c< :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
>= :: Direction -> Direction -> Bool
$cmax :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
min :: Direction -> Direction -> Direction
Ord, Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
(Int -> ReadS Direction)
-> ReadS [Direction]
-> ReadPrec Direction
-> ReadPrec [Direction]
-> Read Direction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Direction
readsPrec :: Int -> ReadS Direction
$creadList :: ReadS [Direction]
readList :: ReadS [Direction]
$creadPrec :: ReadPrec Direction
readPrec :: ReadPrec Direction
$creadListPrec :: ReadPrec [Direction]
readListPrec :: ReadPrec [Direction]
Read, Direction
Direction -> Direction -> Bounded Direction
forall a. a -> a -> Bounded a
$cminBound :: Direction
minBound :: Direction
$cmaxBound :: Direction
maxBound :: Direction
Bounded, Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Direction -> Direction
succ :: Direction -> Direction
$cpred :: Direction -> Direction
pred :: Direction -> Direction
$ctoEnum :: Int -> Direction
toEnum :: Int -> Direction
$cfromEnum :: Direction -> Int
fromEnum :: Direction -> Int
$cenumFrom :: Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
Enum)

-- | A PBCSquareLattice is the Cartesian product of a cycle graph of length L
-- (C_L) => (C_L)▢^d
data PBCSquareLattice = PBCSquareLattice L D
instance Eq PBCSquareLattice where 
  == :: PBCSquareLattice -> PBCSquareLattice -> Bool
(==) (PBCSquareLattice D
la D
da) (PBCSquareLattice D
lb D
db) = 
    D
la D -> D -> Bool
forall a. Eq a => a -> a -> Bool
== D
la Bool -> Bool -> Bool
&& D
da D -> D -> Bool
forall a. Eq a => a -> a -> Bool
== D
db        
instance Show PBCSquareLattice where 
  show :: PBCSquareLattice -> String
show (PBCSquareLattice D
l D
d) = String
"Lattice: { \n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                  String
" L : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ D -> String
forall a. Show a => a -> String
show D
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                  String
" D : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ D -> String
forall a. Show a => a -> String
show D
d String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
" numVertices : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ D -> String
forall a. Show a => a -> String
show (D -> D -> D
gridN D
l D
d) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                      String
" numEdges : " String -> ShowS
forall a. [a] -> [a] -> [a]
++ D -> String
forall a. Show a => a -> String
show (PBCSquareLattice -> D
gridNumEdges (D -> D -> PBCSquareLattice
PBCSquareLattice D
l D
d))

-- | Undirected graph on a PBC cubic lattice (both forward and backward edges).
-- Contains @2 * D * L^D@ directed edges (two per neighbor pair).
undirectedGraphCubicPBC :: PBCSquareLattice -> Graph
undirectedGraphCubicPBC :: PBCSquareLattice -> Graph
undirectedGraphCubicPBC (PBCSquareLattice D
l D
d) = 
  let vs :: [Int]
vs = D -> D -> [Int]
gridVertices D
l D
d
      neis :: Int -> [Int]
neis = D -> D -> Int -> [Int]
pbcUndirectedNeighbors D
l D
d
   in [Int] -> (Int -> [Int]) -> Graph
createGraph [Int]
vs Int -> [Int]
neis

-- | Directed graph embeded in cubic lattice
graphCubicPBC :: PBCSquareLattice -> Graph
graphCubicPBC :: PBCSquareLattice -> Graph
graphCubicPBC (PBCSquareLattice D
l D
d) = 
  let vs :: [Int]
vs = D -> D -> [Int]
gridVertices D
l D
d
      neis :: Int -> [Int]
neis = D -> D -> Int -> [Int]
pbcDirectedNeighbors D
l D
d
   in [Int] -> (Int -> [Int]) -> Graph
createGraph [Int]
vs Int -> [Int]
neis

-- | Number of directed (forward) edges in the lattice: @D * L^D@.
gridNumEdges :: PBCSquareLattice -> Natural
gridNumEdges :: PBCSquareLattice -> D
gridNumEdges (PBCSquareLattice D
l D
d) = D
d D -> D -> D
forall a. Num a => a -> a -> a
* (D -> D -> D
gridN D
l D
d)

gridN :: L -> D -> Natural
gridN :: D -> D -> D
gridN D
l D
d = D
l D -> D -> D
forall a b. (Num a, Integral b) => a -> b -> a
^ D
d

-- | Total number of vertices in the lattice: @L^D@.
gridSize :: PBCSquareLattice -> Natural
gridSize :: PBCSquareLattice -> D
gridSize (PBCSquareLattice D
l D
d) =  D -> D -> D
gridN D
l D
d

gridVertices :: L -> D -> [Vertex]
gridVertices :: D -> D -> [Int]
gridVertices D
l D
d = [Int
1 .. (D -> Int
forall a. Enum a => a -> Int
fromEnum D
l Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ D -> Int
forall a. Enum a => a -> Int
fromEnum D
d)]

-- | Returns the next vertex of v in the d dimension for a grid of side l
pbcNeighbor :: Vertex -> L -> D -> Direction -> Vertex
pbcNeighbor :: Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
d Direction
r 
  | Direction
r Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Forward =
    if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$! Int -> D -> D -> Bool
isBoundary Int
v D
l D
d
      then Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ D -> D -> Int
innerOffset D
l D
d
      else Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ D -> D -> Int
pbcOffset D
l D
d 
  | Direction
r Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Backward =
    if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> D -> D -> Bool
isBoundary (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- D -> D -> Int
innerOffset D
l D
d) D
l D
d
      then Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- D -> D -> Int
innerOffset D
l D
d
      else Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- D -> D -> Int
pbcOffset D
l D
d
  where
    l' :: Int
l' = D -> Int
forall a. Enum a => a -> Int
fromEnum D
l
    d' :: Int
d' = D -> Int
forall a. Enum a => a -> Int
fromEnum D
d
    innerOffset :: L -> D -> Vertex
    innerOffset :: D -> D -> Int
innerOffset D
l D
d = Int
l'Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    pbcOffset :: L -> D -> Vertex
    pbcOffset :: D -> D -> Int
pbcOffset D
l D
d = - Int
l'Int -> D -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^D
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l'Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    isBoundary :: Vertex -> L -> D -> Bool
    isBoundary :: Int -> D -> D -> Bool
isBoundary Int
v D
l D
d = (Int
l'Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
d') Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
l'Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
l'Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^Int
d') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0

-- | Given vertex returns list of nearest neighboring vertices on a Toroidal Boundary Conditions (pbc) grid
pbcDirectedNeighbors :: L -> D -> Neighbors
pbcDirectedNeighbors :: D -> D -> Int -> [Int]
pbcDirectedNeighbors D
l D
d Int
v = (D -> Int) -> [D] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\D
d'-> Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
d' Direction
Forward) [D
1 .. D
d]

-- | Given vertex returns list of nearest neighboring vertices on a Toroidal Boundary Conditions (pbc) grid
pbcUndirectedNeighbors :: L -> D -> Vertex -> [Vertex]
pbcUndirectedNeighbors :: D -> D -> Int -> [Int]
pbcUndirectedNeighbors D
l D
d Int
v = (\Direction
r D
d'-> Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
d' Direction
r) 
  (Direction -> D -> Int) -> [Direction] -> [D -> Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Direction
Forward,Direction
Backward] [D -> Int] -> [D] -> [Int]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [D
1 .. D
d]

-- | Given a Vertex returns a tuple of the Cartesian product of a L sized Cycle graph
vertexToCVertex :: L -> D -> Vertex -> CVertex
vertexToCVertex :: D -> D -> Int -> [Int]
vertexToCVertex D
l' D
d' Int
v = do
  let cix :: a -> a -> b -> a
cix a
l a
n b
i = (a -> a -> a
forall a. Integral a => a -> a -> a
mod (a -> a -> a
forall a. Integral a => a -> a -> a
div (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) (a
la -> b -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(b
ib -> b -> b
forall a. Num a => a -> a -> a
-b
1))) a
l) a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
      out :: [Int]
out = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int -> Int
forall {a} {b}. (Integral a, Integral b) => a -> a -> b -> a
cix Int
l Int
v) [Int
1 .. Int
d]
  [Int]
out
  where l :: Int
l = D -> Int
forall a. Enum a => a -> Int
fromEnum D
l'
        d :: Int
d = D -> Int
forall a. Enum a => a -> Int
fromEnum D
d'

-- | The reverse function of vertexToCVertex
cVertexToVertex :: L -> D -> CVertex -> Vertex
cVertexToVertex :: D -> D -> [Int] -> Int
cVertexToVertex D
l' D
d' [Int]
cv = do
  (((Int, Int) -> Int -> Int) -> Int -> [(Int, Int)] -> Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\t :: (Int, Int)
t@(Int
i,Int
x)-> Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ((Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
lInt -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)))) Int
0 ([(Int, Int)] -> Int) -> [(Int, Int)] -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 .. Int
d] [Int]
cv) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  where l :: Int
l = D -> Int
forall a. Enum a => a -> Int
fromEnum D
l'
        d :: Int
d = D -> Int
forall a. Enum a => a -> Int
fromEnum D
d'

-- | Gives Forward vertex in a cycle graph of length L
forwardVertexInCycle :: L -> Vertex -> Vertex
forwardVertexInCycle :: D -> Int -> Int
forwardVertexInCycle D
l' Int
v
  | Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l = Int
1
  | Bool
otherwise = Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  where l :: Int
l = D -> Int
forall a. Enum a => a -> Int
fromEnum D
l'

-- | Gives Forward vertex in a cycle graph of length L
backwardVertexInCycle :: L -> Vertex -> Vertex
backwardVertexInCycle :: D -> Int -> Int
backwardVertexInCycle D
l' Int
v
  | Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int
l
  | Bool
otherwise = Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  where l :: Int
l = D -> Int
forall a. Enum a => a -> Int
fromEnum D
l'

-- | Given two edges returns if they belong to the lattice
isEdgeInCycle :: L -> Edge -> Bool
isEdgeInCycle :: D -> Edge -> Bool
isEdgeInCycle D
l' (Edge Int
a Int
b)
  | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 = Bool
True
  | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = Bool
True
  | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Bool
True
  | Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l Bool -> Bool -> Bool
&& Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Bool
True
  | Bool
otherwise = Bool
False
  where l :: Int
l = D -> Int
forall a. Enum a => a -> Int
fromEnum D
l'

-- | Returns tuple (edge) giving forward vertices of given vertex on a Toroidal Boundary Conditions (pbc) grid
pbcForwardEdges :: L -> D -> Vertex -> [Edge]
pbcForwardEdges :: D -> D -> Int -> [Edge]
pbcForwardEdges D
l D
d Int
v = (D -> Edge) -> [D] -> [Edge]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\D
d -> Int -> Int -> Edge
Edge Int
v (Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
d Direction
Forward)) [D
1 .. D
d]

-- | Returns tuple (edge) giving backward vertices of given vertex on a Toroidal Boundary Conditions (pbc) grid
pbcBackwardEdges :: L -> D -> Vertex -> [Edge]
pbcBackwardEdges :: D -> D -> Int -> [Edge]
pbcBackwardEdges D
l D
d Int
v = (D -> Edge) -> [D] -> [Edge]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\D
d -> Int -> Int -> Edge
Edge Int
v (Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
d Direction
Backward)) [D
1 .. D
d]

pbcUndirectedEdges :: L -> D -> [Edge]
pbcUndirectedEdges :: D -> D -> [Edge]
pbcUndirectedEdges D
l D
d = 
  let nei :: Int -> [Edge]
nei Int
v = 
        ([Edge] -> D -> [Edge]) -> [Edge] -> [D] -> [Edge]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' 
          (\[Edge]
ac D
d -> [Edge]
ac [Edge] -> [Edge] -> [Edge]
forall a. [a] -> [a] -> [a]
++
              [ Int -> Int -> Edge
Edge Int
v (Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
d Direction
Forward)
              , Int -> Int -> Edge
Edge Int
v (Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
d Direction
Backward)
              ]
          )[] [D
1 .. D
d]
   in (Int -> [Edge] -> [Edge]) -> [Edge] -> [Int] -> [Edge]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int
v [Edge]
ac -> (Int -> [Edge]
nei Int
v) [Edge] -> [Edge] -> [Edge]
forall a. [a] -> [a] -> [a]
++ [Edge]
ac) [] ([Int] -> [Edge]) -> [Int] -> [Edge]
forall a b. (a -> b) -> a -> b
$ D -> D -> [Int]
gridVertices D
l D
d

-- | Returns tuple (edge) giving forward and backward vertices of given vertex on a Toroidal Boundary Conditions (pbc) grid
pbcAdjacentEdges :: L -> D -> Vertex -> [Edge]
pbcAdjacentEdges :: D -> D -> Int -> [Edge]
pbcAdjacentEdges D
l D
d Int
v = (\Direction
r D
d -> 
  case Direction
r of Direction
Forward ->  Int -> Int -> Edge
Edge Int
v (Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
d Direction
r)
            Direction
Backward -> Int -> Int -> Edge
Edge (Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
d Direction
r) Int
v
  ) 
  (Direction -> D -> Edge) -> [Direction] -> [D -> Edge]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Direction
Forward,Direction
Backward] [D -> Edge] -> [D] -> [Edge]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [D
1 .. D
d]

-- | List of edges of grid with periodic boundary conditions
pbcDirectedEdges :: L -> D -> [Edge]
pbcDirectedEdges :: D -> D -> [Edge]
pbcDirectedEdges D
l D
d = (\Int
v D
j-> Int -> Int -> Edge
Edge Int
v (Int -> D -> D -> Direction -> Int
pbcNeighbor Int
v D
l D
j Direction
Forward)) (Int -> D -> Edge) -> [Int] -> [D -> Edge]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> D -> D -> [Int]
gridVertices D
l D
d [D -> Edge] -> [D] -> [Edge]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [D
1 .. D
d]

-- | Index of edge of a grid with periodic boundary conditions
-- Very inefficient, better use Data.Map for lookups.
pbcEdgeIx :: L -> D -> Edge -> Maybe Int
pbcEdgeIx :: D -> D -> Edge -> Maybe Int
pbcEdgeIx D
l D
d Edge
e = do
  let Edge Int
s Int
t = Edge
e
      a :: [Int]
a = D -> D -> Int -> [Int]
vertexToCVertex D
l D
d Int
s
      b :: [Int]
b = D -> D -> Int -> [Int]
vertexToCVertex D
l D
d Int
t
      (((Int
a',Int
b'),Int
di),Int
dist) = CEdge -> (((Int, Int), Int), Int)
diff ([Int] -> [Int] -> CEdge
CEdge [Int]
a [Int]
b)
  case Int
dist Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 of
    Bool
True -> case D -> Int -> Int
forwardVertexInCycle D
l Int
a' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b' of
              Bool
True -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
di
              Bool
False -> Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ((Int
tInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
d') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
di
    Bool
False -> Maybe Int
forall a. Maybe a
Nothing
  where
    d' :: Int
d' = D -> Int
forall a. Enum a => a -> Int
fromEnum D
d
    step :: (((b, b), b), b) -> ((b, b), b) -> (((b, b), b), b)
step (((b
a',b
b'),b
di'), b
ds) ((b
s,b
t),b
di)
      | b
s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
t = (((b
a',b
b'),b
di'), b
ds)
      | b
s b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
t = (((b
s,b
t),b
di), b
dsb -> b -> b
forall a. Num a => a -> a -> a
+b
1)
    diff :: CEdge -> (((Vertex,Vertex),Int),Int)
    diff :: CEdge -> (((Int, Int), Int), Int)
diff (CEdge [Int]
a [Int]
b) = ((((Int, Int), Int), Int)
 -> ((Int, Int), Int) -> (((Int, Int), Int), Int))
-> (((Int, Int), Int), Int)
-> [((Int, Int), Int)]
-> (((Int, Int), Int), Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Int, Int), Int), Int)
-> ((Int, Int), Int) -> (((Int, Int), Int), Int)
forall {b} {b} {b}.
(Eq b, Num b) =>
(((b, b), b), b) -> ((b, b), b) -> (((b, b), b), b)
step (((Int
0,Int
0),Int
0),Int
0) ([((Int, Int), Int)] -> (((Int, Int), Int), Int))
-> [((Int, Int), Int)] -> (((Int, Int), Int), Int)
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> [Int] -> [((Int, Int), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
a [Int]
b) [Int
1..Int
d']