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

    {-# LANGUAGE TypeFamilies, EmptyDataDecls #-}

    module Math.QuantumAlgebra.OrientedTangle where

    import Prelude hiding ( (*>) )

    import Math.Algebra.Field.Base
    import Math.Algebras.LaurentPoly -- hiding (lvar, q, q')

    import Math.QuantumAlgebra.TensorCategory

    import Math.Algebras.VectorSpace
    import Math.Algebras.TensorProduct
    import Math.Algebras.Structures

    -- import MathExperiments.Algebra.TAlgebra

    -- ORIENTED TANGLE CATEGORY

    data Oriented = Plus | Minus deriving (Oriented -> Oriented -> Bool
    (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Bool) -> Eq Oriented
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Oriented -> Oriented -> Bool
    $c/= :: Oriented -> Oriented -> Bool
    == :: Oriented -> Oriented -> Bool
    $c== :: Oriented -> Oriented -> Bool
    Eq,Eq Oriented
    Eq Oriented =>
    (Oriented -> Oriented -> Ordering)
    -> (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Bool)
    -> (Oriented -> Oriented -> Oriented)
    -> (Oriented -> Oriented -> Oriented)
    -> Ord Oriented
    Oriented -> Oriented -> Bool
    Oriented -> Oriented -> Ordering
    Oriented -> Oriented -> Oriented
    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 :: Oriented -> Oriented -> Oriented
    $cmin :: Oriented -> Oriented -> Oriented
    max :: Oriented -> Oriented -> Oriented
    $cmax :: Oriented -> Oriented -> Oriented
    >= :: Oriented -> Oriented -> Bool
    $c>= :: Oriented -> Oriented -> Bool
    > :: Oriented -> Oriented -> Bool
    $c> :: Oriented -> Oriented -> Bool
    <= :: Oriented -> Oriented -> Bool
    $c<= :: Oriented -> Oriented -> Bool
    < :: Oriented -> Oriented -> Bool
    $c< :: Oriented -> Oriented -> Bool
    compare :: Oriented -> Oriented -> Ordering
    $ccompare :: Oriented -> Oriented -> Ordering
    $cp1Ord :: Eq Oriented
    Ord,Int -> Oriented -> ShowS
    [Oriented] -> ShowS
    Oriented -> String
    (Int -> Oriented -> ShowS)
    -> (Oriented -> String) -> ([Oriented] -> ShowS) -> Show Oriented
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Oriented] -> ShowS
    $cshowList :: [Oriented] -> ShowS
    show :: Oriented -> String
    $cshow :: Oriented -> String
    showsPrec :: Int -> Oriented -> ShowS
    $cshowsPrec :: Int -> Oriented -> ShowS
    Show)

    data HorizDir = ToL | ToR deriving (HorizDir -> HorizDir -> Bool
    (HorizDir -> HorizDir -> Bool)
    -> (HorizDir -> HorizDir -> Bool) -> Eq HorizDir
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: HorizDir -> HorizDir -> Bool
    $c/= :: HorizDir -> HorizDir -> Bool
    == :: HorizDir -> HorizDir -> Bool
    $c== :: HorizDir -> HorizDir -> Bool
    Eq,Eq HorizDir
    Eq HorizDir =>
    (HorizDir -> HorizDir -> Ordering)
    -> (HorizDir -> HorizDir -> Bool)
    -> (HorizDir -> HorizDir -> Bool)
    -> (HorizDir -> HorizDir -> Bool)
    -> (HorizDir -> HorizDir -> Bool)
    -> (HorizDir -> HorizDir -> HorizDir)
    -> (HorizDir -> HorizDir -> HorizDir)
    -> Ord HorizDir
    HorizDir -> HorizDir -> Bool
    HorizDir -> HorizDir -> Ordering
    HorizDir -> HorizDir -> HorizDir
    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 :: HorizDir -> HorizDir -> HorizDir
    $cmin :: HorizDir -> HorizDir -> HorizDir
    max :: HorizDir -> HorizDir -> HorizDir
    $cmax :: HorizDir -> HorizDir -> HorizDir
    >= :: HorizDir -> HorizDir -> Bool
    $c>= :: HorizDir -> HorizDir -> Bool
    > :: HorizDir -> HorizDir -> Bool
    $c> :: HorizDir -> HorizDir -> Bool
    <= :: HorizDir -> HorizDir -> Bool
    $c<= :: HorizDir -> HorizDir -> Bool
    < :: HorizDir -> HorizDir -> Bool
    $c< :: HorizDir -> HorizDir -> Bool
    compare :: HorizDir -> HorizDir -> Ordering
    $ccompare :: HorizDir -> HorizDir -> Ordering
    $cp1Ord :: Eq HorizDir
    Ord,Int -> HorizDir -> ShowS
    [HorizDir] -> ShowS
    HorizDir -> String
    (Int -> HorizDir -> ShowS)
    -> (HorizDir -> String) -> ([HorizDir] -> ShowS) -> Show HorizDir
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [HorizDir] -> ShowS
    $cshowList :: [HorizDir] -> ShowS
    show :: HorizDir -> String
    $cshow :: HorizDir -> String
    showsPrec :: Int -> HorizDir -> ShowS
    $cshowsPrec :: Int -> HorizDir -> ShowS
    Show)

    data OrientedTangle

    -- In GHCi 6.12.1, we appear to be limited to 8 value constructors within an associated data family
    instance MCategory OrientedTangle where
        data Ob OrientedTangle = OT [Oriented] deriving (Ob OrientedTangle -> Ob OrientedTangle -> Bool
    (Ob OrientedTangle -> Ob OrientedTangle -> Bool)
    -> (Ob OrientedTangle -> Ob OrientedTangle -> Bool)
    -> Eq (Ob OrientedTangle)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    $c/= :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    == :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    $c== :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    Eq,Eq (Ob OrientedTangle)
    Eq (Ob OrientedTangle) =>
    (Ob OrientedTangle -> Ob OrientedTangle -> Ordering)
    -> (Ob OrientedTangle -> Ob OrientedTangle -> Bool)
    -> (Ob OrientedTangle -> Ob OrientedTangle -> Bool)
    -> (Ob OrientedTangle -> Ob OrientedTangle -> Bool)
    -> (Ob OrientedTangle -> Ob OrientedTangle -> Bool)
    -> (Ob OrientedTangle -> Ob OrientedTangle -> Ob OrientedTangle)
    -> (Ob OrientedTangle -> Ob OrientedTangle -> Ob OrientedTangle)
    -> Ord (Ob OrientedTangle)
    Ob OrientedTangle -> Ob OrientedTangle -> Bool
    Ob OrientedTangle -> Ob OrientedTangle -> Ordering
    Ob OrientedTangle -> Ob OrientedTangle -> Ob OrientedTangle
    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 :: Ob OrientedTangle -> Ob OrientedTangle -> Ob OrientedTangle
    $cmin :: Ob OrientedTangle -> Ob OrientedTangle -> Ob OrientedTangle
    max :: Ob OrientedTangle -> Ob OrientedTangle -> Ob OrientedTangle
    $cmax :: Ob OrientedTangle -> Ob OrientedTangle -> Ob OrientedTangle
    >= :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    $c>= :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    > :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    $c> :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    <= :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    $c<= :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    < :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    $c< :: Ob OrientedTangle -> Ob OrientedTangle -> Bool
    compare :: Ob OrientedTangle -> Ob OrientedTangle -> Ordering
    $ccompare :: Ob OrientedTangle -> Ob OrientedTangle -> Ordering
    $cp1Ord :: Eq (Ob OrientedTangle)
    Ord,Int -> Ob OrientedTangle -> ShowS
    [Ob OrientedTangle] -> ShowS
    Ob OrientedTangle -> String
    (Int -> Ob OrientedTangle -> ShowS)
    -> (Ob OrientedTangle -> String)
    -> ([Ob OrientedTangle] -> ShowS)
    -> Show (Ob OrientedTangle)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Ob OrientedTangle] -> ShowS
    $cshowList :: [Ob OrientedTangle] -> ShowS
    show :: Ob OrientedTangle -> String
    $cshow :: Ob OrientedTangle -> String
    showsPrec :: Int -> Ob OrientedTangle -> ShowS
    $cshowsPrec :: Int -> Ob OrientedTangle -> ShowS
    Show)
        data Ar OrientedTangle = IdT [Oriented]
                               | CapT HorizDir
                               | CupT HorizDir
                               | XPlus | XMinus
                               | SeqT [Ar OrientedTangle]
                               | ParT [Ar OrientedTangle]
                               deriving (Ar OrientedTangle -> Ar OrientedTangle -> Bool
    (Ar OrientedTangle -> Ar OrientedTangle -> Bool)
    -> (Ar OrientedTangle -> Ar OrientedTangle -> Bool)
    -> Eq (Ar OrientedTangle)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    $c/= :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    == :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    $c== :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    Eq,Eq (Ar OrientedTangle)
    Eq (Ar OrientedTangle) =>
    (Ar OrientedTangle -> Ar OrientedTangle -> Ordering)
    -> (Ar OrientedTangle -> Ar OrientedTangle -> Bool)
    -> (Ar OrientedTangle -> Ar OrientedTangle -> Bool)
    -> (Ar OrientedTangle -> Ar OrientedTangle -> Bool)
    -> (Ar OrientedTangle -> Ar OrientedTangle -> Bool)
    -> (Ar OrientedTangle -> Ar OrientedTangle -> Ar OrientedTangle)
    -> (Ar OrientedTangle -> Ar OrientedTangle -> Ar OrientedTangle)
    -> Ord (Ar OrientedTangle)
    Ar OrientedTangle -> Ar OrientedTangle -> Bool
    Ar OrientedTangle -> Ar OrientedTangle -> Ordering
    Ar OrientedTangle -> Ar OrientedTangle -> Ar OrientedTangle
    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 :: Ar OrientedTangle -> Ar OrientedTangle -> Ar OrientedTangle
    $cmin :: Ar OrientedTangle -> Ar OrientedTangle -> Ar OrientedTangle
    max :: Ar OrientedTangle -> Ar OrientedTangle -> Ar OrientedTangle
    $cmax :: Ar OrientedTangle -> Ar OrientedTangle -> Ar OrientedTangle
    >= :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    $c>= :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    > :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    $c> :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    <= :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    $c<= :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    < :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    $c< :: Ar OrientedTangle -> Ar OrientedTangle -> Bool
    compare :: Ar OrientedTangle -> Ar OrientedTangle -> Ordering
    $ccompare :: Ar OrientedTangle -> Ar OrientedTangle -> Ordering
    $cp1Ord :: Eq (Ar OrientedTangle)
    Ord,Int -> Ar OrientedTangle -> ShowS
    [Ar OrientedTangle] -> ShowS
    Ar OrientedTangle -> String
    (Int -> Ar OrientedTangle -> ShowS)
    -> (Ar OrientedTangle -> String)
    -> ([Ar OrientedTangle] -> ShowS)
    -> Show (Ar OrientedTangle)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Ar OrientedTangle] -> ShowS
    $cshowList :: [Ar OrientedTangle] -> ShowS
    show :: Ar OrientedTangle -> String
    $cshow :: Ar OrientedTangle -> String
    showsPrec :: Int -> Ar OrientedTangle -> ShowS
    $cshowsPrec :: Int -> Ar OrientedTangle -> ShowS
    Show)
        id_ :: Ob OrientedTangle -> Ar OrientedTangle
    id_ (OT os) = [Oriented] -> Ar OrientedTangle
    IdT [Oriented]
    os
        source :: Ar OrientedTangle -> Ob OrientedTangle
    source (IdT os) = [Oriented] -> Ob OrientedTangle
    OT [Oriented]
    os
        source (CapT _) = [Oriented] -> Ob OrientedTangle
    OT []
        source (CupT toR) = [Oriented] -> Ob OrientedTangle
    OT [Oriented
    Plus,Oriented
    Minus]
        source (CupT toL) = [Oriented] -> Ob OrientedTangle
    OT [Oriented
    Minus,Oriented
    Plus]
        source XPlus = [Oriented] -> Ob OrientedTangle
    OT [Oriented
    Plus,Oriented
    Plus]
        source XMinus = [Oriented] -> Ob OrientedTangle
    OT [Oriented
    Plus,Oriented
    Plus]
        source (ParT as) = [Oriented] -> Ob OrientedTangle
    OT ([Oriented] -> Ob OrientedTangle)
    -> [Oriented] -> Ob OrientedTangle
    forall a b. (a -> b) -> a -> b
    $ (Ar OrientedTangle -> [Oriented])
    -> [Ar OrientedTangle] -> [Oriented]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((\(OT os) -> [Oriented]
    os) (Ob OrientedTangle -> [Oriented])
    -> (Ar OrientedTangle -> Ob OrientedTangle)
    -> Ar OrientedTangle
    -> [Oriented]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ar OrientedTangle -> Ob OrientedTangle
    forall c. MCategory c => Ar c -> Ob c
    source) [Ar OrientedTangle]
    as
        source (SeqT as) = Ar OrientedTangle -> Ob OrientedTangle
    forall c. MCategory c => Ar c -> Ob c
    source ([Ar OrientedTangle] -> Ar OrientedTangle
    forall a. [a] -> a
    head [Ar OrientedTangle]
    as)
        target :: Ar OrientedTangle -> Ob OrientedTangle
    target (IdT os) = [Oriented] -> Ob OrientedTangle
    OT [Oriented]
    os
        target (CapT ToR) = [Oriented] -> Ob OrientedTangle
    OT [Oriented
    Minus,Oriented
    Plus]
        target (CapT ToL) = [Oriented] -> Ob OrientedTangle
    OT [Oriented
    Plus,Oriented
    Minus]
        target (CupT _) = [Oriented] -> Ob OrientedTangle
    OT []
        target XPlus = [Oriented] -> Ob OrientedTangle
    OT [Oriented
    Plus,Oriented
    Plus]
        target XMinus = [Oriented] -> Ob OrientedTangle
    OT [Oriented
    Plus,Oriented
    Plus]
        target (ParT as) = [Oriented] -> Ob OrientedTangle
    OT ([Oriented] -> Ob OrientedTangle)
    -> [Oriented] -> Ob OrientedTangle
    forall a b. (a -> b) -> a -> b
    $ (Ar OrientedTangle -> [Oriented])
    -> [Ar OrientedTangle] -> [Oriented]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((\(OT os) -> [Oriented]
    os) (Ob OrientedTangle -> [Oriented])
    -> (Ar OrientedTangle -> Ob OrientedTangle)
    -> Ar OrientedTangle
    -> [Oriented]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ar OrientedTangle -> Ob OrientedTangle
    forall c. MCategory c => Ar c -> Ob c
    target) [Ar OrientedTangle]
    as
        target (SeqT as) = Ar OrientedTangle -> Ob OrientedTangle
    forall c. MCategory c => Ar c -> Ob c
    target ([Ar OrientedTangle] -> Ar OrientedTangle
    forall a. [a] -> a
    last [Ar OrientedTangle]
    as)
        a :: Ar OrientedTangle
    a >>> :: Ar OrientedTangle -> Ar OrientedTangle -> Ar OrientedTangle
    >>> b :: Ar OrientedTangle
    b | Ar OrientedTangle -> Ob OrientedTangle
    forall c. MCategory c => Ar c -> Ob c
    target Ar OrientedTangle
    a Ob OrientedTangle -> Ob OrientedTangle -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ar OrientedTangle -> Ob OrientedTangle
    forall c. MCategory c => Ar c -> Ob c
    source Ar OrientedTangle
    b = [Ar OrientedTangle] -> Ar OrientedTangle
    SeqT [Ar OrientedTangle
    a,Ar OrientedTangle
    b]

    instance Monoidal OrientedTangle where
        tunit :: Ob OrientedTangle
    tunit = [Oriented] -> Ob OrientedTangle
    OT []
        tob :: Ob OrientedTangle -> Ob OrientedTangle -> Ob OrientedTangle
    tob (OT as) (OT bs) = [Oriented] -> Ob OrientedTangle
    OT ([Oriented]
    as[Oriented] -> [Oriented] -> [Oriented]
    forall a. [a] -> [a] -> [a]
    ++[Oriented]
    bs)
        tar :: Ar OrientedTangle -> Ar OrientedTangle -> Ar OrientedTangle
    tar a :: Ar OrientedTangle
    a b :: Ar OrientedTangle
    b = [Ar OrientedTangle] -> Ar OrientedTangle
    ParT [Ar OrientedTangle
    a,Ar OrientedTangle
    b]

    idV :: a -> a
    idV = a -> a
    forall a. a -> a
    id
    idV' :: a -> a
    idV' = a -> a
    forall a. a -> a
    id

    evalV :: (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    evalV  = \(E i :: Int
    i, E j :: Int
    j) -> if Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    j Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then () -> Vect (LaurentPoly Q) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () else Vect (LaurentPoly Q) ()
    forall k b. Vect k b
    zerov
    evalV' :: (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    evalV' = \(E i :: Int
    i, E j :: Int
    j) -> if Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    j Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then () -> Vect (LaurentPoly Q) ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () else Vect (LaurentPoly Q) ()
    forall k b. Vect k b
    zerov

    coevalV :: Int -> Vect k (EBasis, EBasis)
    coevalV  m :: Int
    m = (Vect k (EBasis, EBasis)
     -> Vect k (EBasis, EBasis) -> Vect k (EBasis, EBasis))
    -> Vect k (EBasis, EBasis)
    -> [Vect k (EBasis, EBasis)]
    -> Vect k (EBasis, EBasis)
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Vect k (EBasis, EBasis)
    -> Vect k (EBasis, EBasis) -> Vect k (EBasis, EBasis)
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    (<+>) Vect k (EBasis, EBasis)
    forall k b. Vect k b
    zerov [Int -> Vect k EBasis
    forall (m :: * -> *). Monad m => Int -> m EBasis
    e Int
    i Vect k EBasis -> Vect k EBasis -> Vect k (EBasis, EBasis)
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Int -> Vect k EBasis
    forall (m :: * -> *). Monad m => Int -> m EBasis
    e (-Int
    i) | Int
    i <- [1..Int
    m] ]
    coevalV' :: Int -> Vect k (EBasis, EBasis)
    coevalV' m :: Int
    m = (Vect k (EBasis, EBasis)
     -> Vect k (EBasis, EBasis) -> Vect k (EBasis, EBasis))
    -> Vect k (EBasis, EBasis)
    -> [Vect k (EBasis, EBasis)]
    -> Vect k (EBasis, EBasis)
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Vect k (EBasis, EBasis)
    -> Vect k (EBasis, EBasis) -> Vect k (EBasis, EBasis)
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    (<+>) Vect k (EBasis, EBasis)
    forall k b. Vect k b
    zerov [Int -> Vect k EBasis
    forall (m :: * -> *). Monad m => Int -> m EBasis
    e (-Int
    i) Vect k EBasis -> Vect k EBasis -> Vect k (EBasis, EBasis)
    forall k a b. Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
    `te` Int -> Vect k EBasis
    forall (m :: * -> *). Monad m => Int -> m EBasis
    e Int
    i | Int
    i <- [1..Int
    m] ]

    lambda :: b -> LaurentPoly Q
    lambda m :: b
    m = LaurentPoly Q
    q' LaurentPoly Q -> b -> LaurentPoly Q
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ b
    m -- q^-m

    c :: b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    c m :: b
    m (E i :: Int
    i, E j :: Int
    j) = case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    i Int
    j of
                          EQ -> (b -> LaurentPoly Q
    forall b. Integral b => b -> LaurentPoly Q
    lambda b
    m LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Num a => a -> a -> a
    * LaurentPoly Q
    q) LaurentPoly Q
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    i, Int -> EBasis
    E Int
    i)
                          LT -> b -> LaurentPoly Q
    forall b. Integral b => b -> LaurentPoly Q
    lambda b
    m LaurentPoly Q
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    j, Int -> EBasis
    E Int
    i)
                          GT -> b -> LaurentPoly Q
    forall b. Integral b => b -> LaurentPoly Q
    lambda b
    m LaurentPoly Q
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> ((EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    j, Int -> EBasis
    E Int
    i) Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    <+> (LaurentPoly Q
    q LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Num a => a -> a -> a
    - LaurentPoly Q
    q') LaurentPoly Q
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    i, Int -> EBasis
    E Int
    j))

    -- inverse of c
    c' :: b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    c' m :: b
    m (E i :: Int
    i, E j :: Int
    j) = case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    i Int
    j of
                           EQ -> (1LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Fractional a => a -> a -> a
    /(b -> LaurentPoly Q
    forall b. Integral b => b -> LaurentPoly Q
    lambda b
    m LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Num a => a -> a -> a
    * LaurentPoly Q
    q)) LaurentPoly Q
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    i, Int -> EBasis
    E Int
    i)
                           LT -> (1LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Fractional a => a -> a -> a
    /b -> LaurentPoly Q
    forall b. Integral b => b -> LaurentPoly Q
    lambda b
    m) LaurentPoly Q
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> ((EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    j, Int -> EBasis
    E Int
    i) Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b.
    (Eq k, Num k, Ord b) =>
    Vect k b -> Vect k b -> Vect k b
    <+> (LaurentPoly Q
    q'LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Num a => a -> a -> a
    -LaurentPoly Q
    q) LaurentPoly Q
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    i, Int -> EBasis
    E Int
    j))
                           GT -> (1LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Fractional a => a -> a -> a
    /b -> LaurentPoly Q
    forall b. Integral b => b -> LaurentPoly Q
    lambda b
    m) LaurentPoly Q
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    j, Int -> EBasis
    E Int
    i)

    testcc' :: b
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    testcc' m :: b
    m v :: Vect (LaurentPoly Q) (EBasis, EBasis)
    v = Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
    nf (Vect (LaurentPoly Q) (EBasis, EBasis)
     -> Vect (LaurentPoly Q) (EBasis, EBasis))
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall a b. (a -> b) -> a -> b
    $ Vect (LaurentPoly Q) (EBasis, EBasis)
    v Vect (LaurentPoly Q) (EBasis, EBasis)
    -> ((EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis))
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    c b
    m Vect (LaurentPoly Q) (EBasis, EBasis)
    -> ((EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis))
    -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    c' b
    m

    mu :: b -> EBasis -> Vect (LaurentPoly Q) EBasis
    mu m :: b
    m (E i :: Int
    i) = (1 LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Fractional a => a -> a -> a
    / (b -> LaurentPoly Q
    forall b. Integral b => b -> LaurentPoly Q
    lambda b
    m LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Num a => a -> a -> a
    * LaurentPoly Q
    q LaurentPoly Q -> Int -> LaurentPoly Q
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1))) LaurentPoly Q
    -> Vect (LaurentPoly Q) EBasis -> Vect (LaurentPoly Q) EBasis
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> EBasis -> Vect (LaurentPoly Q) EBasis
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    i)

    mu' :: b -> EBasis -> Vect (LaurentPoly Q) EBasis
    mu' m :: b
    m (E i :: Int
    i) = (b -> LaurentPoly Q
    forall b. Integral b => b -> LaurentPoly Q
    lambda b
    m LaurentPoly Q -> LaurentPoly Q -> LaurentPoly Q
    forall a. Num a => a -> a -> a
    * LaurentPoly Q
    q LaurentPoly Q -> Int -> LaurentPoly Q
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ (2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -1)) LaurentPoly Q
    -> Vect (LaurentPoly Q) EBasis -> Vect (LaurentPoly Q) EBasis
    forall k b. (Eq k, Num k) => k -> Vect k b -> Vect k b
    *> EBasis -> Vect (LaurentPoly Q) EBasis
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> EBasis
    E Int
    i)

    -- The following are modified from Kassel. We compose diagrams downwards, whereas he composes them upwards.

    capRL :: Int -> Vect k (EBasis, EBasis)
    capRL m :: Int
    m = Int -> Vect k (EBasis, EBasis)
    forall k. (Eq k, Num k) => Int -> Vect k (EBasis, EBasis)
    coevalV Int
    m

    capLR :: Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR m :: Int
    m = do
        (i :: EBasis
    i,j :: EBasis
    j) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k. (Eq k, Num k) => Int -> Vect k (EBasis, EBasis)
    coevalV' Int
    m
        EBasis
    k <- Int -> EBasis -> Vect (LaurentPoly Q) EBasis
    forall b. Integral b => b -> EBasis -> Vect (LaurentPoly Q) EBasis
    mu' Int
    m EBasis
    j
        (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EBasis
    i,EBasis
    k)

    cupRL :: Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupRL m :: Int
    m = (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    evalV

    cupLR :: Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupLR m :: Int
    m (i :: EBasis
    i,j :: EBasis
    j) = do
        EBasis
    k <- Int -> EBasis -> Vect (LaurentPoly Q) EBasis
    forall b. Integral b => b -> EBasis -> Vect (LaurentPoly Q) EBasis
    mu Int
    m EBasis
    i
        (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    evalV' (EBasis
    k,EBasis
    j)
    -- linear evalV' . (linear (mu' m) `tf` idV)

    xplus :: b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xplus m :: b
    m = b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    c b
    m

    xminus :: b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xminus m :: b
    m = b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    c' b
    m

    yplus :: Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    yplus m :: Int
    m (p :: EBasis
    p,q :: EBasis
    q) = do
        (r :: EBasis
    r,s :: EBasis
    s) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k. (Eq k, Num k) => Int -> Vect k (EBasis, EBasis)
    capRL Int
    m
        (t :: EBasis
    t,u :: EBasis
    u) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xplus Int
    m (EBasis
    q,EBasis
    r)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupRL Int
    m (EBasis
    p,EBasis
    t)
        (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EBasis
    u,EBasis
    s)

    yminus :: Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    yminus m :: Int
    m (p :: EBasis
    p,q :: EBasis
    q) = do
        (r :: EBasis
    r,s :: EBasis
    s) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k. (Eq k, Num k) => Int -> Vect k (EBasis, EBasis)
    capRL Int
    m
        (t :: EBasis
    t,u :: EBasis
    u) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xminus Int
    m (EBasis
    q,EBasis
    r)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupRL Int
    m (EBasis
    p,EBasis
    t)
        (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EBasis
    u,EBasis
    s)

    tplus :: Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    tplus m :: Int
    m (p :: EBasis
    p,q :: EBasis
    q) = do
        (r :: EBasis
    r,s :: EBasis
    s) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR Int
    m
        (t :: EBasis
    t,u :: EBasis
    u) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xplus Int
    m (EBasis
    s,EBasis
    p)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupLR Int
    m (EBasis
    u,EBasis
    q)
        (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EBasis
    r,EBasis
    t)

    tminus :: Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    tminus m :: Int
    m (p :: EBasis
    p,q :: EBasis
    q) = do
        (r :: EBasis
    r,s :: EBasis
    s) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR Int
    m
        (t :: EBasis
    t,u :: EBasis
    u) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xminus Int
    m (EBasis
    s,EBasis
    p)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupLR Int
    m (EBasis
    u,EBasis
    q)
        (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EBasis
    r,EBasis
    t)

    zplus :: Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    zplus m :: Int
    m (p :: EBasis
    p,q :: EBasis
    q) = do
        (r :: EBasis
    r,u :: EBasis
    u) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR Int
    m
        (s :: EBasis
    s,t :: EBasis
    t) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR Int
    m
        (v :: EBasis
    v,w :: EBasis
    w) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xplus Int
    m (EBasis
    t,EBasis
    u)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupLR Int
    m (EBasis
    v,EBasis
    q)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupLR Int
    m (EBasis
    w,EBasis
    p)
        (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EBasis
    r,EBasis
    s)

    zminus :: Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    zminus m :: Int
    m (p :: EBasis
    p,q :: EBasis
    q) = do
        (r :: EBasis
    r,u :: EBasis
    u) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR Int
    m
        (s :: EBasis
    s,t :: EBasis
    t) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR Int
    m
        (v :: EBasis
    v,w :: EBasis
    w) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xminus Int
    m (EBasis
    t,EBasis
    u)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupLR Int
    m (EBasis
    v,EBasis
    q)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupLR Int
    m (EBasis
    w,EBasis
    p)
        (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EBasis
    r,EBasis
    s)

    {-
    Then we have for example the following:
    > let v = e1 `te` e2 in nf $ v >>= xplus 2 >>= xminus 2
    (e1,e2)
    > let v = e (-1) `te` e2 in nf $ v >>= yplus 2 >>= tminus 2
    (e-1,e2)
    > let v = e (-1) `te` e (-2) in nf $ v >>= zplus 2 >>= zminus 2
    (e-1,e-2)
    -}

    oloop :: Int -> Vect (LaurentPoly Q) ()
    oloop m :: Int
    m = Vect (LaurentPoly Q) () -> Vect (LaurentPoly Q) ()
    forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
    nf (Vect (LaurentPoly Q) () -> Vect (LaurentPoly Q) ())
    -> Vect (LaurentPoly Q) () -> Vect (LaurentPoly Q) ()
    forall a b. (a -> b) -> a -> b
    $ do
        (a :: EBasis
    a,b :: EBasis
    b) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR Int
    m
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupRL Int
    m (EBasis
    a,EBasis
    b)

    -- oriented trefoil
    otrefoil :: Int -> Vect (LaurentPoly Q) ()
    otrefoil m :: Int
    m = Vect (LaurentPoly Q) () -> Vect (LaurentPoly Q) ()
    forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
    nf (Vect (LaurentPoly Q) () -> Vect (LaurentPoly Q) ())
    -> Vect (LaurentPoly Q) () -> Vect (LaurentPoly Q) ()
    forall a b. (a -> b) -> a -> b
    $ do
        (p :: EBasis
    p,q :: EBasis
    q) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR Int
    m
        (r :: EBasis
    r,s :: EBasis
    s) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    capLR Int
    m
        (t :: EBasis
    t,u :: EBasis
    u) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    tminus Int
    m (EBasis
    q,EBasis
    r)
        (v :: EBasis
    v,w :: EBasis
    w) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    zminus Int
    m (EBasis
    p,EBasis
    t)
        (x :: EBasis
    x,y :: EBasis
    y) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xminus Int
    m (EBasis
    u,EBasis
    s)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupRL Int
    m (EBasis
    w,EBasis
    x)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupRL Int
    m (EBasis
    v,EBasis
    y)

    -- oriented the other way
    otrefoil' :: Int -> Vect (LaurentPoly Q) ()
    otrefoil' m :: Int
    m = Vect (LaurentPoly Q) () -> Vect (LaurentPoly Q) ()
    forall k b. (Eq k, Num k, Ord b) => Vect k b -> Vect k b
    nf (Vect (LaurentPoly Q) () -> Vect (LaurentPoly Q) ())
    -> Vect (LaurentPoly Q) () -> Vect (LaurentPoly Q) ()
    forall a b. (a -> b) -> a -> b
    $ do
        (p :: EBasis
    p,q :: EBasis
    q) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k. (Eq k, Num k) => Int -> Vect k (EBasis, EBasis)
    capRL Int
    m
        (r :: EBasis
    r,s :: EBasis
    s) <- Int -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall k. (Eq k, Num k) => Int -> Vect k (EBasis, EBasis)
    capRL Int
    m
        (t :: EBasis
    t,u :: EBasis
    u) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    yminus Int
    m (EBasis
    q,EBasis
    r)
        (v :: EBasis
    v,w :: EBasis
    w) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    forall b.
    Integral b =>
    b -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    xminus Int
    m (EBasis
    p,EBasis
    t)
        (x :: EBasis
    x,y :: EBasis
    y) <- Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) (EBasis, EBasis)
    zminus Int
    m (EBasis
    u,EBasis
    s)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupLR Int
    m (EBasis
    w,EBasis
    x)
        Int -> (EBasis, EBasis) -> Vect (LaurentPoly Q) ()
    cupLR Int
    m (EBasis
    v,EBasis
    y)

    {-
    -- REPRESENTATIONS OF THE TANGLE CATEGORY IN VECTOR SPACE CATEGORY
    -- But we need to convert the above code to use TensorAlgebra first

    kauffman :: Ar Tangle -> TangleRep [Oriented] -> TangleRep [Oriented]
    kauffman (IdT n) = id -- could be tf of n ids
    kauffman CapT = linear cap
    kauffman CupT = linear cup
    kauffman OverT = linear over
    kauffman UnderT = linear under
    kauffman (SeqT fs) = foldl (>>>) id $ map kauffman fs
        where g >>> h = h . g
    kauffman (ParT [f]) = kauffman f
    kauffman (ParT (f:fs)) = tf m (kauffman f) (kauffman (ParT fs))
        where OT m = source f
              tf m f' fs' = linear (\xs -> let (ls,rs) = splitAt m xs in f' (return ls) * fs' (return rs) )
    -}