% $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
(ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet
/ecart.begin { beginEcart } def
/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
[/in.ecart.dehomogenize /ll /rr] pushVariables
[
/ll arg1 def
ll tag 6 eq {
ll { ecart.dehomogenize } map /ll set
} {
ll (0). eq {
} {
ll getRing /rr set
ll [ [ (H) rr ,, (1) rr ,, ]
[ (h) rr ,, (1) rr ,, ]] replace
/ll set
} ifelse
} ifelse
/arg1 ll def
] pop
popVariables
arg1
} def
[(ecart.dehomogenize)
[(obj ecart.dehomogenize r)
(h->1, H->1)
]] putUsages
/ecart.dehomogenizeH {
/arg1 set
[/in.ecart.dehomogenize /ll /rr] pushVariables
[
/ll arg1 def
ll tag 6 eq {
ll { ecart.dehomogenize } map /ll set
} {
ll (0). eq {
} {
ll getRing /rr set
ll [ [ (H) rr ,, (1) rr ,, ] ] replace
/ll set
} ifelse
} ifelse
/arg1 ll def
] pop
popVariables
arg1
} def
[(ecart.dehomogenizeH)
[(obj ecart.dehomogenizeH r)
(H->1, h is not changed.)
]] putUsages
/ecart.homogenize01 {
/arg1 set
[/in.ecart.homogenize01 /ll /ll0] pushVariables
[
/ll arg1 def
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
}
] pop
popVariables
arg1
} def
[(ecart.homogenize01)
[(obj ecart.homogenize01 r)
(Example: )
( [(x1,x2) ring_of_differential_operators )
( [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
( [(h) 1 (Dx1) 1 (Dx2) 1] )
( [(Dx1) 1 (Dx2) 1] )
( [(x1) -1 (x2) -1])
( ] weight_vector )
( 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} map /eqs2 set)
( [eqs2] groebner )
]] putUsages
/ecart.homogenize01_with_shiftVector {
/arg2.set
/arg1 set
[/in.ecart.homogenize01 /ll /sv /ll0] pushVariables
[
/sv arg2 def
/ll arg1 def
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
}
] 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.
/ecart.wv1 {
/arg1 set
[/in.ecart.wv1 /v] pushVariables
[
/v arg1 def
[(H) (h) v to_records pop] /v set
v { 1 } map /v set
/arg1 v def
] pop
popVariables
arg1
} def
/ecart.wv2 {
/arg1 set
[/in.ecart.wv2 /v] pushVariables
[
/v arg1 def
[v to_records pop] /v set
v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set
[(h) 1 ] v join /v set
/arg1 v def
] pop
popVariables
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
/ecarth.gb {
/arg1 set
[/in-ecarth.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
wv weight_vector
gb.characteristic
opt
] define_ring
}{
[v ring_of_differential_operators
% [v ecart.wv1 v ecart.wv2] wv join weight_vector
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 {
(The first and the second weight vectors for automatic homogenization: )
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
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.)
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
(ecarth.gb ) messagen-quiet
[(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.)
(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 )
( )
(/ecart.autoHomogenize 0 def )
( not to dehomogenize and homogenize)
( )
$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]] ] 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]]] 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] ] ] 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] [(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) $
$ [ [(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.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
[/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
[
/ff arg1 def
/ecart.save.needSyz ecart.needSyz def
/ecart.needSyz 1 def
ff ecart.gb /ff.ans set
/ecart.needSyz ecart.save.needSyz def
/arg1 ff.ans def
] pop
popVariables
arg1
} def
(ecart.syz ) messagen-quiet
[(ecart.syz)
[(a ecart.syz b)
(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] [(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) $
$ [ [(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 {
hdShift -1 eq {
% 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