{-|
Module      : Braids
Description : All the topology is here.
Copyright   : Adam Saltz
License     : BSD3
Maintainer  : saltz.adam@gmail.com
Stability   : experimental

Longer description to come.
-}
{-# LANGUAGE FlexibleInstances, DataKinds, DeriveFoldable, DeriveDataTypeable #-}
module Braids 
( Braid(..),
  Node(..),
  Resolution,
  Component,
  BDiagram(..),
  braidToPD,
  crossingToNodes,
  resolve,
  resolutions,
  resolutionToComponents,
  cubeOfResolutions,
  braidCube,
  mirror,
  allRes
)
where
import Data.Graph as Graph
import Data.List
import Data.Tree as Tree
import Data.Typeable (Typeable)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Foldable as F 

-- | A 'Braid' is a width and word.
-- Integers in the word represent Artin generators and their invereses.  E.g. @[1,3,-2]@ represents the word \sigma_1\sigma_3\sigma_2^{-1}.
data Braid = Braid { braidWidth :: Int
                   , braidWord :: [Int]}
                   deriving (Eq, Show, Read)

-- | Returns the mirror of @b@.
mirror :: Braid -> Braid
mirror b = Braid {braidWidth = braidWidth b,
                  braidWord  = mirror' (braidWord b) } where
                    mirror' :: [Int] -> [Int]
                    mirror' = fmap (* (-1)) . reverse

-- | A braid can also be written as a collection of 'Node's.  See knotatlas for more info on 'Cross' and 'Join'.
data Node a = Cross a a a a | Join a a
    deriving (Show, Read, Ord, F.Foldable, Typeable, Eq)

-- | A 'PD' (Planar BDiagram) is a collection of 'Node's.
type PD = [Node Int]

-- | A 'Resolution' is a collection of integers.  These should all be 0 or 1.  At some point I will change this to
-- @type Resolution = [Resolution']@ and @data Resolution' = One | Zero deriving (Show, Eq, Ord)@ or somesuch.
type Resolution = [Int] -- change to [Resolution']

-- | A `Component` is represented by a set of integer labels for its arcs.
type Component = Set Int

-- | A resolved 'BDiagram' has a 'Resolution' and a set of 'Component's.
data BDiagram = BDiagram { resolution' :: Resolution
                         , components' :: Set Component}
                         deriving (Eq, Show)

-- | Turn a 'Braid' into a 'PD'.
braidToPD :: Braid -> PD
braidToPD braid = concat [crossingToNodes c (braidWidth braid) d | (c,d) <- zip word [1..]] 
                         ++ [Join a (a + len * braidWidth braid) | a<-[1..(braidWidth braid)]] 
                         where
    word = braidWord braid
    len  = length . braidWord $ braid

-- | Turn a crossing into a 'Node'.
crossingToNodes :: Int -> Int -> Int -> [Node Int]
crossingToNodes crossing width level = concatMap toNode [initial..(initial + width - 1)] where
    initial = 1 + (level - 1)*width
    --range = [initial..(initial + width - 1)]
    cAfter = abs crossing + initial - 1
    toNode :: Int -> [Node Int]
    toNode k | k == cAfter && crossing < 0      = [Cross (k+1) k (k + width) (k + width + 1)]
    toNode k | k == cAfter && crossing > 0      = [Cross k (k + width) (k + width + 1) (k+1)]
    toNode k | k == cAfter + 1                  = []
    toNode k | otherwise                        = [Join k (k + width)]

isCross :: Node Int -> Bool
isCross n = case n of
    Cross{} -> True
    Join{}  -> False

-- | Utility function to return all the resolutions of a planar diagram.  This amounts to all sequences of 0s and 1s of some length.
allRes :: PD -> [Resolution]
allRes pd = sequence binary where
    binary = replicate (length $ filter isCross pd)  [0,1]

-- | Take a 'PD' and a 'Resolution' and returns the resolved 'PD'.  
-- Note that the output is always a list of 'Join's.
resolve :: PD -> Resolution -> PD
resolve (Join a b : ns ) res = Join a b : resolve ns res
resolve (Cross a b c d:ns) (r:res) | r == 0     = [Join a b, Join c d] ++ resolve ns res
                                   | r == 1     = [Join a d, Join b c] ++ resolve ns res
resolve [] _ = []
resolve x _ = x

-- | Compute all resolutions of a 'PD'.
resolutions :: PD -> [PD]
resolutions pd = map (($ pd) . flip resolve) (allRes pd)

-- | This is the only use for "Data.Graph".
resolutionToComponents :: PD -> Set Component
resolutionToComponents pd = Set.fromList . fmap Set.fromList . map (sort . Tree.flatten) $ Graph.components resAsGraph where
    graphAsList = [(v,vs) | v <- allArcs pd, vs <- delete v $ allArcs $ connectedTo v pd]
    resAsGraph = Graph.buildG (minArc pd, maxArc pd) graphAsList

    maxArc :: PD -> Int
    maxArc [] = 0
    maxArc pd' = maximum $ map F.maximum pd' where
        
    minArc :: PD -> Int
    minArc [] = 0
    minArc pd' = minimum $ map F.minimum pd' where
        
    allArcs :: [Node Int] -> [Int]
    allArcs  = nub . concatMap F.toList

    connectedTo :: Int -> [Node Int] -> [Node Int]
    connectedTo a' = filter (a' `F.elem`) where


-- | Take a 'PD' and returns a list of all the 'BDiagram's of its 'Resolution's.
cubeOfResolutions :: PD -> [BDiagram]
cubeOfResolutions pd = [BDiagram {resolution' = res, components' = comps res} | res <- allRes pd] where
    comps res = resolutionToComponents $ resolve pd res 

-- | The total cube of resolutions for a braid.
braidCube :: Braid -> [BDiagram]
braidCube b = do
    res <- allRes . braidToPD $ b
    let diagram res' = resolutionToComponents . resolve (braidToPD b) $ res' 
    return BDiagram {resolution' = res, components' = diagram res}