)abbrev domain ALGSC AlgebraGivenByStructuralConstants
++ Authors: J. Grabmeier, R. Wisbauer
++ Date Created: 01 March 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords: algebra, structural constants
++ Reference:
++  R.D. Schafer: An Introduction to Nonassociative Algebras
++  Academic Press, New York, 1966
++ Description:
++  AlgebraGivenByStructuralConstants implements finite rank algebras
++  over a commutative ring, given by the structural constants \spad{gamma}
++  with respect to a fixed  basis \spad{[a1, .., an]}, where
++  \spad{gamma} is an \spad{n}-vector of n by n matrices
++  \spad{[(gammaijk) for k in 1..rank()]} defined by
++  \spad{ai * aj = gammaij1 * a1 + ... + gammaijn * an}.
++  The symbols for the fixed basis
++  have to be given as a list of symbols.
AlgebraGivenByStructuralConstants(R : CommutativeRing, n : PositiveInteger, _
  ls : List Symbol, gamma : Vector Matrix R ) : public == private where

  V  ==> Vector
  M  ==> Matrix
  I  ==> Integer
  NNI  ==> NonNegativeInteger
  OV ==> OrderedVariableList(ls)

  --public ==> FramedNonAssociativeAlgebra(R) with
  public ==> Join(FramedNonAssociativeAlgebra(R), FreeModuleCategory(R, OV),
      LeftModule(SquareMatrix(n, R)) ) with

    coerce : Vector R -> %
      ++ coerce(v) converts a vector to a member of the algebra
      ++ by forming a linear combination with the basis element.
      ++ Note: the vector is assumed to have length equal to the
      ++ dimension of the algebra.

  private ==> DirectProduct(n, R) add

    Rep := DirectProduct(n, R)

    import from List(V(R))

    x, y : %
    dp : DirectProduct(n, R)
    v : V R

    Term ==> Record(k : OV, c : R)

    -- Operation from FreeModuleCategory

    listOfTerms(x : %) : List(Term) ==
        res := []$List(Term)
        for i in 1..n repeat
            c := x(i)
            if (c ~= 0) then
                res := cons([index(qcoerce(i)@PositiveInteger), c]$Term, res)
        reverse!(res)

    numberOfMonomials(x : %) : NNI ==
        res := 0$NNI
        for i in 1..n repeat
            c := x(i)
            if (c ~= 0) then
                res := res + 1
        res

    monomial?(X : %) : Boolean == numberOfMonomials(x) = 1

    leadingTerm(x : %) : Term ==
        for i in 1..n repeat
            c := x(i)
            if (c ~= 0) then
                return [index(qcoerce(i)@PositiveInteger), c]$Term
        error "can not take leadingTerm of zero element"

    linearExtend(f : (OV -> R), x : %) : R ==
        res := 0$R
        for i in 1..n repeat
            c := x(i)
            if (c ~= 0) then
                res := res + c*f(index(qcoerce(i)@PositiveInteger))
        res

    reductum(x : %) : % ==
        v : Vector R :=  new(n, 0)
        first := true
        for i in 1..n repeat
            c := x(i)
            if (c ~= 0) then
                if first then
                    first := false
                else
                    v(i) := x(i)
        directProduct(v)

    construct(l : List(Term)) : % ==
        v : Vector R :=  new(n, 0)
        for el in l repeat
            i := lookup(el.k)
            v(i) := el.c
        directProduct(v)

    coefficient(x : %, v : OV) : R == x(lookup(v))

    linearExtend(f : (OV -> R), x : %) : R ==
        res := 0$R
        for i in 1..n repeat
            c := x(i)
            if (c ~= 0) then
                res := res + c*f(index(qcoerce(i)@PositiveInteger))
        res

    constructOrdered(l : List(Term)) : % == construct(l)

    monomial(c : R, s : OV) : % ==
        v : Vector R :=  new(n, 0)
        v(lookup(s)) := c
        directProduct(v)

    -------------------

    recip(x) == recip(x)$FiniteRankNonAssociativeAlgebra_&(%, R)

    (m : SquareMatrix(n, R))*(x : %) == apply((m :: Matrix R), x)
    coerce v == directProduct(v) :: %

    structuralConstants() == gamma

    coordinates(x) == vector(entries(x :: Rep)$Rep)$Vector(R)

    if R has IntegralDomain then

        LSMP ==> LinearSystemMatrixPackage2(R)

        coordinates(x, b) ==
            m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger
            transitionMatrix : Matrix(R) := new(n, m, 0$R)$Matrix(R)
            for i in 1..m repeat
                setColumn!(transitionMatrix, i, coordinates(b.i))
            res := solveUniquely(transitionMatrix, coordinates(x))$LSMP
            res case "failed" =>
                error "coordinates: solveUniquely failed"
            res@Vector(R)

    basis() == [unitVector(i::PositiveInteger)::% for i in 1..n]

    someBasis() == basis()$%

    rank() == n

    elt(x, i) == elt(x::Rep, i)$Rep

    coerce(x : %) : OutputForm ==
      zero?(x::Rep)$Rep => (0$R) :: OutputForm
      le : List OutputForm := []
      for i in 1..n repeat
        coef : R := elt(x::Rep, i)
        not zero?(coef)$R =>
          ((coef) = 1)$R =>
            -- sy : OutputForm := elt(ls, i)$(List Symbol) :: OutputForm
            le := cons(elt(ls, i)$(List Symbol) :: OutputForm, le)
          le := cons(coef :: OutputForm *  elt(ls, i)$(List Symbol)_
              :: OutputForm, le)
      reduce("+",le)

    x * y ==
      v : Vector R :=  new(n, 0)
      for k in 1..n repeat
        h : R := 0
        for i in 1..n repeat
          for j in 1..n repeat
            h := h  +$R elt(x, i) *$R elt(y, j) *$R elt(gamma.k, i, j )
        v.k := h
      directProduct v



    alternative?() ==
      for i in 1..n repeat
        -- expression for check of left alternative is symmetric in i and j:
        -- expression for check of right alternative is symmetric in j and k:
        for j in 1..i-1 repeat
          for k in j..n repeat
            -- right check
            for r in 1..n repeat
              res := 0$R
              for l in 1..n repeat
                res := res - _
                  (elt(gamma.l, j, k)+elt(gamma.l, k, j))*elt(gamma.r, i, l)+_
                  (elt(gamma.l, i, j)*elt(gamma.r, l, k) + elt(gamma.l, i, k)*_
                  elt(gamma.r, l, j) )
              not zero? res =>
                messagePrint("algebra is not right alternative")$OutputForm
                return false
        for j in i..n repeat
          for k in 1..j-1 repeat
            -- left check
            for r in 1..n repeat
              res := 0$R
              for l in 1..n repeat
                res := res + _
                  (elt(gamma.l, i, j)+elt(gamma.l, j, i))*elt(gamma.r, l, k)-_
                  (elt(gamma.l, j, k)*elt(gamma.r, i, l) + elt(gamma.l, i, k)*_
                   elt(gamma.r, j, l) )
              not (zero? res) =>
                messagePrint("algebra is not left alternative")$OutputForm
                return false

          for k in j..n repeat
            -- left check
            for r in 1..n repeat
              res := 0$R
              for l in 1..n repeat
                res := res + _
                  (elt(gamma.l, i, j)+elt(gamma.l, j, i))*elt(gamma.r, l, k)-_
                  (elt(gamma.l, j, k)*elt(gamma.r, i, l) + elt(gamma.l, i, k)*_
                   elt(gamma.r, j, l) )
              not (zero? res) =>
                messagePrint("algebra is not left alternative")$OutputForm
                return false
            -- right check
            for r in 1..n repeat
              res := 0$R
              for l in 1..n repeat
                res := res - _
                  (elt(gamma.l, j, k)+elt(gamma.l, k, j))*elt(gamma.r, i, l)+_
                  (elt(gamma.l, i, j)*elt(gamma.r, l, k) + elt(gamma.l, i, k)*_
                  elt(gamma.r, l, j) )
              not (zero? res) =>
                messagePrint("algebra is not right alternative")$OutputForm
                return false

      messagePrint("algebra satisfies 2*associator(a,b,b) = 0 = 2*associator(a,a,b) = 0")$OutputForm
      true

    -- should be in the category, but is not exported
