=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/ecart.sm1,v retrieving revision 1.34 retrieving revision 1.40 diff -u -p -r1.34 -r1.40 --- OpenXM/src/kan96xx/Doc/ecart.sm1 2004/09/13 11:24:10 1.34 +++ OpenXM/src/kan96xx/Doc/ecart.sm1 2012/08/26 01:38:02 1.40 @@ -1,15 +1,19 @@ -% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.33 2004/09/10 13:20:22 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.39 2004/09/14 11:51:20 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 +/ecart.gb.verbose 1 def +/ecart.message.quiet 0 def + /ecartd.begin { ecart.begin [(EcartAutomaticHomogenization) 1] system_variable @@ -19,13 +23,16 @@ [(EcartAutomaticHomogenization) 0] system_variable } def -/ecart.message.quiet 0 def /ecart.message { ecart.message.quiet { pop } { message } ifelse } def /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 @@ -33,6 +40,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 { @@ -60,17 +70,23 @@ exit } { } ifelse +% 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 ecart.gb.verbose { - (ecart.setOpt:) message - (degreeShift=) messagen degreeShift message - $hdShift(startingShift)=$ messagen hdShift message - (sugar=) messagen ecart.useSugar message - (Other options=) messagen ans message + (ecart.setOpt:) ecart.message + (degreeShift=) ecart.messagen degreeShift ecart.message + $hdShift(startingShift)=$ ecart.messagen hdShift ecart.message + (sugar=) ecart.messagen ecart.useSugar ecart.message + (Other options=) ecart.messagen ans ecart.message } { } ifelse /arg1 ans def @@ -151,6 +167,7 @@ [(ecart.homogenize01) [(obj ecart.homogenize01 r) (Example: ) + $(appell.sm1) run ; $ ( [(x1,x2) ring_of_differential_operators ) ( [[(H) 1 (h) 1 (x1) 1 (x2) 1] ) ( [(h) 1 (Dx1) 1 (Dx2) 1] ) @@ -269,6 +286,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 ) @@ -277,7 +300,6 @@ ( not to dehomogenize and homogenize) ]] putUsages -/ecart.gb.verbose 1 def %ecarth.gb s(H)-homogenized outputs. GG's original version of ecart gb. /ecarth.gb { /arg1 set @@ -297,6 +319,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 @@ -419,7 +442,7 @@ } { } ifelse %%BUG: case of v is integer - v ecart.checkOrder + [v ecart.partialEcartGlobalVarX] ecart.checkOrder ecart.begin @@ -599,6 +622,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 @@ -718,7 +742,7 @@ } { } ifelse %%BUG: case of v is integer - v ecart.checkOrder + [v ecart.partialEcartGlobalVarX] ecart.checkOrder ecartn.begin @@ -796,6 +820,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 @@ -851,6 +876,7 @@ [(KanGBmessage) ecart.gb.verbose ] system_variable $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ ecart.message + %%% Start of the preprocess v tag RingP eq { @@ -908,8 +934,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 @@ -989,9 +1016,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 @@ -1015,8 +1056,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 /vvGlobal 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) ] @@ -1738,7 +1825,11 @@ vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set dvv { 1 } map /wv1 set vv { -1 } map dvv { 1 } map join /wv2 set - /arg1 [wv1 wv2 ] def + vv length 0 eq { + /arg1 [ ] def + } { + /arg1 [wv1 wv2 ] def + } ifelse ] pop popVariables arg1 @@ -1749,6 +1840,7 @@ [/in-ecartd.isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f /ecartd.isSameIdeal_h.opt /save-ecart.autoHomogenize /wv /save-ecart.message.quiet + /vvGlobal /rng /noRecomputation ] pushVariables [(CurrentRingp) (Homogenize_vec)] pushEnv [ @@ -1756,21 +1848,41 @@ gb.verbose { (Getting in ecartd.isSameIdeal_h) message } { } ifelse %% comparison of hilbert series has not yet been implemented. /save-ecart.message.quiet ecart.message.quiet def - aa length 3 eq { } + aa length 2 gt { } { ([ii jj vv] ecartd.isSameIdeal_h) error } ifelse /ii aa 0 get def /jj aa 1 get def /vv aa 2 get def + + aa length 3 gt { + /vvGlobal aa 3 get def + vvGlobal isString { [vvGlobal to_records pop] /vvGlobal set } + { vvGlobal { toString } map /vvGlobal set } ifelse + } { /vvGlobal [ ] def } ifelse + ii length 0 eq jj length 0 eq and { /ans 1 def /LLL.ecartd.isSame_h goto } { } ifelse - vv ecart.stdOrder /wv set + [vv vvGlobal] ecart.stdBlockOrder /wv set + vvGlobal length 0 eq { + /rng [vv wv ] def + }{ + /rng [vv wv [(partialEcartGlobalVarX) vvGlobal]] def + } ifelse - /save-ecart.autoHomogenize ecart.autoHomogenize def - /ecart.autoHomogenize 0 def - [ii vv wv] ecartd.gb /iigg set - [jj vv wv] ecartd.gb /jjgg set - save-ecart.autoHomogenize /ecart.autoHomogenize set + aa (noRecomputation) getNode /noRecomputation set + noRecomputation tag 0 eq { /noRecomputation 0 def } { + /noRecomputation 1 def + } ifelse + noRecomputation { + [ii] /iigg set [jj] /jjgg set + } { + /save-ecart.autoHomogenize ecart.autoHomogenize def + /ecart.autoHomogenize 0 def + [ii] rng join ecartd.gb /iigg set + [jj] rng join ecartd.gb /jjgg set + save-ecart.autoHomogenize /ecart.autoHomogenize set + } ifelse iigg getRing ring_def @@ -1780,18 +1892,23 @@ iigg 0 get /iigg set jjgg 0 get /jjgg set %%Bug: not implemented for the case of module. + /ecartd.isSameIdeal_h.gb [iigg jjgg] def /save-ecart.message.quiet ecart.message.quiet def /ecart.message.quiet 1 def gb.verbose { (Comparing) message iigg message (and) message jjgg message } { } ifelse gb.verbose { ( ii < jj ?) messagen } { } ifelse + /ecartd.isSameIdeal_h.failed [ ] def iigg length /n set 0 1 n 1 sub { /k set iigg k get - [jjgg vv wv] ecartd.reduction 0 get - (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} { } ifelse + [jjgg] ecartd.reduction 0 get + (0). eq not { + /ecartd.isSameIdeal_h.failed [ iigg k get jjgg] def + /ans 0 def /LLL.ecartd.isSame_h goto + } { } ifelse gb.verbose { (o) messagen } { } ifelse } for gb.verbose { ( jj < ii ?) messagen } { } ifelse @@ -1799,8 +1916,11 @@ 0 1 n 1 sub { /k set jjgg k get - [iigg vv wv] ecartd.reduction 0 get - (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} { } ifelse + [iigg] ecartd.reduction 0 get + (0). eq not { + /ecartd.isSameIdeal_h.failed [ iigg jjgg k get] def + /ans 0 def /LLL.ecartd.isSame_h goto + } { } ifelse gb.verbose { (o) messagen } { } ifelse } for /LLL.ecartd.isSame_h @@ -1818,11 +1938,141 @@ [(ecartd.isSameIdeal_h) [([ii jj vv] ecartd.isSameIdeal_h bool) (ii, jj : ideal, vv : variables) - $The ideals ii and jj will be compared in the ring h[0,1](D).$ + $The ideals ii and jj will be compared in the ring h[0,1](D_0).$ $ii and jj are re-parsed.$ $Example 1: [ [((1-x) Dx + h)] [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $ + ( ) + ([ii jj vv vvGlobal] ecartd.isSameIdeal_h bool) + $ Ideals are compared in Q(x')_0 [x''] $ + ( where x'' is specified in vvGlobal.) + (cf. partialEcartGlobalVarX option) + ( ) + $Option list: [(noRecomputation) 1] $ + $Example 2: [ [((1-x) Dx + h)] [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $ + $ ecartd.isSameIdeal_h.gb 0 get /ii set $ + $ ecartd.isSameIdeal_h.gb 1 get /jj set $ + $ [ ii jj (x) [[(noRecomputation) 1]] ] ecartd.isSameIdeal_h $ ]] putUsages +/ecartd.isSameIdeal_noh { + /arg1 set + [/aa /ii /jj /iigg /jjgg /vv /ans /k /n /f + /ecartd.isSameIdeal_h.opt + /save-ecart.autoHomogenize /wv /save-ecart.message.quiet + /vvGlobal /rng /noRecomputation + ] pushVariables + [(CurrentRingp) (Homogenize_vec)] pushEnv + [ + /aa arg1 def + gb.verbose { (Getting in ecartd.isSameIdeal_noh) message } { } ifelse + %% comparison of hilbert series has not yet been implemented. + /save-ecart.message.quiet ecart.message.quiet def + aa length 2 gt { } + { ([ii jj vv] ecartd.isSameIdeal_noh) error } ifelse + /ii aa 0 get def + /jj aa 1 get def + /vv aa 2 get def + + aa length 3 gt { + /vvGlobal aa 3 get def + vvGlobal isString { [vvGlobal to_records pop] /vvGlobal set } + { vvGlobal { toString } map /vvGlobal set } ifelse + } { /vvGlobal [ ] def } ifelse + + ii length 0 eq jj length 0 eq and + { /ans 1 def /LLL.ecartd.isSame_h goto } { } ifelse + + [vv vvGlobal] ecart.stdBlockOrder /wv set + vvGlobal length 0 eq { + /rng [vv wv ] def + }{ + /rng [vv wv [(partialEcartGlobalVarX) vvGlobal]] def + } ifelse + + aa (noRecomputation) getNode /noRecomputation set + noRecomputation tag 0 eq { /noRecomputation 0 def } { + /noRecomputation 1 def + } ifelse + noRecomputation { + [ii] /iigg set [jj] /jjgg set + } { + /save-ecart.autoHomogenize ecart.autoHomogenize def + /ecart.autoHomogenize 0 def + [ii] rng join ecartd.gb /iigg set + [jj] rng join ecartd.gb /jjgg set + save-ecart.autoHomogenize /ecart.autoHomogenize set + } ifelse + + iigg getRing ring_def + + getOptions /ecartd.isSameIdeal_h.opt set + + /ans 1 def + iigg 0 get /iigg set + jjgg 0 get /jjgg set + /ecartd.isSameIdeal_noh.gb [iigg jjgg] def + %%Bug: not implemented for the case of module. + + /save-ecart.message.quiet ecart.message.quiet def + /ecart.message.quiet 1 def + gb.verbose { (Comparing) message iigg message (and) message jjgg message } + { } ifelse + gb.verbose { ( ii < jj ?) messagen } { } ifelse + /ecartd.isSameIdeal_noh.failed [ ] def + iigg length /n set + 0 1 n 1 sub { + /k set + iigg k get + [jjgg] ecartd.reduction_noh 0 get + (0). eq not { + /ecartd.isSameIdeal_noh.failed [ iigg k get jjgg] def + /ans 0 def /LLL.ecartd.isSame_noh goto + } { } ifelse + gb.verbose { (o) messagen } { } ifelse + } for + gb.verbose { ( jj < ii ?) messagen } { } ifelse + jjgg length /n set + 0 1 n 1 sub { + /k set + jjgg k get + [iigg] ecartd.reduction_noh 0 get + (0). eq not { + /ecartd.isSameIdeal_noh.failed [ iigg jjgg k get] def + /ans 0 def /LLL.ecartd.isSame_noh goto + } { } ifelse + gb.verbose { (o) messagen } { } ifelse + } for + /LLL.ecartd.isSame_noh + gb.verbose { ( Done) message } { } ifelse + save-ecart.message.quiet /ecart.message.quiet set + ecartd.isSameIdeal_h.opt restoreOptions + /arg1 ans def + ] pop + popEnv + popVariables + arg1 +} def + +[(ecartd.isSameIdeal_noh) +[([ii jj vv] ecartd.isSameIdeal_noh bool) + (ii, jj : ideal, vv : variables) + $The ideals ii and jj will be compared in the ring D_0.$ + $ii and jj are re-parsed.$ + $Example 1: [ [((1-x) Dx + 1)] [((1-x)^2 Dx + (1-x))] (x)] ecartd.isSameIdeal_noh $ + ([ii jj vv vvGlobal] ecartd.isSameIdeal_noh bool) + $ Ideals are compared in Q(x')_0 [x''] $ + ( where x'' is specified in vvGlobal.) + (cf. partialEcartGlobalVarX option, ecartd.reduction_noh, ecartd.isSameIdeal_h) + $Example 2: [ [(1-z) (1-x-y-z)] [(1-x) (1-y)] (x,y,z) [(x)]] $ + $ ecartd.isSameIdeal_noh $ + $Option list: [(noRecomputation) 1] $ + $Example 2': [ [(1-z) (1-x-y-z)] [(1-x) (1-y)] (x,y,z) [(x)]] ecartd.isSameIdeal_noh$ + $ ecartd.isSameIdeal_noh.gb 0 get /ii set $ + $ ecartd.isSameIdeal_noh.gb 1 get /jj set $ + $ [ ii jj (x) [[(noRecomputation) 1]] ] ecartd.isSameIdeal_noh $ +]] putUsages +(ecartd.isSameIdeal_noh ) messagen-quiet + /ecart.01Order { /arg1 set [/in-ecart.01Order /vv /tt /dvv /wv1 /wv2 @@ -1870,7 +2120,48 @@ $Example 1: [ [((1-x) Dx + 1)] (x)] ecart.homogenize01Ideal $ ]] putUsages +% Example: [(x,y,z) (x)] ecart.stdBlockOrder +% [[(Dy) 1 (Dz) 1] [(y) -1 (z) -1 (Dy) 1 (Dz) 1] [(x) 1 (Dx) 1]] +% Example: [(x,y,z) [ ]] ecart.stdBlockOrder +/ecart.stdBlockOrder { + /arg1 set + [/vv /vvGlobal /tt /dd /rr] pushVariables + [ + /vv arg1 0 get def + /vvGlobal arg1 1 get def + { + 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 /vvGlobal set + vvGlobal length 0 eq { + vv ecart.stdOrder /rr set exit + } { } ifelse + + vv vvGlobal setMinus /vv set + vv ecart.stdOrder /rr set + + vvGlobal { /tt set [@@@.Dsymbol tt] cat } map /dd set + [[ + 0 1 vvGlobal length 1 sub { + /tt set + vvGlobal tt get , 1 + } for + 0 1 dd length 1 sub { + /tt set + dd tt get , 1 + } for + ]] rr join /rr set + exit + } loop + /arg1 rr def + ] pop + popVariables + arg1 +} def ( ) message-quiet