braid-0.1.0.0: src/Cancellation.hs

{-|
Module      : Cancellation
Description : Implements the "cancellation lemma".  Most of the work to compute kappa is here.
Copyright   : Adam Saltz
License     : BSD3
Maintainer  : saltz.adam@gmail.com
Stability   : experimental

Longer description to come.
-}

module Cancellation
( kFilteredMorphisms,
  whoHasPsi,
  kWhoHasPsi,
  psiKillers,
  kPsiKillers,
  cancelKey,
  kSimplify,
  kSimplifyComplex,
  kDoesPsiVanish
    )
where
import Complex
import Util
import Kh
import Data.Set (member, Set)
import qualified Data.Set as S
import Data.Map.Strict ((!), mapWithKey, keys)
import qualified Data.Map as M

-- | Return the complex simplified at (g,g')
simplifyEdgeGraph :: (AlgGen, AlgGen) -> Morphisms -> Morphisms
simplifyEdgeGraph (g,g') mors =   addMod2Map (changeBasis g newArrows)
                                . changeBasis g 
                                . deleteEdge (g,g') 
                                $ mors where
                fromG = S.delete g' $ mors ! g :: Set AlgGen
                toG'  = S.fromList . M.keys . M.delete g . M.filter (S.member g') $ mors :: Set AlgGen
                newArrows = M.fromListWith addMod2Set (toG' `fromTo` fromG)  :: Morphisms
                deleteEdge :: (AlgGen, AlgGen) -> Morphisms -> Morphisms
                deleteEdge (h,h') mors' =    fmap (S.delete h) 
                                           . M.delete h 
                                           . fmap (S.delete h') 
                                           . M.delete h' 
                                           $ mors' :: Morphisms
                changeBasis x = compose (fmap (addToKey x) (S.toList toG')) 

-- | Compute all morphisms which change the k-grading by less than k.
kFilteredMorphisms :: Int -> Morphisms -> Morphisms
kFilteredMorphisms k mors = M.filter (not . S.null) 
                            . mapWithKey (\g x -> S.filter (\y -> kDrop' g y <= k) x) 
                            $ mors

-- | Compute all 'Generator's which map to psi'.
whoHasPsi :: AlgGen -> Morphisms -> Set AlgGen
whoHasPsi psi' mors =   S.fromList 
                      . filter (\g -> psi' `member` (mors ! g)) $ keys mors

-- | Compute all 'Generator's which map to psi' with 'kDrop' less than k.
-- (I've tried to stick to this pattern throughout: the k-version of a function just filters by kDrop.)
kWhoHasPsi :: Int -> AlgGen -> Morphisms -> Set AlgGen
kWhoHasPsi k psi' =   S.filter (\g -> kgrade' g <= kgrade' psi' + k) 
                    . whoHasPsi psi'

-- | 'True' if and only if the 'Generator' is the source of a single arrow.
soloArrow :: AlgGen -> Morphisms -> Bool
soloArrow g mors = S.size (mors ! g) == 1

-- | Determine which generators have single arrows to psi'.
psiKillers :: AlgGen -> Morphisms -> Set AlgGen
psiKillers psi' mors = S.filter (`soloArrow` mors) . whoHasPsi psi' $ mors

-- | Same as `psiKillers` but only checks for arrows which shift the filtration by @k@ or less.
kPsiKillers :: Int -> AlgGen -> Morphisms -> Set AlgGen
kPsiKillers k psi' = S.filter (\g -> kgrade' g <= kgrade' psi' + k) . psiKillers psi'

-- | Cancel g in mors while dodging psi'.
cancelKey :: AlgGen -> Morphisms -> AlgGen -> Morphisms
cancelKey psi' mors g = let targets' = M.lookup g mors in 
  case targets' of 
    Nothing -> mors
    Just targets -> if S.null targets || targets == S.singleton psi'
      then mors
      else simplifyEdgeGraph (g, head . S.toList . S.delete psi' $ targets) mors
        
-- | Simplify the complex at filtration k while dodging psi'
-- Uses the Writer monad to keep track of what's canceled (but that information isn't used, presently)
kSimplify :: Int -> AlgGen -> Morphisms -> Morphisms
kSimplify k psi' mors | null . kWhoHasPsi k psi' $ mors                   = mors
                      | kWhoHasPsi k psi' mors == kPsiKillers k psi' mors = mors
                      | otherwise                                         = kSimplify k psi' mors' where 
                                    g = head . S.toList $ (kWhoHasPsi k psi' mors S.\\ kPsiKillers k psi' mors)
                                    mors' = cancelKey psi' mors g

-- | Simplify the complex up to filtration k while dodging psi'.
kSimplifyComplex :: Int -> AlgGen -> Morphisms -> Morphisms
kSimplifyComplex k psi' mors = foldl (\mor k' -> kSimplify k' psi' mor) mors [0,2..k] where
  
-- | Test whether psi' dies at filtration k.
kDoesPsiVanish :: Int -> AlgGen -> Morphisms -> Bool
kDoesPsiVanish k psi' mors = any (`soloArrow` mors) . S.filter rightK . whoHasPsi psi' $ mors where 
  rightK g = kgrade' g - kgrade' psi' <= k