version 1.15, 2003/08/29 04:34:07 |
version 1.28, 2004/05/27 11:13:49 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.14 2003/08/27 03:11:13 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.27 2004/05/15 12:00:48 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.gb.oxRingStructure [[ ] [ ] ] def |
|
|
/ecartd.begin { |
/ecartd.begin { |
ecart.begin |
ecart.begin |
[(EcartAutomaticHomogenization) 1] system_variable |
[(EcartAutomaticHomogenization) 1] system_variable |
|
|
[(EcartAutomaticHomogenization) 0] system_variable |
[(EcartAutomaticHomogenization) 0] system_variable |
} def |
} def |
|
|
|
/ecart.message.quiet 0 def |
|
/ecart.message { |
|
ecart.message.quiet { pop } { message } ifelse |
|
} def |
|
/ecart.messagen { |
|
ecart.message.quiet { pop } { messagen } ifelse |
|
} def |
/ecart.setOpt { |
/ecart.setOpt { |
/arg1 set |
/arg1 set |
[/in-ecart.setOpt /opt /i /n /ans] pushVariables |
[/in-ecart.setOpt /opt /i /n /ans] pushVariables |
|
|
/hdShift -1 def |
/hdShift -1 def |
exit |
exit |
} { } ifelse |
} { } 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 |
ans [opt i get opt i 1 add get ] append /ans set |
exit |
exit |
} loop |
} loop |
|
|
(ecart.setOpt:) message |
(ecart.setOpt:) message |
(degreeShift=) messagen degreeShift message |
(degreeShift=) messagen degreeShift message |
$hdShift(startingShift)=$ messagen hdShift message |
$hdShift(startingShift)=$ messagen hdShift message |
|
(sugar=) messagen ecart.useSugar message |
(Other options=) messagen ans message |
(Other options=) messagen ans message |
} { } ifelse |
} { } ifelse |
|
|
|
|
ll (0). eq { |
ll (0). eq { |
} { |
} { |
ll getRing /rr set |
ll getRing /rr set |
ll [ [ (H) rr ,, (1) rr ,, ] |
ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] |
[ (h) rr ,, (1) rr ,, ]] replace |
[ (h) rr ,, (1) rr ,, ]] replace |
/ll set |
/ll set |
} ifelse |
} ifelse |
|
|
ll (0). eq { |
ll (0). eq { |
} { |
} { |
ll getRing /rr set |
ll getRing /rr set |
ll [ [ (H) rr ,, (1) rr ,, ] ] replace |
ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] ] replace |
/ll set |
/ll set |
} ifelse |
} ifelse |
} ifelse |
} ifelse |
|
|
( [(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) |
|
|
[/in.ecart.wv1 /v] pushVariables |
[/in.ecart.wv1 /v] pushVariables |
[ |
[ |
/v arg1 def |
/v arg1 def |
[(H) (h) v to_records pop] /v set |
[@@@.Hsymbol (h) v to_records pop] /v set |
v { 1 } map /v set |
v { 1 } map /v set |
/arg1 v def |
/arg1 v def |
] pop |
] pop |
|
|
|
|
/ecart.gb {ecartd.gb} def |
/ecart.gb {ecartd.gb} def |
|
|
|
[(ecartd.gb) |
|
[(See ecart.gb)]] putUsages |
|
|
[(ecart.gb) |
[(ecart.gb) |
[(a ecart.gb b) |
[(a ecart.gb b) |
(array a; array b;) |
(array a; array b;) |
|
|
( 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 [(degreeShift) ds (noAutoHomogenize) 1]]; 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 $ |
|
( ecartd.gb.oxRingStructure ) |
( ) |
( ) |
$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 ; $ |
|
|
/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 |
|
|
} { } 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 { |
|
|
} { } 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 |
|
|
setarg { } { (ecart.gb : Argument mismatch) error } ifelse |
setarg { } { (ecart.gb : Argument mismatch) error } ifelse |
|
|
[(KanGBmessage) ecart.gb.verbose ] system_variable |
[(KanGBmessage) ecart.gb.verbose ] system_variable |
$ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message |
$ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ ecart.message |
|
|
%%% Start of the preprocess |
%%% Start of the preprocess |
v tag RingP eq { |
v tag RingP eq { |
|
|
(Error in gb: Specify variables) error |
(Error in gb: Specify variables) error |
} { } ifelse |
} { } ifelse |
wv isInteger { |
wv isInteger { |
(Give an weight vector such that x < 1) error |
(Give a weight vector such that x < 1) error |
}{ |
}{ |
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 |
|
|
|
|
ecartd.begin |
ecartd.begin |
|
|
ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse |
ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse |
|
|
hdShift tag 1 eq { |
hdShift tag 1 eq { |
ecart.autoHomogenize not hdShift -1 eq or { |
ecart.autoHomogenize not hdShift -1 eq or { |
|
|
f { {. } map} map /f set |
f { {. } map} map /f set |
} { |
} { |
% Automatic h-homogenization without degreeShift |
% Automatic h-homogenization without degreeShift |
(ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) message |
(ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) ecart.message |
f { {. ecart.dehomogenize} map} map /f set |
f { {. ecart.dehomogenize} map} map /f set |
f ecart.homogenize01 /f set |
f ecart.homogenize01 /f set |
f { { [[(H). (1).]] replace } map } map /f set |
f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set |
} ifelse |
} ifelse |
} { |
} { |
% Automatic h-homogenization with degreeShift |
% Automatic h-homogenization with degreeShift |
(ecartd.gb : Input polynomial or vectors are automatically homogenized with degreeShift) message |
(ecartd.gb : Input polynomial or vectors are automatically homogenized with degreeShift) message |
f { {. ecart.dehomogenize} map} map /f set |
f { {. ecart.dehomogenize} map} map /f set |
f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set |
f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set |
f { { [[(H). (1).]] replace } map } map /f set |
f { { [[@@@.Hsymbol . (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 { |
|
|
|
|
ecartd.end |
ecartd.end |
|
|
|
ans getRing (oxRingStructure) dc /ecartd.gb.oxRingStructure set |
%% |
%% |
env1 restoreOptions %% degreeShift changes "grade" |
env1 restoreOptions %% degreeShift changes "grade" |
|
|
|
|
arg1 |
arg1 |
} def |
} def |
[(ecart.gen_input) |
[(ecart.gen_input) |
[$[ff v weight_vector [(degreeShift) uv_shift_m (startingShift) [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 [(degreeShift) uv_shift_m (startingShift) [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) |
|
|
|
|
|
|
[(ecart.minimalBase) |
[(ecart.minimalBase) |
[$[ff v weight_vector [(degreeShift) uv_shift_m (startingShift) [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 [(degreeShift) new_uv_shift_m (startingShift) [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.) |
|
|
[(ecart.minimalResol) |
[(ecart.minimalResol) |
[ |
[ |
|
|
$[ff v weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] 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] ) |
( [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) $ |
$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]] $ |
$ [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $ |
$ [(degreeShift) [ [0] ] $ |
$ [(degreeShift) [ [0] ] $ |
$ (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $ |
$ (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $ |
]] putUsages |
]] 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 |
|
|
|
(----------- reduction by h=1 ---------------) message |
|
[[( 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]]] /ggg set |
|
[(Homogenize) 0] system_variable |
|
(Dx) ggg ecartd.reduction /gg5 set |
|
[(Homogenize) 1] system_variable |
|
gg5 message |
|
|
|
[gg2 gg3 gg4 gg5] |
|
} 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.) |
|
(The first element of basis <g_1,...,g_m> must be a standard basis.) |
|
(r is the return value format of reduction.) |
|
(r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i) |
|
(basis is given in the argument format of ecartd.gb.) |
|
$h[0,1](D)-homogenization is used.$ |
|
(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 |
|
|
|
/ecart.stdOrder { |
|
/arg1 set |
|
[/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2 |
|
] pushVariables |
|
[ |
|
/vv arg1 def |
|
vv isString { [ vv to_records pop] /vv set } |
|
{ } ifelse |
|
vv { toString} map /vv set |
|
|
|
vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set |
|
dvv { 1 } map /wv1 set |
|
vv { -1 } map dvv { 1 } map join /wv2 set |
|
/arg1 [wv1 wv2 ] def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
/ecartd.isSameIdeal_h { |
|
/arg1 set |
|
[/in-ecartd.isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f |
|
/ecartd.isSameIdeal_h.opt |
|
/save-ecart.autoHomogenize /wv /save-ecart.message.quiet |
|
] pushVariables |
|
[(CurrentRingp) (Homogenize_vec)] pushEnv |
|
[ |
|
/aa arg1 def |
|
gb.verbose { (Getting in ecartd.isSameIdeal_h) message } { } ifelse |
|
%% comparison of hilbert series has not yet been implemented. |
|
/save-ecart.message.quiet ecart.message.quiet def |
|
aa length 3 eq { } |
|
{ ([ii jj vv] ecartd.isSameIdeal_h) error } ifelse |
|
/ii aa 0 get def |
|
/jj aa 1 get def |
|
/vv aa 2 get def |
|
ii length 0 eq jj length 0 eq and |
|
{ /ans 1 def /LLL.ecartd.isSame_h goto } { } ifelse |
|
|
|
vv ecart.stdOrder /wv set |
|
|
|
/save-ecart.autoHomogenize ecart.autoHomogenize def |
|
/ecart.autoHomogenize 0 def |
|
[ii vv wv] ecartd.gb /iigg set |
|
[jj vv wv] ecartd.gb /jjgg set |
|
save-ecart.autoHomogenize /ecart.autoHomogenize set |
|
|
|
iigg getRing ring_def |
|
|
|
getOptions /ecartd.isSameIdeal_h.opt set |
|
|
|
/ans 1 def |
|
iigg 0 get /iigg set |
|
jjgg 0 get /jjgg set |
|
%%Bug: not implemented for the case of module. |
|
|
|
/save-ecart.message.quiet ecart.message.quiet def |
|
/ecart.message.quiet 1 def |
|
gb.verbose { (Comparing) message iigg message (and) message jjgg message } |
|
{ } ifelse |
|
gb.verbose { ( ii < jj ?) messagen } { } ifelse |
|
iigg length /n set |
|
0 1 n 1 sub { |
|
/k set |
|
iigg k get |
|
[jjgg vv wv] ecartd.reduction 0 get |
|
(0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} { } ifelse |
|
gb.verbose { (o) messagen } { } ifelse |
|
} for |
|
gb.verbose { ( jj < ii ?) messagen } { } ifelse |
|
jjgg length /n set |
|
0 1 n 1 sub { |
|
/k set |
|
jjgg k get |
|
[iigg vv wv] ecartd.reduction 0 get |
|
(0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} { } ifelse |
|
gb.verbose { (o) messagen } { } ifelse |
|
} for |
|
/LLL.ecartd.isSame_h |
|
gb.verbose { ( Done) message } { } ifelse |
|
save-ecart.message.quiet /ecart.message.quiet set |
|
ecartd.isSameIdeal_h.opt restoreOptions |
|
/arg1 ans def |
|
] pop |
|
popEnv |
|
popVariables |
|
arg1 |
|
} def |
|
(ecartd.isSameIdeal_h ) messagen-quiet |
|
|
|
[(ecartd.isSameIdeal_h) |
|
[([ii jj vv] ecartd.isSameIdeal_h bool) |
|
(ii, jj : ideal, vv : variables) |
|
$The ideals ii and jj will be compared in the ring h[0,1](D).$ |
|
$ii and jj are re-parsed.$ |
|
$Example 1: [ [((1-x) Dx + h)] [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $ |
|
]] putUsages |
|
|
|
/ecart.01Order { |
|
/arg1 set |
|
[/in-ecart.01Order /vv /tt /dvv /wv1 /wv2 |
|
] pushVariables |
|
[ |
|
/vv arg1 def |
|
vv isString { [ vv to_records pop] /vv set } |
|
{ } ifelse |
|
vv { toString} map /vv set |
|
|
|
vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set |
|
dvv { 1 } map /wv1 set |
|
/arg1 [wv1] def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
/ecart.homogenize01Ideal { |
|
/arg1 set |
|
[/in.ecart.homogenize01Ideal /ll /vv /wv /ans] pushVariables |
|
[ |
|
/ll arg1 0 get def |
|
/vv arg1 1 get def |
|
vv isArray { vv from_records /vv set } { } ifelse |
|
vv ecart.01Order /wv set |
|
[vv ring_of_differential_operators 0] define_ring |
|
ll ,,, /ll set ll dehomogenize /ll set |
|
[ll vv wv] gb 0 get /ll set |
|
|
|
ecart.begin |
|
[vv ring_of_differential_operators |
|
vv ecart.stdOrder weight_vector 0 |
|
[(weightedHomogenization) 1]] define_ring |
|
ll ,,, {ecart.homogenize01 ecart.dehomogenizeH} map /ans set |
|
ecart.end |
|
/arg1 ans def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
[(ecart.homogenize01Ideal) |
|
[([ii vv] ecartd.homogenize01Ideal) |
|
(ii : ideal, vv : variables) |
|
$The ideal ii is homogenized in h[0,1](D).$ |
|
$Example 1: [ [((1-x) Dx + 1)] (x)] ecart.homogenize01Ideal $ |
|
]] putUsages |
|
|
|
|
|
|
( ) message-quiet |
( ) message-quiet |
|
|