version 1.3, 2003/07/29 08:36:39 |
version 1.5, 2003/08/04 11:42:42 |
|
|
% $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.4 2003/07/30 09:00:51 takayama Exp $ |
%[(parse) (hol.sm1) pushfile] extension |
%[(parse) (hol.sm1) pushfile] extension |
%[(parse) (appell.sm1) pushfile] extension |
%[(parse) (appell.sm1) pushfile] extension |
|
|
|
|
} 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 |
|
|
} 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 |
|
|
} 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 |
|
] 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 |
|
$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 |
|
|
|
ecart.begin |
|
[(EcartAutomaticHomogenization) 1] system_variable |
|
|
|
ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse |
|
|
|
f { {. ecart.dehomogenize} map} map /f set |
|
f ecart.homogenize01 /f set |
|
f { { [[(H). (1).]] replace } map } map /f set |
|
|
|
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 |
|
}{ |
|
/ans [gg gg {wv 0 get weightv init} map] def |
|
}ifelse |
|
|
|
%% Postprocess : recover the matrix expression. |
|
mm { |
|
ans { /tmp set [mm tmp] toVectors } map |
|
/ans set |
|
}{ } |
|
ifelse |
|
} ifelse |
|
|
|
ecart.end |
|
[(EcartAutomaticHomogenization) 0] system_variable |
|
|
|
%% |
|
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) vv i get] 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 |
|
|