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

)abbrev category RSETCAT RegularTriangularSetCategory
++ Author: Marc Moreno Maza
++ Date Created: 09/03/1998
++ Date Last Updated: 12/15/1998
++ References :
++ SALSA Solvers for Algebraic Systems and Applications
++ Kalk91 Three contributions to elimination theory
++ Kalk98 Algorithmic properties of polynomial rings
++ Aubr96 Triangular Sets for Solving Polynomial Systems: 
++ Aubr99 On the Theories of Triangular Sets
++ Aubr99a Triangular Sets for Solving Polynomial Systems: 
++ Laza91 A new method for solving algebraic systems of positive dimension
++ Maza95 Polynomial Gcd Computations over Towers of Algebraic Extensions
++ Maza97 Calculs de pgcd au-dessus des tours d'extensions simples et 
++        resolution des systemes d'equations algebriques
++ Maza98 A new algorithm for computing triangular decomposition of 
++        algebraic varieties
++ Maza00 On Triangular Decompositions of Algebraic Varieties
++ Description:
++ The category of regular triangular sets, introduced under
++ the name regular chains in [1] (and other papers).
++ In [3] it is proved that regular triangular sets and towers of simple
++ extensions of a field are equivalent notions.
++ In the following definitions, all polynomials and ideals
++ are taken from the polynomial ring \spad{k[x1,...,xn]} where \spad{k}
++ is the fraction field of \spad{R}.
++ The triangular set \spad{[t1,...,tm]} is regular 
++ iff for every \spad{i} the initial of \spad{ti+1} is invertible
++ in the tower of simple extensions associated with \spad{[t1,...,ti]}.
++ A family \spad{[T1,...,Ts]} of regular triangular sets 
++ is a split of Kalkbrener of a given ideal \spad{I}
++ iff the radical of \spad{I} is equal to the intersection
++ of the radical ideals generated by the saturated ideals 
++ of the \spad{[T1,...,Ti]}.
++ A family \spad{[T1,...,Ts]} of regular triangular sets 
++ is a split of Kalkbrener of a given triangular set \spad{T}
++ iff it is a split of Kalkbrener of the saturated ideal of \spad{T}.
++ Let \spad{K} be an algebraic closure of \spad{k}.
++ Assume that \spad{V} is finite with cardinality
++ \spad{n} and let \spad{A} be the affine space \spad{K^n}.
++ For a regular triangular set \spad{T} let denote by \spad{W(T)} the
++ set of regular zeros of \spad{T}.
++ A family \spad{[T1,...,Ts]} of regular triangular sets 
++ is a split of Lazard of a given subset \spad{S} of \spad{A}
++ iff the union of the \spad{W(Ti)} contains \spad{S} and
++ is contained in the closure of \spad{S} (w.r.t. Zariski topology).
++ A family \spad{[T1,...,Ts]} of regular triangular sets 
++ is a split of Lazard of a given triangular set \spad{T}
++ if it is a split of Lazard of \spad{W(T)}.
++ Note that if \spad{[T1,...,Ts]} is a split of Lazard of 
++ \spad{T} then it is also a split of Kalkbrener of \spad{T}.
++ The converse is false. 
++ This category provides operations related to both kinds of
++ splits, the former being related to ideals decomposition whereas 
++ the latter deals with varieties decomposition.
++ See the example illustrating the RegularTriangularSet constructor for more 
++ explanations about decompositions by means of regular triangular sets. 

