braid-0.1.0.0: src/Complex.hs

{-|
Module      : Complex
Description : Mod 2 vector space.
Copyright   : Adam Saltz
License     : BSD3
Maintainer  : saltz.adam@gmail.com
Stability   : experimental

Longer description to come.
-}

module Complex 
(   Generator(..),
    Sign(..),
    signToNum,
    AlgGen(..),
    wrapGen,
    toSet,
    Morphisms,
    addMod2,
    addMod2Set,
    addMod2Map,
    addToKey,
    fromTo        )
where
import Braids
import Data.Set (Set)
import qualified Data.Set as S
import Data.Map (Map, (!))
import qualified Data.Map as M
import Data.Monoid

{- | A 'Generator' is a 'Set' of 'Components' labled with 'Sign's.  Strictly speaking, we could make do
 without components, as @components = Data.Set.fromList . Data.Map.keys $ signs@.
 kgrade depends totally on signs, so it should be taken out too. -}

data Generator = Generator { resolution :: Resolution
               , components :: Set Component
               , signs :: Map Component Sign
               , kgrade :: Int}
               deriving (Eq, Ord, Show)


-- | These stand for v_+ and v_- in Khovanov homology.  We could include some more algebra here, but
-- | for now I don't see a reason to.
data Sign = Plus | Minus deriving (Eq, Show, Ord)

signToNum :: Sign -> Int
signToNum Plus = 1
signToNum Minus = (-1)

-- | Stands for sums of generators modulo 2.  'wrapGen' wraps a single generator.
-- | Should be a type synonym instead?
-- | This is something like an implementation of mod 2 vector spaces.  Could this be done better with vector-spaces or linear?
newtype AlgGen = AlgGen (Set Generator) deriving (Show, Ord, Eq)

wrapGen :: Generator -> AlgGen
wrapGen  = AlgGen . S.singleton

toSet :: AlgGen -> Set Generator
toSet (AlgGen s) = s

instance Monoid AlgGen where
    mempty = AlgGen S.empty
    mappend (AlgGen s) (AlgGen s') = AlgGen (addMod2Set s s')

-- | 'Morphisms' is a map from (a linear combination of) 'Generator's to a set of (linear combinations of) 'Generator's.
type Morphisms = Map AlgGen (Set AlgGen)

-- | Generates all arrows from elements of @s@ to elements of @s'@ with the latter wrapped as singleton `Set`s.
-- This is purely algebraic -- the function doesn't check if their ought to be any such arrows.
fromTo :: Set AlgGen -> Set AlgGen -> [(AlgGen, Set AlgGen)]
fromTo s s' = [(x,S.singleton y) | x <- S.toList s, y <- S.toList s']

-- | The next three functions implement mod 2 addition at the level of 'Set's and 'Map's.
addMod2 :: (Eq a, Ord a) => a -> Set a -> Set a
addMod2 b set = if S.member b set then S.delete b set else S.insert b set

addMod2Set :: (Eq a, Ord a) => Set a -> Set a -> Set a
addMod2Set bs set = S.foldr addMod2 set bs 

addMod2Map :: (Ord a, Ord k) => Map k (Set a) -> Map k (Set a) -> Map k (Set a)
addMod2Map x y = M.filter (not . S.null) (M.unionWith addMod2Set x y)

-- | Adds a x to the key key (but only if key is a key of mors).
addToKey :: (Ord k, Monoid k, Monoid a) => k -> k -> Map k a -> Map k a
addToKey x key mors = if key `M.member` mors 
                      then   M.insert (x <> key) (mors ! key)
                           . M.delete key
                           $ mors
                      else mors