--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

)abbrev domain LIE AssociatedLieAlgebra
++ Author: J. Grabmeier
++ Date Created: 07 March 1991
++ Date Last Updated: 14 June 1991
++ Basic Operations: *,**,+,-
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords: associated Liealgebra
++ References:
++ Description:
++  AssociatedLieAlgebra takes an algebra \spad{A}
++  and uses \spadfun{*$A} to define the
++  Lie bracket \spad{a*b := (a *$A b - b *$A a)} (commutator). Note that
++  the notation \spad{[a,b]} cannot be used due to
++  restrictions of the current compiler.
++  This domain only gives a Lie algebra if the
++  Jacobi-identity \spad{(a*b)*c + (b*c)*a + (c*a)*b = 0} holds
++  for all \spad{a},\spad{b},\spad{c} in \spad{A}.
++  This relation can be checked by
++  \spad{lieAdmissible?()$A}.
++
++  If the underlying algebra is of type
++  \spadtype{FramedNonAssociativeAlgebra(R)} (i.e. a non
++  associative algebra over R which is a free \spad{R}-module of finite
++  rank, together with a fixed \spad{R}-module basis), then the same
++  is true for the associated Lie algebra.
++  Also, if the underlying algebra is of type
++  \spadtype{FiniteRankNonAssociativeAlgebra(R)} (i.e. a non
++  associative algebra over R which is a free R-module of finite
++  rank), then the same is true for the associated Lie algebra.

AssociatedLieAlgebra(R:CommutativeRing,A:NonAssociativeAlgebra R):
    public == private where
  public ==> Join (NonAssociativeAlgebra R, CoercibleTo A)  with
    coerce : A -> %
      ++ coerce(a) coerces the element \spad{a} of the algebra \spad{A}
      ++ to an element of the Lie
      ++ algebra \spadtype{AssociatedLieAlgebra}(R,A).
    if A has FramedNonAssociativeAlgebra(R) then 
      FramedNonAssociativeAlgebra(R)
    if A has FiniteRankNonAssociativeAlgebra(R) then 
      FiniteRankNonAssociativeAlgebra(R)

  private ==> A add
    (a:%) * (b:%) == per(rep a * rep b - rep b * rep a)
    coerce(a:%):A == rep a
    coerce(a:A):% == per a
    (a:%) ** (n:PositiveInteger) ==
      n = 1 => a
      0

)abbrev domain JORDAN AssociatedJordanAlgebra
++ Author: J. Grabmeier
++ Date Created: 14 June 1991
++ Date Last Updated: 14 June 1991
++ Basic Operations: *,**,+,-
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords: associated Jordan algebra
++ References:
++ Description:
++  AssociatedJordanAlgebra takes an algebra \spad{A} and uses \spadfun{*$A}
++  to define the new multiplications \spad{a*b := (a *$A b + b *$A a)/2}
++  (anticommutator).
++  The usual notation \spad{{a,b}_+} cannot be used due to
++  restrictions in the current language.
++  This domain only gives a Jordan algebra if the
++  Jordan-identity \spad{(a*b)*c + (b*c)*a + (c*a)*b = 0} holds
++  for all \spad{a},\spad{b},\spad{c} in \spad{A}.
++  This relation can be checked by
++  \spadfun{jordanAdmissible?()$A}.
++
++ If the underlying algebra is of type
++ \spadtype{FramedNonAssociativeAlgebra(R)} (i.e. a non
++ associative algebra over R which is a free R-module of finite
++ rank, together with a fixed R-module basis), then the same
++ is true for the associated Jordan algebra.
++ Moreover, if the underlying algebra is of type
++ \spadtype{FiniteRankNonAssociativeAlgebra(R)} (i.e. a non
++ associative algebra over R which is a free R-module of finite
++ rank), then the same true for the associated Jordan algebra.

