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
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'))
kFilteredMorphisms :: Int -> Morphisms -> Morphisms
kFilteredMorphisms k mors = M.filter (not . S.null)
. mapWithKey (\g x -> S.filter (\y -> kDrop' g y <= k) x)
$ mors
whoHasPsi :: AlgGen -> Morphisms -> Set AlgGen
whoHasPsi psi' mors = S.fromList
. filter (\g -> psi' `member` (mors ! g)) $ keys mors
kWhoHasPsi :: Int -> AlgGen -> Morphisms -> Set AlgGen
kWhoHasPsi k psi' = S.filter (\g -> kgrade' g <= kgrade' psi' + k)
. whoHasPsi psi'
soloArrow :: AlgGen -> Morphisms -> Bool
soloArrow g mors = S.size (mors ! g) == 1
psiKillers :: AlgGen -> Morphisms -> Set AlgGen
psiKillers psi' mors = S.filter (`soloArrow` mors) . whoHasPsi psi' $ mors
kPsiKillers :: Int -> AlgGen -> Morphisms -> Set AlgGen
kPsiKillers k psi' = S.filter (\g -> kgrade' g <= kgrade' psi' + k) . psiKillers 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
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
kSimplifyComplex :: Int -> AlgGen -> Morphisms -> Morphisms
kSimplifyComplex k psi' mors = foldl (\mor k' -> kSimplify k' psi' mor) mors [0,2..k] where
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