{-| Module : Kappa Description : Functions to compute kappa. Copyright : Adam Saltz License : BSD3 Maintainer : saltz.adam@gmail.com Stability : experimental Longer description to come. -} module Kappa where import Cancellation import Kh import Complex import Braids import Data.Map (Map, (!)) import qualified Data.Map as M import Data.Set (Set) import qualified Data.Set as S import Control.Arrow (second) import Data.List (find) -- | Return @(Maybe kappa, Maybe the simplified complex)@. computeKappa' :: Braid -> Maybe (Int, Morphisms) computeKappa' braid = fmap (second (M.filter ((S.singleton . wrapGen . psi \$ braid) ==))) . find (\(k, c) -> kDoesPsiVanish k psi' c) \$ fmap (\k -> (k, kSimplifyComplex k psi' morphisms )) [0,2..2*braidWidth braid] where morphisms = M.unionsWith S.union . fmap (filteredComplexLevel (2*braidWidth braid) gens) \$ [0..(1 + length (braidWord braid))] :: Morphisms gens = khovanovComplex (braidWidth braid) (psiCube braid) :: Map Int (Set Generator) psi' = wrapGen (psi braid) :: AlgGen -- | Returns @Just kappa@ if kappa is finite. Otherwise, returns @Nothing@. computeKappa :: Braid -> Maybe Int computeKappa braid = case computeKappa' braid of Nothing -> Nothing Just (kap, _) -> Just kap {- computeReducedKappa :: Braid -> Int -> (Maybe Int, Maybe (Writer Cancellations Morphisms)) computeReducedKappa braid m = maybeTuple . find (\(k, c) -> isKappaK k psi' . fst . runWriter \$ c) \$ map (\k -> (k, kSimplifyComplex k psi' morphisms )) [0,2..2*braidWidth braid] where morphisms = M.unionsWith S.union . fmap (filteredComplexLevel (2*braidWidth braid) gens) \$ [0..(1 + length (braidWord braid))] gens = reducedKhovanovComplex m (braidWidth braid) (psiCube braid) psi' = psi braid computeQuotientKappa :: Braid -> Int -> (Maybe Int, Maybe (Writer Cancellations Morphisms)) computeQuotientKappa braid m = first (fmap (+2)) . maybeTuple . find (\(k, c) -> isKappaK k psi' . fst . runWriter \$ c) \$ map (\k -> (k, kSimplifyComplex k psi' morphisms )) [0,2..2*braidWidth braid] where morphisms = M.unionsWith S.union . fmap (filteredComplexLevel (2*braidWidth braid) gens) \$ [0..(1 + length (braidWord braid))] gens = quotientKhovanovComplex m (braidWidth braid) (psiCube braid) psi' = quotPsi braid m computeKappaNum :: Braid -> Maybe Int computeKappaNum = fst . computeKappa computeReducedKappaNum :: Braid -> Int -> Maybe Int computeReducedKappaNum b m = fst \$ computeReducedKappa b m computeQuotientKappaNum :: Braid -> Int -> Maybe Int computeQuotientKappaNum b m = fst \$ computeQuotientKappa b m computeKappaComplex :: Braid -> Maybe (Writer Cancellations Morphisms) computeKappaComplex = snd . computeKappa wordProblem :: Braid -> Bool wordProblem b = (computeKappaNum b == Just 2) && (computeKappaNum (mirror b) == Just 2) -}