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

    -- |A module defining the tensor, symmetric, and exterior algebras.

    -- This module has been partially superceded by Math.Algebras.TensorAlgebra, which should be used in preference.

    -- This module is likely to be removed at some point.

    module Math.Algebra.NonCommutative.TensorAlgebra where

    import Math.Algebra.Field.Base
    import Math.Algebra.NonCommutative.NCPoly hiding (X)
    import Math.Algebra.NonCommutative.GSBasis

    -- TENSOR ALGEBRA

    -- Tensor product satisfies the universal property that any multilinear map from the cartesian product can be factored through the tensor product

    -- The tensor algebra is the free algebra on the basis elts of the vector space

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

    instance Show Basis where
        show :: Basis -> 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 Q Basis
    e_ i :: Int
    i = [(Monomial Basis, Q)] -> NPoly Q Basis
    forall r v. [(Monomial v, r)] -> NPoly r v
    NP [([Basis] -> Monomial Basis
    forall v. [v] -> Monomial v
    M [Int -> Basis
    E Int
    i], 1)] :: NPoly Q Basis

    e1 :: NPoly Q Basis
    e1 = Int -> NPoly Q Basis
    e_ 1
    e2 :: NPoly Q Basis
    e2 = Int -> NPoly Q Basis
    e_ 2
    e3 :: NPoly Q Basis
    e3 = Int -> NPoly Q Basis
    e_ 3
    e4 :: NPoly Q Basis
    e4 = Int -> NPoly Q Basis
    e_ 4

    -- given an elt of the tensor algebra, return the dimension of the vector space it's defined over

    dim :: NPoly r Basis -> Int
    dim (NP ts :: [(Monomial Basis, r)]
    ts) = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ 0 Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : [Int
    i | (M bs :: [Basis]
    bs,c :: r
    c) <- [(Monomial Basis, r)]
    ts, E i :: Int
    i <- [Basis]
    bs]

    -- Monomial basis for tensor algebra over k^n - infinite

    tensorBasis :: Int -> [NPoly Q Basis]
    tensorBasis n :: Int
    n = [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
    forall r v.
    (Eq r, Fractional r, Ord v, Show v) =>
    [NPoly r v] -> [NPoly r v] -> [NPoly r v]
    mbasisQA [Int -> NPoly Q Basis
    e_ Int
    i | Int
    i <- [1..Int
    n]] []

    -- EXTERIOR ALGEBRA

    -- Exterior product satisfies the universal property that any alternating multilinear map from the cartesian product can be factored through the exterior product

    -- Exterior algebra over k^n is tensor algebra over k^n quotiented by these relations

    extRelations :: Int -> [NPoly Q Basis]
    extRelations n :: Int
    n = [Int -> NPoly Q Basis
    e_ Int
    i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    * Int -> NPoly Q Basis
    e_ Int
    i | Int
    i <- [1..Int
    n] ] [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
    forall a. [a] -> [a] -> [a]
    ++
                     [Int -> NPoly Q Basis
    e_ Int
    i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    * Int -> NPoly Q Basis
    e_ Int
    j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    + Int -> NPoly Q Basis
    e_ Int
    j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    * Int -> NPoly Q Basis
    e_ Int
    i | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n] ]

    extnf :: NPoly Q Basis -> NPoly Q Basis
    extnf t :: NPoly Q Basis
    t = NPoly Q Basis
    t NPoly Q Basis -> [NPoly Q Basis] -> NPoly Q Basis
    forall r v.
    (Fractional r, Ord v, Show v, Eq r) =>
    NPoly r v -> [NPoly r v] -> NPoly r v
    %% (Int -> [NPoly Q Basis]
    extRelations (Int -> [NPoly Q Basis]) -> Int -> [NPoly Q Basis]
    forall a b. (a -> b) -> a -> b
    $ NPoly Q Basis -> Int
    forall r. NPoly r Basis -> Int
    dim NPoly Q Basis
    t)

    -- Monomial basis for exterior algebra over k^n - finite

    exteriorBasis :: Int -> [NPoly Q Basis]
    exteriorBasis n :: Int
    n = [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
    forall r v.
    (Eq r, Fractional r, Ord v, Show v) =>
    [NPoly r v] -> [NPoly r v] -> [NPoly r v]
    mbasisQA [Int -> NPoly Q Basis
    e_ Int
    i | Int
    i <- [1..Int
    n]] ([NPoly Q Basis] -> [NPoly Q Basis])
    -> [NPoly Q Basis] -> [NPoly Q Basis]
    forall a b. (a -> b) -> a -> b
    $ Int -> [NPoly Q Basis]
    extRelations Int
    n

    -- SYMMETRIC ALGEBRA

    -- Symmetric product satisfies the universal property that any symmetric multilinear map from the cartesian product can be factored through the symmetric product

    -- Symmetric algebra over k^n is tensor algebra over k^n quotiented by these relations

    symRelations :: Int -> [NPoly Q Basis]
    symRelations n :: Int
    n = [Int -> NPoly Q Basis
    e_ Int
    i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    * Int -> NPoly Q Basis
    e_ Int
    j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    - Int -> NPoly Q Basis
    e_ Int
    j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    * Int -> NPoly Q Basis
    e_ Int
    i | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n] ]

    symnf :: NPoly Q Basis -> NPoly Q Basis
    symnf t :: NPoly Q Basis
    t = NPoly Q Basis
    t NPoly Q Basis -> [NPoly Q Basis] -> NPoly Q Basis
    forall r v.
    (Fractional r, Ord v, Show v, Eq r) =>
    NPoly r v -> [NPoly r v] -> NPoly r v
    %% (Int -> [NPoly Q Basis]
    symRelations (Int -> [NPoly Q Basis]) -> Int -> [NPoly Q Basis]
    forall a b. (a -> b) -> a -> b
    $ NPoly Q Basis -> Int
    forall r. NPoly r Basis -> Int
    dim NPoly Q Basis
    t)

    -- Monomial basis for symmetric algebra over k^n - infinite

    symmetricBasis :: Int -> [NPoly Q Basis]
    symmetricBasis n :: Int
    n = [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
    forall r v.
    (Eq r, Fractional r, Ord v, Show v) =>
    [NPoly r v] -> [NPoly r v] -> [NPoly r v]
    mbasisQA [Int -> NPoly Q Basis
    e_ Int
    i | Int
    i <- [1..Int
    n]] ([NPoly Q Basis] -> [NPoly Q Basis])
    -> [NPoly Q Basis] -> [NPoly Q Basis]
    forall a b. (a -> b) -> a -> b
    $ Int -> [NPoly Q Basis]
    symRelations Int
    n

    -- WEYL ALGEBRAS

    -- http://en.wikipedia.org/wiki/Weyl_algebra

    -- Coutinho, A Primer of Algebraic D-modules, ch1

    -- Given a symplectic form w, represented by

    -- [0  I]

    -- [-I 0]

    -- on R^2n

    -- The Weyl algebra is the tensor algebra quotiented by < u*v-v*u-w(u,v) >

    -- It has a natural interpretation as an operator algebra in which

    -- e_1 .. e_i .. e_n correspond to x_i (the "multiply by x_i" operator),

    -- e_n+1 .. e_n+i .. e_2*n correspond to d_x_i (the "differentiate wrt x_i" operator)

    -- Weyl algebra W(V) is a "quantization" of the Symmetric algebra Sym(V)

    weylRelations :: Int -> [NPoly Q Basis]
    weylRelations n :: Int
    n = [Int -> NPoly Q Basis
    e_ Int
    j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    * Int -> NPoly Q Basis
    e_ Int
    i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    - Int -> NPoly Q Basis
    e_ Int
    i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    * Int -> NPoly Q Basis
    e_ Int
    j | Int
    i <- [1..2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n], Int
    j Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n ] [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
    forall a. [a] -> [a] -> [a]
    ++
                      [Int -> NPoly Q Basis
    e_ (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n) NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    * Int -> NPoly Q Basis
    e_ Int
    i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    - Int -> NPoly Q Basis
    e_ Int
    i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    * Int -> NPoly Q Basis
    e_ (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n) NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
    forall a. Num a => a -> a -> a
    - 1 | Int
    i <- [1..Int
    n] ]

    weylnf :: Int -> NPoly Q Basis -> NPoly Q Basis
    weylnf n :: Int
    n t :: NPoly Q Basis
    t = NPoly Q Basis
    t NPoly Q Basis -> [NPoly Q Basis] -> NPoly Q Basis
    forall r v.
    (Fractional r, Ord v, Show v, Eq r) =>
    NPoly r v -> [NPoly r v] -> NPoly r v
    %% (Int -> [NPoly Q Basis]
    weylRelations Int
    n)

    weylBasis :: Int -> [NPoly Q Basis]
    weylBasis n :: Int
    n = [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
    forall r v.
    (Eq r, Fractional r, Ord v, Show v) =>
    [NPoly r v] -> [NPoly r v] -> [NPoly r v]
    mbasisQA [Int -> NPoly Q Basis
    e_ Int
    i | Int
    i <- [1..2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    n]] ([NPoly Q Basis] -> [NPoly Q Basis])
    -> [NPoly Q Basis] -> [NPoly Q Basis]
    forall a b. (a -> b) -> a -> b
    $ Int -> [NPoly Q Basis]
    weylRelations Int
    n

    -- Explicit construction of Weyl algebra in terms of d_x_i and x_i operators

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

    instance Show WeylGens where
        show :: WeylGens -> String
    show (D i :: Int
    i) = 'd'Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    i
        show (X i :: Int
    i) = 'x'Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    i

    d_ :: Int -> NPoly Q WeylGens
    d_ i :: Int
    i = [(Monomial WeylGens, Q)] -> NPoly Q WeylGens
    forall r v. [(Monomial v, r)] -> NPoly r v
    NP [([WeylGens] -> Monomial WeylGens
    forall v. [v] -> Monomial v
    M [Int -> WeylGens
    D Int
    i], 1)] :: NPoly Q WeylGens
    x_ :: Int -> NPoly Q WeylGens
    x_ i :: Int
    i = [(Monomial WeylGens, Q)] -> NPoly Q WeylGens
    forall r v. [(Monomial v, r)] -> NPoly r v
    NP [([WeylGens] -> Monomial WeylGens
    forall v. [v] -> Monomial v
    M [Int -> WeylGens
    X Int
    i], 1)] :: NPoly Q WeylGens

    d1 :: NPoly Q WeylGens
    d1 = Int -> NPoly Q WeylGens
    d_ 1
    d2 :: NPoly Q WeylGens
    d2 = Int -> NPoly Q WeylGens
    d_ 2
    d3 :: NPoly Q WeylGens
    d3 = Int -> NPoly Q WeylGens
    d_ 3

    x1 :: NPoly Q WeylGens
    x1 = Int -> NPoly Q WeylGens
    x_ 1
    x2 :: NPoly Q WeylGens
    x2 = Int -> NPoly Q WeylGens
    x_ 2
    x3 :: NPoly Q WeylGens
    x3 = Int -> NPoly Q WeylGens
    x_ 3

    comm :: a -> a -> a
    comm p :: a
    p q :: a
    q = a
    pa -> a -> a
    forall a. Num a => a -> a -> a
    *a
    q a -> a -> a
    forall a. Num a => a -> a -> a
    - a
    qa -> a -> a
    forall a. Num a => a -> a -> a
    *a
    p

    delta :: a -> a -> p
    delta i :: a
    i j :: a
    j = if a
    i a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    j then 1 else 0

    weylRelations' :: Int -> [NPoly Q WeylGens]
    weylRelations' n :: Int
    n = [NPoly Q WeylGens -> NPoly Q WeylGens -> NPoly Q WeylGens
    forall a. Num a => a -> a -> a
    comm (Int -> NPoly Q WeylGens
    x_ Int
    i) (Int -> NPoly Q WeylGens
    x_ Int
    j) | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n] ] [NPoly Q WeylGens] -> [NPoly Q WeylGens] -> [NPoly Q WeylGens]
    forall a. [a] -> [a] -> [a]
    ++
                       [NPoly Q WeylGens -> NPoly Q WeylGens -> NPoly Q WeylGens
    forall a. Num a => a -> a -> a
    comm (Int -> NPoly Q WeylGens
    d_ Int
    i) (Int -> NPoly Q WeylGens
    d_ Int
    j) | Int
    i <- [1..Int
    n], Int
    j <- [Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +1..Int
    n] ] [NPoly Q WeylGens] -> [NPoly Q WeylGens] -> [NPoly Q WeylGens]
    forall a. [a] -> [a] -> [a]
    ++
                       [NPoly Q WeylGens -> NPoly Q WeylGens -> NPoly Q WeylGens
    forall a. Num a => a -> a -> a
    comm (Int -> NPoly Q WeylGens
    d_ Int
    i) (Int -> NPoly Q WeylGens
    x_ Int
    j) NPoly Q WeylGens -> NPoly Q WeylGens -> NPoly Q WeylGens
    forall a. Num a => a -> a -> a
    - Int -> Int -> NPoly Q WeylGens
    forall a p. (Eq a, Num p) => a -> a -> p
    delta Int
    i Int
    j | Int
    i <- [1..Int
    n], Int
    j <- [1..Int
    n] ]

    weylnf' :: NPoly Q WeylGens -> NPoly Q WeylGens
    weylnf' f :: NPoly Q WeylGens
    f@(NP ts :: [(Monomial WeylGens, Q)]
    ts) = NPoly Q WeylGens
    f NPoly Q WeylGens -> [NPoly Q WeylGens] -> NPoly Q WeylGens
    forall r v.
    (Fractional r, Ord v, Show v, Eq r) =>
    NPoly r v -> [NPoly r v] -> NPoly r v
    %% Int -> [NPoly Q WeylGens]
    weylRelations' Int
    n where
        n :: Int
    n = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ 0 Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : [Int
    i | (M bs :: [WeylGens]
    bs,c :: Q
    c) <- [(Monomial WeylGens, Q)]
    ts, X i <- [WeylGens]
    bs] [Int] -> [Int] -> [Int]
    forall a. [a] -> [a] -> [a]
    ++ [Int
    i | (M bs :: [WeylGens]
    bs,c :: Q
    c) <- [(Monomial WeylGens, Q)]
    ts, D i <- [WeylGens]
    bs]

    weylBasis' :: Int -> [NPoly Q WeylGens]
    weylBasis' n :: Int
    n = [NPoly Q WeylGens] -> [NPoly Q WeylGens] -> [NPoly Q WeylGens]
    forall r v.
    (Eq r, Fractional r, Ord v, Show v) =>
    [NPoly r v] -> [NPoly r v] -> [NPoly r v]
    mbasisQA ((Int -> NPoly Q WeylGens) -> [Int] -> [NPoly Q WeylGens]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> NPoly Q WeylGens
    x_ [1..Int
    n] [NPoly Q WeylGens] -> [NPoly Q WeylGens] -> [NPoly Q WeylGens]
    forall a. [a] -> [a] -> [a]
    ++ (Int -> NPoly Q WeylGens) -> [Int] -> [NPoly Q WeylGens]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> NPoly Q WeylGens
    d_ [1..Int
    n]) (Int -> [NPoly Q WeylGens]
    weylRelations' Int
    n)

    {-
    -- HEISENBERG ALGEBRA

    data Heisenberg = D | U deriving (Eq,Ord)

    instance Show Heisenberg where
        show D = "d"
        show U = "u"

    d = NP [(M [D], 1)] :: NPoly Q Heisenberg
    u = NP [(M [U], 1)] :: NPoly Q Heisenberg

    heisenberg = [u*d-d*u-1]

    -- Monomial basis for Heisenberg algebra - infinite
    hBasis = mbasisQA [d,u] (gb heisenberg)
    -}