axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / GCNAALG.spad

)abbrev domain GCNAALG GenericNonAssociativeAlgebra
++ Authors: J. Grabmeier, R. Wisbauer
++ Date Created: 26 June 1991
++ Date Last Updated: 26 June 1991
++ 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, the scalars are extended to include symbolic
++ coefficients

GenericNonAssociativeAlgebra(R,n,ls,gamma) : SIG == CODE where
  R : CommutativeRing
  n : PositiveInteger
  ls : List Symbol
  gamma : Vector Matrix R 

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

  SIG ==> 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, the linear combination
      ++ of the fixed basis with the symbolic coefficients
      ++ \spad{%x1,%x2,..}

    generic : Symbol -> %
      ++ generic(s) returns a generic element, the linear combination
      ++ of the fixed basis with the symbolic coefficients
      ++ \spad{s1,s2,..}

    generic : Vector Symbol -> %
      ++ generic(vs) returns a generic element, 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, the linear combination
      ++ of \spad{ve} basis with the symbolic coefficients
      ++ \spad{%x1,%x2,..}

    generic : (Symbol, Vector %) -> %
      ++ generic(s,v) returns a generic element, the linear combination
      ++ of v with the symbolic coefficients
      ++ \spad{s1,s2,..}

    generic : (Vector Symbol, Vector %) -> %
      ++ generic(vs,ve) returns a generic element, 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

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

    listOfNumbers : List String :=  [PRINC_-TO_-STRING(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
        void()$Void

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

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

      leftRankPolynomial() ==
        if initLeft? then initializeLeft()
        leftRankPoly

      rightRankPolynomial() ==
        if initRight? then initializeRight()
        rightRankPoly

      genericLeftMinimalPolynomial a ==
        if initLeft? then initializeLeft()
        map(x+->eval(x,a),leftRankPoly)$SUP(FPR)

      genericRightMinimalPolynomial a ==
        if initRight? then initializeRight()
        map(x+->eval(x,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 v > maxIndex ve =>
        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 :=  [PRINC_-TO_-STRING(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 :=  [PRINC_-TO_-STRING(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()$%)