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

)abbrev domain ANTISYM AntiSymm
++ Author: Larry A. Lambe
++ Date     : 01/26/91.
++ Revised  : 30 Nov 94
++ Description:
++ The domain of antisymmetric polynomials.
 
AntiSymm(R,lVar) : SIG == CODE where
  R : Ring
  lVar : List Symbol

  LALG ==> LeftAlgebra
  FMR  ==> FM(R,EAB)
  FM   ==> FreeModule
  I    ==> Integer
  L    ==> List
  EAB  ==> ExtAlgBasis     -- these are exponents of basis elements in order
  NNI  ==> NonNegativeInteger
  O    ==> OutputForm
  base ==> k
  coef ==> c
  Term ==> Record(k:EAB,c:R)
 
  SIG ==> Join(LALG(R), RetractableTo(R)) with

      leadingCoefficient : % -> R
        ++ leadingCoefficient(p) returns the leading
        ++ coefficient of antisymmetric polynomial p.

      leadingBasisTerm : % -> %
        ++ leadingBasisTerm(p) returns the leading
        ++ basis term of antisymmetric polynomial p.

      reductum : % -> %
        ++ reductum(p), where p is an antisymmetric polynomial,
        ++ returns p minus the leading
        ++ term of p if p has at least two terms, and 0 otherwise.

      coefficient : (%,%) -> R 
        ++ coefficient(p,u) returns the coefficient of 
        ++ the term in p containing the basis term u if such 
        ++ a term exists, and 0 otherwise.
        ++ Error: if the second argument u is not a basis element.

      generator : NNI -> %
        ++ generator(n) returns the nth multiplicative generator,
        ++ a basis term.
        ++
        ++X AS:=AntiSymm(Integer,[x,y,z])
        ++X [dx,dy,dz]:=[generator(i)$AS for i in 1..3]

      exp : L I -> %
        ++ exp([i1,...in]) returns \spad{u_1\^{i_1} ... u_n\^{i_n}}

      homogeneous? : % -> Boolean
        ++ homogeneous?(p) tests if all of the terms of 
        ++ p have the same degree.

      retractable? : % -> Boolean
        ++ retractable?(p) tests if p is a 0-form,
        ++ if degree(p) = 0.

      degree : % -> NNI
        ++ degree(p) returns the homogeneous degree of p.

      map : (R -> R, %) -> %
        ++ map(f,p) changes each coefficient of p by the
        ++ application of f.

--    1 corresponds to the empty monomial Nul = [0,...,0]
--    from EAB.  In terms of the exterior algebra on X,
--    it corresponds to the identity element which lives
--    in homogeneous degree 0.
 
  CODE ==> FMR add

      Rep := L Term
      x,y :  EAB
      a,b :  %
      r   :  R
      m   :  I

      dim := #lVar

      1 == 
        [[ Nul(dim)$EAB, 1$R ]]

      coefficient(a,u) ==
        not null u.rest => error "2nd argument must be a basis element"
        x := u.first.base
        for t in a repeat
          if t.base = x then return t.coef
          if t.base < x then return 0
        0

      retractable?(a) ==
        null a or (a.first.k  =  Nul(dim))

      retractIfCan(a):Union(R,"failed") ==
        null a               => 0$R
        a.first.k = Nul(dim) => leadingCoefficient a
        "failed"

      retract(a):R ==
        null a => 0$R
        leadingCoefficient a

      homogeneous? a ==
        null a => true
        siz := _+/exponents(a.first.base)
        for ta in reductum a repeat
          _+/exponents(ta.base) ^= siz => return false
        true

      degree a ==
        null a => 0$NNI
        homogeneous? a => (_+/exponents(a.first.base)) :: NNI
        error "not a homogeneous element"

      zo : (I,I) -> L I
      zo(p,q) ==
        p = 0 => [1,q]
        q = 0 => [1,1]
        [0,0]

      getsgn : (EAB,EAB) -> I
      getsgn(x,y) ==
        sgn:I  := 0
        xx:L I := exponents x
        yy:L I := exponents y
        for i in 1 .. (dim-1) repeat
          xx  := rest xx
          sgn := sgn + (_+/xx)*yy.i
        sgn rem 2 = 0 => 1
        -1

      Nalpha: (EAB,EAB) -> L I
      Nalpha(x,y) ==
        i:I := 1
        dum2:L I := [0 for i in 1..dim]
        for j in 1..dim repeat
          dum:=zo((exponents x).j,(exponents y).j)
          (i:= i*dum.1) = 0 => leave
          dum2.j := dum.2
        i = 0 => cons(i, dum2)
        cons(getsgn(x,y), dum2)

      a * b ==
        null a => 0
        null b => 0
        ((null a.rest) and (a.first.k = Nul(dim))) => a.first.c * b
        ((null b.rest) and (b.first.k = Nul(dim))) => b.first.c * a
        z:% := 0
        for tb in b repeat
          for ta in a repeat
            stuff:=Nalpha(ta.base,tb.base)
            r:=first(stuff)*ta.coef*tb.coef
            if r ^= 0 then z := z + [[rest(stuff)::EAB, r]]
        z

      coerce(r):% == 
        r = 0 => 0
        [ [Nul(dim), r] ]

      coerce(m):% == 
        m = 0 => 0
        [ [Nul(dim), m::R] ]

      characteristic() == 
        characteristic()$R

      generator(j) == 
        -- j < 1 or j > dim => error "your subscript is out of range"
        -- error will be generated by dum.j if out of range
        dum:L I := [0 for i in 1..dim]
        dum.j:=1
        [[dum::EAB, 1::R]]

      exp(li:(L I)) == 
        [[li::EAB, 1]]
 
      leadingBasisTerm a ==
        [[a.first.k, 1]]

      displayList:EAB -> O
      displayList(x):O ==
        le: L I := exponents(x)$EAB
        reduce(_*,[(lVar.i)::O for i in 1..dim | ((le.i) = 1)])$L(O)

      makeTerm:(R,EAB) -> O
      makeTerm(r,x) ==
        -- we know that r ^= 0
        x = Nul(dim)$EAB  => r::O
        (r = 1) => displayList(x)
        r::O * displayList(x)

      coerce(a):O ==
        zero? a     => 0$I::O
        null rest(a @ Rep) => 
                 t := first(a @ Rep)
                 makeTerm(t.coef,t.base)
        reduce(_+,[makeTerm(t.coef,t.base) for t in (a @ Rep)])$L(O)