version 1.10, 2003/08/23 02:28:40 |
version 1.11, 2003/08/24 05:19:44 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.9 2003/08/22 23:55:21 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.10 2003/08/23 02:28:40 takayama Exp $ |
%[(parse) (hol.sm1) pushfile] extension |
%[(parse) (hol.sm1) pushfile] extension |
%[(parse) (appell.sm1) pushfile] extension |
%[(parse) (appell.sm1) pushfile] extension |
|
|
|
|
|
|
/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 |
|
} |
] 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 |
|
} |
] 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. |
|
|
(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 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 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) $ |
$cf. ecarth.gb (homogenized), ecartd.gb (dehomogenize) $ |
( ) |
( ) |
|
|
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 |
|
|
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 |
|
|
[/in-ecart.gb /aa /typev /setarg /f /v |
[/in-ecart.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 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 |
|
|
|
|
|
|
ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse |
ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse |
|
|
f { {. ecart.dehomogenize} map} map /f set |
hdShift tag 1 eq { |
f ecart.homogenize01 /f set |
hdShift -1 eq { |
f { { [[(H). (1).]] replace } map } map /f set |
% 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 { |
ecart.needSyz { |
[f [(needSyz)] gb.options join ] groebner /gg set |
[f [(needSyz)] gb.options join ] groebner /gg set |
|
|
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 |
}{ |
}{ |
|
%% Get the initial ideal |
degreeShift isInteger { |
degreeShift isInteger { |
/ans [gg gg {wv 0 get weightv init} map] def |
/ans [gg gg {wv 0 get weightv init} map] def |
} { |
} { |