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

    {-# LANGUAGE FlexibleInstances #-}

    module Math.Projects.KnotTheory.IwahoriHecke where

    -- import qualified Data.Map as M

    import Math.Algebra.Field.Base
    import Math.Algebra.NonCommutative.NCPoly as NP hiding (x,y,z)
    import Math.Algebra.NonCommutative.GSBasis

    import Math.Projects.KnotTheory.LaurentMPoly as LP hiding (z)
    import Math.Projects.KnotTheory.Braid

    -- IWAHORI-HECKE ALGEBRAS

    data IwahoriHeckeGens = T Int deriving (IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    (IwahoriHeckeGens -> IwahoriHeckeGens -> Bool)
    -> (IwahoriHeckeGens -> IwahoriHeckeGens -> Bool)
    -> Eq IwahoriHeckeGens
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    $c/= :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    == :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    $c== :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    Eq,Eq IwahoriHeckeGens
    Eq IwahoriHeckeGens =>
    (IwahoriHeckeGens -> IwahoriHeckeGens -> Ordering)
    -> (IwahoriHeckeGens -> IwahoriHeckeGens -> Bool)
    -> (IwahoriHeckeGens -> IwahoriHeckeGens -> Bool)
    -> (IwahoriHeckeGens -> IwahoriHeckeGens -> Bool)
    -> (IwahoriHeckeGens -> IwahoriHeckeGens -> Bool)
    -> (IwahoriHeckeGens -> IwahoriHeckeGens -> IwahoriHeckeGens)
    -> (IwahoriHeckeGens -> IwahoriHeckeGens -> IwahoriHeckeGens)
    -> Ord IwahoriHeckeGens
    IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    IwahoriHeckeGens -> IwahoriHeckeGens -> Ordering
    IwahoriHeckeGens -> IwahoriHeckeGens -> IwahoriHeckeGens
    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 :: IwahoriHeckeGens -> IwahoriHeckeGens -> IwahoriHeckeGens
    $cmin :: IwahoriHeckeGens -> IwahoriHeckeGens -> IwahoriHeckeGens
    max :: IwahoriHeckeGens -> IwahoriHeckeGens -> IwahoriHeckeGens
    $cmax :: IwahoriHeckeGens -> IwahoriHeckeGens -> IwahoriHeckeGens
    >= :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    $c>= :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    > :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    $c> :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    <= :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    $c<= :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    < :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    $c< :: IwahoriHeckeGens -> IwahoriHeckeGens -> Bool
    compare :: IwahoriHeckeGens -> IwahoriHeckeGens -> Ordering
    $ccompare :: IwahoriHeckeGens -> IwahoriHeckeGens -> Ordering
    $cp1Ord :: Eq IwahoriHeckeGens
    Ord)

    instance Show IwahoriHeckeGens where
        show :: IwahoriHeckeGens -> String
    show (T i :: Int
    i) = 't'Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    i

    t_ :: Int -> NPoly LPQ IwahoriHeckeGens
    t_ i :: Int
    i = [(Monomial IwahoriHeckeGens, LPQ)] -> NPoly LPQ IwahoriHeckeGens
    forall r v. [(Monomial v, r)] -> NPoly r v
    NP [([IwahoriHeckeGens] -> Monomial IwahoriHeckeGens
    forall v. [v] -> Monomial v
    M [Int -> IwahoriHeckeGens
    T Int
    i], 1)] :: NPoly LPQ IwahoriHeckeGens

    t1 :: NPoly LPQ IwahoriHeckeGens
    t1 = Int -> NPoly LPQ IwahoriHeckeGens
    t_ 1
    t2 :: NPoly LPQ IwahoriHeckeGens
    t2 = Int -> NPoly LPQ IwahoriHeckeGens
    t_ 2
    t3 :: NPoly LPQ IwahoriHeckeGens
    t3 = Int -> NPoly LPQ IwahoriHeckeGens
    t_ 3
    t4 :: NPoly LPQ IwahoriHeckeGens
    t4 = Int -> NPoly LPQ IwahoriHeckeGens
    t_ 4

    q :: LPQ
    q = String -> LPQ
    forall r. Num r => String -> LaurentMPoly r
    LP.var "q" -- :: LPQ

    z :: LPQ
    z = String -> LPQ
    forall r. Num r => String -> LaurentMPoly r
    LP.var "z" -- :: LPQ

    q' :: NPoly LPQ IwahoriHeckeGens
    q' = LPQ -> NPoly LPQ IwahoriHeckeGens
    forall r v. (Num r, Eq r, Eq v, Show v) => r -> NPoly r v
    NP.inject LPQ
    q :: NPoly LPQ IwahoriHeckeGens
    z' :: NPoly LPQ IwahoriHeckeGens
    z' = LPQ -> NPoly LPQ IwahoriHeckeGens
    forall r v. (Num r, Eq r, Eq v, Show v) => r -> NPoly r v
    NP.inject LPQ
    z :: NPoly LPQ IwahoriHeckeGens

    -- inverses

    instance Invertible (NPoly LPQ IwahoriHeckeGens) where
        inv :: NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    inv (NP [(M [T i :: Int
    i], 1)]) = (Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    - NPoly LPQ IwahoriHeckeGens
    z') NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Fractional a => a -> a -> a
    / NPoly LPQ IwahoriHeckeGens
    q'

    -- x ^- n = inv x ^ n

    -- Iwahori-Hecke algebra Hn(q,z), generated by n-1 elts t1..t_n-1, together with relations

    ihRelations :: Int -> [NPoly LPQ IwahoriHeckeGens]
    ihRelations n :: Int
    n =
        [Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    * Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    j NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    - Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    j NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    * Int -> NPoly LPQ IwahoriHeckeGens
    t_ 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 IwahoriHeckeGens]
    -> [NPoly LPQ IwahoriHeckeGens] -> [NPoly LPQ IwahoriHeckeGens]
    forall a. [a] -> [a] -> [a]
    ++
        [Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    * Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    j NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    * Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    - Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    j NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    * Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    * Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    j | 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 IwahoriHeckeGens]
    -> [NPoly LPQ IwahoriHeckeGens] -> [NPoly LPQ IwahoriHeckeGens]
    forall a. [a] -> [a] -> [a]
    ++
        [(Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i)NPoly LPQ IwahoriHeckeGens -> Integer -> NPoly LPQ IwahoriHeckeGens
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2 NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    - NPoly LPQ IwahoriHeckeGens
    z' NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    * Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    - NPoly LPQ IwahoriHeckeGens
    q' | Int
    i <- [1..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1] ]

    -- given an elt of the Temperley-Lieb algebra, return the dimension it's defined over (ie the number of points)

    dimIH :: NPoly r IwahoriHeckeGens -> Int
    dimIH (NP ts :: [(Monomial IwahoriHeckeGens, 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 :: [IwahoriHeckeGens]
    bs,c :: r
    c) <- [(Monomial IwahoriHeckeGens, r)]
    ts, T i :: Int
    i <- [IwahoriHeckeGens]
    bs])

    -- Reduce to normal form

    ihnf :: NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    ihnf f :: NPoly LPQ IwahoriHeckeGens
    f = NPoly LPQ IwahoriHeckeGens
    f NPoly LPQ IwahoriHeckeGens
    -> [NPoly LPQ IwahoriHeckeGens] -> NPoly LPQ IwahoriHeckeGens
    forall r v.
    (Fractional r, Ord v, Show v, Eq r) =>
    NPoly r v -> [NPoly r v] -> NPoly r v
    %% ([NPoly LPQ IwahoriHeckeGens] -> [NPoly LPQ IwahoriHeckeGens]
    forall v r.
    (Show v, Fractional r, Ord v, Ord r) =>
    [NPoly r v] -> [NPoly r v]
    gb ([NPoly LPQ IwahoriHeckeGens] -> [NPoly LPQ IwahoriHeckeGens])
    -> [NPoly LPQ IwahoriHeckeGens] -> [NPoly LPQ IwahoriHeckeGens]
    forall a b. (a -> b) -> a -> b
    $ Int -> [NPoly LPQ IwahoriHeckeGens]
    ihRelations (Int -> [NPoly LPQ IwahoriHeckeGens])
    -> Int -> [NPoly LPQ IwahoriHeckeGens]
    forall a b. (a -> b) -> a -> b
    $ NPoly LPQ IwahoriHeckeGens -> Int
    forall r. NPoly r IwahoriHeckeGens -> Int
    dimIH NPoly LPQ IwahoriHeckeGens
    f)

    -- Monomial basis for Iwahori-Hecke algebra (as quotient of free algebra by Iwahori-Hecke relations)

    ihBasis :: Int -> [NPoly LPQ IwahoriHeckeGens]
    ihBasis n :: Int
    n = [NPoly LPQ IwahoriHeckeGens]
    -> [NPoly LPQ IwahoriHeckeGens] -> [NPoly LPQ IwahoriHeckeGens]
    forall r v.
    (Eq r, Fractional r, Ord v, Show v) =>
    [NPoly r v] -> [NPoly r v] -> [NPoly r v]
    mbasisQA [Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i | Int
    i <- [1..Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1]] ([NPoly LPQ IwahoriHeckeGens] -> [NPoly LPQ IwahoriHeckeGens]
    forall v r.
    (Show v, Fractional r, Ord v, Ord r) =>
    [NPoly r v] -> [NPoly r v]
    gb ([NPoly LPQ IwahoriHeckeGens] -> [NPoly LPQ IwahoriHeckeGens])
    -> [NPoly LPQ IwahoriHeckeGens] -> [NPoly LPQ IwahoriHeckeGens]
    forall a b. (a -> b) -> a -> b
    $ Int -> [NPoly LPQ IwahoriHeckeGens]
    ihRelations Int
    n)

    -- OCNEANU TRACE

    -- Trace function on single terms

    tau' :: Int -> (Monomial IwahoriHeckeGens, LPQ) -> LPQ
    tau' 1 (1,c :: LPQ
    c) = LPQ
    c
    tau' 2 (1,c :: LPQ
    c) = LPQ
    c LPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    * (1LPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    -LPQ
    q)LPQ -> LPQ -> LPQ
    forall a. Fractional a => a -> a -> a
    /LPQ
    z
    tau' 2 (m :: Monomial IwahoriHeckeGens
    m,c :: LPQ
    c) = LPQ
    c
    tau' n :: Int
    n (m :: Monomial IwahoriHeckeGens
    m,c :: LPQ
    c) = case Monomial IwahoriHeckeGens
    m Monomial IwahoriHeckeGens
    -> Monomial IwahoriHeckeGens
    -> Maybe (Monomial IwahoriHeckeGens, Monomial IwahoriHeckeGens)
    forall v.
    Eq v =>
    Monomial v -> Monomial v -> Maybe (Monomial v, Monomial v)
    `divM` [IwahoriHeckeGens] -> Monomial IwahoriHeckeGens
    forall v. [v] -> Monomial v
    M [Int -> IwahoriHeckeGens
    T (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1)] of
                   Just (l :: Monomial IwahoriHeckeGens
    l,r :: Monomial IwahoriHeckeGens
    r) -> Int -> NPoly LPQ IwahoriHeckeGens -> LPQ
    tau (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) (NPoly LPQ IwahoriHeckeGens -> LPQ)
    -> NPoly LPQ IwahoriHeckeGens -> LPQ
    forall a b. (a -> b) -> a -> b
    $ [(Monomial IwahoriHeckeGens, LPQ)] -> NPoly LPQ IwahoriHeckeGens
    forall r v. [(Monomial v, r)] -> NPoly r v
    NP [(Monomial IwahoriHeckeGens
    lMonomial IwahoriHeckeGens
    -> Monomial IwahoriHeckeGens -> Monomial IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    *Monomial IwahoriHeckeGens
    r,LPQ
    c)] -- have to call tau not tau', because l*r might be reducible

                   Nothing -> Int -> (Monomial IwahoriHeckeGens, LPQ) -> LPQ
    tau' (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1) (Monomial IwahoriHeckeGens
    m,LPQ
    cLPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    *(1LPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    -LPQ
    q)LPQ -> LPQ -> LPQ
    forall a. Fractional a => a -> a -> a
    /LPQ
    z)

    -- Trace function on polynomials, by linearity

    -- Given an elt of Iwahori-Hecke algebra, returns an elt of Q[q,z]

    tau :: Int -> NPoly LPQ IwahoriHeckeGens -> LPQ
    tau n :: Int
    n f :: NPoly LPQ IwahoriHeckeGens
    f | NPoly LPQ IwahoriHeckeGens -> Int
    forall r. NPoly r IwahoriHeckeGens -> Int
    dimIH NPoly LPQ IwahoriHeckeGens
    f Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    n = let NP ts :: [(Monomial IwahoriHeckeGens, LPQ)]
    ts = NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    ihnf NPoly LPQ IwahoriHeckeGens
    f in [LPQ] -> LPQ
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Int -> (Monomial IwahoriHeckeGens, LPQ) -> LPQ
    tau' Int
    n (Monomial IwahoriHeckeGens, LPQ)
    t | (Monomial IwahoriHeckeGens, LPQ)
    t <- [(Monomial IwahoriHeckeGens, LPQ)]
    ts]

    fromBraid :: NPoly LPQ BraidGens -> NPoly LPQ IwahoriHeckeGens
    fromBraid f :: NPoly LPQ BraidGens
    f = NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    ihnf ([(NPoly LPQ BraidGens, NPoly LPQ IwahoriHeckeGens)]
    -> NPoly LPQ BraidGens -> NPoly LPQ IwahoriHeckeGens
    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 IwahoriHeckeGens)]
    skeinRelations NPoly LPQ BraidGens
    f) where
        skeinRelations :: [(NPoly LPQ BraidGens, NPoly LPQ IwahoriHeckeGens)]
    skeinRelations = [[(NPoly LPQ BraidGens, NPoly LPQ IwahoriHeckeGens)]]
    -> [(NPoly LPQ BraidGens, NPoly LPQ IwahoriHeckeGens)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [ [(Int -> NPoly LPQ BraidGens
    s_ Int
    i, Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i), (Int -> NPoly LPQ BraidGens
    s_ (-Int
    i), (Int -> NPoly LPQ IwahoriHeckeGens
    t_ Int
    i NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Num a => a -> a -> a
    - NPoly LPQ IwahoriHeckeGens
    z') NPoly LPQ IwahoriHeckeGens
    -> NPoly LPQ IwahoriHeckeGens -> NPoly LPQ IwahoriHeckeGens
    forall a. Fractional a => a -> a -> a
    / NPoly LPQ IwahoriHeckeGens
    q')] | Int
    i <- [1..] ]

    -- HOMFLY polynomial, also called Jones-Conway polynomial

    -- Kassel, Turaev version, as poly in x,y

    -- Satisfies skein relation x P_L_+(x,y) - x^-1 P_L_-(x,y) == y P_L_0(x,y)

    -- n is the index of the Iwahori-Hecke algebra we're working in (ie the number of strings in the braid)

    -- f is the braid expressed in the Iwahori-Hecke generators ti

    homfly :: Int -> NPoly LPQ BraidGens -> LPQ
    homfly n :: Int
    n f :: NPoly LPQ BraidGens
    f = [(LPQ, LPQ)] -> LPQ -> LPQ
    forall r.
    (Eq r, Fractional r, Show r) =>
    [(LaurentMPoly r, LaurentMPoly r)]
    -> LaurentMPoly r -> LaurentMPoly r
    LP.subst [(LPQ
    q,1LPQ -> LPQ -> LPQ
    forall a. Fractional a => a -> a -> a
    /LPQ
    xLPQ -> Integer -> LPQ
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2),(LPQ
    z,LPQ
    yLPQ -> LPQ -> LPQ
    forall a. Fractional a => a -> a -> a
    /LPQ
    x)] (LPQ -> LPQ) -> LPQ -> LPQ
    forall a b. (a -> b) -> a -> b
    $ Int -> NPoly LPQ IwahoriHeckeGens -> LPQ
    tau Int
    n (NPoly LPQ IwahoriHeckeGens -> LPQ)
    -> NPoly LPQ IwahoriHeckeGens -> LPQ
    forall a b. (a -> b) -> a -> b
    $ NPoly LPQ BraidGens -> NPoly LPQ IwahoriHeckeGens
    fromBraid NPoly LPQ BraidGens
    f

    i :: LPQ
    i = String -> LPQ
    forall r. Num r => String -> LaurentMPoly r
    LP.var "i" :: LPQ
    l :: LPQ
    l = String -> LPQ
    forall r. Num r => String -> LaurentMPoly r
    LP.var "l" :: LPQ
    m :: LPQ
    m = String -> LPQ
    forall r. Num r => String -> LaurentMPoly r
    LP.var "m" :: LPQ

    -- HOMFLY polynomial (for braid f over n strings)

    -- Lickorish version, as poly in l,m

    -- Satisfies skein relation l P_L_+(l,m) + l^-1 P_L_-(l,m) + m P_L_0(l,m) == 0

    homfly' :: Int -> NPoly LPQ BraidGens -> LPQ
    homfly' n :: Int
    n f :: NPoly LPQ BraidGens
    f =
        let f' :: LPQ
    f' = [(LPQ, LPQ)] -> LPQ -> LPQ
    forall r.
    (Eq r, Fractional r, Show r) =>
    [(LaurentMPoly r, LaurentMPoly r)]
    -> LaurentMPoly r -> LaurentMPoly r
    LP.subst [(LPQ
    x,LPQ
    iLPQ -> Integer -> LPQ
    forall a b. (Num a, Integral b) => a -> b -> a
    ^3LPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    *LPQ
    l),(LPQ
    y,LPQ
    iLPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    *LPQ
    m)] (Int -> NPoly LPQ BraidGens -> LPQ
    homfly Int
    n NPoly LPQ BraidGens
    f)
        in LPQ -> LPQ -> LPQ
    forall r.
    (Eq r, Fractional r) =>
    LaurentMPoly r -> LaurentMPoly r -> LaurentMPoly r
    reduceLP LPQ
    f' (LPQ
    iLPQ -> Integer -> LPQ
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2LPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    +1)

    -- Closer to Thistlethwaite notation

    homfly'' :: Int -> NPoly LPQ BraidGens -> LaurentMPoly LPQ
    homfly'' n :: Int
    n f :: NPoly LPQ BraidGens
    f = [LaurentMPoly LPQ] -> LaurentMPoly LPQ
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([LaurentMPoly LPQ] -> LaurentMPoly LPQ)
    -> [LaurentMPoly LPQ] -> LaurentMPoly LPQ
    forall a b. (a -> b) -> a -> b
    $ (LaurentMPoly LPQ -> LaurentMPoly LPQ -> LaurentMPoly LPQ)
    -> [LaurentMPoly LPQ] -> [LaurentMPoly LPQ] -> [LaurentMPoly LPQ]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith LaurentMPoly LPQ -> LaurentMPoly LPQ -> LaurentMPoly LPQ
    forall a. Num a => a -> a -> a
    (*) ((LPQ -> LaurentMPoly LPQ) -> [LPQ] -> [LaurentMPoly LPQ]
    forall a b. (a -> b) -> [a] -> [b]
    map LPQ -> LaurentMPoly LPQ
    forall r. (Eq r, Num r) => r -> LaurentMPoly r
    LP.inject ([LPQ] -> [LaurentMPoly LPQ]) -> [LPQ] -> [LaurentMPoly LPQ]
    forall a b. (a -> b) -> a -> b
    $ LPQ -> LPQ -> [LPQ]
    forall r.
    (Eq r, Fractional r) =>
    LaurentMPoly r -> LaurentMPoly r -> [LaurentMPoly r]
    coeffs (LPQ
    mLPQ -> Integer -> LPQ
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2) (Int -> NPoly LPQ BraidGens -> LPQ
    homfly' Int
    n NPoly LPQ BraidGens
    f)) ((LaurentMPoly LPQ -> LaurentMPoly LPQ)
    -> LaurentMPoly LPQ -> [LaurentMPoly LPQ]
    forall a. (a -> a) -> a -> [a]
    iterate (LaurentMPoly LPQ -> LaurentMPoly LPQ -> LaurentMPoly LPQ
    forall a. Num a => a -> a -> a
    *(LaurentMPoly LPQ
    m'LaurentMPoly LPQ -> Integer -> LaurentMPoly LPQ
    forall a b. (Num a, Integral b) => a -> b -> a
    ^2)) 1)
        where m' :: LaurentMPoly LPQ
    m' = String -> LaurentMPoly LPQ
    forall r. Num r => String -> LaurentMPoly r
    LP.var "m" :: LaurentMPoly LPQ
        -- where m' = LP [(LM $ M.singleton "m" 1, 1)] :: LaurentMPoly LPQ

    -- express an lpoly as a upoly over one of its variables

    coeffs :: LaurentMPoly r -> LaurentMPoly r -> [LaurentMPoly r]
    coeffs v :: LaurentMPoly r
    v 0 = []
    coeffs v :: LaurentMPoly r
    v f :: LaurentMPoly r
    f = let (f' :: LaurentMPoly r
    f',c :: LaurentMPoly r
    c) = LaurentMPoly r
    -> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
    forall r.
    (Eq r, Fractional r) =>
    LaurentMPoly r
    -> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
    quotRemLP LaurentMPoly r
    f LaurentMPoly r
    v in LaurentMPoly r
    c LaurentMPoly r -> [LaurentMPoly r] -> [LaurentMPoly r]
    forall a. a -> [a] -> [a]
    : LaurentMPoly r -> LaurentMPoly r -> [LaurentMPoly r]
    coeffs LaurentMPoly r
    v LaurentMPoly r
    f'

    -- Jones polynomial (for braid f over m strings)

    -- from the HOMFLY polynomial via the substitution x -> 1/t, y -> t^1/2 - t^-1/2

    -- The reason the code is so complicated is that y == t^1/2 - t^-1/2 can appear in the denominator,

    -- and we have to cancel it out with the numerator by hand because our code can't do it for us

    jones' :: Int -> NPoly LPQ BraidGens -> LPQ
    jones' m :: Int
    m f :: NPoly LPQ BraidGens
    f = let f' :: LPQ
    f' = Int -> NPoly LPQ BraidGens -> LPQ
    homfly Int
    m NPoly LPQ BraidGens
    f
                     n :: LPQ
    n = LPQ
    dLPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    *LPQ
    f'
                     d :: LPQ
    d = LPQ -> LPQ
    forall r1 r2. Num r1 => LaurentMPoly r2 -> LaurentMPoly r1
    denominatorLP LPQ
    f'
                     subs :: [(LPQ, LPQ)]
    subs = [(LPQ
    x,1LPQ -> LPQ -> LPQ
    forall a. Fractional a => a -> a -> a
    /LPQ
    t),(LPQ
    y,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
    /2)LPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> 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
    /2))]
                     -- subs = [(x,1/t^2),(y,t-1/t)]

                     n' :: LPQ
    n' = [(LPQ, LPQ)] -> LPQ -> LPQ
    forall r.
    (Eq r, Fractional r, Show r) =>
    [(LaurentMPoly r, LaurentMPoly r)]
    -> LaurentMPoly r -> LaurentMPoly r
    LP.subst [(LPQ, LPQ)]
    subs LPQ
    n
                     d' :: LPQ
    d' = [(LPQ, LPQ)] -> LPQ -> LPQ
    forall r.
    (Eq r, Fractional r, Show r) =>
    [(LaurentMPoly r, LaurentMPoly r)]
    -> LaurentMPoly r -> LaurentMPoly r
    LP.subst [(LPQ, LPQ)]
    subs LPQ
    d
                     nn :: LPQ
    nn = LPQ
    ndLPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    *LPQ
    n'
                     nd :: LPQ
    nd = LPQ -> LPQ
    forall r1 r2. Num r1 => LaurentMPoly r2 -> LaurentMPoly r1
    denominatorLP LPQ
    n'
                     dn :: LPQ
    dn = LPQ
    ddLPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    *LPQ
    d'
                     dd :: LPQ
    dd = LPQ -> LPQ
    forall r1 r2. Num r1 => LaurentMPoly r2 -> LaurentMPoly r1
    denominatorLP LPQ
    d'
                     (q :: LPQ
    q,r :: LPQ
    r) = LPQ -> LPQ -> (LPQ, LPQ)
    forall r.
    (Eq r, Fractional r) =>
    LaurentMPoly r
    -> LaurentMPoly r -> (LaurentMPoly r, LaurentMPoly r)
    quotRemLP LPQ
    nn LPQ
    dn
                 -- in if r == 0 then halfExponents' (dd/nd * q) else error ""

                 in if LPQ
    r LPQ -> LPQ -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then (LPQ
    ddLPQ -> LPQ -> LPQ
    forall a. Fractional a => a -> a -> a
    /LPQ
    nd LPQ -> LPQ -> LPQ
    forall a. Num a => a -> a -> a
    * LPQ
    q) else String -> LPQ
    forall a. HasCallStack => String -> a
    error ""

    -- Alexander polynomial is the substitution x -> 1, y -> t^1/2 - t^-1/2