--    conditionsForIdempotents b  ==
--      n := rank()
--      --gamma : Vector Matrix R := structuralConstants b
--      listOfNumbers : List String :=  [convert(q) for q in 1..n]
--      symbolsForCoef : Vector Symbol :=
--        [concat("%", concat("x", i))::Symbol  for i in listOfNumbers]
--      conditions : List Polynomial R := []
 --     for k in 1..n repeat
 --       xk := symbolsForCoef.k
 --       p : Polynomial R :=  monomial( - 1$Polynomial(R), [xk], [1] )
 --       for i in 1..n repeat
 --         for j in 1..n repeat
 --           xi := symbolsForCoef.i
 --           xj := symbolsForCoef.j
 --           p := p + monomial(_
 --             elt((gamma.k), i, j) :: Polynomial(R), [xi, xj], [1, 1])
 --       conditions := cons(p, conditions)
 --     conditions

    associative?() ==
      for i in 1..n repeat
       for j in 1..n repeat
        for k in 1..n repeat
         for r in 1..n repeat
           res := 0$R
           for l in 1..n repeat
             res := res + elt(gamma.l, i, j)*elt(gamma.r, l, k)-_
                          elt(gamma.l, j, k)*elt(gamma.r, i, l)
           not (zero? res) =>
            messagePrint("algebra is not associative")$OutputForm
            return false
      messagePrint("algebra is associative")$OutputForm
      true


    antiAssociative?() ==
      for i in 1..n repeat
       for j in 1..n repeat
        for k in 1..n repeat
         for r in 1..n repeat
           res := 0$R
           for l in 1..n repeat
             res := res + elt(gamma.l, i, j)*elt(gamma.r, l, k)+_
                          elt(gamma.l, j, k)*elt(gamma.r, i, l)
           not (zero? res) =>
            messagePrint("algebra is not anti-associative")$OutputForm
            return false
      messagePrint("algebra is anti-associative")$OutputForm
      true

    commutative?() ==
      for i in 1..n repeat
       for j in (i+1)..n repeat
        for k in 1..n repeat
           not ( elt(gamma.k, i, j)=elt(gamma.k, j, i) ) =>
            messagePrint("algebra is not commutative")$OutputForm
            return false
      messagePrint("algebra is commutative")$OutputForm
      true

    antiCommutative?() ==
      for i in 1..n repeat
       for j in i..n repeat
        for k in 1..n repeat
          not zero? (i = j => elt(gamma.k, i, i); elt(gamma.k, i, j)+elt(gamma.k, j, i) ) =>
            messagePrint("algebra is not anti-commutative")$OutputForm
            return false
      messagePrint("algebra is anti-commutative")$OutputForm
      true

    leftAlternative?() ==
      for i in 1..n repeat
       -- expression is symmetric in i and j:
       for j in i..n repeat
        for k in 1..n repeat
         for r in 1..n repeat
           res := 0$R
           for l in 1..n repeat
             res := res + (elt(gamma.l, i, j)+elt(gamma.l, j, i))*elt(gamma.r, l, k)-_
               (elt(gamma.l, j, k)*elt(gamma.r, i, l) + elt(gamma.l, i, k)*elt(gamma.r, j, l) )
           not (zero? res) =>
            messagePrint("algebra is not left alternative")$OutputForm
            return false
      messagePrint("algebra is left alternative")$OutputForm
      true


    rightAlternative?() ==
      for i in 1..n repeat
       for j in 1..n repeat
       -- expression is symmetric in j and k:
        for k in j..n repeat
         for r in 1..n repeat
           res := 0$R
           for l in 1..n repeat
             res := res - (elt(gamma.l, j, k)+elt(gamma.l, k, j))*elt(gamma.r, i, l)+_
               (elt(gamma.l, i, j)*elt(gamma.r, l, k) + elt(gamma.l, i, k)*elt(gamma.r, l, j) )
           not (zero? res) =>
            messagePrint("algebra is not right alternative")$OutputForm
            return false
      messagePrint("algebra is right alternative")$OutputForm
      true


    flexible?() ==
      for i in 1..n repeat
       for j in 1..n repeat
       -- expression is symmetric in i and k:
        for k in i..n repeat
         for r in 1..n repeat
           res := 0$R
           for l in 1..n repeat
             res := res + elt(gamma.l, i, j)*elt(gamma.r, l, k)-_
                          elt(gamma.l, j, k)*elt(gamma.r, i, l)+_
                          elt(gamma.l, k, j)*elt(gamma.r, l, i)-_
                          elt(gamma.l, j, i)*elt(gamma.r, k, l)
           not (zero? res) =>
            messagePrint("algebra is not flexible")$OutputForm
            return false
      messagePrint("algebra is flexible")$OutputForm
      true

    lieAdmissible?() ==
      for i in 1..n repeat
       for j in 1..n repeat
        for k in 1..n repeat
         for r in 1..n repeat
           res := 0$R
           for l in 1..n repeat
             res := res_
              + (elt(gamma.l, i, j)-elt(gamma.l, j, i))*(elt(gamma.r, l, k)-elt(gamma.r, k, l)) _
              + (elt(gamma.l, j, k)-elt(gamma.l, k, j))*(elt(gamma.r, l, i)-elt(gamma.r, i, l)) _
              + (elt(gamma.l, k, i)-elt(gamma.l, i, k))*(elt(gamma.r, l, j)-elt(gamma.r, j, l))
           not (zero? res) =>
            messagePrint("algebra is not Lie admissible")$OutputForm
            return false
      messagePrint("algebra is Lie admissible")$OutputForm
      true

    jordanAdmissible?()  ==
      recip(2 * 1$R) case "failed" =>
        messagePrint("this algebra is not Jordan admissible, as 2 is not invertible in the ground ring")$OutputForm
        false
      for i in 1..n repeat
       for j in 1..n repeat
        for k in 1..n repeat
         for w in 1..n repeat
          for t in 1..n repeat
           res := 0$R
           for l in 1..n repeat
            for r in 1..n repeat
             res := res_
              + (elt(gamma.l, i, j)+elt(gamma.l, j, i))_
                * (elt(gamma.r, w, k)+elt(gamma.r, k, w))_
                * (elt(gamma.t, l, r)+elt(gamma.t, r, l))_
              - (elt(gamma.r, w, k)+elt(gamma.r, k, w))_
                * (elt(gamma.l, j, r)+elt(gamma.l, r, j))_
                * (elt(gamma.t, i, l)+elt(gamma.t, l, i))_
              + (elt(gamma.l, w, j)+elt(gamma.l, j, w))_
                * (elt(gamma.r, k, i)+elt(gamma.r, i, k))_
                * (elt(gamma.t, l, r)+elt(gamma.t, r, l))_
              - (elt(gamma.r, k, i)+elt(gamma.r, k, i))_
                * (elt(gamma.l, j, r)+elt(gamma.l, r, j))_
                * (elt(gamma.t, w, l)+elt(gamma.t, l, w))_
              + (elt(gamma.l, k, j)+elt(gamma.l, j, k))_
                * (elt(gamma.r, i, w)+elt(gamma.r, w, i))_
                * (elt(gamma.t, l, r)+elt(gamma.t, r, l))_
              - (elt(gamma.r, i, w)+elt(gamma.r, w, i))_
                * (elt(gamma.l, j, r)+elt(gamma.l, r, j))_
                * (elt(gamma.t, k, l)+elt(gamma.t, l, k))
           not (zero? res) =>
             messagePrint("algebra is not Jordan admissible")$OutputForm
             return false
      messagePrint("algebra is Jordan admissible")$OutputForm
      true

    jordanAlgebra?()  ==
      recip(2 * 1$R) case "failed" =>
        messagePrint("this is not a Jordan algebra, as 2 is not invertible in the ground ring")$OutputForm
        false
      not commutative?() =>
        messagePrint("this is not a Jordan algebra")$OutputForm
        false
      for i in 1..n repeat
       for j in 1..n repeat
        for k in 1..n repeat
         for l in 1..n repeat
           for t in 1..n repeat
             res := 0$R
             for r in 1..n repeat
               for s in 1..n repeat
                 res := res +  _
                   elt(gamma.r, i, j)*elt(gamma.s, l, k)*elt(gamma.t, r, s) - _
                   elt(gamma.r, l, k)*elt(gamma.s, j, r)*elt(gamma.t, i, s) + _
                   elt(gamma.r, l, j)*elt(gamma.s, k, k)*elt(gamma.t, r, s) - _
                   elt(gamma.r, k, i)*elt(gamma.s, j, r)*elt(gamma.t, l, s) + _
                   elt(gamma.r, k, j)*elt(gamma.s, i, k)*elt(gamma.t, r, s) - _
                   elt(gamma.r, i, l)*elt(gamma.s, j, r)*elt(gamma.t, k, s)
                 not zero? res =>
                   messagePrint("this is not a Jordan algebra")$OutputForm
                   return false
      messagePrint("this is a Jordan algebra")$OutputForm
      true


    jacobiIdentity?()  ==
      for i in 1..n repeat
       for j in 1..n repeat
        for k in 1..n repeat
         for r in 1..n repeat
           res := 0$R
           for s in 1..n repeat
                 res := res +  elt(gamma.s, i, j)*elt(gamma.r, s, k) +_
                               elt(gamma.s, j, k)*elt(gamma.r, s, i) +_
                               elt(gamma.s, k, i)*elt(gamma.r, s, j)
           not zero? res =>
                 messagePrint("Jacobi identity does not hold")$OutputForm
                 return false
      messagePrint("Jacobi identity holds")$OutputForm
      true

)abbrev package SCPKG StructuralConstantsPackage
++ Authors: J. Grabmeier
++ Date Created: 02 April 1992
++ Basic Operations:
++ Related Constructors: AlgebraPackage, AlgebraGivenByStructuralConstants
++ Also See:
++ AMS Classifications:
++ Keywords: structural constants
++ Reference:
++ Description:
++  StructuralConstantsPackage provides functions creating
++  structural constants from a multiplication tables or a basis
++  of a matrix algebra and other useful functions in this context.
StructuralConstantsPackage(R : IntegralDomain) : public == private where

  L  ==> List
  S  ==> Symbol
  FRAC ==> Fraction
  POLY ==> Polynomial
  V  ==> Vector
  M  ==> Matrix

  public ==>  with
      -- what we really want to have here is a matrix over
      -- linear polynomials in the list of symbols, having arbitrary
      -- coefficients from a ring extension of R, e.g. FRAC POLY R.
      structuralConstants : (L S, M FRAC POLY R) -> V M FRAC POLY R
        ++ structuralConstants(ls, mt) determines the structural constants
        ++ of an algebra with generators ls and multiplication table mt, the
        ++ entries of which must be given as linear polynomials in the
        ++ indeterminates given by ls. The result is in particular useful
        ++  as fourth argument for \spadtype{AlgebraGivenByStructuralConstants}
        ++  and \spadtype{GenericNonAssociativeAlgebra}.
      structuralConstants : (L S, M POLY R) -> V M POLY R
        ++ structuralConstants(ls, mt) determines the structural constants
        ++ of an algebra with generators ls and multiplication table mt, the
        ++ entries of which must be given as linear polynomials in the
        ++ indeterminates given by ls. The result is in particular useful
        ++  as fourth argument for \spadtype{AlgebraGivenByStructuralConstants}
        ++  and \spadtype{GenericNonAssociativeAlgebra}.
      structuralConstants : L M R -> V M R
        ++ structuralConstants(basis)  takes the basis of a matrix
        ++ algebra, e.g. the result of \spadfun{basisOfCentroid} and calculates
        ++ the structural constants.
        ++ Note, that the it is not checked, whether basis really is a
        ++ basis of a matrix algebra.
      coordinates : (M R, L M R) -> V R
        ++ coordinates(a, [v1, ..., vn]) returns the coordinates of \spad{a}
        ++ with respect to the \spad{R}-module basis \spad{v1}, ..., \spad{vn}.

  private ==> add

      LSMP ==> LinearSystemMatrixPackage2(R)

      matrix2Vector : M R -> V R
      matrix2Vector m ==
        lili : L L R := listOfLists m
        --li : L R  := reduce(concat, listOfLists m)
        li : L R  := reduce(concat, lili)
        construct(li)$(V R)

      coordinates(x, b) ==
        m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger
        n : NonNegativeInteger := nrows(b.1) * ncols(b.1)
        transitionMatrix   : Matrix R := new(n, m, 0$R)$Matrix(R)
        for i in 1..m repeat
          setColumn!(transitionMatrix, i, matrix2Vector(b.i))
        res:= solveUniquely(transitionMatrix, matrix2Vector(x))$LSMP
        res case "failed" =>
          error "coordinates: solveUniquely failed"
        res@Vector(R)

      structuralConstants b ==
        --n := rank()
        -- be careful with the possibility that b is not a basis
        m : NonNegativeInteger := (maxIndex b) :: NonNegativeInteger
        sC : Vector Matrix R := [new(m, m, 0$R) for k in 1..m]
        for i in 1..m repeat
          for j in 1..m repeat
            covec : Vector R := coordinates(b.i * b.j, b)$%
            for k in 1..m repeat
               setelt!(sC.k, i, j, covec.k)
        sC

      structuralConstants(ls : L S, mt : M POLY R)  ==
        nn := #(ls)
        nrows(mt) ~= nn or ncols(mt) ~= nn =>
          error "structuralConstants: size of second argument does not _
