{-|
Module      : Braids
Description : All the topology is here.
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]}

-- | 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}