version 1.3, 2003/07/29 08:36:39 |
version 1.12, 2003/08/26 05:06:00 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.2 2003/07/25 01:03:00 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) (hol.sm1) pushfile] extension |
%[(parse) (appell.sm1) pushfile] extension |
%[(parse) (appell.sm1) pushfile] extension |
|
|
|
|
/ecart.end { endEcart } def |
/ecart.end { endEcart } def |
/ecart.autoHomogenize 1 def |
/ecart.autoHomogenize 1 def |
/ecart.needSyz 0 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 { |
/ecart.dehomogenize { |
/arg1 set |
/arg1 set |
|
|
|
|
/ecart.homogenize01 { |
/ecart.homogenize01 { |
/arg1 set |
/arg1 set |
[/in.ecart.homogenize01 /ll ] pushVariables |
[/in.ecart.homogenize01 /ll /ll0] pushVariables |
[ |
[ |
/ll arg1 def |
/ll arg1 def |
[(degreeShift) [ ] ll ] homogenize |
ll tag ArrayP eq { |
/arg1 set |
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 |
] pop |
popVariables |
popVariables |
arg1 |
arg1 |
|
|
( [(x1) -1 (x2) -1]) |
( [(x1) -1 (x2) -1]) |
( ] weight_vector ) |
( ] weight_vector ) |
( 0 ) |
( 0 ) |
( [(degreeShift) [[0 0 0]]]) |
( [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]]) |
( ] define_ring) |
( ] define_ring) |
( ecart.begin) |
( ecart.begin) |
( [[1 -4 -2 5]] appell4 0 get /eqs set) |
( [[1 -4 -2 5]] appell4 0 get /eqs set) |
( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map ) |
( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map ) |
( ecart.homogenize01 /eqs2 set) |
( {ecart.homogenize01} map /eqs2 set) |
( [eqs2] groebner ) |
( [eqs2] groebner ) |
]] putUsages |
]] putUsages |
|
|
/ecart.homogenize01_with_shiftVector { |
/ecart.homogenize01_with_shiftVector { |
/arg2.set |
/arg2.set |
/arg1 set |
/arg1 set |
[/in.ecart.homogenize01 /ll /sv] pushVariables |
[/in.ecart.homogenize01 /ll /sv /ll0] pushVariables |
[ |
[ |
/sv arg2 def |
/sv arg2 def |
/ll arg1 def |
/ll arg1 def |
[(degreeShift) sv ll ] homogenize |
ll tag ArrayP eq { |
/arg1 set |
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 |
] pop |
popVariables |
popVariables |
arg1 |
arg1 |
} def |
} def |
[(ecart.dehomogenize01_with_degreeShift) |
[(ecart.dehomogenize01_with_degreeShift) |
[(obj shift-vector ecart.dehomogenize01_with_degreeShift r) |
[(obj shift-vector ecart.dehomogenize01_with_degreeShift r) |
|
(cf. homogenize) |
]] putUsages |
]] putUsages |
|
|
%% Aux functions to return the default weight vectors. |
%% Aux functions to return the default weight vectors. |
|
|
arg1 |
arg1 |
} def |
} 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 <<a>> 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.verbose 1 def |
/ecart.gb { |
%ecarth.gb s(H)-homogenized outputs. GG's original version of ecart gb. |
|
/ecarth.gb { |
/arg1 set |
/arg1 set |
[/in-ecart.gb /aa /typev /setarg /f /v |
[/in-ecarth.gb /aa /typev /setarg /f /v |
/gg /wv /vec /ans /rr /mm |
/gg /wv /vec /ans /rr /mm |
/degreeShift /env2 /opt /ans.gb |
/degreeShift /env2 /opt /ans.gb |
|
/hdShift |
] pushVariables |
] pushVariables |
[(CurrentRingp) (KanGBmessage)] pushEnv |
[(CurrentRingp) (KanGBmessage)] pushEnv |
[ |
[ |
|
|
/setarg 0 def |
/setarg 0 def |
/wv 0 def |
/wv 0 def |
/degreeShift 0 def |
/degreeShift 0 def |
|
/hdShift 0 def |
/opt [(weightedHomogenization) 1] def |
/opt [(weightedHomogenization) 1] def |
aa { tag } map /typev set |
aa { tag } map /typev set |
typev [ ArrayP ] eq |
typev [ ArrayP ] eq |
|
|
/degreeShift aa 3 get def |
/degreeShift aa 3 get def |
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } 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 |
typev [ArrayP ArrayP ArrayP ArrayP] eq |
{ /f aa 0 get def |
{ /f aa 0 get def |
/v aa 1 get from_records def |
/v aa 1 get from_records def |
|
|
/degreeShift aa 3 get def |
/degreeShift aa 3 get def |
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } 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 |
/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 |
[(KanGBmessage) ecart.gb.verbose ] system_variable |
|
|
|
|
} { } ifelse |
} { } ifelse |
wv isInteger { |
wv isInteger { |
[v ring_of_differential_operators |
[v ring_of_differential_operators |
[ v ecart.wv1 v ecart.wv2 ] weight_vector |
% [ v ecart.wv1 v ecart.wv2 ] weight_vector |
gb.characteristic |
gb.characteristic |
opt |
opt |
] define_ring |
] define_ring |
}{ |
}{ |
degreeShift isInteger { |
degreeShift isInteger { |
[v ring_of_differential_operators |
[v ring_of_differential_operators |
[v ecart.wv1 v ecart.wv2] wv join weight_vector |
% [v ecart.wv1 v ecart.wv2] wv join weight_vector |
|
wv weight_vector |
gb.characteristic |
gb.characteristic |
opt |
opt |
] define_ring |
] define_ring |
|
|
}{ |
}{ |
[v ring_of_differential_operators |
[v ring_of_differential_operators |
[v ecart.wv1 v ecart.wv2] wv join weight_vector |
% [v ecart.wv1 v ecart.wv2] wv join weight_vector |
|
wv weight_vector |
gb.characteristic |
gb.characteristic |
[(degreeShift) degreeShift] opt join |
[(degreeShift) degreeShift] opt join |
] define_ring |
] define_ring |
|
|
%%% Enf of the preprocess |
%%% Enf of the preprocess |
|
|
ecart.gb.verbose { |
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 |
message |
v ecart.wv1 message |
v ecart.wv1 message |
v ecart.wv2 message |
v ecart.wv2 message |
|
|
} ifelse |
} ifelse |
} { } ifelse |
} { } ifelse |
|
|
|
%%BUG: case of v is integer |
|
v ecart.checkOrder |
|
|
ecart.begin |
ecart.begin |
|
|
ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse |
ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse |
ecart.autoHomogenize { |
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 |
message |
} { } ifelse |
} { } ifelse |
ecart.autoHomogenize { |
|
f { {. ecart.dehomogenize} map} map /f set |
hdShift tag 1 eq { |
f ecart.homogenize01 /f set |
ecart.autoHomogenize not hdShift -1 eq or { |
}{ |
% No automatic h-s-homogenization. |
f { {. } map } map /f set |
f { {. } map} map /f set |
} ifelse |
} { |
|
% 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 { |
ecart.needSyz { |
[f [(needSyz)] gb.options join ] groebner /gg set |
[f [(needSyz)] gb.options join ] groebner /gg set |
} { |
} { |
|
|
ecart.needSyz { |
ecart.needSyz { |
mm { |
mm { |
gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set |
gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set |
} { /ans.gb gg 0 get def } ifelse |
} { /ans.gb gg 0 get def } ifelse |
/ans [gg 2 get , ans.gb , gg 1 get , f ] def |
/ans [gg 2 get , ans.gb , gg 1 get , f ] def |
ans pmat ; |
% ans pmat ; |
} { |
} { |
wv isInteger { |
wv isInteger { |
/ans [gg gg {init} map] def |
/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 |
}ifelse |
|
|
%% Postprocess : recover the matrix expression. |
%% Postprocess : recover the matrix expression. |
|
|
popVariables |
popVariables |
arg1 |
arg1 |
} def |
} def |
(ecart.gb ) messagen-quiet |
(ecarth.gb ) messagen-quiet |
|
|
[(ecart.gb) |
[(ecarth.gb) |
[(a ecart.gb b) |
[(a ecarth.gb b) |
(array a; array b;) |
(array a; array b;) |
$b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$ |
$b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$ |
( in the ring of differential operators.) |
( in the ring of differential operators.) |
(The computation is done by using Ecart division algorithm and ) |
(The computation is done by using Ecart division algorithm.) |
(the double homogenization.) |
$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) |
(cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003) |
$ ii is the initial ideal in case of w is given or <<a>> belongs$ |
$ ii is the initial ideal in case of w is given or <<a>> belongs$ |
$ to a ring. In the other cases, it returns the initial monominal.$ |
$ to a ring. In the other cases, it returns the initial monominal.$ |
|
|
( not to dehomogenize and homogenize) |
( not to dehomogenize and homogenize) |
( ) |
( ) |
$Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ |
$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: ) |
(Example 2: ) |
(To put H and h=1, type in, e.g., ) |
(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) $ |
$ [ [(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) $ |
$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) $ |
$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) $ |
$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) |
( ecart.dehomogenize, ecart.dehomogenizeH) |
( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for ) |
( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for ) |
( define_ring ) |
( define_ring ) |
]] putUsages |
]] putUsages |
|
|
%% BUG: " f weight init " works well in case of vectors with degree shift ? |
|
|
|
/ecart.syz { |
/ecart.syz { |
/arg1 set |
/arg1 set |
|
|
(array a; array b;) |
(array a; array b;) |
$b : [syzygy gb tmat input]; gb = tmat * input $ |
$b : [syzygy gb tmat input]; gb = tmat * input $ |
$Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ |
$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 0 get ff 3 get mul pmat $ |
$ ff 2 get ff 3 get mul [ff 1 get ] transpose sub 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) $ |
$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) |
(cf. ecart.gb) |
( /ecart.autoHomogenize 0 def ) |
( /ecart.autoHomogenize 0 def ) |
|
|
} ifelse |
} ifelse |
} { } ifelse |
} { } ifelse |
|
|
|
%%BUG: case of v is integer |
|
v ecart.checkOrder |
|
|
ecartn.begin |
ecartn.begin |
|
|
ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse |
ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse |
|
|
gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set |
gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set |
} { /ans.gb gg 0 get def } ifelse |
} { /ans.gb gg 0 get def } ifelse |
/ans [gg 2 get , ans.gb , gg 1 get , f ] def |
/ans [gg 2 get , ans.gb , gg 1 get , f ] def |
ans pmat ; |
% ans pmat ; |
} { |
} { |
wv isInteger { |
wv isInteger { |
/ans [gg gg {init} map] def |
/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 |
}ifelse |
|
|
%% Postprocess : recover the matrix expression. |
%% Postprocess : recover the matrix expression. |
|
|
} def |
} def |
(ecartn.gb[gb by non-ecart division] ) messagen-quiet |
(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 |
( ) message-quiet |
|
|