=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/ecart.sm1,v retrieving revision 1.22 retrieving revision 1.35 diff -u -p -r1.22 -r1.35 --- OpenXM/src/kan96xx/Doc/ecart.sm1 2004/05/05 06:57:09 1.22 +++ OpenXM/src/kan96xx/Doc/ecart.sm1 2004/09/14 03:12:17 1.35 @@ -1,12 +1,16 @@ -% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.21 2004/05/04 08:29:35 takayama Exp $ -%[(parse) (hol.sm1) pushfile] extension +% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.34 2004/09/13 11:24:10 takayama Exp $ +(hol_loaded) boundp { } +{ [(parse) (hol.sm1) pushfile] extension } ifelse %[(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, 2004/09/14 ) message-quiet /ecart.begin { beginEcart } def /ecart.end { endEcart } def /ecart.autoHomogenize 1 def /ecart.needSyz 0 def +/ecartd.gb.oxRingStructure [[ ] [ ] ] def +/ecart.partialEcartGlobalVarX [ ] def + /ecartd.begin { ecart.begin [(EcartAutomaticHomogenization) 1] system_variable @@ -23,6 +27,10 @@ /ecart.messagen { ecart.message.quiet { pop } { messagen } ifelse } def +/ecart.setOpt.init { +% Initialize + /ecart.partialEcartGlobalVarX [ ] def +} def /ecart.setOpt { /arg1 set [/in-ecart.setOpt /opt /i /n /ans] pushVariables @@ -30,6 +38,9 @@ /opt arg1 def /ans [ ] def /n opt length def + + ecart.setOpt.init + 0 2 n 1 sub { /i set opt i get tag StringP eq not { @@ -57,7 +68,13 @@ exit } { } ifelse - ans [opt i get opt i 1 add get ] append /ans set +% Global: ecart.partialEcartGlobalVarX + opt i get (partialEcartGlobalVarX) eq { + /ecart.partialEcartGlobalVarX opt , i 1 add , get def + % do not exit. + } { } ifelse + + ans [opt i get opt i 1 add get ] join /ans set exit } loop } for @@ -87,8 +104,8 @@ ll (0). eq { } { ll getRing /rr set - ll [ [ (H) rr ,, (1) rr ,, ] - [ (h) rr ,, (1) rr ,, ]] replace + ll [ [ @@@.Hsymbol rr __ (1) rr __ ] + [ (h) rr __ (1) rr __ ]] replace /ll set } ifelse } ifelse @@ -113,7 +130,7 @@ ll (0). eq { } { ll getRing /rr set - ll [ [ (H) rr ,, (1) rr ,, ] ] replace + ll [ [ @@@.Hsymbol rr __ (1) rr __ ] ] replace /ll set } ifelse } ifelse @@ -195,7 +212,7 @@ [/in.ecart.wv1 /v] pushVariables [ /v arg1 def - [(H) (h) v to_records pop] /v set + [@@@.Hsymbol (h) v to_records pop] /v set v { 1 } map /v set /arg1 v def ] pop @@ -244,6 +261,7 @@ $ [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $ ( ) $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) $ $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $ @@ -265,6 +283,12 @@ $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $ $ [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $ ( ) + $Example 6: [ [(1-z) (-x+1-y-z)] (x,y,z) $ + $ [[(y) -1 (z) -1 (Dy) 1 (Dz) 1] [(x) 1 (Dx) 1]] $ + $ [(partialEcartGlobalVarX) [(x)]] ] /std set $ + $ std ecart.gb pmat ; $ + $ std ecart.gb getRing :: $ + ( ) (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, ) ( ecart.dehomogenize, ecart.dehomogenizeH) ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for ) @@ -293,6 +317,7 @@ /hdShift 0 def /opt [(weightedHomogenization) 1] def /ecart.useSugar 0 def + ecart.setOpt.init aa { tag } map /typev set typev [ ArrayP ] eq { /f aa 0 get def @@ -415,7 +440,7 @@ } { } ifelse %%BUG: case of v is integer - v ecart.checkOrder + [v ecart.partialEcartGlobalVarX] ecart.checkOrder ecart.begin @@ -595,6 +620,7 @@ /wv 0 def /degreeShift 0 def /opt [(weightedHomogenization) 1] def + ecart.setOpt.init aa { tag } map /typev set typev [ ArrayP ] eq { /f aa 0 get def @@ -714,7 +740,7 @@ } { } ifelse %%BUG: case of v is integer - v ecart.checkOrder + [v ecart.partialEcartGlobalVarX] ecart.checkOrder ecartn.begin @@ -792,6 +818,7 @@ /hdShift 0 def /ecart.useSugar 0 def /opt [(weightedHomogenization) 1] def + ecart.setOpt.init aa { tag } map /typev set typev [ ArrayP ] eq { /f aa 0 get def @@ -904,8 +931,9 @@ } { } ifelse %%BUG: case of v is integer - v ecart.checkOrder + [v ecart.partialEcartGlobalVarX] ecart.checkOrder + ecartd.begin ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse @@ -919,14 +947,14 @@ (ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) ecart.message f { {. ecart.dehomogenize} map} map /f set f ecart.homogenize01 /f set - f { { [[(H). (1).]] replace } map } map /f set + f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set } ifelse } { % Automatic h-homogenization with degreeShift (ecartd.gb : Input polynomial or vectors are automatically homogenized with degreeShift) message 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 + f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set }ifelse ecart.useSugar { @@ -971,6 +999,7 @@ ecartd.end + ans getRing (oxRingStructure) dc /ecartd.gb.oxRingStructure set %% env1 restoreOptions %% degreeShift changes "grade" @@ -984,9 +1013,23 @@ /ecart.checkOrder { /arg1 set - [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables + [/vv] pushVariables [ /vv arg1 def + vv length 1 eq { + vv 0 get ecart.checkOrder.noGlobal /arg1 set + }{ + vv ecart.checkOrder.global /arg1 set + } ifelse + ] pop + popVariables + /arg1 +} def +/ecart.checkOrder.noglobal { + /arg1 set + [/vv /tt /dd /n /i] pushVariables + [ + /vv arg1 def vv isArray { } { [vv to_records pop] /vv set } ifelse vv {toString} map /vv set @@ -1010,8 +1053,54 @@ popVariables arg1 } def + +/ecart.checkOrder.global { + /arg1 set + [/vv /vvGlobal /tt /dd /n /i] pushVariables + [ + /vv arg1 def + /vvGlobal vv 1 get def + vv 0 get /vv set + vv isArray + { } { [vv to_records pop] /vv set } ifelse + vv {toString} map /vv set + vvGlobal isArray + { } { [vvGlobal to_records pop] /vvGlobal set } ifelse + vvGlobal {toString} map /vv set + + vv vvGlobal setMinus /vv set + vv { /tt set [@@@.Dsymbol tt] cat } map /dd set + % Starting the checks. Check for local variables. + 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 ) ] cat error} ifelse + } for + + % check for global variables. + 0 1 vvGlobal length 1 sub { + /i set + vvGlobal i get . /tt set + tt (1). add init (1). eq { [vvGlobal i get ( is smaller than 1 ) ] cat error } + { } ifelse + } for + + + /arg1 1 def + ] pop + popVariables + arg1 +} def [(ecart.checkOrder) - [(v ecart.checkOrder bool checks if the given order is relevant) + [([v vGlobal] ecart.checkOrder bool checks if the given order is relevant) (for the ecart division.) (cf. ecartd.gb, ecart.gb, ecartn.gb) ] @@ -1552,6 +1641,7 @@ /univ vars 0 get reverse vars 1 get reverse join def + w-vectors to_int32 /w-vectors set [ 0 1 << w-vectors length 1 sub >> { @@ -1587,11 +1677,11 @@ /gbasis2 gbasis 0 get def } { [ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def - /gbasis2 gbasis 0 get ,,, def + /gbasis2 gbasis 0 get ___ def } ifelse ecartd.begin - flist ,,, /flist set + flist ___ /flist set flist tag 6 eq { flist { gbasis2 reduction } map /ans set }{ @@ -1624,7 +1714,16 @@ (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set (Dx) ggg ecartd.reduction /gg4 set 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 /ecarth.reduction { @@ -1644,11 +1743,11 @@ /gbasis2 gbasis 0 get def } { [ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def - /gbasis2 gbasis 0 get ,,, def + /gbasis2 gbasis 0 get ___ def } ifelse ecarth.begin - flist ,,, /flist set + flist ___ /flist set flist tag 6 eq { flist { gbasis2 reduction } map /ans set }{ @@ -1678,6 +1777,38 @@ $ (Dx+Dy) ggg ecartd.reduction :: $ ]] 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 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 { /arg1 set [/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2 @@ -1692,7 +1823,8 @@ dvv { 1 } map /wv1 set vv { -1 } map dvv { 1 } map join /wv2 set /arg1 [wv1 wv2 ] def - ] popVariables + ] pop + popVariables arg1 } def @@ -1775,7 +1907,55 @@ $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 +/ecart_loaded 1 def \ No newline at end of file