=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/hol.sm1,v retrieving revision 1.6 retrieving revision 1.23 diff -u -p -r1.6 -r1.23 --- OpenXM/src/kan96xx/Doc/hol.sm1 2000/06/09 08:02:01 1.6 +++ OpenXM/src/kan96xx/Doc/hol.sm1 2005/06/16 08:40:04 1.23 @@ -1,4 +1,4 @@ -% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.5 2000/06/08 08:35:01 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.22 2004/09/10 13:20:22 takayama Exp $ %% hol.sm1, 1998, 11/8, 11/10, 11/14, 11/25, 1999, 5/18, 6/5. 2000, 6/8 %% rank, rrank, characteristic %% This file is error clean. @@ -13,6 +13,8 @@ hol.version [(Version)] system_variable gt $hol.sm1, basic package for holonomic systems (C) N.Takayama, 2000, 06/08 $ message-quiet +/gb.warning 0 def +/gb.oxRingStructure [[ ] [ ]] def /rank.v [(x) (y) (z)] def %% default value of v (variables). /rank.ch [ ] def %% characteristic variety. /rank.verbose 0 def @@ -268,21 +270,48 @@ message-quiet ] putUsages (rrank ) messagen-quiet + +% Take the value of arg1 in prior. +/mergeGroebnerOptions { + /arg2 set + /arg1 set + [/loc /glo /ans] pushVariables + [ + /loc arg1 def + /glo arg2 def + /ans [ ] def + { + loc tag 0 eq { /ans glo def exit } { } ifelse + /ans glo loc join def + exit + } loop + /arg1 ans def + ] pop + popVariables + arg1 +} def + /gb.v 1 def /gb.verbose 0 def /gb.options [ ] def +/gb.characteristic 0 def +/gb.homogenized 0 def +/gb.autoHomogenize 1 def /gb { /arg1 set [/in-gb /aa /typev /setarg /f /v /gg /wv /termorder /vec /ans /rr /mm + /degreeShift /env2 /groebnerOptions ] pushVariables [(CurrentRingp) (KanGBmessage)] pushEnv [ /aa arg1 def aa isArray { } { ( << array >> gb) error } ifelse + aa getAttributeList configureGroebnerOption /groebnerOptions set /setarg 0 def /wv 0 def + /degreeShift 0 def aa { tag } map /typev set typev [ ArrayP ] eq { /f aa 0 get def @@ -294,6 +323,11 @@ message-quiet /v aa 1 get def /setarg 1 def } { } ifelse + typev [ArrayP RingP] eq + { /f aa 0 get def + /v aa 1 get def + /setarg 1 def + } { } ifelse typev [ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def @@ -311,51 +345,87 @@ message-quiet /wv aa 2 get def /setarg 1 def } { } ifelse + typev [ArrayP StringP ArrayP ArrayP] eq + { /f aa 0 get def + /v aa 1 get def + /wv aa 2 get def + /degreeShift aa 3 get def + /setarg 1 def + } { } ifelse + typev [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 + /setarg 1 def + } { } ifelse + /env1 getOptions def + setarg { } { (gb : Argument mismatch) error } ifelse [(KanGBmessage) gb.verbose ] system_variable %%% Start of the preprocess - f getRing /rr set + v tag RingP eq { + /rr v def + }{ + f getRing /rr set + } ifelse %% To the normal form : matrix expression. f gb.toMatrixOfString /f set /mm gb.itWasMatrix def - rr tag 0 eq { + rr tag 0 eq + v isInteger not + or { %% Define our own ring v isInteger { (Error in gb: Specify variables) error } { } ifelse wv isInteger { [v ring_of_differential_operators - 0] define_ring + gb.characteristic] define_ring /termorder 1 def }{ - [v ring_of_differential_operators - wv weight_vector - 0] define_ring - wv gb.isTermOrder /termorder set + degreeShift isInteger { + [v ring_of_differential_operators + wv weight_vector + gb.characteristic] define_ring + wv gb.isTermOrder /termorder set + }{ + [v ring_of_differential_operators + wv weight_vector + gb.characteristic + [(degreeShift) degreeShift] + ] define_ring + wv gb.isTermOrder /termorder set + } ifelse } ifelse } { %% Use the ring structre given by the input. - v isInteger not { - (Warning : the given ring definition is not used.) message - } { } ifelse rr ring_def /wv rr gb.getWeight def wv gb.isTermOrder /termorder set } ifelse %%% Enf of the preprocess - gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse termorder { - f { {. dehomogenize} map } map /f set - [f gb.options] groebner_sugar 0 get /gg set + /gb.homogenized 0 def }{ - f { {. dehomogenize} map} map /f set - f fromVectors { homogenize } map /f set - [f gb.options] groebner 0 get /gg set + /gb.homogenized 1 def + } ifelse + groebnerOptions gb.options mergeGroebnerOptions /groebnerOptions set + gb.verbose { (groebnerOptions = ) messagen groebnerOptions message } { } ifelse + termorder { + f { {___ dehomogenize} map } map /f set + [f groebnerOptions] groebner_sugar 0 get /gg set + }{ + f { {___ dehomogenize} map} map /f set + gb.autoHomogenize { + f fromVectors { homogenize } map /f set + } { } ifelse + [f groebnerOptions] groebner 0 get /gg set }ifelse wv isInteger { /ans [gg gg {init} map] def @@ -369,7 +439,11 @@ message-quiet /ans set }{ } ifelse + ans getRing (oxRingStructure) dc /gb.oxRingStructure set + %% gg getAttributeList message + ans gg getAttributeList setAttributeList /ans set %% + env1 restoreOptions %% degreeShift changes "grade" /arg1 ans def ] pop @@ -383,12 +457,14 @@ message-quiet /arg1 set [/in-pgb /aa /typev /setarg /f /v /gg /wv /termorder /vec /ans /rr /mm + /groebnerOptions ] pushVariables [(CurrentRingp) (KanGBmessage) (UseCriterion1)] pushEnv [ /aa arg1 def aa isArray { } { (<< array >> pgb) error } ifelse + aa getAttributeList configureGroebnerOption /groebnerOptions set /setarg 0 def /wv 0 def aa { tag } map /typev set @@ -437,18 +513,20 @@ message-quiet } { } ifelse wv isInteger { [v ring_of_polynomials - 0] define_ring + gb.characteristic] define_ring /termorder 1 def }{ [v ring_of_polynomials wv weight_vector - 0] define_ring + gb.characteristic] define_ring wv gb.isTermOrder /termorder set } ifelse } { %% Use the ring structre given by the input. v isInteger not { - (Warning : the given ring definition is not used.) message + gb.warning { + (Warning : the given ring definition is not used.) message + } { } ifelse } { } ifelse rr ring_def /wv rr gb.getWeight def @@ -456,17 +534,18 @@ message-quiet } ifelse %%% Enf of the preprocess - gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse + groebnerOptions gb.options mergeGroebnerOptions /groebnerOptions set + gb.verbose { (groenberOptions = ) messagen groebnerOptions message } { } ifelse termorder { f { {. dehomogenize} map } map /f set [(UseCriterion1) 1] system_variable - [f gb.options] groebner_sugar 0 get /gg set + [f groenberOptions] groebner_sugar 0 get /gg set [(UseCriterion1) 0] system_variable }{ f { {. dehomogenize} map} map /f set f fromVectors { homogenize } map /f set [(UseCriterion1) 1] system_variable - [f gb.options] groebner 0 get /gg set + [f groebnerOptions] groebner 0 get /gg set [(UseCriterion1) 0] system_variable }ifelse wv isInteger { @@ -482,6 +561,7 @@ message-quiet }{ } ifelse %% + ans gg getAttributeList setAttributeList /ans set /arg1 ans def ] pop @@ -709,7 +789,12 @@ message-quiet (a : [f ]; array f; f is a set of generators of an ideal in a ring.) (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 ds]; array f; string v; array of array w; w is the weight matirx.) + ( array ds; ds is the degree shift ) ( ) + (gb.authoHomogenize 1 [default]) + (gb.oxRingStructure ) + ( ) $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $ $ [ [ (Dx) 1 ] ] ] gb pmat ; $ (Example 2: ) @@ -723,6 +808,15 @@ message-quiet $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $ $ [ [ (x) -1 (y) -1] ] ] gb pmat ; $ ( ) + $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $ + $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] gb pmat ; $ + ( ) + $Example 6: [ [( (x Dx)^2 + (y Dy)^2 - x y Dx Dy + 1) ( x y Dx Dy -1)] (x,y) $ + $ [ [ (Dx) 1 ] ] ] [(reduceOnly) 1] setAttributeList gb pmat ; $ + ( ) + $Example 7: [ [( (x Dx)^2 + (y Dy)^2 + 1) ( x y Dx Dy -1)] (x,y) $ + $ [ [ (Dx) 1 ] ] ] [(gbCheck) 1] setAttributeList gb getAttributeList ::$ + ( ) (cf. gb, groebner, groebner_sugar, syz. ) ]] putUsages @@ -739,6 +833,8 @@ message-quiet $Example 1: [(x,y) ring_of_polynomials 0] define_ring $ $ [ [(x^2+y^2-4). (x y -1).] ] pgb :: $ $Example 2: [ [(x^2+y^2) (x y)] (x,y) [ [(x) -1 (y) -1] ] ] pgb :: $ + $Example 3: [ [(x^2+y^2 + x y ) (x y)] (x,y) [ [(x) -1 (y) -1] ] ] $ + $ [(reduceOnly)] setAttributeList pgb :: $ (cf. gb, groebner, groebner_sugar, syz. ) ]] putUsages @@ -770,6 +866,11 @@ message-quiet /v aa 1 get def /setarg 1 def } { } ifelse + typev [ArrayP RingP] eq + { /f aa 0 get def + /v aa 1 get def + /setarg 1 def + } { } ifelse typev [ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def @@ -781,6 +882,12 @@ message-quiet /wv aa 2 get def /setarg 1 def } { } ifelse + typev [ArrayP RingP ArrayP] eq + { /f aa 0 get def + /v aa 1 get def + /wv aa 2 get def + /setarg 1 def + } { } ifelse typev [ArrayP ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def @@ -795,7 +902,11 @@ message-quiet %%% Start of the preprocess - f getRing /rr set + v tag RingP eq { + /rr v def + }{ + f getRing /rr set + } ifelse %% To the normal form : matrix expression. f gb.toMatrixOfString /f set /mm gb.itWasMatrix def @@ -823,7 +934,9 @@ message-quiet }{ %% Use the ring structre given by the input. v isInteger not { - (Warning : the given ring definition is not used.) message + gb.warning { + (Warning : the given ring definition is not used.) message + } { } ifelse } { } ifelse rr ring_def /wv rr gb.getWeight def @@ -846,7 +959,10 @@ message-quiet [vsize gtmp] toVectors /gtmp set ggall 0 gtmp put }{ } ifelse - /arg1 [gg dehomogenize ggall] def + + gg getRing (oxRingStructure) dc /gb.oxRingStructure set + + /arg1 [gg dehomogenize ggall] def ] pop popEnv popVariables @@ -863,6 +979,7 @@ message-quiet (a : [f ]; array f; f is a set of generators of an ideal in a ring.) (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.) + ( v may be a ring object. ) $Example 1: [(x,y) ring_of_polynomials 0] define_ring $ $ [ [(x^2+y^2-4). (x y -1).] ] syz :: $ $Example 2: [ [(x^2+y^2) (x y)] (x,y) [ [(x) -1 (y) -1] ] ] syz :: $ @@ -1225,7 +1342,9 @@ message-quiet } { %% Use the ring structre given by the input. v isInteger not { - (Warning : the given ring definition is not used.) message + gb.warning { + (Warning : the given ring definition is not used.) message + } { } ifelse } { } ifelse rr ring_def /wv rr gb.getWeight def @@ -1293,7 +1412,7 @@ message-quiet /arg1 set [/in-gb_h /aa /typev /setarg /f /v /gg /wv /termorder /vec /ans /rr /mm - /gb_h.opt + /gb_h.opt /groebnerOptions ] pushVariables [(CurrentRingp) (KanGBmessage) (Homogenize_vec)] pushEnv [ @@ -1301,6 +1420,7 @@ message-quiet /aa arg1 def gb.verbose { (Getting in gb_h) message } { } ifelse aa isArray { } { ( << array >> gb_h) error } ifelse + aa getAttributeList configureGroebnerOption /groebnerOptions set /setarg 0 def /wv 0 def aa { tag } map /typev set @@ -1314,6 +1434,11 @@ message-quiet /v aa 1 get def /setarg 1 def } { } ifelse + typev [ArrayP RingP] eq + { /f aa 0 get def + /v aa 1 get def + /setarg 1 def + } { } ifelse typev [ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def @@ -1337,7 +1462,11 @@ message-quiet [(KanGBmessage) gb.verbose ] system_variable %%% Start of the preprocess - f getRing /rr set + v tag RingP eq { + /rr v def + }{ + f getRing /rr set + } ifelse %% To the normal form : matrix expression. f gb.toMatrixOfString /f set /mm gb.itWasMatrix def @@ -1360,7 +1489,9 @@ message-quiet } { %% Use the ring structre given by the input. v isInteger not { - (Warning : the given ring definition is not used.) message + gb.warning { + (Warning : the given ring definition is not used.) message + } { } ifelse } { } ifelse rr ring_def /wv rr gb.getWeight def @@ -1371,14 +1502,15 @@ message-quiet [(Homogenize_vec) 0] system_variable %%% End of the preprocess - gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse + groebnerOptions gb.options mergeGroebnerOptions /groebnerOptions set + gb.verbose { (groebnerOptions = ) messagen groebnerOptions message } { } ifelse termorder { f { {. } map } map /f set - [f gb.options] groebner 0 get /gg set %% Do not use sugar. + [f groebnerOptions] groebner 0 get /gg set %% Do not use sugar. }{ f { {. } map} map /f set f fromVectors /f set - [f gb.options] groebner 0 get /gg set + [f groebnerOptions] groebner 0 get /gg set }ifelse wv isInteger { /ans [gg gg {init} map] def @@ -1392,6 +1524,7 @@ message-quiet /ans set }{ } ifelse + ans gg getAttributeList setAttributeList /ans set gb_h.opt restoreOptions gb.verbose { (Getting out of gb_h) message } { } ifelse %% @@ -1418,6 +1551,7 @@ message-quiet $ [(Homogenize_vec) 0] system_variable (grade) (module1v) switch_function$ (a : [f ]; array f; f is a set of generators of an ideal in a ring.) (a : [f v]; array f; string v; v is the variables. ) + (a : [f r]; array f; ring r ) (a : [f v w]; array f; string v; array of array w; w is the weight matirx.) ( ) $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -h^4) ( x y Dx Dy -h^4)] (x,y) $ @@ -1431,6 +1565,8 @@ message-quiet $ [(2 x^5+x y^4) (y h^3 +x h^3 +x y^3)]] (x,y) $ $ [ [ (x) -1 (y) -1] ] ] gb_h pmat ; $ $ This is fine because grade(v_1) = grade(v_2)+1 for all vectors. $ + $Example 5: [ [[(h+x) (x^3 + 2 h^3 + 2 x h^2)] [(x) (x)]] (x)] $ + $ [(reduceOnly)] setAttributeList gb_h pmat $ ( ) (cf. gb, groebner, syz_h. ) ]] putUsages @@ -1460,6 +1596,11 @@ message-quiet /v aa 1 get def /setarg 1 def } { } ifelse + typev [ArrayP RingP] eq + { /f aa 0 get def + /v aa 1 get def + /setarg 1 def + } { } ifelse typev [ArrayP ArrayP] eq { /f aa 0 get def /v aa 1 get from_records def @@ -1485,7 +1626,11 @@ message-quiet %%% Start of the preprocess - f getRing /rr set + v tag RingP eq { + /rr v def + }{ + f getRing /rr set + } ifelse %% To the normal form : matrix expression. f gb.toMatrixOfString /f set /mm gb.itWasMatrix def @@ -1513,7 +1658,9 @@ message-quiet }{ %% Use the ring structre given by the input. v isInteger not { - (Warning : the given ring definition is not used.) message + gb.warning { + (Warning : the given ring definition is not used.) message + } { } ifelse } { } ifelse rr ring_def /wv rr gb.getWeight def @@ -1567,6 +1714,7 @@ message-quiet $ [(Homogenize_vec) 0] system_variable (grade) (module1v) switch_function$ (a : [f ]; array f; f is a set of generators of an ideal in a ring.) (a : [f v]; array f; string v; v is the variables.) + (a : [f r]; array f; ring r ) (a : [f v w]; array f; string v; array of array w; w is the weight matirx.) $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -h^4) ( x y Dx Dy -h^4)] (x,y) $ $ [ [ (Dx) 1 ] ] ] syz_h pmat ; $ @@ -1680,6 +1828,8 @@ message-quiet jjgg 0 get { [ (toe_) 3 -1 roll ] gbext } map /jjgg set + gb.verbose { (Comparing) message iigg message (and) message jjgg message } + { } ifelse gb.verbose { ( ii < jj ?) messagen } { } ifelse iigg length /n set 0 1 n 1 sub { @@ -1720,11 +1870,128 @@ message-quiet $ [[(x Dx -h^2) (0)] [(Dx^2) (1)] [(Dx^3) (Dx)]] (x,y)] isSameIdeal_h $ ]] putUsages +/gb.reduction { + /arg2 set + /arg1 set + [/in-gb.reduction /gbasis /flist /ans /gbasis2 + ] pushVariables + [(CurrentRingp) (KanGBmessage)] pushEnv + [ + /gbasis arg2 def + /flist arg1 def + gbasis 0 get tag 6 eq { } + { (gb.reduction: the second argument must be a list of lists) error } + ifelse + gbasis length 1 eq { + gbasis getRing ring_def + /gbasis2 gbasis 0 get def + } { + [ [(1)] ] gbasis rest join gb 0 get getRing ring_def + /gbasis2 gbasis 0 get ___ def + } ifelse -( ) message-quiet ; + flist ___ /flist set + flist tag 6 eq { + flist { gbasis2 reduction } map /ans set + }{ + flist gbasis2 reduction /ans set + } ifelse + /arg1 ans def + ] pop + popEnv + popVariables + arg1 +} def + +/gb.reduction_noh { + /arg2 set + /arg1 set + [/in-gb.reduction_noh /gbasis /flist /ans /gbasis2 + ] pushVariables + [(CurrentRingp) (KanGBmessage) (Homogenize)] pushEnv + [ + /gbasis arg2 def + /flist arg1 def + gbasis 0 get tag 6 eq { } + { (gb.reduction_noh: the second argument must be a list of lists) error } + ifelse + + gbasis length 1 eq { + gbasis getRing ring_def + /gbasis2 gbasis 0 get def + } { + [ [(1)] ] gbasis rest join gb 0 get getRing ring_def + /gbasis2 gbasis 0 get ___ def + } ifelse + + + flist ___ /flist set + [(Homogenize) 0] system_variable + flist tag 6 eq { + flist { gbasis2 reduction } map /ans set + }{ + flist gbasis2 reduction /ans set + } ifelse + /arg1 ans def + + ] pop + popEnv + popVariables + arg1 +} def + +/gb.reduction.test { + [ + [( 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]]] + gb /gg set + + ((h-x-y)*Dx) [gg 0 get] gb.reduction /gg2 set + gg2 message + (-----------------------------) message + + [[( 2*(h-x-y) Dx + h^2 ) ( 2*(h-x-y) Dy + h^2 )] + (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set + ((h-x-y)*Dx) ggg gb.reduction /gg4 set + gg4 message + (-----------------------------) message + [gg2 gg4] +} def +[(gb.reduction) +[ (f basis gb.reduction r) + (f is reduced by basis by the normal form algorithm.) + (The first element of basis must be a Grobner 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 gb.) + $h[1,1](D)-homogenization is used.$ + (cf. reduction, gb, ecartd.gb, gb.reduction.test ) + $Example:$ + $ [[( 2*(h-x-y) Dx + h^2 ) ( 2*(h-x-y) Dy + h^2 )] $ + $ (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $ + $ ((h-x-y)^2*Dx*Dy) ggg gb.reduction :: $ +]] putUsages + +[(gb.reduction_noh) +[ (f basis gb.reduction_noh r) + (f is reduced by basis by the normal form algorithm.) + (The first element of basis must be a Grobner 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 gb.) + (cf. gb.reduction, gb ) + $Example:$ + $ [[( 2*Dx + 1 ) ( 2*Dy + 1 )] $ + $ (x,y) [[(Dx) 1 (Dy) 1]]] /ggg set $ + $ ((1-x-y)^2*Dx*Dy) ggg gb.reduction_noh :: $ +]] putUsages + +( ) message-quiet ; + +/hol_loaded 1 def