agree with number of generators"
        gamma : L M POLY R := []
        lscopy : L S := copy ls
        while not(empty?(lscopy)) repeat
          mat : M POLY R := new(nn, nn, 0)
          s : S := first lscopy
          for i in 1..nn repeat
            for j in 1..nn repeat
              p := qelt(mt, i, j)
              totalDegree(p, ls) > 1 =>
                error "structuralConstants: entries of second argument _
must be linear polynomials in the generators"
              if (c := coefficient(p, s, 1) ) ~= 0 then qsetelt!(mat, i, j, c)
          gamma := cons(mat, gamma)
          lscopy := rest lscopy
        vector reverse gamma

      structuralConstants(ls : L S, mt : M FRAC POLY R)  ==
        nn := #(ls)
        nrows(mt) ~= nn or ncols(mt) ~= nn =>
          error "structuralConstants: size of second argument does not _
agree with number of generators"
        gamma : L M FRAC(POLY R) := []
        lscopy : L S := copy ls
        while not(empty?(lscopy)) repeat
          mat : M FRAC(POLY R) := new(nn, nn, 0)
          s : S := first lscopy
          for i in 1..nn repeat
            for j in 1..nn repeat
              r := qelt(mt, i, j)
              q := denom(r)
              totalDegree(q, ls) ~= 0 =>
                error "structuralConstants: entries of second argument _
