    -- Copyright (c) David Amos, 2008. All rights reserved.

    {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

    module Math.Projects.KnotTheory.Braid where

    import Data.List ( (\\) )

    import Math.Algebra.Field.Base
    import Math.Algebra.NonCommutative.NCPoly

    import Math.Projects.KnotTheory.LaurentMPoly

    type LPQ = LaurentMPoly Q

    instance Invertible LPQ where
        inv :: LPQ -> LPQ
    inv = LPQ -> LPQ
    forall a. Fractional a => a -> a
    recip

    -- BRAID ALGEBRA

    data BraidGens = S Int deriving (BraidGens -> BraidGens -> Bool
    (BraidGens -> BraidGens -> Bool)
    -> (BraidGens -> BraidGens -> Bool) -> Eq BraidGens
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: BraidGens -> BraidGens -> Bool
    $c/= :: BraidGens -> BraidGens -> Bool
    == :: BraidGens -> BraidGens -> Bool
    $c== :: BraidGens -> BraidGens -> Bool
    Eq,Eq BraidGens
    Eq BraidGens =>
    (BraidGens -> BraidGens -> Ordering)
    -> (BraidGens -> BraidGens -> Bool)
    -> (BraidGens -> BraidGens -> Bool)
    -> (BraidGens -> BraidGens -> Bool)
    -> (BraidGens -> BraidGens -> Bool)
    -> (BraidGens -> BraidGens -> BraidGens)
    -> (BraidGens -> BraidGens -> BraidGens)
    -> Ord BraidGens
    BraidGens -> BraidGens -> Bool
    BraidGens -> BraidGens -> Ordering
    BraidGens -> BraidGens -> BraidGens
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: BraidGens -> BraidGens -> BraidGens
    $cmin :: BraidGens -> BraidGens -> BraidGens
    max :: BraidGens -> BraidGens -> BraidGens
    $cmax :: BraidGens -> BraidGens -> BraidGens
    >= :: BraidGens -> BraidGens -> Bool
    $c>= :: BraidGens -> BraidGens -> Bool
    > :: BraidGens -> BraidGens -> Bool
    $c> :: BraidGens -> BraidGens -> Bool
    <= :: BraidGens -> BraidGens -> Bool
    $c<= :: BraidGens -> BraidGens -> Bool
    < :: BraidGens -> BraidGens -> Bool
    $c< :: BraidGens -> BraidGens -> Bool
    compare :: BraidGens -> BraidGens -> Ordering
    $ccompare :: BraidGens -> BraidGens -> Ordering
    $cp1Ord :: Eq BraidGens
    Ord)
    -- Inverse of S n is S (-n)

    instance Show BraidGens where
        show :: BraidGens -> String
    show (S i :: Int
    i) | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 = 's'Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    i
                   | Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 = 's'Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show (-Int
    i) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "'"

    s_ :: Int -> NPoly LPQ BraidGens
    s_ i :: Int
    i = [(Monomial BraidGens, LPQ)] -> NPoly LPQ BraidGens
    forall r v. [(Monomial v, r)] -> NPoly r v
    NP [([BraidGens] -> Monomial BraidGens
    forall v. [v] -> Monomial v
    M [Int -> BraidGens
    S Int
    i], 1)] :: NPoly LPQ BraidGens

    s1 :: NPoly LPQ BraidGens
    s1 = Int -> NPoly LPQ BraidGens
    s_ 1
    s2 :: NPoly LPQ BraidGens
    s2 = Int -> NPoly LPQ BraidGens
    s_ 2
    s3 :: NPoly LPQ BraidGens
    s3 = Int -> NPoly LPQ BraidGens
    s_ 3
    s4 :: NPoly LPQ BraidGens
    s4 = Int -> NPoly LPQ BraidGens
    s_ 4

    instance Invertible (NPoly LPQ BraidGens) where
        inv :: NPoly LPQ BraidGens -> NPoly LPQ BraidGens
    inv (NP [(M [S i :: Int
    i], 1)]) = Int -> NPoly LPQ BraidGens
    s_ (-Int
    i)

    {-
    braidRelations n =
        [s_ j * s_ i - s_ i * s_ j | i <- [1..n-1], j <- [i+2..n-1] ] ++
        [s_ (i+1) * s_ i * s_ (i+1) - s_ i * s_ (i+1) * s_ i | i <- [1..n-2] ]
    -- !! need relations for the inverses too !!
    -- (but we're not intending to work in the braid algebra - we're intending to map into Temperley-Lieb or Iwahori-Hecke)
    -}

    -- The writhe of a braid == the sum of the signs of the crossings

    writhe :: NPoly r BraidGens -> Int
    writhe (NP [(M xs :: [BraidGens]
    xs,c :: r
    c)]) = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Int -> Int
    forall a. Num a => a -> a
    signum Int
    i | S i :: Int
    i <- [BraidGens]
    xs]

    -- Some knots - Lickorish p5, p27

    -- (Note: These knots/braids give the correct Homfly/Jones polynomials compared to Lickorish)

    -- (In general, that's not sufficient to prove that they are the claimed knots, although in these cases, they are.)

    k3_1 :: NPoly LPQ BraidGens
    k3_1 = NPoly LPQ BraidGens
    s1NPoly LPQ BraidGens -> Integer -> NPoly LPQ BraidGens
    forall b a. (Integral b, Invertible a, Num a) => a -> b -> a
    ^-3
    k4_1 :: NPoly LPQ BraidGens
    k4_1 = NPoly LPQ BraidGens
    s2NPoly LPQ BraidGens -> Integer -> NPoly LPQ BraidGens
    forall b a. (Integral b, Invertible a, Num a) => a -> b -> a
    ^-1 NPoly LPQ BraidGens -> NPoly LPQ BraidGens -> NPoly LPQ BraidGens
    forall a. Num a => a -> a -> a
    * NPoly LPQ BraidGens
    s1 NPoly LPQ BraidGens -> NPoly LPQ BraidGens -> NPoly LPQ BraidGens
    forall a. Num a => a -> a -> a
    * NPoly LPQ BraidGens
    s2NPoly LPQ BraidGens -> Integer -> NPoly LPQ BraidGens
    forall b a. (Integral b, Invertible a, Num a) => a -> b -> a
    ^-1 NPoly LPQ BraidGens -> NPoly LPQ BraidGens -> NPoly LPQ BraidGens
    forall a. Num a => a -> a -> a
    * NPoly LPQ BraidGens
    s1
    k5_1 :: NPoly LPQ BraidGens
    k5_1 = NPoly LPQ BraidGens
    s1NPoly LPQ BraidGens -> Integer -> NPoly LPQ BraidGens
    forall b a. (Integral b, Invertible a, Num a) => a -> b -> a
    ^-5
    k7_1 :: NPoly LPQ BraidGens
    k7_1 = NPoly LPQ BraidGens
    s1NPoly LPQ BraidGens -> Integer -> NPoly LPQ BraidGens
    forall b a. (Integral b, Invertible a, Num a) => a -> b -> a
    ^-7