RegularTriangularSetCategory(R,E,V,P) : Category == SIG where
  R : GcdDomain
  E : OrderedAbelianMonoidSup
  V : OrderedSet
  P : RecursivePolynomialCategory(R,E,V)

  SIG ==> TriangularSetCategory(R,E,V,P) with 

    purelyAlgebraic? : (P,$) -> Boolean
      ++ \spad{purelyAlgebraic?(p,ts)} returns \spad{true} iff every
      ++ variable of \spad{p} is algebraic w.r.t. \spad{ts}.

    purelyTranscendental? : (P,$) -> Boolean
      ++ \spad{purelyTranscendental?(p,ts)} returns \spad{true} iff every
      ++ variable of \spad{p} is not algebraic w.r.t. \spad{ts}

    algebraicCoefficients? : (P,$) -> Boolean
      ++ \spad{algebraicCoefficients?(p,ts)} returns \spad{true} iff every
      ++ variable of \spad{p} which is not the main one of \spad{p}
      ++ is algebraic w.r.t. \spad{ts}.

    purelyAlgebraic? : $ -> Boolean
      ++ \spad{purelyAlgebraic?(ts)} returns true iff for every algebraic 
      ++ variable \spad{v} of \spad{ts} we have 
      ++ \spad{algebraicCoefficients?(t_v,ts_v_-)} where \spad{ts_v}
      ++ is select from TriangularSetCategory(ts,v) and 
      ++ \spad{ts_v_-} is 
      ++ collectUnder from TriangularSetCategory(ts,v).

    purelyAlgebraicLeadingMonomial? : (P, $) -> Boolean
      ++ \spad{purelyAlgebraicLeadingMonomial?(p,ts)} returns true iff
      ++ the main variable of any non-constant iterarted initial 
      ++ of \spad{p} is algebraic w.r.t. \spad{ts}. 

    invertibleElseSplit? : (P,$) -> Union(Boolean,List $)
      ++ \spad{invertibleElseSplit?(p,ts)} returns \spad{true} (resp.
      ++ \spad{false}) if \spad{p} is invertible in the tower 
      ++ associated with \spad{ts} or returns a split of Kalkbrener 
      ++ of \spad{ts}.

    invertible? : (P,$) -> List Record(val : Boolean, tower : $)
      ++ \spad{invertible?(p,ts)} returns \spad{lbwt} where \spad{lbwt.i}
      ++ is the result of \spad{invertibleElseSplit?(p,lbwt.i.tower)} and
      ++ the list of the \spad{(lqrwt.i).tower} is a split of Kalkbrener of 
      ++ \spad{ts}.

    invertible? : (P,$) -> Boolean
      ++ \spad{invertible?(p,ts)} returns true iff \spad{p} is invertible
      ++ in the tower associated with \spad{ts}.

    invertibleSet : (P,$) -> List $
      ++ \spad{invertibleSet(p,ts)} returns a split of Kalkbrener of the
      ++ quotient ideal of the ideal \axiom{I}  by \spad{p} where \spad{I} is 
      ++ the radical of saturated of \spad{ts}.

    lastSubResultantElseSplit : (P, P, $) -> Union(P,List $)
      ++ \spad{lastSubResultantElseSplit(p1,p2,ts)} returns either
      ++ \spad{g} a quasi-monic gcd of \spad{p1} and \spad{p2} w.r.t.
      ++ the \spad{ts} or a split of Kalkbrener of \spad{ts}.
      ++ This assumes that \spad{p1} and \spad{p2} have the same maim
      ++ variable and that this variable is greater that any variable
      ++ occurring in \spad{ts}. 

    lastSubResultant : (P, P, $) -> List Record(val : P, tower : $)
      ++ \spad{lastSubResultant(p1,p2,ts)} returns \spad{lpwt} such that
      ++ \spad{lpwt.i.val} is a quasi-monic gcd of \spad{p1} and \spad{p2} 
      ++ w.r.t. \spad{lpwt.i.tower}, for every \spad{i}, and such 
      ++ that the list of the \spad{lpwt.i.tower} is a split of Kalkbrener of 
      ++ \spad{ts}. Moreover, if \spad{p1} and \spad{p2} do not
      ++ have a non-trivial gcd w.r.t. \spad{lpwt.i.tower} then 
      ++ \spad{lpwt.i.val} is the resultant of these polynomials w.r.t. 
      ++ \spad{lpwt.i.tower}. This assumes that \spad{p1} and \spad{p2} have 
      ++ the same main variable and that this variable is greater that any 
      ++ variable occurring in \spad{ts}. 

    squareFreePart : (P,$) -> List Record(val : P, tower : $)
      ++ \spad{squareFreePart(p,ts)} returns \spad{lpwt} such that
      ++ \spad{lpwt.i.val} is a square-free polynomial
      ++ w.r.t. \spad{lpwt.i.tower}, this polynomial being associated with 
      ++ \spad{p} modulo \spad{lpwt.i.tower}, for every \spad{i}. Moreover,
      ++ the list of the \spad{lpwt.i.tower} is a split
      ++ of Kalkbrener of \spad{ts}. 
      ++ WARNING: This assumes that \spad{p} is a non-constant polynomial 
      ++ such that if \spad{p} is added to \spad{ts}, then the resulting set 
      ++ is a regular triangular set. 

    intersect : (P,$) -> List $
      ++ \spad{intersect(p,ts)} returns the same as 
      ++ \spad{intersect([p],ts)}

    intersect : (List P, $) -> List $
      ++ \spad{intersect(lp,ts)} returns \spad{lts} a split of Lazard
      ++ of the intersection of the affine variety associated 
      ++ with \spad{lp} and the regular zero set of \spad{ts}.

    intersect : (List P, List $) -> List $
      ++ \spad{intersect(lp,lts)} returns the same as
      ++ \spad{concat([intersect(lp,ts) for ts in lts])|}

    intersect : (P, List $) -> List $
      ++ \spad{intersect(p,lts)} returns the same as
      ++ \spad{intersect([p],lts)}

    augment : (P,$) -> List $
      ++ \spad{augment(p,ts)} assumes that \spad{p} is a non-constant
      ++ polynomial whose main variable is greater than any variable
      ++ of \spad{ts}. This operation assumes also that if \spad{p} is 
      ++ added to \spad{ts} the resulting set, say \spad{ts+p}, is a
      ++ regular triangular set. Then it returns a split of Kalkbrener
      ++ of \spad{ts+p}. This may not be \spad{ts+p} itself, if for
      ++ instance \spad{ts+p} is required to be square-free.

    augment : (P,List $) -> List $
      ++ \spad{augment(p,lts)} returns the same as
      ++ \spad{concat([augment(p,ts) for ts in lts])}

    augment : (List P,$) -> List $   
      ++ \spad{augment(lp,ts)} returns \spad{ts} if \spad{empty? lp},
      ++ \spad{augment(p,ts)} if \spad{lp = [p]}, otherwise
      ++ \spad{augment(first lp, augment(rest lp, ts))}

    augment : (List P,List $) -> List $
      ++ \spad{augment(lp,lts)} returns the same as 
      ++ \spad{concat([augment(lp,ts) for ts in lts])}

    internalAugment : (P, $) -> $
      ++ \spad{internalAugment(p,ts)} assumes that \spad{augment(p,ts)}
      ++ returns a singleton and returns it.

    internalAugment : (List P, $) -> $
      ++ \spad{internalAugment(lp,ts)} returns \spad{ts} if \spad{lp}
      ++ is empty otherwise returns 
      ++ \spad{internalAugment(rest lp, internalAugment(first lp, ts))}

    extend : (P,$) -> List $
      ++ \spad{extend(p,ts)} assumes that \spad{p} is a non-constant
      ++ polynomial whose main variable is greater than any variable
      ++ of \spad{ts}. Then it returns a split of Kalkbrener
      ++ of \spad{ts+p}. This may not be \spad{ts+p} itself, if for
      ++ instance \spad{ts+p} is not a regular triangular set.

    extend : (P, List $)  -> List $
      ++ \spad{extend(p,lts)} returns the same as 
      ++ \spad{concat([extend(p,ts) for ts in lts])|}

    extend : (List P,$) -> List $   
      ++ \spad{extend(lp,ts)} returns \spad{ts} if \spad{empty? lp}
      ++ \spad{extend(p,ts)} if \spad{lp = [p]} else
      ++ \spad{extend(first lp, extend(rest lp, ts))}

    extend : (List P,List $) -> List $
      ++ \spad{extend(lp,lts)} returns the same as 
      ++ \spad{concat([extend(lp,ts) for ts in lts])|}

    zeroSetSplit : (List P, Boolean) -> List $
      ++ \spad{zeroSetSplit(lp,clos?)} returns \spad{lts} a split of 
      ++ Kalkbrener of the radical ideal associated with \spad{lp}.
      ++ If \spad{clos?} is false, it is also a decomposition of the
      ++ variety associated with \spad{lp} into the regular zero set of the 
      ++ \spad{ts} in \spad{lts} (or, in other words, a split of Lazard of 
      ++ this variety). See the example illustrating the 
      ++ \spadtype{RegularTriangularSet} constructor for more explanations 
      ++ about decompositions by means of regular triangular sets. 

   add

     NNI ==> NonNegativeInteger
     INT ==> Integer
     LP ==> List P
     PWT ==> Record(val : P, tower : $)
     LpWT ==> Record(val : (List P), tower : $)
     Split ==> List $
     pack ==> PolynomialSetUtilitiesPackage(R,E,V,P)

     purelyAlgebraic?(p: P, ts: $): Boolean ==
       ground? p => true
       not algebraic?(mvar(p),ts) => false
       algebraicCoefficients?(p,ts)

     purelyTranscendental?(p:P,ts:$): Boolean  ==
       empty? ts => true
       lv : List V := variables(p)$P
       while (not empty? lv) and (not algebraic?(first(lv),ts)) repeat _
         lv := rest lv
       empty? lv

     purelyAlgebraicLeadingMonomial?(p: P, ts: $): Boolean  ==
       ground? p => true
       algebraic?(mvar(p),ts) and purelyAlgebraicLeadingMonomial?(init(p), ts)

     algebraicCoefficients?(p:P,ts:$): Boolean  ==
       ground? p => true
       (not ground? init(p)) and not (algebraic?(mvar(init(p)),ts)) => false
       algebraicCoefficients?(init(p),ts) =>
         ground? tail(p) => true
         mvar(tail(p)) = mvar(p) => 
           algebraicCoefficients?(tail(p),ts)
         algebraic?(mvar(tail(p)),ts) => 
           algebraicCoefficients?(tail(p),ts)
         false
       false

     if V has Finite
     then

       purelyAlgebraic?(ts: $): Boolean ==
         empty? ts => true
         size()$V = #ts => true
         lp: LP := sort(infRittWu?,members(ts))
         i: NonNegativeInteger := size()$V
         for p in lp repeat
           v: V := mvar(p)
           (i = (lookup(v)$V)::NNI) => 
             i := subtractIfCan(i,1)::NNI
           univariate?(p)$pack => 
             i := subtractIfCan(i,1)::NNI
           not algebraicCoefficients?(p,collectUnder(ts,v)) =>
             return false
           i := subtractIfCan(i,1)::NNI
         true
           
     else

       purelyAlgebraic?(ts: $): Boolean ==
         empty? ts => true
         v: V := mvar(ts)
         p: P := select(ts,v)::P
         ts := collectUnder(ts,v)
         empty? ts => univariate?(p)$pack
         not purelyAlgebraic?(ts) => false
         algebraicCoefficients?(p,ts)

     augment(p:P,lts:List $) ==
       toSave: Split := []
       while not empty? lts repeat
         ts := first lts
         lts := rest lts
         toSave := concat(augment(p,ts),toSave)
       toSave

     augment(lp:LP,ts:$) ==
       toSave: Split := [ts]
       empty? lp => toSave
       lp := sort(infRittWu?,lp)
       while not empty? lp repeat
         p := first lp
         lp := rest lp
         toSave := augment(p,toSave)
       toSave

     augment(lp:LP,lts:List $) ==
       empty? lp => lts
       toSave: Split := []
       while not empty? lts repeat
         ts := first lts
         lts := rest lts
         toSave := concat(augment(lp,ts),toSave)
       toSave    

     extend(p:P,lts:List $) ==
       toSave : Split := []
       while not empty? lts repeat
         ts := first lts
         lts := rest lts
         toSave := concat(extend(p,ts),toSave)
       toSave

     extend(lp:LP,ts:$) ==
       toSave: Split := [ts]
       empty? lp => toSave
       lp := sort(infRittWu?,lp)
       while not empty? lp repeat
         p := first lp
         lp := rest lp
         toSave := extend(p,toSave)
       toSave

     extend(lp:LP,lts:List $) ==
       empty? lp => lts
       toSave: Split := []
       while not empty? lts repeat
         ts := first lts
         lts := rest lts
         toSave := concat(extend(lp,ts),toSave)
       toSave    

     intersect(lp:LP,lts:List $): List $  ==
       -- A VERY GENERAL default algorithm
       (empty? lp) or (empty? lts) => lts
       lp := [primitivePart(p) for p in lp]
       lp := removeDuplicates lp
       lp := remove(zero?,lp)
       any?(ground?,lp) => []
       toSee: List LpWT := [[lp,ts]$LpWT for ts in lts]
       toSave: List $ := []
       lp: LP
       p: P
       ts: $
       lus: List $
       while (not empty? toSee) repeat
         lpwt := first toSee; toSee := rest toSee
         lp := lpwt.val; ts := lpwt.tower
         empty? lp => toSave := cons(ts, toSave)
         p := first lp;  lp := rest lp
         lus := intersect(p,ts)
         toSee := concat([[lp,us]$LpWT for us in lus], toSee)
       toSave

     intersect(lp: LP,ts: $): List $  ==
       intersect(lp,[ts])

     intersect(p: P,lts: List $): List $  ==
       intersect([p],lts)