must be (linear) polynomials in the generators"
              p := numer(r)
              totalDegree(p, ls) > 1 =>
                error "structuralConstants: entries of second argument _
must be linear polynomials in the generators"
              if (c := coefficient(p, s, 1) ) ~= 0 then qsetelt!(mat, i, j, c/q)
          gamma := cons(mat, gamma)
          lscopy := rest lscopy
        vector reverse gamma

)abbrev package ALGPKG AlgebraPackage
++ Authors: J. Grabmeier, R. Wisbauer
++ Date Created: 04 March 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords: rank, nucleus, nucloid, structural constants
++ Reference:
++  R.S. Pierce: Associative Algebras
++  Graduate Texts in Mathematics 88
++  Springer-Verlag,  Heidelberg, 1982, ISBN 0-387-90693-2
++
++  R.D. Schafer: An Introduction to Nonassociative Algebras
++  Academic Press, New York, 1966
++
++  A. Woerz-Busekros: Algebra in Genetics
++  Lectures Notes in Biomathematics 36,
++  Springer-Verlag,  Heidelberg, 1980
++ Description:
++  AlgebraPackage assembles a variety of useful functions for
++  general algebras.
AlgebraPackage(R : IntegralDomain, A : FramedNonAssociativeAlgebra(R)) : _
   public == private where

  V  ==> Vector
  M  ==> Matrix
  I  ==> Integer
  NNI  ==> NonNegativeInteger
  REC  ==> Record(particular: Union(V R,"failed"),basis: List V R)
  LSMP ==> LinearSystemMatrixPackage(R, V R, V R, M R)

  public ==>  with

      leftRank : A -> NonNegativeInteger
        ++ leftRank(x) determines the number of linearly independent elements
        ++ in \spad{x*b1}, ..., \spad{x*bn},
        ++ where \spad{b=[b1, ..., bn]} is a basis.
      rightRank : A -> NonNegativeInteger
        ++ rightRank(x) determines the number of linearly independent elements
        ++ in \spad{b1*x}, ..., \spad{bn*x},
        ++ where \spad{b=[b1, ..., bn]} is a basis.
      doubleRank : A -> NonNegativeInteger
        ++ doubleRank(x) determines the number of linearly
        ++ independent elements
        ++ in \spad{b1*x}, ..., \spad{x*bn},
        ++ where \spad{b=[b1, ..., bn]} is a basis.
      weakBiRank : A -> NonNegativeInteger
        ++ weakBiRank(x) determines the number of
        ++ linearly independent elements
        ++ in the \spad{bi*x*bj}, \spad{i, j=1, ..., n},
        ++ where \spad{b=[b1, ..., bn]} is a basis.
      biRank : A -> NonNegativeInteger
        ++ biRank(x) determines the number of linearly independent elements
        ++ in \spad{x}, \spad{x*bi}, \spad{bi*x}, \spad{bi*x*bj},
        ++ \spad{i, j=1, ..., n},
        ++ where \spad{b=[b1, ..., bn]} is a basis.
        ++ Note: if \spad{A} has a unit,
        ++ then \spadfunFrom{doubleRank}{AlgebraPackage},
        ++ \spadfunFrom{weakBiRank}{AlgebraPackage}
        ++ and \spadfunFrom{biRank}{AlgebraPackage} coincide.
      basisOfCommutingElements : () -> List A
        ++ basisOfCommutingElements() returns a basis of the space of
        ++ all x of \spad{A} satisfying \spad{0 = commutator(x, a)} for all
        ++ \spad{a} in \spad{A}.
      basisOfLeftAnnihilator : A -> List A
        ++ basisOfLeftAnnihilator(a) returns a basis of the space of
        ++ all x of \spad{A} satisfying \spad{0 = x*a}.
      basisOfRightAnnihilator : A -> List A
        ++ basisOfRightAnnihilator(a) returns a basis of the space of
        ++ all x of \spad{A} satisfying \spad{0 = a*x}.
      basisOfLeftNucleus : () -> List A
        ++ basisOfLeftNucleus() returns a basis of the space of
        ++ all x of \spad{A} satisfying \spad{0 = associator(x, a, b)}
        ++ for all \spad{a}, b in \spad{A}.
      basisOfRightNucleus : () -> List A
        ++ basisOfRightNucleus() returns a basis of the space of
        ++ all x of \spad{A} satisfying \spad{0 = associator(a, b, x)}
        ++ for all \spad{a}, b in \spad{A}.
      basisOfMiddleNucleus : () -> List A
        ++ basisOfMiddleNucleus() returns a basis of the space of
        ++ all x of \spad{A} satisfying \spad{0 = associator(a, x, b)}
        ++ for all \spad{a}, b in \spad{A}.
      basisOfNucleus : () -> List A
        ++ basisOfNucleus() returns a basis of the space of all x of \spad{A} satisfying
        ++ \spad{associator(x, a, b) = associator(a, x, b) = associator(a, b, x) = 0}
        ++ for all \spad{a}, b in \spad{A}.
      basisOfCenter : () -> List A
        ++ basisOfCenter() returns a basis of the space of
        ++ all x of \spad{A} satisfying \spad{commutator(x, a) = 0} and
        ++ \spad{associator(x, a, b) = associator(a, x, b) = associator(a, b, x) = 0}
        ++ for all \spad{a}, b in \spad{A}.
      basisOfLeftNucloid : ()-> List Matrix R
        ++ basisOfLeftNucloid() returns a basis of the space of
        ++ endomorphisms of \spad{A} as right module.
        ++ Note: left nucloid coincides with left nucleus if \spad{A} has a unit.
      basisOfRightNucloid : ()-> List Matrix R
        ++ basisOfRightNucloid() returns a basis of the space of
        ++ endomorphisms of \spad{A} as left module.
        ++ Note: right nucloid coincides with right nucleus if \spad{A} has a unit.
      basisOfCentroid : ()-> List Matrix R
        ++ basisOfCentroid() returns a basis of the centroid, i.e. the
        ++ endomorphism ring of \spad{A} considered as \spad{(A, A)}-bimodule.
      radicalOfLeftTraceForm : () -> List A
        ++ radicalOfLeftTraceForm() returns basis for null space of
        ++ \spad{leftTraceMatrix()}, if the algebra is
        ++ associative, alternative or a Jordan algebra, then this
        ++ space equals the radical (maximal nil ideal) of the algebra.
      if R has EuclideanDomain then
        basis : V A ->  V A
          ++ basis(va) selects a basis from the elements of va.


  private ==>  add

      -- constants

      n  : PositiveInteger := rank()$A
      n2 : PositiveInteger := n*n
      n3 : PositiveInteger := n*n2
      gamma : Vector Matrix R  := structuralConstants()$A


      -- local functions

      convVM : Vector R -> Matrix R
        -- converts n2-vector to (n, n)-matrix row by row
      convMV : Matrix R -> Vector R
        -- converts n-square matrix to  n2-vector row by row
      convVM v  ==
        cond : Matrix(R) := new(n, n, 0$R)$M(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)
        cond


      -- convMV m ==
      --     vec : Vector(R) := new(n*n, 0$R)
      --     z : Integer := 0
      --     for i in 1..n repeat
      --       for j in 1..n  repeat
      --         z := z+1
      --         setelt!(vec, z, elt(m, i, j))
      --     vec


      radicalOfLeftTraceForm() ==
        ma : M R := leftTraceMatrix()$A
        map(represents, nullSpace ma)$ListFunctions2(Vector R, A)


      basisOfLeftAnnihilator a ==
        ca : M R := transpose (coordinates(a) :: M R)
        cond : M R := reduce(vertConcat$(M R),
          [ca*transpose(gamma.i) for i in 1..#gamma])
        map(represents, nullSpace cond)$ListFunctions2(Vector R, A)

      basisOfRightAnnihilator a ==
        ca : M R := transpose (coordinates(a) :: M R)
        cond : M R := reduce(vertConcat$(M R),
          [ca*(gamma.i) for i in 1..#gamma])
        map(represents, nullSpace cond)$ListFunctions2(Vector R, A)

      basisOfLeftNucloid() ==
        cond : Matrix(R) := new(n3, n2, 0$R)$M(R)
        condo : Matrix(R) := new(n3, n2, 0$R)$M(R)
        z : Integer := 0
        for i in 1..n repeat
          for j in 1..n repeat
            r1  : Integer := 0
            for k in 1..n repeat
              z := z + 1
              -- z equals (i-1)*n*n+(j-1)*n+k (loop-invariant)
              r2 : Integer := i
              for r in 1..n repeat
                r1 := r1 + 1
                -- here r1 equals (k-1)*n+r (loop-invariant)
                setelt!(cond, z, r1, elt(gamma.r, i, j))
                -- here r2 equals (r-1)*n+i (loop-invariant)
                setelt!(condo, z, r2, -elt(gamma.k, r, j))
                r2 := r2 + n
        [convVM(sol) for sol in nullSpace(cond+condo)]

      basisOfCommutingElements() ==
        --gamma1 := first gamma
        --gamma1 := gamma1 - transpose gamma1
        --cond : Matrix(R) := gamma1 :: Matrix(R)
        --for  i in  2..n repeat
        --  gammak := gamma.i
        --  gammak := gammak - transpose gammak
        --  cond :=  vertConcat(cond, gammak :: Matrix(R))$Matrix(R)
        --map(represents, nullSpace cond)$ListFunctions2(Vector R, A)

        cond : M R := reduce(vertConcat$(M R),
          [(gam := gamma.i) - transpose gam for i in 1..#gamma])
        map(represents, nullSpace cond)$ListFunctions2(Vector R, A)

      basisOfLeftNucleus() ==
        condi : Matrix(R) := new(n3, n, 0$R)$Matrix(R)
        z : Integer := 0
        for k in 1..n repeat
         for j in 1..n repeat
          for s in 1..n repeat
            z := z+1
            for i in 1..n repeat
              entry : R := 0
              for l in 1..n repeat
                entry :=  entry+elt(gamma.l, j, k)*elt(gamma.s, i, l)_
                               -elt(gamma.l, i, j)*elt(gamma.s, l, k)
              setelt!(condi, z, i, entry)$Matrix(R)
        map(represents, nullSpace condi)$ListFunctions2(Vector R, A)

      basisOfRightNucleus() ==
        condo : Matrix(R) := new(n3, n, 0$R)$Matrix(R)
        z : Integer := 0
        for k in 1..n repeat
         for j in 1..n repeat
          for s in 1..n repeat
            z := z+1
            for i in 1..n repeat
              entry : R := 0
              for l in 1..n repeat
                entry :=  entry+elt(gamma.l, k, i)*elt(gamma.s, j, l) _
                               -elt(gamma.l, j, k)*elt(gamma.s, l, i)
              setelt!(condo, z, i, entry)$Matrix(R)
        map(represents, nullSpace condo)$ListFunctions2(Vector R, A)

      basisOfMiddleNucleus() ==
        conda : Matrix(R) := new(n3, n, 0$R)$Matrix(R)
        z : Integer := 0
        for k in 1..n repeat
         for j in 1..n repeat
          for s in 1..n repeat
            z := z+1
            for i in 1..n repeat
              entry : R := 0
              for l in 1..n repeat
                entry :=  entry+elt(gamma.l, j, i)*elt(gamma.s, l, k)
                               -elt(gamma.l, i, k)*elt(gamma.s, j, l)
              setelt!(conda, z, i, entry)$Matrix(R)
        map(represents, nullSpace conda)$ListFunctions2(Vector R, A)


      basisOfNucleus() ==
        condi : Matrix(R) := new(3*n3, n, 0$R)$Matrix(R)
        z : Integer := 0
        u : Integer := n3
        w : Integer := 2*n3
        for k in 1..n repeat
         for j in 1..n repeat
          for s in 1..n repeat
            z := z+1
            u := u+1
            w := w+1
            for i in 1..n repeat
              entry : R := 0
              enter : R := 0
              ent   : R := 0
              for l in 1..n repeat
                entry :=  entry + elt(gamma.l, j, k)*elt(gamma.s, i, l) _
                                - elt(gamma.l, i, j)*elt(gamma.s, l, k)
                enter :=  enter + elt(gamma.l, k, i)*elt(gamma.s, j, l) _
                                - elt(gamma.l, j, k)*elt(gamma.s, l, i)
                ent :=  ent  +  elt(gamma.l, j, k)*elt(gamma.s, i, l) _
                             -  elt(gamma.l, j, i)*elt(gamma.s, l, k)
              setelt!(condi, z, i, entry)$Matrix(R)
              setelt!(condi, u, i, enter)$Matrix(R)
              setelt!(condi, w, i, ent)$Matrix(R)
        map(represents, nullSpace condi)$ListFunctions2(Vector R, A)

      basisOfCenter() ==
        gamma1 := first gamma
        gamma1 := gamma1 - transpose gamma1
        cond : Matrix(R) := gamma1 :: Matrix(R)
        for  i in  2..n repeat
          gammak := gamma.i
          gammak := gammak - transpose gammak
          cond :=  vertConcat(cond, gammak :: Matrix(R))$Matrix(R)
        B := cond :: Matrix(R)
        condi : Matrix(R) := new(2*n3, n, 0$R)$Matrix(R)
        z : Integer := 0
        u : Integer := n3
        for k in 1..n repeat
         for j in 1..n repeat
          for s in 1..n repeat
            z := z+1
            u := u+1
            for i in 1..n repeat
              entry : R := 0
              enter : R := 0
              for l in 1..n repeat
                entry :=  entry + elt(gamma.l, j, k)*elt(gamma.s, i, l) _
                                - elt(gamma.l, i, j)*elt(gamma.s, l, k)
                enter :=  enter + elt(gamma.l, k, i)*elt(gamma.s, j, l) _
                                - elt(gamma.l, j, k)*elt(gamma.s, l, i)
              setelt!(condi, z, i, entry)$Matrix(R)
              setelt!(condi, u, i, enter)$Matrix(R)
        D := vertConcat(condi, B)$Matrix(R)
        map(represents, nullSpace D)$ListFunctions2(Vector R, A)

      basisOfRightNucloid() ==
        cond : Matrix(R) := new(n3, n2, 0$R)$M(R)
        condo : Matrix(R) := new(n3, n2, 0$R)$M(R)
        z : Integer := 0
        for i in 1..n repeat
          for j in 1..n repeat
            r1  : Integer := 0
            for k in 1..n repeat
              z := z + 1
              -- z equals (i-1)*n*n+(j-1)*n+k (loop-invariant)
              r2 : Integer := i
              for r in 1..n repeat
                r1 := r1 + 1
                -- here r1 equals (k-1)*n+r (loop-invariant)
                setelt!(cond, z, r1, elt(gamma.r, j, i))
                -- here r2 equals (r-1)*n+i (loop-invariant)
                setelt!(condo, z, r2, -elt(gamma.k, j, r))
                r2 := r2 + n
        [convVM(sol) for sol in nullSpace(cond+condo)]

      basisOfCentroid() ==
        cond : Matrix(R) := new(2*n3, n2, 0$R)$M(R)
        condo : Matrix(R) := new(2*n3, n2, 0$R)$M(R)
        z : Integer := 0
        u : Integer := n3
        for i in 1..n repeat
          for j in 1..n repeat
            r1  : Integer := 0
            for k in 1..n repeat
              z := z + 1
              u := u + 1
              -- z equals (i-1)*n*n+(j-1)*n+k (loop-invariant)
              -- u equals n^3 + (i-1)*n*n+(j-1)*n+k (loop-invariant)
              r2 : Integer := i
              for r in 1..n repeat
                r1 := r1 + 1
                -- here r1 equals (k-1)*n+r (loop-invariant)
                setelt!(cond, z, r1, elt(gamma.r, i, j))
                setelt!(cond, u, r1, elt(gamma.r, j, i))
                -- here r2 equals (r-1)*n+i (loop-invariant)
                setelt!(condo, z, r2, -elt(gamma.k, r, j))
                setelt!(condo, u, r2, -elt(gamma.k, j, r))
                r2 := r2 + n
        [convVM(sol) for sol in nullSpace(cond+condo)]


      doubleRank x ==
        cond : Matrix(R) := new(2*n, n, 0$R)
        for k in 1..n repeat
         z : Integer := 0
         u : Integer := n
         for j in 1..n repeat
           z := z+1
           u := u+1
           entry : R := 0
           enter : R := 0
           for i in 1..n repeat
             entry := entry + elt(x, i)*elt(gamma.k, j, i)
             enter := enter + elt(x, i)*elt(gamma.k, i, j)
           setelt!(cond, z, k, entry)$Matrix(R)
           setelt!(cond, u, k, enter)$Matrix(R)
        rank(cond)$(M R)

      weakBiRank(x) ==
        cond : Matrix(R) := new(n2, n, 0$R)$Matrix(R)
        z : Integer := 0
        for i in 1..n repeat
          for j in 1..n repeat
            z := z+1
            for k in 1..n repeat
              entry : R := 0
              for l in 1..n repeat
               for s in 1..n repeat
                entry := entry+elt(x, l)*elt(gamma.s, i, l)*elt(gamma.k, s, j)
              setelt!(cond, z, k, entry)$Matrix(R)
        rank(cond)$(M R)

      biRank(x) ==
        cond : Matrix(R) := new(n2+2*n+1, n, 0$R)$Matrix(R)
        z : Integer := 0
        for j in 1..n repeat
          for i in 1..n repeat
            z := z+1
            for k in 1..n repeat
              entry : R := 0
              for l in 1..n repeat
               for s in 1..n repeat
                entry := entry+elt(x, l)*elt(gamma.s, i, l)*elt(gamma.k, s, j)
              setelt!(cond, z, k, entry)$Matrix(R)
        u : Integer := n*n
        w : Integer := n*(n+1)
        c := n2 + 2*n + 1
        for j in 1..n repeat
           u := u+1
           w := w+1
           for k in 1..n repeat
             entry : R := 0
             enter : R := 0
             for i in 1..n repeat
               entry := entry + elt(x, i)*elt(gamma.k, j, i)
               enter := enter + elt(x, i)*elt(gamma.k, i, j)
             setelt!(cond, u, k, entry)$Matrix(R)
             setelt!(cond, w, k, enter)$Matrix(R)
           setelt!(cond, c, j, elt(x, j))
        rank(cond)$(M R)

      leftRank x ==
        cond : Matrix(R) := new(n, n, 0$R)
        for k in 1..n repeat
         for j in 1..n repeat
           entry : R := 0
           for i in 1..n repeat
             entry := entry + elt(x, i)*elt(gamma.k, i, j)
           setelt!(cond, j, k, entry)$Matrix(R)
        rank(cond)$(M R)

      rightRank x ==
        cond : Matrix(R) := new(n, n, 0$R)
        for k in 1..n repeat
         for j in 1..n repeat
           entry : R := 0
           for i in 1..n repeat
             entry := entry + elt(x, i)*elt(gamma.k, j, i)
           setelt!(cond, j, k, entry)$Matrix(R)
        rank(cond)$(M R)


      if R has EuclideanDomain then
        basis va ==
          v : V A := remove(zero?, va)$(V A)
          v : V A := removeDuplicates v
          empty? v =>  [0$A]
          m : Matrix R := coerce(coordinates(v.1))$(Matrix R)
          for i in 2..maxIndex v repeat
            m := horizConcat(m, coerce(coordinates(v.i))$(Matrix R) )
          m := rowEchelon m
          lj : List Integer := []
          h : Integer := 1
          mRI : Integer := maxRowIndex m
          mCI : Integer := maxColIndex m
          finished? : Boolean := false
          j : Integer := 1
          while not finished? repeat
            not zero? m(h, j) =>  -- corner found
              lj := cons(j, lj)
              h := mRI
              while zero? m(h, j) repeat h := h-1
              finished? := (h = mRI)
              if not finished? then h := h+1
            if j < mCI then
              j := j + 1
            else
              finished? := true
          [v.j for j in reverse lj]

)abbrev package FRNAAF2 FramedNonAssociativeAlgebraFunctions2
++ Author: Johannes Grabmeier
++ Date Created: 28 February 1992
++ Basic Operations: map
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords: non-associative algebra
++ References:
++ Description:
++  FramedNonAssociativeAlgebraFunctions2 implements functions between
++  two framed non associative algebra domains defined over different rings.
++  The function map is used to coerce between algebras over different
++  domains having the same structural constants.

FramedNonAssociativeAlgebraFunctions2(AR, R, AS, S) : Exports ==
  Implementation where
    R  : CommutativeRing
    S  : CommutativeRing
    AR : FramedNonAssociativeAlgebra R
    AS : FramedNonAssociativeAlgebra S
    V ==> Vector
    Exports ==> with
      map :     (R -> S, AR) -> AS
        ++ map(f, u) maps f onto the coordinates of u to get an element
        ++ in \spad{AS} via identification of the basis of \spad{AR}
        ++ as beginning part of the basis of \spad{AS}.
    Implementation ==> add
      map(fn : R -> S, u : AR) : AS ==
        rank()$AR > rank()$AS => error("map: ranks of algebras do not fit")
        vr : V R := coordinates u
        vs : V S := map(fn, vr)$VectorFunctions2(R, S)
        rank()$AR = rank()$AS => represents(vs)$AS
        ba := basis()$AS
        represents(vs, [ba.i for i in 1..rank()$AR])

--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.
