path: root/src/algebra/generic.spad.pamphlet

\documentclass{article}
\usepackage{open-axiom}
\begin{document}
\title{\$SPAD/src/algebra generic.spad}
\author{Johannes Grabmeier, Robert Wisbauer}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject

\section{domain GCNAALG GenericNonAssociativeAlgebra}

<<domain GCNAALG GenericNonAssociativeAlgebra>>=
import Fraction
import Polynomial
import SparseUnivariatePolynomial
)abbrev domain GCNAALG GenericNonAssociativeAlgebra
++ Authors: J. Grabmeier, R. Wisbauer
++ Date Created: 26 June 1991
++ Date Last Updated: June 13, 2010
++ Basic Operations: generic
++ Related Constructors: AlgebraPackage
++ Also See:
++ AMS Classifications:
++ Keywords: generic element. rank polynomial
++ Reference:
++  A. Woerz-Busekros: Algebra in Genetics
++  Lectures Notes in Biomathematics 36,
++  Springer-Verlag,  Heidelberg, 1980
++ Description:
++  AlgebraGenericElementPackage allows you to create generic elements
++  of an algebra, i.e. the scalars are extended to include symbolic
++  coefficients
GenericNonAssociativeAlgebra(R : CommutativeRing, n : PositiveInteger,_
  ls : List Symbol, gamma: Vector Matrix R ): public == private where

  NNI ==> NonNegativeInteger
  V   ==> Vector
  PR  ==> Polynomial R
  FPR ==> Fraction Polynomial R
  SUP ==> SparseUnivariatePolynomial
  S   ==> Symbol

  public ==> Join(FramedNonAssociativeAlgebra(FPR), _
      LeftModule(SquareMatrix(n,FPR)) ) with

    coerce : Vector FPR -> %
      ++ coerce(v) assumes that it is called with a vector
      ++ of length equal to the dimension of the algebra, then
      ++ a linear combination with the basis element is formed
    leftUnits:() -> Union(Record(particular: %, basis: List %), "failed")
      ++ leftUnits() returns the affine space of all left units of the
      ++ algebra, or \spad{"failed"} if there is none
    rightUnits:() -> Union(Record(particular: %, basis: List %), "failed")
      ++ rightUnits() returns the affine space of all right units of the
      ++ algebra, or \spad{"failed"} if there is none
    generic : () -> %
      ++ generic() returns a generic element, i.e. the linear combination
      ++ of the fixed basis with the symbolic coefficients
      ++ \spad{%x1,%x2,..}
    generic : Symbol -> %
      ++ generic(s) returns a generic element, i.e. the linear combination
      ++ of the fixed basis with the symbolic coefficients
      ++ \spad{s1,s2,..}
    generic : Vector Symbol -> %
      ++ generic(vs) returns a generic element, i.e. the linear combination
      ++ of the fixed basis with the symbolic coefficients
      ++ \spad{vs};
      ++ error, if the vector of symbols is too short
    generic : Vector % -> %
      ++ generic(ve) returns a generic element, i.e. the linear combination
      ++ of \spad{ve} basis with the symbolic coefficients
      ++ \spad{%x1,%x2,..}
    generic : (Symbol, Vector %) -> %
      ++ generic(s,v) returns a generic element, i.e. the linear combination
      ++ of v with the symbolic coefficients
      ++ \spad{s1,s2,..}
    generic : (Vector Symbol, Vector %) -> %
      ++ generic(vs,ve) returns a generic element, i.e. the linear combination
      ++ of \spad{ve} with the symbolic coefficients \spad{vs}
      ++ error, if the vector of symbols is shorter than the vector of
      ++ elements
    if R has IntegralDomain then
      leftRankPolynomial : () -> SparseUnivariatePolynomial FPR
        ++ leftRankPolynomial() returns the left minimimal polynomial
        ++ of the generic element
      genericLeftMinimalPolynomial : % -> SparseUnivariatePolynomial FPR
        ++ genericLeftMinimalPolynomial(a) substitutes the coefficients
        ++ of {em a} for the generic coefficients in
        ++ \spad{leftRankPolynomial()}
      genericLeftTrace : % -> FPR
        ++ genericLeftTrace(a) substitutes the coefficients
        ++ of \spad{a} for the generic coefficients into the
        ++ coefficient of the second highest term in
        ++ \spadfun{leftRankPolynomial} and changes the sign.
        ++  This is a linear form
      genericLeftNorm : % -> FPR
        ++ genericLeftNorm(a) substitutes the coefficients
        ++ of \spad{a} for the generic coefficients into the
        ++ coefficient of the constant term in \spadfun{leftRankPolynomial}
        ++ and changes the sign if the degree of this polynomial is odd.
        ++ This is a form of degree k
      rightRankPolynomial : () -> SparseUnivariatePolynomial FPR
        ++ rightRankPolynomial() returns the right minimimal polynomial
        ++ of the generic element
      genericRightMinimalPolynomial : % -> SparseUnivariatePolynomial FPR
        ++ genericRightMinimalPolynomial(a) substitutes the coefficients
        ++ of \spad{a} for the generic coefficients in
        ++ \spadfun{rightRankPolynomial}
      genericRightTrace : % -> FPR
        ++ genericRightTrace(a) substitutes the coefficients
        ++ of \spad{a} for the generic coefficients into the
        ++ coefficient of the second highest term in
        ++ \spadfun{rightRankPolynomial} and changes the sign
      genericRightNorm : % -> FPR
        ++ genericRightNorm(a) substitutes the coefficients
        ++ of \spad{a} for the generic coefficients into the
        ++ coefficient of the constant term in \spadfun{rightRankPolynomial}
        ++ and changes the sign if the degree of this polynomial is odd
      genericLeftTraceForm : (%,%) -> FPR
        ++ genericLeftTraceForm (a,b) is defined to be
        ++ \spad{genericLeftTrace (a*b)}, this defines
        ++ a symmetric bilinear form on the algebra
      genericLeftDiscriminant: () -> FPR
        ++ genericLeftDiscriminant() is the determinant of the
        ++ generic left trace forms of all products of basis element,
        ++ if the generic left trace form is associative, an algebra
        ++ is separable if the generic left discriminant is invertible,
        ++ if it is non-zero, there is some ring extension which
        ++ makes the algebra separable
      genericRightTraceForm : (%,%) -> FPR
        ++ genericRightTraceForm (a,b) is defined to be
        ++ \spadfun{genericRightTrace (a*b)}, this defines
        ++ a symmetric bilinear form on the algebra
      genericRightDiscriminant: () -> FPR
        ++ genericRightDiscriminant() is the determinant of the
        ++ generic left trace forms of all products of basis element,
        ++ if the generic left trace form is associative, an algebra
        ++ is separable if the generic left discriminant is invertible,
        ++ if it is non-zero, there is some ring extension which
        ++ makes the algebra separable
      conditionsForIdempotents: Vector % -> List Polynomial R
        ++ conditionsForIdempotents([v1,...,vn]) determines a complete list
        ++ of polynomial equations for the coefficients of idempotents
        ++ with respect to the \spad{R}-module basis \spad{v1},...,\spad{vn}
      conditionsForIdempotents: () -> List Polynomial R
        ++ conditionsForIdempotents() determines a complete list
        ++ of polynomial equations for the coefficients of idempotents
        ++ with respect to the fixed \spad{R}-module basis

  private ==> AlgebraGivenByStructuralConstants(FPR,n,ls,_
         coerce(gamma)$CoerceVectorMatrixPackage(R) ) add

    listOfNumbers : List String :=  [STRINGIMAGE(q)$Lisp for q in 1..n]
    symbolsForCoef : V Symbol :=
        [concat("%", concat("x", i))::Symbol  for i in listOfNumbers]
    genericElement : % :=
      v : Vector PR :=
        [monomial(1$PR, [symbolsForCoef.i],[1]) for i in 1..n]
      convert map(coerce,v)$VectorFunctions2(PR,FPR)

    eval : (FPR, %) -> FPR
    eval(rf,a) ==
      -- for the moment we only substitute the numerators
      -- of the coefficients
      coefOfa : List PR :=
        map(numer, entries coordinates a)$ListFunctions2(FPR,PR)
      ls : List PR :=[monomial(1$PR, [s],[1]) for s in entries symbolsForCoef]
      lEq : List Equation PR := []
      for i in 1..maxIndex ls repeat
        lEq := cons(equation(ls.i,coefOfa.i)$Equation(PR) , lEq)
      top : PR := eval(numer(rf),lEq)$PR
      bot : PR := eval(numer(rf),lEq)$PR
      top/bot


    if R has IntegralDomain then

      genericLeftTraceForm(a,b) == genericLeftTrace(a*b)
      genericLeftDiscriminant() ==
        listBasis : List % := entries basis()$%
        m : Matrix FPR := matrix
          [[genericLeftTraceForm(a,b) for a in listBasis] for b in listBasis]
        determinant m

      genericRightTraceForm(a,b) == genericRightTrace(a*b)
      genericRightDiscriminant() ==
        listBasis : List % := entries basis()$%
        m : Matrix FPR := matrix
          [[genericRightTraceForm(a,b) for a in listBasis] for b in listBasis]
        determinant m



      leftRankPoly : SparseUnivariatePolynomial FPR := 0
      initLeft? : Boolean :=true

      initializeLeft: () -> Void
      initializeLeft() ==
        -- reset initialize flag
        initLeft?:=false
        leftRankPoly := leftMinimalPolynomial genericElement

      rightRankPoly : SparseUnivariatePolynomial FPR := 0
      initRight? : Boolean :=true

      initializeRight: () -> Void
      initializeRight() ==
        -- reset initialize flag
        initRight?:=false
        rightRankPoly := rightMinimalPolynomial genericElement

      leftRankPolynomial(): SparseUnivariatePolynomial FPR ==
        if initLeft? then initializeLeft()
        leftRankPoly

      rightRankPolynomial(): SparseUnivariatePolynomial FPR ==
        if initRight? then initializeRight()
        rightRankPoly

      genericLeftMinimalPolynomial a ==
        if initLeft? then initializeLeft()
        map(eval(#1,a),leftRankPoly)$SUP(FPR)

      genericRightMinimalPolynomial a ==
        if initRight? then initializeRight()
        map(eval(#1,a),rightRankPoly)$SUP(FPR)

      genericLeftTrace a ==
        if initLeft? then initializeLeft()
        d1 : NNI := (degree leftRankPoly - 1) :: NNI
        rf : FPR := coefficient(leftRankPoly, d1)
        rf := eval(rf,a)
        - rf

      genericRightTrace a ==
        if initRight? then initializeRight()
        d1 : NNI := (degree rightRankPoly - 1) :: NNI
        rf : FPR := coefficient(rightRankPoly, d1)
        rf := eval(rf,a)
        - rf

      genericLeftNorm a ==
        if initLeft? then initializeLeft()
        rf : FPR := coefficient(leftRankPoly, 1)
        if odd? degree leftRankPoly then rf := - rf
        rf

      genericRightNorm a ==
        if initRight? then initializeRight()
        rf : FPR := coefficient(rightRankPoly, 1)
        if odd? degree rightRankPoly then rf := - rf
        rf

    conditionsForIdempotents(b: V %) : List Polynomial R ==
      x : % := generic(b)
      map(numer,entries coordinates(x*x-x,b))$ListFunctions2(FPR,PR)

    conditionsForIdempotents(): List Polynomial R ==
      x : % := genericElement
      map(numer,entries coordinates(x*x-x))$ListFunctions2(FPR,PR)

    generic() ==  genericElement

    generic(vs:V S, ve: V %): % ==
      maxIndex ve > maxIndex vs =>
        error "generic: too little symbols"
      v : Vector PR :=
        [monomial(1$PR, [vs.i],[1]) for i in 1..maxIndex ve]
      represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve)

    generic(s: S, ve: V %): % ==
      lON : List String :=  [STRINGIMAGE(q)$Lisp for q in 1..maxIndex ve]
      sFC : Vector Symbol :=
        [concat(s pretend String, i)::Symbol  for i in lON]
      generic(sFC, ve)

    generic(ve : V %) ==
      lON : List String :=  [STRINGIMAGE(q)$Lisp for q in 1..maxIndex ve]
      sFC : Vector Symbol :=
        [concat("%", concat("x", i))::Symbol  for i in lON]
      v : Vector PR :=
        [monomial(1$PR, [sFC.i],[1]) for i in 1..maxIndex ve]
      represents(map(coerce,v)$VectorFunctions2(PR,FPR),ve)

    generic(vs:V S): % == generic(vs, basis()$%)

    generic(s: S): % == generic(s, basis()$%)

)fin
      -- variations on eval
      --coefOfa : List FPR := entries coordinates a
      --ls : List Symbol := entries symbolsForCoef
      -- a very dangerous sequential implementation for  the moment,
      -- because the compiler doesn't manage the parallel code
      -- also doesn't run:
      -- not known that (Fraction (Polynomial R)) has (has (Polynomial R)
      --  (Evalable (Fraction (Polynomial R))))
      --res : FPR := rf
      --for eq in lEq repeat res := eval(res,eq)$FPR
      --res
      --rf
      --eval(rf, le)$FPR
      --eval(rf, entries symbolsForCoef, coefOfa)$FPR
      --eval(rf, ls, coefOfa)$FPR
      --le : List Equation PR := [equation(lh,rh) for lh in ls for rh in coefOfa]

@
\section{package CVMP CoerceVectorMatrixPackage}
<<package CVMP CoerceVectorMatrixPackage>>=
)abbrev package CVMP CoerceVectorMatrixPackage
++ Authors: J. Grabmeier
++ Date Created: 26 June 1991
++ Date Last Updated: 26 June 1991
++ Basic Operations: coerceP, coerce
++ Related Constructors: GenericNonAssociativeAlgebra
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Reference:
++ Description:
++  CoerceVectorMatrixPackage: an unexposed, technical package
++  for data conversions
CoerceVectorMatrixPackage(R : CommutativeRing): public == private where
  M2P ==> MatrixCategoryFunctions2(R, Vector R, Vector R, Matrix R, _
    Polynomial R, Vector Polynomial R, Vector Polynomial R, Matrix Polynomial R)
  M2FP ==> MatrixCategoryFunctions2(R, Vector R, Vector R, Matrix R, _
    Fraction Polynomial R, Vector Fraction Polynomial R, _
    Vector Fraction Polynomial R, Matrix Fraction Polynomial R)
  public ==> with
    coerceP: Vector Matrix R -> Vector Matrix Polynomial R
      ++ coerceP(v) coerces a vector v with entries in \spadtype{Matrix R}
      ++ as vector over \spadtype{Matrix Polynomial R}
    coerce: Vector Matrix R -> Vector Matrix Fraction Polynomial R
      ++ coerce(v) coerces a vector v with entries in \spadtype{Matrix R}
      ++ as vector over \spadtype{Matrix Fraction Polynomial R}
  private ==> add

    imbedFP : R -> Fraction Polynomial R
    imbedFP r == (r:: Polynomial R) :: Fraction Polynomial R

    imbedP : R -> Polynomial R
    imbedP r == (r:: Polynomial R)

    coerceP(g:Vector Matrix R) : Vector Matrix Polynomial R ==
      m2 : Matrix Polynomial R
      lim : List Matrix R := entries g
      l: List Matrix Polynomial R :=  []
      for m in lim repeat
        m2 :=  map(imbedP,m)$M2P
        l := cons(m2,l)
      vector reverse l

    coerce(g:Vector Matrix R) : Vector Matrix Fraction Polynomial R ==
      m3 : Matrix Fraction Polynomial R
      lim : List Matrix R := entries g
      l: List Matrix Fraction Polynomial R :=  []
      for m in lim repeat
        m3 :=  map(imbedFP,m)$M2FP
        l := cons(m3,l)
      vector reverse l

@
\section{License}
<<license>>=
--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.
@
<<*>>=
<<license>>

<<domain GCNAALG GenericNonAssociativeAlgebra>>
<<package CVMP CoerceVectorMatrixPackage>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}