{-# LANGUAGE FlexibleInstances #-}
module Math.Projects.KnotTheory.TemperleyLieb where
import Data.List ( (\\) )
import Math.Algebra.Field.Base
import Math.Algebra.NonCommutative.NCPoly as NP
import Math.Algebra.NonCommutative.GSBasis
import Math.Projects.KnotTheory.LaurentMPoly as LP
import Math.Projects.KnotTheory.Braid
data TemperleyLiebGens = E Int deriving (TemperleyLiebGens -> TemperleyLiebGens -> Bool
(TemperleyLiebGens -> TemperleyLiebGens -> Bool)
-> (TemperleyLiebGens -> TemperleyLiebGens -> Bool)
-> Eq TemperleyLiebGens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
$c/= :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
== :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
$c== :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
Eq,Eq TemperleyLiebGens
Eq TemperleyLiebGens =>
(TemperleyLiebGens -> TemperleyLiebGens -> Ordering)
-> (TemperleyLiebGens -> TemperleyLiebGens -> Bool)
-> (TemperleyLiebGens -> TemperleyLiebGens -> Bool)
-> (TemperleyLiebGens -> TemperleyLiebGens -> Bool)
-> (TemperleyLiebGens -> TemperleyLiebGens -> Bool)
-> (TemperleyLiebGens -> TemperleyLiebGens -> TemperleyLiebGens)
-> (TemperleyLiebGens -> TemperleyLiebGens -> TemperleyLiebGens)
-> Ord TemperleyLiebGens
TemperleyLiebGens -> TemperleyLiebGens -> Bool
TemperleyLiebGens -> TemperleyLiebGens -> Ordering
TemperleyLiebGens -> TemperleyLiebGens -> TemperleyLiebGens
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 :: TemperleyLiebGens -> TemperleyLiebGens -> TemperleyLiebGens
$cmin :: TemperleyLiebGens -> TemperleyLiebGens -> TemperleyLiebGens
max :: TemperleyLiebGens -> TemperleyLiebGens -> TemperleyLiebGens
$cmax :: TemperleyLiebGens -> TemperleyLiebGens -> TemperleyLiebGens
>= :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
$c>= :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
> :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
$c> :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
<= :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
$c<= :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
< :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
$c< :: TemperleyLiebGens -> TemperleyLiebGens -> Bool
compare :: TemperleyLiebGens -> TemperleyLiebGens -> Ordering
$ccompare :: TemperleyLiebGens -> TemperleyLiebGens -> Ordering
$cp1Ord :: Eq TemperleyLiebGens
Ord)
instance Show TemperleyLiebGens where
show :: TemperleyLiebGens -> String
show (E i :: Int
i) = 'e'Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i
e_ :: Int -> NPoly LPQ TemperleyLiebGens
e_ i :: Int
i = [(Monomial TemperleyLiebGens, LPQ)] -> NPoly LPQ TemperleyLiebGens
forall r v. [(Monomial v, r)] -> NPoly r v
NP [([TemperleyLiebGens] -> Monomial TemperleyLiebGens
forall v. [v] -> Monomial v
M [Int -> TemperleyLiebGens
E Int
i], 1)] :: NPoly LPQ TemperleyLiebGens
d :: LPQ
d = String -> LPQ
forall r. Num r => String -> LaurentMPoly r
LP.var "d"
d' :: NPoly LPQ TemperleyLiebGens
d' = LPQ -> NPoly LPQ TemperleyLiebGens
forall r v. (Num r, Eq r, Eq v, Show v) => r -> NPoly r v
NP.inject LPQ
d :: NPoly LPQ TemperleyLiebGens
e1 :: NPoly LPQ TemperleyLiebGens
e1 = Int -> NPoly LPQ TemperleyLiebGens
e_ 1
e2 :: NPoly LPQ TemperleyLiebGens
e2 = Int -> NPoly LPQ TemperleyLiebGens
e_ 2
e3 :: NPoly LPQ TemperleyLiebGens
e3 = Int -> NPoly LPQ TemperleyLiebGens
e_ 3
e4 :: NPoly LPQ TemperleyLiebGens
e4 = Int -> NPoly LPQ TemperleyLiebGens
e_ 4
tlRelations :: Int -> [NPoly LPQ TemperleyLiebGens]
tlRelations n :: Int
n =
[Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
* Int -> NPoly LPQ TemperleyLiebGens
e_ Int
j NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
- Int -> NPoly LPQ TemperleyLiebGens
e_ Int
j NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
* Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i | Int
i <- [1..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1], Int
j <- [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+2..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1] ] [NPoly LPQ TemperleyLiebGens]
-> [NPoly LPQ TemperleyLiebGens] -> [NPoly LPQ TemperleyLiebGens]
forall a. [a] -> [a] -> [a]
++
[Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
* Int -> NPoly LPQ TemperleyLiebGens
e_ Int
j NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
* Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
- Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i | Int
i <- [1..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1], Int
j <- [1..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1], Int -> Int
forall a. Num a => a -> a
abs (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 ] [NPoly LPQ TemperleyLiebGens]
-> [NPoly LPQ TemperleyLiebGens] -> [NPoly LPQ TemperleyLiebGens]
forall a. [a] -> [a] -> [a]
++
[(Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i)NPoly LPQ TemperleyLiebGens
-> Integer -> NPoly LPQ TemperleyLiebGens
forall a b. (Num a, Integral b) => a -> b -> a
^2 NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
- NPoly LPQ TemperleyLiebGens
d' NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
* Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i | Int
i <- [1..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1] ]
dimTL :: NPoly r TemperleyLiebGens -> Int
dimTL (NP ts :: [(Monomial TemperleyLiebGens, r)]
ts) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
i | (M bs :: [TemperleyLiebGens]
bs,c :: r
c) <- [(Monomial TemperleyLiebGens, r)]
ts, E i :: Int
i <- [TemperleyLiebGens]
bs])
tlnf :: NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
tlnf f :: NPoly LPQ TemperleyLiebGens
f = NPoly LPQ TemperleyLiebGens
f NPoly LPQ TemperleyLiebGens
-> [NPoly LPQ TemperleyLiebGens] -> NPoly LPQ TemperleyLiebGens
forall r v.
(Fractional r, Ord v, Show v, Eq r) =>
NPoly r v -> [NPoly r v] -> NPoly r v
%% ([NPoly LPQ TemperleyLiebGens] -> [NPoly LPQ TemperleyLiebGens]
forall v r.
(Show v, Fractional r, Ord v, Ord r) =>
[NPoly r v] -> [NPoly r v]
gb ([NPoly LPQ TemperleyLiebGens] -> [NPoly LPQ TemperleyLiebGens])
-> [NPoly LPQ TemperleyLiebGens] -> [NPoly LPQ TemperleyLiebGens]
forall a b. (a -> b) -> a -> b
$ Int -> [NPoly LPQ TemperleyLiebGens]
tlRelations (Int -> [NPoly LPQ TemperleyLiebGens])
-> Int -> [NPoly LPQ TemperleyLiebGens]
forall a b. (a -> b) -> a -> b
$ NPoly LPQ TemperleyLiebGens -> Int
forall r. NPoly r TemperleyLiebGens -> Int
dimTL NPoly LPQ TemperleyLiebGens
f)
tlBasis :: Int -> [NPoly LPQ TemperleyLiebGens]
tlBasis n :: Int
n = [NPoly LPQ TemperleyLiebGens]
-> [NPoly LPQ TemperleyLiebGens] -> [NPoly LPQ TemperleyLiebGens]
forall r v.
(Eq r, Fractional r, Ord v, Show v) =>
[NPoly r v] -> [NPoly r v] -> [NPoly r v]
mbasisQA [Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i | Int
i <- [1..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1]] ([NPoly LPQ TemperleyLiebGens] -> [NPoly LPQ TemperleyLiebGens]
forall v r.
(Show v, Fractional r, Ord v, Ord r) =>
[NPoly r v] -> [NPoly r v]
gb ([NPoly LPQ TemperleyLiebGens] -> [NPoly LPQ TemperleyLiebGens])
-> [NPoly LPQ TemperleyLiebGens] -> [NPoly LPQ TemperleyLiebGens]
forall a b. (a -> b) -> a -> b
$ Int -> [NPoly LPQ TemperleyLiebGens]
tlRelations Int
n)
tr' :: Int -> Monomial TemperleyLiebGens -> LPQ
tr' n :: Int
n (M g :: [TemperleyLiebGens]
g) = LPQ
d LPQ -> Int -> LPQ
forall a b. (Num a, Integral b) => a -> b -> a
^ ( -1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[Int]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TemperleyLiebGens] -> [Int] -> [[Int]]
forall t. t -> [Int] -> [[Int]]
orbits [TemperleyLiebGens]
g [1..Int
n]) ) where
image :: Int -> [TemperleyLiebGens] -> Int
image i :: Int
i [] = Int
i
image i :: Int
i (E j :: Int
j : es :: [TemperleyLiebGens]
es) | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j = Int -> [TemperleyLiebGens] -> Int
image (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [TemperleyLiebGens]
es
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+1 = Int -> [TemperleyLiebGens] -> Int
image (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) [TemperleyLiebGens]
es
| Bool
otherwise = Int -> [TemperleyLiebGens] -> Int
image Int
i [TemperleyLiebGens]
es
orbits :: t -> [Int] -> [[Int]]
orbits g :: t
g [] = []
orbits g :: t
g (i :: Int
i:is :: [Int]
is) = let i' :: [Int]
i' = Int -> [Int] -> [Int]
orbit Int
i [] in [Int]
i' [Int] -> [[Int]] -> [[Int]]
forall a. a -> [a] -> [a]
: t -> [Int] -> [[Int]]
orbits t
g ((Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
is) [Int] -> [Int] -> [Int]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Int]
i')
orbit :: Int -> [Int] -> [Int]
orbit j :: Int
j js :: [Int]
js = let j' :: Int
j' = Int -> [TemperleyLiebGens] -> Int
image Int
j [TemperleyLiebGens]
g in if Int
j' Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Int
jInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
js) then [Int] -> [Int]
forall a. [a] -> [a]
reverse (Int
jInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
js) else Int -> [Int] -> [Int]
orbit Int
j' (Int
jInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
js)
tr :: Int -> NPoly LPQ TemperleyLiebGens -> LPQ
tr n :: Int
n f :: NPoly LPQ TemperleyLiebGens
f@(NP ts :: [(Monomial TemperleyLiebGens, LPQ)]
ts) = [LPQ] -> LPQ
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [LPQ
c LPQ -> LPQ -> LPQ
forall a. Num a => a -> a -> a
* Int -> Monomial TemperleyLiebGens -> LPQ
tr' Int
n Monomial TemperleyLiebGens
m | (m :: Monomial TemperleyLiebGens
m,c :: LPQ
c) <- [(Monomial TemperleyLiebGens, LPQ)]
ts]
a :: LPQ
a = String -> LPQ
forall r. Num r => String -> LaurentMPoly r
LP.var "a"
a' :: NPoly LPQ TemperleyLiebGens
a' = LPQ -> NPoly LPQ TemperleyLiebGens
forall r v. (Num r, Eq r, Eq v, Show v) => r -> NPoly r v
NP.inject LPQ
a :: NPoly LPQ TemperleyLiebGens
fromBraid :: NPoly LPQ BraidGens -> NPoly LPQ TemperleyLiebGens
fromBraid f :: NPoly LPQ BraidGens
f = NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
tlnf ([(NPoly LPQ BraidGens, NPoly LPQ TemperleyLiebGens)]
-> NPoly LPQ BraidGens -> NPoly LPQ TemperleyLiebGens
forall r1 v1 v2 r2.
(Num r1, Ord v1, Show v1, Eq r1, Eq v2, Eq r2, Show r2, Show v2,
Num r2) =>
[(NPoly r2 v2, NPoly r1 v1)] -> NPoly r1 v2 -> NPoly r1 v1
NP.subst [(NPoly LPQ BraidGens, NPoly LPQ TemperleyLiebGens)]
skeinRelations NPoly LPQ BraidGens
f) where
skeinRelations :: [(NPoly LPQ BraidGens, NPoly LPQ TemperleyLiebGens)]
skeinRelations = [[(NPoly LPQ BraidGens, NPoly LPQ TemperleyLiebGens)]]
-> [(NPoly LPQ BraidGens, NPoly LPQ TemperleyLiebGens)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [(Int -> NPoly LPQ BraidGens
s_ Int
i, 1NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Fractional a => a -> a -> a
/NPoly LPQ TemperleyLiebGens
a' NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
* Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
+ NPoly LPQ TemperleyLiebGens
a'), (Int -> NPoly LPQ BraidGens
s_ (-Int
i), NPoly LPQ TemperleyLiebGens
a' NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
* Int -> NPoly LPQ TemperleyLiebGens
e_ Int
i NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Num a => a -> a -> a
+ 1NPoly LPQ TemperleyLiebGens
-> NPoly LPQ TemperleyLiebGens -> NPoly LPQ TemperleyLiebGens
forall a. Fractional a => a -> a -> a
/NPoly LPQ TemperleyLiebGens
a')] | Int
i <- [1..] ]
jones :: Int -> NPoly LPQ BraidGens -> LPQ
jones n :: Int
n f :: NPoly LPQ BraidGens
f = let kauffman :: LPQ
kauffman = [(LPQ, LPQ)] -> LPQ -> LPQ
forall r.
(Eq r, Fractional r, Show r) =>
[(LaurentMPoly r, LaurentMPoly r)]
-> LaurentMPoly r -> LaurentMPoly r
LP.subst [(LPQ
d, - LPQ
aLPQ -> Integer -> LPQ
forall a b. (Num a, Integral b) => a -> b -> a
^2 LPQ -> LPQ -> LPQ
forall a. Num a => a -> a -> a
- 1LPQ -> LPQ -> LPQ
forall a. Fractional a => a -> a -> a
/LPQ
aLPQ -> Integer -> LPQ
forall a b. (Num a, Integral b) => a -> b -> a
^2)] (LPQ -> LPQ) -> LPQ -> LPQ
forall a b. (a -> b) -> a -> b
$ Int -> NPoly LPQ TemperleyLiebGens -> LPQ
tr Int
n (NPoly LPQ BraidGens -> NPoly LPQ TemperleyLiebGens
fromBraid NPoly LPQ BraidGens
f)
j :: LPQ
j = (-LPQ
a)LPQ -> Int -> LPQ
forall a b. (Fractional a, Integral b) => a -> b -> a
^^(-3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* NPoly LPQ BraidGens -> Int
forall r. NPoly r BraidGens -> Int
writhe NPoly LPQ BraidGens
f) LPQ -> LPQ -> LPQ
forall a. Num a => a -> a -> a
* LPQ
kauffman
in [(LPQ, LPQ)] -> LPQ -> LPQ
forall r.
(Eq r, Fractional r, Show r) =>
[(LaurentMPoly r, LaurentMPoly r)]
-> LaurentMPoly r -> LaurentMPoly r
LP.subst [(LPQ
a,1LPQ -> LPQ -> LPQ
forall a. Fractional a => a -> a -> a
/LPQ
tLPQ -> Q -> LPQ
forall a.
(Eq a, Fractional a, Show a) =>
LaurentMPoly a -> Q -> LaurentMPoly a
^^^(1Q -> Q -> Q
forall a. Fractional a => a -> a -> a
/4))] LPQ
j