version 1.29, 2004/05/28 08:11:31 |
version 1.33, 2004/09/10 13:20:22 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.28 2004/05/27 11:13:49 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.32 2004/08/31 05:30:20 takayama Exp $ |
%[(parse) (hol.sm1) pushfile] extension |
(hol_loaded) boundp { } |
|
{ [(parse) (hol.sm1) pushfile] extension } ifelse |
%[(parse) (appell.sm1) pushfile] extension |
%[(parse) (appell.sm1) pushfile] extension |
|
|
(ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet |
(ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet |
|
|
ll (0). eq { |
ll (0). eq { |
} { |
} { |
ll getRing /rr set |
ll getRing /rr set |
ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] |
ll [ [ @@@.Hsymbol rr __ (1) rr __ ] |
[ (h) rr ,, (1) rr ,, ]] replace |
[ (h) rr __ (1) rr __ ]] replace |
/ll set |
/ll set |
} ifelse |
} ifelse |
} ifelse |
} ifelse |
|
|
ll (0). eq { |
ll (0). eq { |
} { |
} { |
ll getRing /rr set |
ll getRing /rr set |
ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] ] replace |
ll [ [ @@@.Hsymbol rr __ (1) rr __ ] ] replace |
/ll set |
/ll set |
} ifelse |
} ifelse |
} ifelse |
} ifelse |
|
|
/univ vars 0 get reverse |
/univ vars 0 get reverse |
vars 1 get reverse join |
vars 1 get reverse join |
def |
def |
|
w-vectors to_int32 /w-vectors set |
[ |
[ |
0 1 << w-vectors length 1 sub >> |
0 1 << w-vectors length 1 sub >> |
{ |
{ |
|
|
/gbasis2 gbasis 0 get def |
/gbasis2 gbasis 0 get def |
} { |
} { |
[ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def |
[ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def |
/gbasis2 gbasis 0 get ,,, def |
/gbasis2 gbasis 0 get ___ def |
} ifelse |
} ifelse |
ecartd.begin |
ecartd.begin |
|
|
flist ,,, /flist set |
flist ___ /flist set |
flist tag 6 eq { |
flist tag 6 eq { |
flist { gbasis2 reduction } map /ans set |
flist { gbasis2 reduction } map /ans set |
}{ |
}{ |
|
|
/gbasis2 gbasis 0 get def |
/gbasis2 gbasis 0 get def |
} { |
} { |
[ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def |
[ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def |
/gbasis2 gbasis 0 get ,,, def |
/gbasis2 gbasis 0 get ___ def |
} ifelse |
} ifelse |
ecarth.begin |
ecarth.begin |
|
|
flist ,,, /flist set |
flist ___ /flist set |
flist tag 6 eq { |
flist tag 6 eq { |
flist { gbasis2 reduction } map /ans set |
flist { gbasis2 reduction } map /ans set |
}{ |
}{ |
|
|
vv isArray { vv from_records /vv set } { } ifelse |
vv isArray { vv from_records /vv set } { } ifelse |
vv ecart.01Order /wv set |
vv ecart.01Order /wv set |
[vv ring_of_differential_operators 0] define_ring |
[vv ring_of_differential_operators 0] define_ring |
ll ,,, /ll set ll dehomogenize /ll set |
ll ___ /ll set ll dehomogenize /ll set |
[ll vv wv] gb 0 get /ll set |
[ll vv wv] gb 0 get /ll set |
|
|
ecart.begin |
ecart.begin |
[vv ring_of_differential_operators |
[vv ring_of_differential_operators |
vv ecart.stdOrder weight_vector 0 |
vv ecart.stdOrder weight_vector 0 |
[(weightedHomogenization) 1]] define_ring |
[(weightedHomogenization) 1]] define_ring |
ll ,,, {ecart.homogenize01 ecart.dehomogenizeH} map /ans set |
ll ___ {ecart.homogenize01 ecart.dehomogenizeH} map /ans set |
ecart.end |
ecart.end |
/arg1 ans def |
/arg1 ans def |
] pop |
] pop |
|
|
|
|
( ) message-quiet |
( ) message-quiet |
|
|
|
/ecart_loaded 1 def |
|
|