version 1.14, 2003/08/27 03:11:13 |
version 1.19, 2004/04/29 12:04:45 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.13 2003/08/26 12:46:03 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.18 2003/09/30 00:06:56 takayama Exp $ |
%[(parse) (hol.sm1) pushfile] extension |
%[(parse) (hol.sm1) pushfile] extension |
%[(parse) (appell.sm1) pushfile] extension |
%[(parse) (appell.sm1) pushfile] extension |
|
|
|
|
[(EcartAutomaticHomogenization) 0] system_variable |
[(EcartAutomaticHomogenization) 0] system_variable |
} def |
} def |
|
|
|
/ecart.setOpt { |
|
/arg1 set |
|
[/in-ecart.setOpt /opt /i /n /ans] pushVariables |
|
[ |
|
/opt arg1 def |
|
/ans [ ] def |
|
/n opt length def |
|
0 2 n 1 sub { |
|
/i set |
|
opt i get tag StringP eq not { |
|
(ecart.setOpt : [keyword value keyword value ....] ) error |
|
} { } ifelse |
|
{ % start of the loop |
|
% Global: degreeShift |
|
opt i get (degreeShift) eq { |
|
/degreeShift opt i 1 add get def |
|
exit |
|
} { } ifelse |
|
% Global: hdShift |
|
opt i get (startingShift) eq { |
|
/hdShift opt i 1 add get def |
|
exit |
|
} { } ifelse |
|
% Global: hdShift |
|
opt i get (noAutoHomogenize) eq { |
|
/hdShift -1 def |
|
exit |
|
} { } ifelse |
|
% Global: ecart.useSugar |
|
opt i get (sugar) eq { |
|
/ecart.useSugar opt i 1 add get def |
|
exit |
|
} { } ifelse |
|
|
|
ans [opt i get opt i 1 add get ] append /ans set |
|
exit |
|
} loop |
|
} for |
|
|
|
ecart.gb.verbose { |
|
(ecart.setOpt:) message |
|
(degreeShift=) messagen degreeShift message |
|
$hdShift(startingShift)=$ messagen hdShift message |
|
(sugar=) messagen ecart.useSugar message |
|
(Other options=) messagen ans message |
|
} { } ifelse |
|
|
|
/arg1 ans def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
|
/ecart.dehomogenize { |
/ecart.dehomogenize { |
/arg1 set |
/arg1 set |
[/in.ecart.dehomogenize /ll /rr] pushVariables |
[/in.ecart.dehomogenize /ll /rr] pushVariables |
|
|
( [(h) 1 (Dx1) 1 (Dx2) 1] ) |
( [(h) 1 (Dx1) 1 (Dx2) 1] ) |
( [(Dx1) 1 (Dx2) 1] ) |
( [(Dx1) 1 (Dx2) 1] ) |
( [(x1) -1 (x2) -1]) |
( [(x1) -1 (x2) -1]) |
( ] weight_vector ) |
( ] ecart.weight_vector ) |
( 0 ) |
( 0 ) |
( [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]]) |
( [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]]) |
( ] define_ring) |
( ] define_ring) |
|
|
(a : [f ]; array f; f is a set of generators of an ideal in a ring.) |
(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]; 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]; 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.) |
$a : [f v w [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$ |
( array ds; ds is the degree shift for the ring. ) |
( 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.) |
$a : [f v w [(degreeShift) ds (startingShift) 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 ds; ds is the degree shift for the ring. ) |
( array hsShift is the degree shift for the homogenization. cf.homogenize ) |
( 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.$ |
$a : [f v w [(degreeShift) ds (noAutoHomogenize) 1]]; array f; string v; array of array w; w is the weight matirx.$ |
( No automatic homogenization.) |
( No automatic homogenization.) |
|
$ [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $ |
( ) |
( ) |
$cf. ecarth.gb (homogenized), ecartd.gb (dehomogenize) $ |
$cf. ecarth.gb (homogenized), ecartd.gb (dehomogenize), ecartd.reduction $ |
( ) |
( ) |
$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 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $ |
$ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $ |
|
|
( This example will cause an error on order.) |
( 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) $ |
$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 ; $ |
$ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $ |
|
$ [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $ |
( ) |
( ) |
(cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, ) |
(cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, ) |
( ecart.dehomogenize, ecart.dehomogenizeH) |
( ecart.dehomogenize, ecart.dehomogenizeH) |
|
|
/gg /wv /vec /ans /rr /mm |
/gg /wv /vec /ans /rr /mm |
/degreeShift /env2 /opt /ans.gb |
/degreeShift /env2 /opt /ans.gb |
/hdShift |
/hdShift |
|
/ecart.useSugar |
] pushVariables |
] pushVariables |
[(CurrentRingp) (KanGBmessage)] pushEnv |
[(CurrentRingp) (KanGBmessage)] pushEnv |
[ |
[ |
|
|
/degreeShift 0 def |
/degreeShift 0 def |
/hdShift 0 def |
/hdShift 0 def |
/opt [(weightedHomogenization) 1] def |
/opt [(weightedHomogenization) 1] def |
|
/ecart.useSugar 0 def |
aa { tag } map /typev set |
aa { tag } map /typev set |
typev [ ArrayP ] eq |
typev [ ArrayP ] eq |
{ /f aa 0 get def |
{ /f aa 0 get def |
|
|
/wv aa 2 get def |
/wv aa 2 get def |
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } ifelse |
|
|
typev [ArrayP StringP ArrayP ArrayP] eq |
typev [ArrayP StringP ArrayP ArrayP] eq |
{ /f aa 0 get def |
{ /f aa 0 get def |
/v aa 1 get def |
/v aa 1 get def |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/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 |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/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 |
|
typev [ArrayP StringP ArrayP ArrayP StringP] eq |
|
{ /f aa 0 get def |
|
/v aa 1 get 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 |
|
|
|
|
} { } 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 ] ecart.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 ecart.weight_vector |
wv weight_vector |
wv ecart.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 ecart.weight_vector |
wv weight_vector |
wv ecart.weight_vector |
gb.characteristic |
gb.characteristic |
[(degreeShift) degreeShift] opt join |
[(degreeShift) degreeShift] opt join |
] define_ring |
] define_ring |
|
|
f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set |
f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set |
}ifelse |
}ifelse |
|
|
ecart.needSyz { |
ecart.useSugar { |
[f [(needSyz)] gb.options join ] groebner /gg set |
ecart.needSyz { |
} { |
[f [(needSyz)] gb.options join ] groebner_sugar /gg set |
[f gb.options] groebner 0 get /gg set |
} { |
|
[f gb.options] groebner_sugar 0 get /gg set |
|
} ifelse |
|
} { |
|
ecart.needSyz { |
|
[f [(needSyz)] gb.options join ] groebner /gg set |
|
} { |
|
[f gb.options] groebner 0 get /gg set |
|
} ifelse |
} ifelse |
} ifelse |
|
|
ecart.needSyz { |
ecart.needSyz { |
|
|
(a : [f ]; array f; f is a set of generators of an ideal in a ring.) |
(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]; 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]; 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.) |
$a : [f v w [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$ |
( array ds; ds is the degree shift ) |
( array ds; ds is the degree shift ) |
( ) |
( ) |
(/ecart.autoHomogenize 0 def ) |
(/ecart.autoHomogenize 0 def ) |
|
|
$ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.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) $ |
$ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] [[0 1] [-3 1] ] ] ecarth.gb pmat ; (buggy infinite loop)$ |
$ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $ |
|
$ [(degreeShift) [[0 1] [-3 1] ]] ] ecarth.gb pmat ; $ |
( ) |
( ) |
(cf. gb, groebner, ecart.gb, ecartd.gb, 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) |
|
|
/wv aa 2 get def |
/wv aa 2 get def |
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } ifelse |
|
|
typev [ArrayP StringP ArrayP ArrayP] eq |
typev [ArrayP StringP ArrayP ArrayP] eq |
{ /f aa 0 get def |
{ /f aa 0 get def |
/v aa 1 get def |
/v aa 1 get def |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } 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 |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } ifelse |
|
|
|
|
} { } 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 ] ecart.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 ecart.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 ecart.weight_vector |
gb.characteristic |
gb.characteristic |
[(degreeShift) degreeShift] opt join |
[(degreeShift) degreeShift] opt join |
] define_ring |
] define_ring |
|
|
/gg /wv /vec /ans /rr /mm |
/gg /wv /vec /ans /rr /mm |
/degreeShift /env2 /opt /ans.gb |
/degreeShift /env2 /opt /ans.gb |
/hdShift |
/hdShift |
|
/ecart.useSugar |
] pushVariables |
] pushVariables |
[(CurrentRingp) (KanGBmessage)] pushEnv |
[(CurrentRingp) (KanGBmessage)] pushEnv |
[ |
[ |
|
|
/wv 0 def |
/wv 0 def |
/degreeShift 0 def |
/degreeShift 0 def |
/hdShift 0 def |
/hdShift 0 def |
|
/ecart.useSugar 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 |
|
|
/wv aa 2 get def |
/wv aa 2 get def |
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } ifelse |
|
|
typev [ArrayP StringP ArrayP ArrayP] eq |
typev [ArrayP StringP ArrayP ArrayP] eq |
{ /f aa 0 get def |
{ /f aa 0 get def |
/v aa 1 get def |
/v aa 1 get def |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } 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 |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/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 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 |
|
typev [ArrayP StringP ArrayP ArrayP StringP] eq |
|
{ /f aa 0 get def |
|
/v aa 1 get 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 |
|
|
|
|
}{ |
}{ |
degreeShift isInteger { |
degreeShift isInteger { |
[v ring_of_differential_operators |
[v ring_of_differential_operators |
wv weight_vector |
wv ecart.weight_vector |
gb.characteristic |
gb.characteristic |
opt |
opt |
] define_ring |
] define_ring |
|
|
}{ |
}{ |
[v ring_of_differential_operators |
[v ring_of_differential_operators |
wv weight_vector |
wv ecart.weight_vector |
gb.characteristic |
gb.characteristic |
[(degreeShift) degreeShift] opt join |
[(degreeShift) degreeShift] opt join |
] define_ring |
] define_ring |
|
|
f { { [[(H). (1).]] replace } map } map /f set |
f { { [[(H). (1).]] replace } map } map /f set |
}ifelse |
}ifelse |
|
|
ecart.needSyz { |
ecart.useSugar { |
[f [(needSyz)] gb.options join ] groebner /gg set |
ecart.needSyz { |
} { |
[f [(needSyz)] gb.options join ] groebner_sugar /gg set |
[f gb.options] groebner 0 get /gg set |
} { |
|
[f gb.options] groebner_sugar 0 get /gg set |
|
} ifelse |
|
} { |
|
ecart.needSyz { |
|
[f [(needSyz)] gb.options join ] groebner /gg set |
|
} { |
|
[f gb.options] groebner 0 get /gg set |
|
} ifelse |
} ifelse |
} ifelse |
|
|
ecart.needSyz { |
ecart.needSyz { |
|
|
/shift [ [1 0 1 0 0] ] def |
/shift [ [1 0 1 0 0] ] def |
/weight [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] def |
/weight [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] def |
|
|
[ff (t,x,y) weight shift nmshift] ecart.minimalBase |
[ff (t,x,y) weight [(degreeShift) shift (startingShift) nmshift]] ecart.minimalBase |
|
|
|
|
} def |
} def |
|
|
/wv 0 def |
/wv 0 def |
/degreeShift 0 def |
/degreeShift 0 def |
/hdShift 0 def |
/hdShift 0 def |
|
/opt [ ] def |
aa { tag } map /typev set |
aa { tag } map /typev set |
typev [ArrayP StringP ArrayP ArrayP ArrayP] eq |
typev [ArrayP StringP ArrayP ArrayP] eq |
{ /f aa 0 get def |
{ /f aa 0 get def |
/v aa 1 get def |
/v aa 1 get def |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/hdShift aa 4 get def |
|
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } ifelse |
typev [ArrayP 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 |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/hdShift aa 4 get def |
|
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } ifelse |
setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse |
setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse |
|
|
f 0 get tag ArrayP eq { } |
f 0 get tag ArrayP eq { } |
{ f { /tt set [ tt ] } map /f set } ifelse |
{ f { /tt set [ tt ] } map /f set } ifelse |
|
|
[f v wv degreeShift [hdShift 0 get degreeShift 0 get]] |
[f v wv [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join] |
ecart.gb /ff set |
ecart.gb /ff set |
ff getRing ring_def |
ff getRing ring_def |
|
|
ff 0 get { {toString } map } map /ff set |
ff 0 get { {toString } map } map /ff set |
|
|
[ff v wv degreeShift [hdShift 0 get degreeShift 0 get]] /arg1 set |
[ff v wv |
|
[(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join |
|
] /arg1 set |
] pop |
] pop |
popVariables |
popVariables |
arg1 |
arg1 |
} def |
} def |
[(ecart.gen_input) |
[(ecart.gen_input) |
[([ff v weight_vector uv_shift_m [D_shift_n uv_shift_m]] ecart.gen_input ) |
[$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]] ] ecart.gen_input $ |
( [gg_h v weight_vector uv_shift_m [D_shift_n uv_shift_m]] ) |
$ [gg_h v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] $ |
(It generates the input for the minimal filtered free resolution.) |
(It generates the input for the minimal filtered free resolution.) |
(Current ring is changed to the ring of gg_h.) |
(Current ring is changed to the ring of gg_h.) |
(cf. ecart.minimalBase) |
(cf. ecart.minimalBase) |
$Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $ |
$Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $ |
$ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $ |
$ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $ |
$ [ [0] ] $ |
$ [(degreeShift) [ [0] ] $ |
$ [ [0] [0] ] ] ecart.gen_input /gg set gg pmat $ |
$ (startingShift) [ [0] [0] ]] ] ecart.gen_input /gg set gg pmat $ |
]] putUsages |
]] putUsages |
|
|
|
|
[(ecart.minimalBase) |
[(ecart.minimalBase) |
[([ff v weight_vector uv_shift_m [D_shift_n uv_shift_m]] ecart.minimalBase ) |
[$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] ecart.minimalBase $ |
( [mbase gr_of_mbase ) |
( [mbase gr_of_mbase ) |
( [syz v weight_vector new_uv_shift_m [new_D_shift_n new_uv_shift_m]]) |
$ [syz v ecart.weight_vector [(degreeShift) new_uv_shift_m (startingShift) [new_D_shift_n new_uv_shift_m]]]$ |
( gr_of_syz ]) |
( gr_of_syz ]) |
(mbase is the minimal generators of ff in D^h in the sense of filtered minimal) |
(mbase is the minimal generators of ff in D^h in the sense of filtered minimal) |
(generators.) |
(generators.) |
$Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $ |
$Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $ |
$ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $ |
$ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $ |
$ [ [0] ] $ |
$ [(degreeShift) [ [0] ] $ |
$ [ [0] [0] ] ] ecart.gen_input /gg0 set $ |
$ (startingShift) [ [0] [0] ] ] ] ecart.gen_input /gg0 set $ |
$ gg0 ecart.minimalBase /ss0 set $ |
$ gg0 ecart.minimalBase /ss0 set $ |
$ ss0 2 get ecart.minimalBase /ss1 set $ |
$ ss0 2 get ecart.minimalBase /ss1 set $ |
$ ss1 2 get ecart.minimalBase /ss2 set $ |
$ ss1 2 get ecart.minimalBase /ss2 set $ |
$ (--------- minimal filtered resolution -------) message $ |
$ (--------- minimal filtered resolution -------) message $ |
$ ss0 0 get pmat ss1 0 get pmat ss2 0 get pmat $ |
$ ss0 0 get pmat ss1 0 get pmat ss2 0 get pmat $ |
$ (--------- degree shift (n,m) n:D-shift m:uv-shift -------) message $ |
$ (--------- degree shift (n,m) n:D-shift m:uv-shift -------) message $ |
$ gg0 4 get message $ |
$ gg0 3 get 3 get message $ |
$ ss0 2 get 4 get message $ |
$ ss0 2 get 3 get 3 get message $ |
$ ss1 2 get 4 get message $ |
$ ss1 2 get 3 get 3 get message $ |
$ ss2 2 get 4 get message ; $ |
$ ss2 2 get 3 get 3 get message ; $ |
|
|
]] putUsages |
]] putUsages |
/ecart.minimalBase { |
/ecart.minimalBase { |
|
|
/wv 0 def |
/wv 0 def |
/degreeShift 0 def |
/degreeShift 0 def |
/hdShift 0 def |
/hdShift 0 def |
|
/opt [ ] def |
aa { tag } map /typev set |
aa { tag } map /typev set |
typev [ArrayP StringP ArrayP ArrayP ArrayP] eq |
typev [ArrayP StringP ArrayP ArrayP] eq |
{ /f aa 0 get def |
{ /f aa 0 get def |
/v aa 1 get def |
/v aa 1 get def |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/hdShift aa 4 get def |
|
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } ifelse |
typev [ArrayP 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 |
/wv aa 2 get def |
/wv aa 2 get def |
/degreeShift aa 3 get def |
opt aa 3 get ecart.setOpt join /opt set |
/hdShift aa 4 get def |
|
/setarg 1 def |
/setarg 1 def |
} { } ifelse |
} { } ifelse |
setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse |
setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse |
|
|
|
|
f 0 get tag ArrayP eq { } |
f 0 get tag ArrayP eq { } |
{ f { /tt set [ tt ] } map /f set } ifelse |
{ f { /tt set [ tt ] } map /f set } ifelse |
[f v wv degreeShift (no)] ecart.syz /ss0 set |
[f v wv [(degreeShift) degreeShift (noAutoHomogenize) 1] opt join] ecart.syz /ss0 set |
|
|
ss0 getRing ring_def |
ss0 getRing ring_def |
/degreeShiftD hdShift 0 get def |
/degreeShiftD hdShift 0 get def |
|
|
/arg1 |
/arg1 |
[ ai1 |
[ ai1 |
ai1 {[wv 0 get weightv degreeShift 0 get] init} map %Getting gr of A_{i-1} |
ai1 {[wv 0 get weightv degreeShift 0 get] init} map %Getting gr of A_{i-1} |
[ai v wv [degreeShiftUVnew] [degreeShiftDnew degreeShiftUVnew]] |
[ai v wv [(degreeShift) [degreeShiftUVnew] (startingShift) [degreeShiftDnew degreeShiftUVnew]]] |
ai {[wv 0 get weightv degreeShiftUVnew] init} map %Getting gr of A_i |
ai {[wv 0 get weightv degreeShiftUVnew] init} map %Getting gr of A_i |
] |
] |
def |
def |
|
|
popVariables |
popVariables |
arg1 |
arg1 |
} def |
} def |
|
|
|
/ecart.minimalResol { |
|
/arg1 set |
|
[/in-ecart.minimalResol /aa /ans /gg0 /ansds /ans_gr /c] pushVariables |
|
[ |
|
/aa arg1 def |
|
/ans [ ] def |
|
/ansds [ ] def |
|
/ans_gr [ ] def |
|
/c 0 def |
|
|
|
(---- ecart.gen_input ----) message |
|
aa ecart.gen_input /gg0 set |
|
ansds gg0 3 get 3 get append /ansds set |
|
(---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set |
|
gg0 ecart.minimalBase /ssi set |
|
ansds ssi 2 get 3 get 3 get append /ansds set |
|
ans ssi 0 get append /ans set |
|
ans_gr ssi 1 get append /ans_gr set |
|
{ |
|
ssi 3 get [ ] eq { exit } { } ifelse |
|
(---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set |
|
ssi 2 get ecart.minimalBase /ssi_new set |
|
ans ssi_new 0 get append /ans set |
|
ansds ssi_new 2 get 3 get 3 get append /ansds set |
|
ans_gr ssi_new 1 get append /ans_gr set |
|
/ssi ssi_new def |
|
} loop |
|
/arg1 [ans ansds ans_gr] def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
(ecart.minimalResol) message |
|
|
|
[(ecart.minimalResol) |
|
[ |
|
|
|
$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] ecart.minimalResol $ |
|
( [resol degree_shifts gr_of_resol_by_uv_shift_m] ) |
|
$Example1: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $ |
|
$ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $ |
|
$ [(degreeShift) [ [0] ] $ |
|
$ (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $ |
|
]] putUsages |
|
|
|
%% for ecart.weight_vector |
|
/ecart.eliminationOrderTemplate { %% esize >= 1 |
|
%% if esize == 0, it returns reverse lexicographic order. |
|
%% m esize eliminationOrderTemplate mat |
|
/arg2 set /arg1 set |
|
[/m /esize /m1 /m2 /k /om /omtmp] pushVariables |
|
[ |
|
/m arg1 def /esize arg2 def |
|
/m1 m esize sub 1 sub def |
|
/m2 esize 1 sub def |
|
[esize 0 gt |
|
{ |
|
[1 1 esize |
|
{ pop 1 } for |
|
esize 1 << m 1 sub >> |
|
{ pop 0 } for |
|
] %% 1st vector |
|
} |
|
{ } ifelse |
|
|
|
m esize gt |
|
{ |
|
[1 1 esize |
|
{ pop 0 } for |
|
esize 1 << m 1 sub >> |
|
{ pop 1 } for |
|
] %% 2nd vector |
|
} |
|
{ } ifelse |
|
|
|
m1 0 gt |
|
{ |
|
m 1 sub -1 << m m1 sub >> |
|
{ |
|
/k set |
|
m k evec_neg |
|
} for |
|
} |
|
{ } ifelse |
|
|
|
m2 0 gt |
|
{ |
|
<< esize 1 sub >> -1 1 |
|
{ |
|
/k set |
|
m k evec_neg |
|
} for |
|
} |
|
{ } ifelse |
|
|
|
] /om set |
|
om [ 0 << m 2 idiv >> 1 sub] 0 put |
|
om [ << m 2 idiv >> 1 add << m 2 idiv >> 1 sub] 0 put |
|
/arg1 om def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
%note 2003.09.29 |
|
/ecart.elimination_order { |
|
%% [x-list d-list params] (x,y,z) elimination_order |
|
%% vars evars |
|
%% [x-list d-list params order] |
|
/arg2 set /arg1 set |
|
[/vars /evars /univ /order /perm /univ0 /compl /m /omtmp] pushVariables |
|
/vars arg1 def /evars [arg2 to_records pop] def |
|
[ |
|
/univ vars 0 get reverse |
|
vars 1 get reverse join |
|
def |
|
|
|
<< univ length 2 sub >> |
|
<< evars length >> |
|
ecart.eliminationOrderTemplate /order set |
|
|
|
[[1]] order oplus [[1]] oplus /order set |
|
|
|
/m order length 2 sub def |
|
/omtmp [1 1 m 2 add { pop 0 } for ] def |
|
omtmp << m 2 idiv >> 1 put |
|
order omtmp append /order set |
|
% order pmat |
|
|
|
/univ0 [univ reverse aload pop pop] reverse def %% [e,x,y,h] --> [x,y,h] |
|
|
|
/compl |
|
[univ 0 get] evars join evars univ0 complement join |
|
def |
|
compl univ |
|
getPerm /perm set |
|
%%perm :: univ :: compl :: |
|
|
|
order perm permuteOrderMatrix /order set |
|
|
|
|
|
vars [order] join /arg1 set |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
/ecart.define_ring { |
|
/arg1 set |
|
[/rp /param /foo] pushVariables |
|
[/rp arg1 def |
|
|
|
rp 0 get length 3 eq { |
|
rp 0 [rp 0 get 0 get rp 0 get 1 get rp 0 get 2 get ] |
|
( ) ecart.elimination_order put |
|
} { } ifelse |
|
|
|
[ |
|
rp 0 get 0 get %% x-list |
|
rp 0 get 1 get %% d-list |
|
rp 0 get 2 get /param set |
|
param 0 << rp 1 get >> put %% << rp 1 get >> is 17 in the example. |
|
param %% parameters. |
|
rp 0 get 3 get %% order matrix. |
|
rp length 2 eq |
|
{ [ ] } %% null optional argument. |
|
{ rp 2 get } |
|
ifelse |
|
] /foo set |
|
foo aload pop set_up_ring@ |
|
] pop |
|
popVariables |
|
[(CurrentRingp)] system_variable |
|
} def |
|
/ecart.weight_vector { |
|
/arg2 set /arg1 set |
|
[/vars /univ /w-vectors /www /k /order1 /order2] pushVariables |
|
/vars arg1 def /w-vectors arg2 def |
|
[ |
|
/univ vars 0 get reverse |
|
vars 1 get reverse join |
|
def |
|
[ |
|
0 1 << w-vectors length 1 sub >> |
|
{ |
|
/k set |
|
univ w-vectors k get w_to_vec |
|
} for |
|
] /order1 set |
|
%% order1 :: |
|
|
|
vars ( ) ecart.elimination_order 3 get /order2 set |
|
vars [ << order1 order2 join >> ] join /arg1 set |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
%% end of for ecart.define_ring |
|
|
|
/ecartd.reduction { |
|
/arg2 set |
|
/arg1 set |
|
[/in-ecartd.reduction /gbasis /flist /ans /gbasis2] pushVariables |
|
[(CurrentRingp) (KanGBmessage)] pushEnv |
|
[ |
|
/gbasis arg2 def |
|
/flist arg1 def |
|
gbasis 0 get tag 6 eq { } |
|
{ (ecartd.reduction: the second argument must be a list of lists) error } |
|
ifelse |
|
|
|
gbasis length 1 eq { |
|
gbasis getRing ring_def |
|
/gbasis2 gbasis 0 get def |
|
} { |
|
[ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def |
|
/gbasis2 gbasis 0 get ,,, def |
|
} ifelse |
|
ecartd.begin |
|
|
|
flist ,,, /flist set |
|
flist tag 6 eq { |
|
flist { gbasis2 reduction } map /ans set |
|
}{ |
|
flist gbasis2 reduction /ans set |
|
} ifelse |
|
/arg1 ans def |
|
|
|
ecartd.end |
|
] pop |
|
popEnv |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
/ecartd.reduction.test { |
|
[ |
|
[( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )] |
|
(x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] |
|
ecartd.gb /gg set |
|
|
|
(Dx) [gg 0 get] ecartd.reduction /gg2 set |
|
gg2 message |
|
(-----------------------------) message |
|
|
|
[(Dx) (Dy) (Dx+x*Dy)] [gg 0 get] ecartd.reduction /gg3 set |
|
gg3 message |
|
|
|
(-----------------------------) message |
|
[[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )] |
|
(x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set |
|
(Dx) ggg ecartd.reduction /gg4 set |
|
gg4 message |
|
[gg2 gg3 gg4] |
|
} def |
|
|
|
/ecarth.reduction { |
|
/arg2 set |
|
/arg1 set |
|
[/in-ecarth.reduction /gbasis /flist /ans /gbasis2] pushVariables |
|
[(CurrentRingp) (KanGBmessage)] pushEnv |
|
[ |
|
/gbasis arg2 def |
|
/flist arg1 def |
|
gbasis 0 get tag 6 eq { } |
|
{ (ecarth.reduction: the second argument must be a list of lists) error } |
|
ifelse |
|
|
|
gbasis length 1 eq { |
|
gbasis getRing ring_def |
|
/gbasis2 gbasis 0 get def |
|
} { |
|
[ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def |
|
/gbasis2 gbasis 0 get ,,, def |
|
} ifelse |
|
ecarth.begin |
|
|
|
flist ,,, /flist set |
|
flist tag 6 eq { |
|
flist { gbasis2 reduction } map /ans set |
|
}{ |
|
flist gbasis2 reduction /ans set |
|
} ifelse |
|
/arg1 ans def |
|
|
|
ecarth.end |
|
] pop |
|
popEnv |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
[(ecartd.reduction) |
|
[ (f basis ecartd.reduction r) |
|
(f is reduced by basis by the tangent cone algorithm.) |
|
(r is the return value format of reduction.) |
|
(basis is the argument format of ecartd.gb.) |
|
(The first element of basis must be a standard basis.) |
|
(cf. reduction, ecartd.gb, ecartd.reduction.test ) |
|
$Example:$ |
|
$ [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )] $ |
|
$ (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $ |
|
$ (Dx+Dy) ggg ecartd.reduction :: $ |
|
]] putUsages |
|
|
|
|
( ) message-quiet |
( ) message-quiet |