===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/ecart.sm1,v
retrieving revision 1.2
retrieving revision 1.12
diff -u -p -r1.2 -r1.12
--- OpenXM/src/kan96xx/Doc/ecart.sm1 2003/07/25 01:03:00 1.2
+++ OpenXM/src/kan96xx/Doc/ecart.sm1 2003/08/26 05:06:00 1.12
@@ -1,4 +1,4 @@
-% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.1 2003/07/25 01:00:38 takayama Exp $
+% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.11 2003/08/24 05:19:44 takayama Exp $
%[(parse) (hol.sm1) pushfile] extension
%[(parse) (appell.sm1) pushfile] extension
@@ -7,6 +7,14 @@
/ecart.end { endEcart } def
/ecart.autoHomogenize 1 def
/ecart.needSyz 0 def
+/ecartd.begin {
+ ecart.begin
+ [(EcartAutomaticHomogenization) 1] system_variable
+} def
+/ecartd.end {
+ ecart.end
+ [(EcartAutomaticHomogenization) 0] system_variable
+} def
/ecart.dehomogenize {
/arg1 set
@@ -61,11 +69,18 @@
/ecart.homogenize01 {
/arg1 set
- [/in.ecart.homogenize01 /ll ] pushVariables
+ [/in.ecart.homogenize01 /ll /ll0] pushVariables
[
/ll arg1 def
- [(degreeShift) [ ] ll ] homogenize
- /arg1 set
+ ll tag ArrayP eq {
+ ll 0 get tag ArrayP eq not {
+ [(degreeShift) [ ] ll ] homogenize /arg1 set
+ } {
+ ll { ecart.homogenize01 } map /arg1 set
+ } ifelse
+ } {
+ [(degreeShift) [ ] ll ] homogenize /arg1 set
+ } ifelse
] pop
popVariables
arg1
@@ -80,30 +95,38 @@
( [(x1) -1 (x2) -1])
( ] weight_vector )
( 0 )
- ( [(degreeShift) [[0 0 0]]])
+ ( [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]])
( ] define_ring)
( ecart.begin)
( [[1 -4 -2 5]] appell4 0 get /eqs set)
( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
- ( ecart.homogenize01 /eqs2 set)
+ ( {ecart.homogenize01} map /eqs2 set)
( [eqs2] groebner )
]] putUsages
/ecart.homogenize01_with_shiftVector {
/arg2.set
/arg1 set
- [/in.ecart.homogenize01 /ll /sv] pushVariables
+ [/in.ecart.homogenize01 /ll /sv /ll0] pushVariables
[
/sv arg2 def
/ll arg1 def
- [(degreeShift) sv ll ] homogenize
- /arg1 set
+ ll tag ArrayP eq {
+ ll 0 get tag ArrayP eq not {
+ [(degreeShift) sv ll ] homogenize /arg1 set
+ } {
+ ll { ecart.homogenize01_with_shiftVector } map /arg1 set
+ } ifelse
+ } {
+ [(degreeShift) sv ll ] homogenize /arg1 set
+ } ifelse
] pop
popVariables
arg1
} def
[(ecart.dehomogenize01_with_degreeShift)
[(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
+ (cf. homogenize)
]] putUsages
%% Aux functions to return the default weight vectors.
@@ -133,12 +156,66 @@
arg1
} def
+/ecart.gb {ecartd.gb} def
+
+[(ecart.gb)
+ [(a ecart.gb b)
+ (array a; array b;)
+ $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
+ ( in the ring of differential operators.)
+ (The computation is done by using Ecart division algorithm and )
+ (the double homogenization.)
+ (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
+ $ ii is the initial ideal in case of w is given or <> belongs$
+ $ to a ring. In the other cases, it returns the initial monominal.$
+ (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
+ (a : [f v]; array f; string v; v is the variables. )
+ (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
+ (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
+ ( array ds; ds is the degree shift for the ring. )
+ (a : [f v w ds hdShift]; array f; string v; array of array w; w is the weight matirx.)
+ ( array ds; ds is the degree shift for the ring. )
+ ( array hsShift is the degree shift for the homogenization. cf.homogenize )
+ $a : [f v w ds (no)]; array f; string v; array of array w; w is the weight matirx.$
+ ( No automatic homogenization.)
+ ( )
+ $cf. ecarth.gb (homogenized), ecartd.gb (dehomogenize) $
+ ( )
+ $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
+ $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
+ (Example 2: )
+ $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
+ $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /ff set ff pmat ;$
+ (To set the current ring to the ring in which ff belongs )
+ ( ff getRing ring_def )
+ ( )
+ $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
+ $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
+ ( This example will cause an error on order.)
+ ( )
+ $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
+ $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
+ ( This example will cause an error on order.)
+ ( )
+ $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
+ $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] [[0 1] [-3 1] ] ] ecart.gb pmat ; $
+ ( )
+ (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
+ ( ecart.dehomogenize, ecart.dehomogenizeH)
+ ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
+ ( define_ring )
+ (/ecart.autoHomogenize 0 def )
+ ( not to dehomogenize and homogenize)
+]] putUsages
+
/ecart.gb.verbose 1 def
-/ecart.gb {
+%ecarth.gb s(H)-homogenized outputs. GG's original version of ecart gb.
+/ecarth.gb {
/arg1 set
- [/in-ecart.gb /aa /typev /setarg /f /v
+ [/in-ecarth.gb /aa /typev /setarg /f /v
/gg /wv /vec /ans /rr /mm
/degreeShift /env2 /opt /ans.gb
+ /hdShift
] pushVariables
[(CurrentRingp) (KanGBmessage)] pushEnv
[
@@ -147,6 +224,7 @@
/setarg 0 def
/wv 0 def
/degreeShift 0 def
+ /hdShift 0 def
/opt [(weightedHomogenization) 1] def
aa { tag } map /typev set
typev [ ArrayP ] eq
@@ -188,6 +266,15 @@
/degreeShift aa 3 get def
/setarg 1 def
} { } ifelse
+
+ typev [ArrayP StringP ArrayP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ /hdShift aa 4 get def
+ /setarg 1 def
+ } { } ifelse
typev [ArrayP ArrayP ArrayP ArrayP] eq
{ /f aa 0 get def
/v aa 1 get from_records def
@@ -195,10 +282,31 @@
/degreeShift aa 3 get def
/setarg 1 def
} { } ifelse
+ typev [ArrayP ArrayP ArrayP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ /hdShift aa 4 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP ArrayP ArrayP ArrayP StringP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ aa 4 get (no) eq {
+ /hdShift -1 def
+ } {
+ (Unknown keyword for the 5th argument) error
+ } ifelse
+ /setarg 1 def
+ } { } ifelse
/env1 getOptions def
- setarg { } { (ecart.gb : Argument mismatch) error } ifelse
+ ecart.gb.verbose { $ecarth.gb computes std basis with h-s(H)-homogenized buchberger algorithm.$ message } { } ifelse
+ setarg { } { (ecarth.gb : Argument mismatch) error } ifelse
[(KanGBmessage) ecart.gb.verbose ] system_variable
@@ -219,22 +327,24 @@
} { } ifelse
wv isInteger {
[v ring_of_differential_operators
- [ v ecart.wv1 v ecart.wv2 ] weight_vector
- 0
+% [ v ecart.wv1 v ecart.wv2 ] weight_vector
+ gb.characteristic
opt
] define_ring
}{
degreeShift isInteger {
[v ring_of_differential_operators
- [v ecart.wv1 v ecart.wv2] wv join weight_vector
- 0
+% [v ecart.wv1 v ecart.wv2] wv join weight_vector
+ wv weight_vector
+ gb.characteristic
opt
] define_ring
}{
[v ring_of_differential_operators
- [v ecart.wv1 v ecart.wv2] wv join weight_vector
- 0
+% [v ecart.wv1 v ecart.wv2] wv join weight_vector
+ wv weight_vector
+ gb.characteristic
[(degreeShift) degreeShift] opt join
] define_ring
@@ -254,7 +364,7 @@
%%% Enf of the preprocess
ecart.gb.verbose {
- (The first and the second weight vectors are automatically set as follows)
+ (The first and the second weight vectors for automatic homogenization: )
message
v ecart.wv1 message
v ecart.wv2 message
@@ -265,19 +375,32 @@
} ifelse
} { } ifelse
+ %%BUG: case of v is integer
+ v ecart.checkOrder
+
ecart.begin
ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
ecart.autoHomogenize {
- (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
+ (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized.)
message
} { } ifelse
- ecart.autoHomogenize {
- f { {. ecart.dehomogenize} map} map /f set
- f ecart.homogenize01 /f set
- }{
- f { {. } map } map /f set
- } ifelse
+
+ hdShift tag 1 eq {
+ ecart.autoHomogenize not hdShift -1 eq or {
+% No automatic h-s-homogenization.
+ f { {. } map} map /f set
+ } {
+% Automatic h-s-homogenization without degreeShift
+ f { {. ecart.dehomogenize} map} map /f set
+ f ecart.homogenize01 /f set
+ } ifelse
+ } {
+% Automatic h-s-homogenization with degreeShift
+ f { {. ecart.dehomogenize} map} map /f set
+ f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
+ }ifelse
+
ecart.needSyz {
[f [(needSyz)] gb.options join ] groebner /gg set
} {
@@ -287,14 +410,18 @@
ecart.needSyz {
mm {
gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
- } { /ans.gb gg 0 get def } ifelse
- /ans [gg 2 get , ans.gb , gg 1 get , f ] def
- ans pmat ;
+ } { /ans.gb gg 0 get def } ifelse
+ /ans [gg 2 get , ans.gb , gg 1 get , f ] def
+% ans pmat ;
} {
wv isInteger {
/ans [gg gg {init} map] def
}{
- /ans [gg gg {wv 0 get weightv init} map] def
+ degreeShift isInteger {
+ /ans [gg gg {wv 0 get weightv init} map] def
+ } {
+ /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
+ } ifelse
}ifelse
%% Postprocess : recover the matrix expression.
@@ -316,15 +443,16 @@
popVariables
arg1
} def
-(ecart.gb ) messagen-quiet
+(ecarth.gb ) messagen-quiet
-[(ecart.gb)
- [(a ecart.gb b)
+[(ecarth.gb)
+ [(a ecarth.gb b)
(array a; array b;)
$b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
( in the ring of differential operators.)
- (The computation is done by using Ecart division algorithm and )
- (the double homogenization.)
+ (The computation is done by using Ecart division algorithm.)
+ $Buchberger algorithm is applied for double h-H(s)-homogenized elements and$
+ (they are not dehomogenized.)
(cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
$ ii is the initial ideal in case of w is given or <> belongs$
$ to a ring. In the other cases, it returns the initial monominal.$
@@ -338,28 +466,27 @@
( not to dehomogenize and homogenize)
( )
$Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
- $ [ [ (Dx) 1 ] ] ] ecart.gb pmat ; $
+ $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
(Example 2: )
(To put H and h=1, type in, e.g., )
$ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
- $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /gg set gg ecart.dehomogenize pmat ;$
+ $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecarth.gb /gg set gg ecart.dehomogenize pmat ;$
( )
$Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
- $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
+ $ [ [ (Dx) 1 (Dy) 1] ] ] ecarth.gb pmat ; $
( )
$Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
- $ [ [ (x) -1 (y) -1] ] ] ecart.gb pmat ; $
+ $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
( )
$Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
- $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.gb pmat ; $
+ $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] [[0 1] [-3 1] ] ] ecarth.gb pmat ; (buggy infinite loop)$
( )
- (cf. gb, groebner, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
+ (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
( ecart.dehomogenize, ecart.dehomogenizeH)
( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
( define_ring )
]] putUsages
-%% BUG: " f weight init " works well in case of vectors with degree shift ?
/ecart.syz {
/arg1 set
@@ -382,16 +509,501 @@
(array a; array b;)
$b : [syzygy gb tmat input]; gb = tmat * input $
$Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
- $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.syz /ff set $
+ $ [ [ (Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.syz /ff set $
$ ff 0 get ff 3 get mul pmat $
$ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $
( )
+ (To set the current ring to the ring in which ff belongs )
+ ( ff getRing ring_def )
$Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
- $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
+ $ [ [(Dx) 1 (Dy) 1] [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
( )
(cf. ecart.gb)
( /ecart.autoHomogenize 0 def )
]] putUsages
+/ecartn.begin {
+ (red@) (standard) switch_function
+%% (red@) (ecart) switch_function
+ [(Ecart) 1] system_variable
+ [(CheckHomogenization) 0] system_variable
+ [(ReduceLowerTerms) 0] system_variable
+ [(AutoReduce) 0] system_variable
+ [(EcartAutomaticHomogenization) 0] system_variable
+} def
+/ecartn.gb {
+ /arg1 set
+ [/in-ecartn.gb /aa /typev /setarg /f /v
+ /gg /wv /vec /ans /rr /mm
+ /degreeShift /env2 /opt /ans.gb
+ ] pushVariables
+ [(CurrentRingp) (KanGBmessage)] pushEnv
+ [
+ /aa arg1 def
+ aa isArray { } { ( << array >> gb) error } ifelse
+ /setarg 0 def
+ /wv 0 def
+ /degreeShift 0 def
+ /opt [(weightedHomogenization) 1] def
+ aa { tag } map /typev set
+ typev [ ArrayP ] eq
+ { /f aa 0 get def
+ /v gb.v def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP StringP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP RingP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP StringP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /wv aa 2 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /wv aa 2 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP StringP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP ArrayP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ /setarg 1 def
+ } { } ifelse
+
+ /env1 getOptions def
+
+ setarg { } { (ecart.gb : Argument mismatch) error } ifelse
+
+ [(KanGBmessage) ecart.gb.verbose ] system_variable
+
+ %%% Start of the preprocess
+ v tag RingP eq {
+ /rr v def
+ }{
+ f getRing /rr set
+ } ifelse
+ %% To the normal form : matrix expression.
+ f gb.toMatrixOfString /f set
+ /mm gb.itWasMatrix def
+
+ rr tag 0 eq {
+ %% Define our own ring
+ v isInteger {
+ (Error in gb: Specify variables) error
+ } { } ifelse
+ wv isInteger {
+ [v ring_of_differential_operators
+ [ v ecart.wv1 v ecart.wv2 ] weight_vector
+ gb.characteristic
+ opt
+ ] define_ring
+ }{
+ degreeShift isInteger {
+ [v ring_of_differential_operators
+ [v ecart.wv1 v ecart.wv2] wv join weight_vector
+ gb.characteristic
+ opt
+ ] define_ring
+
+ }{
+ [v ring_of_differential_operators
+ [v ecart.wv1 v ecart.wv2] wv join weight_vector
+ gb.characteristic
+ [(degreeShift) degreeShift] opt join
+ ] define_ring
+
+ } ifelse
+ } ifelse
+ } {
+ %% Use the ring structre given by the input.
+ v isInteger not {
+ gb.warning {
+ (Warning : the given ring definition is not used.) message
+ } { } ifelse
+ } { } ifelse
+ rr ring_def
+ /wv rr gb.getWeight def
+
+ } ifelse
+ %%% Enf of the preprocess
+
+ ecart.gb.verbose {
+ (The first and the second weight vectors are automatically set as follows)
+ message
+ v ecart.wv1 message
+ v ecart.wv2 message
+ degreeShift isInteger { }
+ {
+ (The degree shift is ) messagen
+ degreeShift message
+ } ifelse
+ } { } ifelse
+
+ %%BUG: case of v is integer
+ v ecart.checkOrder
+
+ ecartn.begin
+
+ ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
+ ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
+ ecart.autoHomogenize {
+ (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
+ message
+ } { } ifelse
+ ecart.autoHomogenize {
+ f { {. ecart.dehomogenize} map} map /f set
+ f ecart.homogenize01 /f set
+ }{
+ f { {. } map } map /f set
+ } ifelse
+ ecart.needSyz {
+ [f [(needSyz)] gb.options join ] groebner /gg set
+ } {
+ [f gb.options] groebner 0 get /gg set
+ } ifelse
+
+ ecart.needSyz {
+ mm {
+ gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
+ } { /ans.gb gg 0 get def } ifelse
+ /ans [gg 2 get , ans.gb , gg 1 get , f ] def
+% ans pmat ;
+ } {
+ wv isInteger {
+ /ans [gg gg {init} map] def
+ }{
+ degreeShift isInteger {
+ /ans [gg gg {wv 0 get weightv init} map] def
+ } {
+ /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
+ } ifelse
+ }ifelse
+
+ %% Postprocess : recover the matrix expression.
+ mm {
+ ans { /tmp set [mm tmp] toVectors } map
+ /ans set
+ }{ }
+ ifelse
+ } ifelse
+
+ ecart.end
+
+ %%
+ env1 restoreOptions %% degreeShift changes "grade"
+
+ /arg1 ans def
+ ] pop
+ popEnv
+ popVariables
+ arg1
+} def
+(ecartn.gb[gb by non-ecart division] ) messagen-quiet
+
+/ecartd.gb {
+ /arg1 set
+ [/in-ecart.gb /aa /typev /setarg /f /v
+ /gg /wv /vec /ans /rr /mm
+ /degreeShift /env2 /opt /ans.gb
+ /hdShift
+ ] pushVariables
+ [(CurrentRingp) (KanGBmessage)] pushEnv
+ [
+ /aa arg1 def
+ aa isArray { } { ( << array >> gb) error } ifelse
+ /setarg 0 def
+ /wv 0 def
+ /degreeShift 0 def
+ /hdShift 0 def
+ /opt [(weightedHomogenization) 1] def
+ aa { tag } map /typev set
+ typev [ ArrayP ] eq
+ { /f aa 0 get def
+ /v gb.v def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP StringP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP RingP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP StringP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /wv aa 2 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /wv aa 2 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP StringP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP ArrayP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP StringP ArrayP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ /hdShift aa 4 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP ArrayP ArrayP ArrayP ArrayP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ /hdShift aa 4 get def
+ /setarg 1 def
+ } { } ifelse
+ typev [ArrayP ArrayP ArrayP ArrayP StringP] eq
+ { /f aa 0 get def
+ /v aa 1 get from_records def
+ /wv aa 2 get def
+ /degreeShift aa 3 get def
+ aa 4 get (no) eq {
+ /hdShift -1 def
+ } {
+ (Unknown keyword for the 5th argument) error
+ } ifelse
+ /setarg 1 def
+ } { } ifelse
+
+ /env1 getOptions def
+
+ setarg { } { (ecart.gb : Argument mismatch) error } ifelse
+
+ [(KanGBmessage) ecart.gb.verbose ] system_variable
+ $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message
+
+ %%% Start of the preprocess
+ v tag RingP eq {
+ /rr v def
+ }{
+ f getRing /rr set
+ } ifelse
+ %% To the normal form : matrix expression.
+ f gb.toMatrixOfString /f set
+ /mm gb.itWasMatrix def
+
+ rr tag 0 eq {
+ %% Define our own ring
+ v isInteger {
+ (Error in gb: Specify variables) error
+ } { } ifelse
+ wv isInteger {
+ (Give an weight vector such that x < 1) error
+ }{
+ degreeShift isInteger {
+ [v ring_of_differential_operators
+ wv weight_vector
+ gb.characteristic
+ opt
+ ] define_ring
+
+ }{
+ [v ring_of_differential_operators
+ wv weight_vector
+ gb.characteristic
+ [(degreeShift) degreeShift] opt join
+ ] define_ring
+
+ } ifelse
+ } ifelse
+ } {
+ %% Use the ring structre given by the input.
+ v isInteger not {
+ gb.warning {
+ (Warning : the given ring definition is not used.) message
+ } { } ifelse
+ } { } ifelse
+ rr ring_def
+ /wv rr gb.getWeight def
+
+ } ifelse
+ %%% Enf of the preprocess
+
+ ecart.gb.verbose {
+ degreeShift isInteger { }
+ {
+ (The degree shift is ) messagen
+ degreeShift message
+ } ifelse
+ } { } ifelse
+
+ %%BUG: case of v is integer
+ v ecart.checkOrder
+
+ ecartd.begin
+
+ ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
+
+ hdShift tag 1 eq {
+ ecart.autoHomogenize not hdShift -1 eq or {
+% No automatic h-homogenization.
+ f { {. } map} map /f set
+ } {
+% Automatic h-homogenization without degreeShift
+ f { {. ecart.dehomogenize} map} map /f set
+ f ecart.homogenize01 /f set
+ f { { [[(H). (1).]] replace } map } map /f set
+ } ifelse
+ } {
+% Automatic h-homogenization with degreeShift
+ f { {. ecart.dehomogenize} map} map /f set
+ f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
+ f { { [[(H). (1).]] replace } map } map /f set
+ }ifelse
+
+ ecart.needSyz {
+ [f [(needSyz)] gb.options join ] groebner /gg set
+ } {
+ [f gb.options] groebner 0 get /gg set
+ } ifelse
+
+ ecart.needSyz {
+ mm {
+ gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
+ } { /ans.gb gg 0 get def } ifelse
+ /ans [gg 2 get , ans.gb , gg 1 get , f ] def
+% ans pmat ;
+ } {
+ wv isInteger {
+ /ans [gg gg {init} map] def
+ }{
+%% Get the initial ideal
+ degreeShift isInteger {
+ /ans [gg gg {wv 0 get weightv init} map] def
+ } {
+ /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
+ } ifelse
+ }ifelse
+
+ %% Postprocess : recover the matrix expression.
+ mm {
+ ans { /tmp set [mm tmp] toVectors } map
+ /ans set
+ }{ }
+ ifelse
+ } ifelse
+
+ ecartd.end
+
+ %%
+ env1 restoreOptions %% degreeShift changes "grade"
+
+ /arg1 ans def
+ ] pop
+ popEnv
+ popVariables
+ arg1
+} def
+(ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
+
+/ecart.checkOrder {
+ /arg1 set
+ [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables
+ [
+ /vv arg1 def
+ vv isArray
+ { } { [vv to_records pop] /vv set } ifelse
+ vv {toString} map /vv set
+ vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
+ % Starting the checks.
+ 0 1 vv length 1 sub {
+ /i set
+ vv i get . dd i get . mul /tt set
+ tt @@@.hsymbol . add init tt eq { }
+ { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
+ } for
+
+ 0 1 vv length 1 sub {
+ /i set
+ vv i get . /tt set
+ tt (1). add init (1). eq { }
+ { [vv i get ( is larger than 1 ) ] cat error} ifelse
+ } for
+ /arg1 1 def
+ ] pop
+ popVariables
+ arg1
+} def
+[(ecart.checkOrder)
+ [(v ecart.checkOrder bool checks if the given order is relevant)
+ (for the ecart division.)
+ (cf. ecartd.gb, ecart.gb, ecartn.gb)
+ ]
+] putUsages
+
+/ecart.wv_last {
+ /arg1 set
+ [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables
+ [
+ /vv arg1 def
+ vv isArray
+ { } { [vv to_records pop] /vv set } ifelse
+ vv {toString} map /vv set
+ vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
+ vv { -1 } map
+ dd { 1 } map join /arg1 set
+ ] pop
+ popVariables
+ arg1
+} def
+[(ecart.wv_last)
+ [(v ecart.wv_last wt )
+ (It returns the weight vector -1,-1,...-1; 1,1, ..., 1)
+ (Use this weight vector as the last weight vector for ecart division)
+ (if ecart.checkOrder complains about the order given.)
+ ]
+] putUsages
+
( ) message-quiet
+