braid-0.1.0.0: src/Kappa.hs

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