-- 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