AssociatedJordanAlgebra(R:CommutativeRing,A:NonAssociativeAlgebra R):
    public == private where
  public ==> Join (NonAssociativeAlgebra R, CoercibleTo A)  with
    coerce : A -> %
      ++ coerce(a) coerces the element \spad{a} of the algebra \spad{A}
      ++ to an element of the Jordan algebra
      ++ \spadtype{AssociatedJordanAlgebra}(R,A).
    if A has FramedNonAssociativeAlgebra(R) then _
      FramedNonAssociativeAlgebra(R)
    if A has FiniteRankNonAssociativeAlgebra(R) then _
      FiniteRankNonAssociativeAlgebra(R)

  private ==> A add
    oneHalf : R := recip(1$R + 1$R) :: R
    (a:%) * (b:%) ==
      characteristic$R = 2 => error
        "constructor must not be called with Ring of characteristic 2"
      per((rep a * rep b + rep b * rep a) * oneHalf)
    coerce(a:%):A == rep a
    coerce(a:A):% == per a
    (a:%) ** (n:PositiveInteger) == a

)abbrev domain LSQM LieSquareMatrix
++ Author: J. Grabmeier
++ Date Created: 07 March 1991
++ Date Last Updated: 08 March 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++   LieSquareMatrix(n,R) implements the Lie algebra of the n by n
++   matrices over the commutative ring R.
++   The Lie bracket (commutator) of the algebra is given by
++   \spad{a*b := (a *$SQMATRIX(n,R) b - b *$SQMATRIX(n,R) a)},
++   where \spadfun{*$SQMATRIX(n,R)} is the usual matrix multiplication.
LieSquareMatrix(n,R): Exports == Implementation where

  n    : PositiveInteger
  R    : CommutativeRing

  Row ==> DirectProduct(n,R)
  Col ==> DirectProduct(n,R)

  Exports ==> Join(SquareMatrixCategory(n,R,Row,Col), CoercibleTo Matrix R,_
      FramedNonAssociativeAlgebra R) --with

  Implementation ==> AssociatedLieAlgebra (R,SquareMatrix(n, R)) add
      -- local functions
    n2 : PositiveInteger := n*n

    convDM : DirectProduct(n2,R) -> %
    conv : DirectProduct(n2,R) ->  SquareMatrix(n,R)
      --++ converts n2-vector to (n,n)-matrix row by row
    conv v  ==
      cond : Matrix(R) := new(n,n,0$R)$Matrix(R)
      z : Integer := 0
      for i in 1..n repeat
        for j in 1..n  repeat
          z := z+1
          setelt(cond,i,j,v.z)
      squareMatrix(cond)$SquareMatrix(n, R)


    coordinates(a:%,b:Vector(%)):Vector(R) ==
      -- only valid for b canonicalBasis
      res : Vector R := new(n2,0$R)
      z : Integer := 0
      for i in 1..n repeat
        for j in 1..n repeat
          z := z+1
          res.z := elt(a,i,j)$%
      res


    convDM v ==
      per(conv(v)::Rep)

    basis() ==
      n2 : PositiveInteger := n*n
      ldp : List DirectProduct(n2,R) :=
        [unitVector(i::PositiveInteger)$DirectProduct(n2,R) for i in 1..n2]
      res:Vector % := vector map(convDM,_
        ldp)$ListFunctions2(DirectProduct(n2,R), %)

    someBasis() == basis()
    rank() == n*n


--    transpose: % -> %
--      ++ computes the transpose of a matrix
--    squareMatrix: Matrix R -> %
--      ++ converts a Matrix to a LieSquareMatrix
--    coerce: % -> Matrix R
--      ++ converts a LieSquareMatrix to a Matrix
--    symdecomp : % -> Record(sym:%,antisym:%)
--    if R has commutative("*") then
--      minorsVect: -> Vector(Union(R,"uncomputed")) --range: 1..2**n-1
--    if R has commutative("*") then central
--    if R has commutative("*") and R has unitsKnown then unitsKnown

