=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/hol.sm1,v retrieving revision 1.6 retrieving revision 1.22 diff -u -p -r1.6 -r1.22 --- OpenXM/src/kan96xx/Doc/hol.sm1 2000/06/09 08:02:01 1.6 +++ OpenXM/src/kan96xx/Doc/hol.sm1 2004/09/10 13:20:22 1.22 @@ -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.21 2004/07/29 08:13:42 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 @@ -271,10 +273,14 @@ message-quiet /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 ] pushVariables [(CurrentRingp) (KanGBmessage)] pushEnv [ @@ -283,6 +289,7 @@ message-quiet aa isArray { } { ( << array >> gb) error } ifelse /setarg 0 def /wv 0 def + /degreeShift 0 def aa { tag } map /typev set typev [ ArrayP ] eq { /f aa 0 get def @@ -294,6 +301,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,50 +323,85 @@ 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 + termorder { + /gb.homogenized 0 def + }{ + /gb.homogenized 1 def + } ifelse gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse termorder { - f { {. dehomogenize} map } map /f set + f { {___ dehomogenize} map } map /f set [f gb.options] groebner_sugar 0 get /gg set }{ - f { {. dehomogenize} map} map /f set - f fromVectors { homogenize } map /f set + f { {___ dehomogenize} map} map /f set + gb.autoHomogenize { + f fromVectors { homogenize } map /f set + } { } ifelse [f gb.options] groebner 0 get /gg set }ifelse wv isInteger { @@ -369,7 +416,9 @@ message-quiet /ans set }{ } ifelse + ans getRing (oxRingStructure) dc /gb.oxRingStructure set %% + env1 restoreOptions %% degreeShift changes "grade" /arg1 ans def ] pop @@ -437,18 +486,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 @@ -709,7 +760,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 +779,9 @@ 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 ; $ + ( ) (cf. gb, groebner, groebner_sugar, syz. ) ]] putUsages @@ -770,6 +829,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 +845,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 +865,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 +897,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 +922,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 +942,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 +1305,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 @@ -1314,6 +1396,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 +1424,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 +1451,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 @@ -1418,6 +1511,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) $ @@ -1460,6 +1554,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 +1584,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 +1616,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 +1672,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 +1786,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 +1828,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