version 1.24, 2004/05/13 05:33:10 |
version 1.34, 2004/09/13 11:24:10 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.23 2004/05/05 07:32:54 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.33 2004/09/10 13:20:22 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 |
|
|
/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.gb.oxRingStructure [[ ] [ ] ] def |
|
|
/ecartd.begin { |
/ecartd.begin { |
ecart.begin |
ecart.begin |
|
|
exit |
exit |
} { } ifelse |
} { } ifelse |
|
|
ans [opt i get opt i 1 add get ] append /ans set |
ans [opt i get opt i 1 add get ] join /ans set |
exit |
exit |
} loop |
} loop |
} for |
} for |
|
|
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 |
|
|
$ [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $ |
$ [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $ |
( ) |
( ) |
$cf. ecarth.gb (homogenized), ecartd.gb (dehomogenize), ecartd.reduction $ |
$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 ; $ |
|
|
/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 |
}{ |
}{ |
|
|
(x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set |
(x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set |
(Dx) ggg ecartd.reduction /gg4 set |
(Dx) ggg ecartd.reduction /gg4 set |
gg4 message |
gg4 message |
[gg2 gg3 gg4] |
|
|
(----------- 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 |
} def |
|
|
/ecarth.reduction { |
/ecarth.reduction { |
|
|
/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 |
}{ |
}{ |
|
|
$ (Dx+Dy) ggg ecartd.reduction :: $ |
$ (Dx+Dy) ggg ecartd.reduction :: $ |
]] putUsages |
]] putUsages |
|
|
|
/ecartd.reduction_noh { |
|
/arg2 set |
|
/arg1 set |
|
[/in-ecarth.reduction_noh /gbasis /flist] pushVariables |
|
[(Homogenize)] pushEnv |
|
[ |
|
/gbasis arg2 def |
|
/flist arg1 def |
|
[(Homogenize) 0] system_variable |
|
flist gbasis ecartd.reduction /arg1 set |
|
] pop |
|
popEnv |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
[(ecartd.reduction_noh) |
|
[ (f basis ecartd.reduction_noh 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 and) |
|
(it should not contain the variable h. cf. dehomogenize) |
|
$h[0,1](D)-homogenization is NOT used.$ |
|
(cf. reduction, ecartd.gb, ecartd.reduction ) |
|
$Example:$ |
|
$ [[( 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 $ |
|
$ (Dx+Dy) ggg ecartd.reduction_noh :: $ |
|
]] putUsages |
|
|
/ecart.stdOrder { |
/ecart.stdOrder { |
/arg1 set |
/arg1 set |
[/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2 |
[/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2 |
|
|
} def |
} def |
/ecart.homogenize01Ideal { |
/ecart.homogenize01Ideal { |
/arg1 set |
/arg1 set |
[/in.ecart.homogenize01Ideal /ll /vv /wv] pushVariables |
[/in.ecart.homogenize01Ideal /ll /vv /wv /ans] pushVariables |
[ |
[ |
/ll arg1 0 get def |
/ll arg1 0 get def |
/vv arg1 1 get def |
/vv arg1 1 get def |
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 /arg1 set |
ll ___ {ecart.homogenize01 ecart.dehomogenizeH} map /ans set |
|
ecart.end |
|
/arg1 ans def |
] pop |
] pop |
popVariables |
popVariables |
arg1 |
arg1 |
|
|
|
|
( ) message-quiet |
( ) message-quiet |
|
|
|
/ecart_loaded 1 def |
|
|