=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/hol.sm1,v retrieving revision 1.1.1.1 retrieving revision 1.25 diff -u -p -r1.1.1.1 -r1.25 --- OpenXM/src/kan96xx/Doc/hol.sm1 1999/10/08 02:12:02 1.1.1.1 +++ OpenXM/src/kan96xx/Doc/hol.sm1 2005/07/24 09:02:40 1.25 @@ -1,4 +1,5 @@ -%% hol.sm1, 1998, 11/8, 11/10, 11/14, 11/25, 1999, 5/18, 6/5. +% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.24 2005/06/23 03:23:26 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. /hol.version (2.990515) def @@ -9,9 +10,11 @@ hol.version [(Version)] system_variable gt error } { } ifelse -$hol.sm1, basic package for holonomic systems (C) N.Takayama, 1999, 6/05 $ +$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 @@ -267,20 +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 @@ -292,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 @@ -309,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 - termorder { - f { {. dehomogenize} map } map /f set - [f] groebner_sugar 0 get /gg set + /gb.homogenized 0 def }{ - f { {. dehomogenize} map} map /f set - f fromVectors { homogenize } map /f set - [f] 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 @@ -367,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 @@ -381,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 @@ -435,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 @@ -454,17 +534,18 @@ message-quiet } ifelse %%% Enf of the preprocess - + groebnerOptions gb.options mergeGroebnerOptions /groebnerOptions set + gb.verbose { (groebnerOptions = ) messagen groebnerOptions message } { } ifelse termorder { f { {. dehomogenize} map } map /f set [(UseCriterion1) 1] system_variable - [f] groebner_sugar 0 get /gg set + [f groebnerOptions] 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] groebner 0 get /gg set + [f groebnerOptions] groebner 0 get /gg set [(UseCriterion1) 0] system_variable }ifelse wv isInteger { @@ -480,6 +561,7 @@ message-quiet }{ } ifelse %% + ans gg getAttributeList setAttributeList /ans set /arg1 ans def ] pop @@ -707,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: ) @@ -721,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 @@ -737,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) 1] setAttributeList pgb :: $ (cf. gb, groebner, groebner_sugar, syz. ) ]] putUsages @@ -768,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 @@ -779,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 @@ -793,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 @@ -821,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 @@ -844,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 @@ -861,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 :: $ @@ -1163,11 +1282,716 @@ message-quiet $Example 2: [(x^2+y^2+z^2) (x,y,z)] genericAnnWithL ::$ $Example 3: [(x^3-y^2 z^2) (x,y,z)] genericAnnWithL ::$ ]] putUsages - -( ) message-quiet ; +/reduction*.noH 0 def +/reduction* { + /arg1 set + [/in-reduction* /aa /typev /setarg /f /v + /gg /wv /termorder /vec /ans /rr /mm /h /size /a0 /a3 + /opt + ] pushVariables + [(CurrentRingp) (KanGBmessage)] pushEnv + [ + /aa arg1 def + aa isArray { } { ( << array >> reduction*) error } ifelse + /setarg 0 def + /wv 0 def + aa { tag } map /typev set + typev [StringP ArrayP ArrayP] eq + typev [ArrayP ArrayP ArrayP] eq or + typev [PolyP ArrayP ArrayP] eq or + { /h aa 0 get def + /f aa 1 get def + /v aa 2 get from_records def + /setarg 1 def + } { } ifelse + typev [StringP ArrayP ArrayP ArrayP] eq + typev [ArrayP ArrayP ArrayP ArrayP] eq or + typev [PolyP ArrayP ArrayP ArrayP] eq or + { /h aa 0 get def + /f aa 1 get def + /v aa 2 get from_records def + /wv aa 3 get def + /setarg 1 def + } { } ifelse + setarg { } { (reduction* : Argument mismatch) error } ifelse + + [(KanGBmessage) gb.verbose ] system_variable + + %%% Start of the preprocess + f getRing /rr set + + + rr tag 0 eq { + %% Define our own ring + v isInteger { + (Error in reduction*: Specify variables) error + } { } ifelse + wv isInteger { + [v ring_of_differential_operators + 0] define_ring + /termorder 1 def + }{ + [v ring_of_differential_operators + wv weight_vector + 0] define_ring + wv gb.isTermOrder /termorder set + } ifelse + } { + %% Use the ring structre given by the input. + v isInteger not { + gb.warning { + (Warning : the given ring definition is not used.) message + } { } ifelse + } { } ifelse + rr ring_def + /wv rr gb.getWeight def + wv gb.isTermOrder /termorder set + } ifelse + %%% Enf of the preprocess + + f 0 get isArray { + /size f 0 get length def + f { { toString . } map } map /f set + f fromVectors /f set + }{ + /size -1 def + f { toString . } map /f set + } ifelse + + h isArray { + h { toString . } map /h set + [h] fromVectors 0 get /h set + }{ + h toString . /h set + } ifelse + f { toString . } map /f set + getOptions /opt set + [(ReduceLowerTerms) 1] system_variable + reduction*.noH { + h f reduction-noH /ans set + } { + h f reduction /ans set + } ifelse + opt restoreOptions + size -1 eq not { + [size ans 0 get] toVectors /a0 set + [size ans 3 get] toVectors /a3 set + /ans [a0 ans 1 get ans 2 get a3] def + } { } ifelse + /arg1 ans def + ] pop + popEnv + popVariables + arg1 +} def + + +[(reduction*) +[([f base v] reduction* [h c0 syz input]) + ([f base v weight] reduction* [h c0 syz input]) + (reduction* is an user interface for reduction and reduction-noH.) + (If reduction*.noH is one, then reduction-noH will be called.) + (Example 1: [(x^2) [(x^2+y^2-4) (x y-1)] [(x) (y)]] reduction* ) + (Example 2: [[(1) (y^2-1)] [ [(0) (y-1)] [(1) (y+1)]] [(x) (y)]] reduction*) + (Example 3: [(x^2) [(x^2+y^2-4) (x y-1)] [(x) (y)] [[(x) 10]] ] reduction* ) +]] putUsages + + + +%% 2000, 6/7, at Sevilla, Hernando Colon +%% macros that deal with homogenized inputs. +%% Sample: [ [(h+x). (x^3).] [(x). (x).]] /ff set +%% [(Homogenize_vec) 0] system_varialbe +%% (grade) (grave1v) switch_function +%% YA homogenization: [ [(h^3*(h+x)). (x^3).] [(h x). (x).]] /ff set +%% 4+0 3+1 2+0 1+1 +/gb_h { + /arg1 set + [/in-gb_h /aa /typev /setarg /f /v + /gg /wv /termorder /vec /ans /rr /mm + /gb_h.opt /groebnerOptions + ] pushVariables + [(CurrentRingp) (KanGBmessage) (Homogenize_vec)] pushEnv + [ + + /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 + typev [ ArrayP ] eq + { /f aa 0 get def + /v gb.v def + /setarg 1 def + } { } ifelse + typev [ArrayP StringP] eq + { /f aa 0 get def + /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 + /setarg 1 def + } { } ifelse + typev [ArrayP StringP 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 + /wv aa 2 get def + /setarg 1 def + } { } ifelse + + setarg { } { (gb_h : Argument mismatch) error } ifelse + + [(KanGBmessage) gb.verbose ] system_variable + + %%% Start of the preprocess + 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 { + %% Define our own ring + v isInteger { + (Error in gb_h: Specify variables) error + } { } ifelse + wv isInteger { + [v ring_of_differential_operators + 0] define_ring + /termorder 1 def + }{ + [v ring_of_differential_operators + wv weight_vector + 0] define_ring + wv gb.isTermOrder /termorder set + } ifelse + } { + %% Use the ring structre given by the input. + v isInteger not { + gb.warning { + (Warning : the given ring definition is not used.) message + } { } ifelse + } { } ifelse + rr ring_def + /wv rr gb.getWeight def + wv gb.isTermOrder /termorder set + } ifelse + getOptions /gb_h.opt set + (grade) (module1v) switch_function + [(Homogenize_vec) 0] system_variable + %%% End of the preprocess + + groebnerOptions gb.options mergeGroebnerOptions /groebnerOptions set + gb.verbose { (groebnerOptions = ) messagen groebnerOptions message } { } ifelse + termorder { + f { {. } map } map /f set + [f groebnerOptions] groebner 0 get /gg set %% Do not use sugar. + }{ + f { {. } map} map /f set + f fromVectors /f set + [f groebnerOptions] groebner 0 get /gg set + }ifelse + wv isInteger { + /ans [gg gg {init} map] def + }{ + /ans [gg gg {wv 0 get weightv init} map] def + }ifelse + + %% Postprocess : recover the matrix expression. + mm { + ans { /tmp set [mm tmp] toVectors } map + /ans set + }{ } + ifelse + ans gg getAttributeList setAttributeList /ans set + gb_h.opt restoreOptions + gb.verbose { (Getting out of gb_h) message } { } ifelse + %% + + /arg1 ans def + ] pop + popEnv + popVariables + arg1 +} def +(gb_h ) messagen-quiet +[(gb_h) + [(a gb_h b) + (array a; array b;) + (b : [g ii]; array g; array in; g is a Grobner basis of f) + ( in the ring of homogenized differential operators.) + ( The input must be homogenized properly.) + ( Inproper homogenization may cause an infinite loop.) + ( Each element of vectors must be homogenized. If you are using ) + ( non-term orders, all elements of vectors must have the same degree with) + ( a proper degree shift vector.) + $ ii is the initial ideal in case of w is given or <> belongs$ + $ to a ring. In the other cases, it returns the initial monominal.$ + $ [(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 ] ] ] gb_h pmat ; $ + $Example 2: [ [[(h+x) (x^3)] [(x) (x)]] (x)] gb_h pmat $ + $Example 3: [[ [(x^2) (y+x)] [(x+y) (y^3)] $ + $ [(2 x^2+x y) (y h^3 +x h^3 +x y^3)]] (x,y) $ + $ [ [ (x) -1 (y) -1] ] ] gb_h pmat ; $ + $ Infinite loop: see by [(DebugReductionRed) 1] system_variable$ + $Example 4: [[ [(x^2) (y+x)] [(x^2+y^2) (y)] $ + $ [(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) 1] setAttributeList gb_h pmat $ + ( ) + (cf. gb, groebner, syz_h. ) +]] putUsages + +/syz_h { + /arg1 set + [/in-syz_h /aa /typev /setarg /f /v + /gg /wv /termorder /vec /ans /ggall /vectorInput /vsize /gtmp /gtmp2 + /rr /mm + /syz_h.opt + ] pushVariables + [(CurrentRingp) (KanGBmessage)] pushEnv + [ + + /aa arg1 def + aa isArray { } { (<< array >> syz_h) error } ifelse + /setarg 0 def + /wv 0 def + aa { tag } map /typev set + typev [ ArrayP ] eq + { /f aa 0 get def + /v syz.v def + /setarg 1 def + } { } ifelse + typev [ArrayP StringP] eq + { /f aa 0 get def + /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 + /setarg 1 def + } { } ifelse + typev [ArrayP StringP 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 + /wv aa 2 get def + /setarg 1 def + } { } ifelse + + setarg { } { (syz_h : Argument mismatch) error } ifelse + + [(KanGBmessage) syz.verbose ] system_variable + + + + %%% Start of the preprocess + 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 + mm 0 gt { + /vectorInput 1 def + }{ + /vectorInput 1 def + } ifelse + + rr tag 0 eq { + %% Define our own ring + v isInteger { + (Error in syz_h: Specify variables) error + } { } ifelse + wv isInteger { + [v ring_of_differential_operators + 0] define_ring + /termorder 1 def + }{ + [v ring_of_differential_operators + wv weight_vector + 0] define_ring + wv gb.isTermOrder /termorder set + } ifelse + }{ + %% Use the ring structre given by the input. + v isInteger not { + gb.warning { + (Warning : the given ring definition is not used.) message + } { } ifelse + } { } ifelse + rr ring_def + /wv rr gb.getWeight def + wv gb.isTermOrder /termorder set + } ifelse + + getOptions /syz_h.opt set + (grade) (module1v) switch_function + [(Homogenize_vec) 0] system_variable + %%% End of the preprocess + + termorder { + f { {. } map } map /f set + [f [(needBack) (needSyz)]] groebner /ggall set %% Do not use sugar. + ggall 2 get /gg set + }{ + f { {. } map } map /f set + [f [(needBack) (needSyz)]] groebner /ggall set + ggall 2 get /gg set + }ifelse + vectorInput { + /vsize f 0 get length def %% input vector size. + /gtmp ggall 0 get def + [vsize gtmp] toVectors /gtmp set + ggall 0 gtmp put + }{ } ifelse + + syz_h.opt restoreOptions + %% + + /arg1 [gg ggall] def + ] pop + popEnv + popVariables + arg1 +} def +(syz_h ) messagen-quiet + +[(syz_h) + [(a syz_h [b c]) + (array a; array b; array c) + (b is a set of generators of the syzygies of f in the ring of) + (homogenized differential operators.) + ( The input must be homogenized properly.) + ( Inproper homogenization may cause an infinite loop.) + ( Each element of vectors must be homogenized. If you are using ) + ( non-term orders, all elements of vectors must have the same degree with) + ( a proper degree shift vector.) + (c = [gb, backward transformation, syzygy without dehomogenization].) + (See gb_h.) + $ [(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 ; $ + $Example 2: [ [[(h+x) (x^3)] [(x) (x)]] (x)] syz_h pmat $ + $Example 3: [[ [(x^2) (y+x)] [(x+y) (y^3)] $ + $ [(2 x^2+x y) (y h^3 +x h^3 +x y^3)]] (x,y) $ + $ [ [ (x) -1 (y) -1] ] ] syz_h pmat ; $ + $ Infinite loop: see by [(DebugReductionRed) 1] system_variable$ + $Example 4: [[ [(x^2) (y+x)] [(x^2+y^2) (y)] $ + $ [(2 x^5+x y^4) (y h^3 +x h^3 +x y^3)]] (x,y) $ + $ [ [ (x) -1 (y) -1] ] ] syz_h pmat ; $ + $ This is fine because grade(v_1) = grade(v_2)+1 for all vectors. $ + $Example 5: [ [ [(0) (0)] [(0) (0)] [(x) (y)]] $ + $ [(x) (y)]] syz pmat ;$ +]] putUsages + + +/isSameIdeal { + /arg1 set + [/in-isSameIdeal /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f] pushVariables + [(CurrentRingp)] pushEnv + [ + /aa arg1 def + %% comparison of hilbert series has not yet been implemented. + aa length 3 eq { } + { ([ii jj vv] isSameIdeal) error } ifelse + gb.verbose { (Getting in isSameIdeal) message } { } ifelse + /ii aa 0 get def + /jj aa 1 get def + /vv aa 2 get def + ii length 0 eq jj length 0 eq and + { /ans 1 def /LLL.isSame goto } { } ifelse + [ii vv] gb /iigg set + [jj vv] gb /jjgg set + + iigg getRing ring_def + + /ans 1 def + iigg 0 get { [ (toe_) 3 -1 roll ] gbext } map + /iigg set + jjgg 0 get { [ (toe_) 3 -1 roll ] gbext } map + /jjgg set + + gb.verbose { ( ii < jj ?) messagen } { } ifelse + iigg length /n set + 0 1 n 1 sub { + /k set + iigg k get + jjgg reduction-noH 0 get + (0). eq not { /ans 0 def /LLL.isSame 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 reduction-noH 0 get + (0). eq not { /ans 0 def /LLL.isSame goto} { } ifelse + gb.verbose { (o) messagen } { } ifelse + } for + /LLL.isSame + gb.verbose { ( Done) message } { } ifelse + /arg1 ans def + ] pop + popEnv + popVariables + arg1 +} def +(isSameIdeal ) messagen-quiet + +[(isSameIdeal) +[([ii jj vv] isSameIdeal bool) + (ii, jj : ideal, vv : variables) + (Note that ii and jj will be dehomogenized and compared in the ring) + (of differential operators. cf. isSameIdeal_h) + $Example 1: [ [(x^3) (y^2)] [(x^2+y) (y)] (x,y)] isSameIdeal $ + $Example 2: [ [[(x^3) (0)] [(y^2) (1)]] $ + $ [[(x^3+y^2) (1)] [(y^2) (1)]] (x,y)] isSameIdeal $ +]] putUsages + +/isSameIdeal_h { + /arg1 set + [/in-isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f + /isSameIdeal_h.opt + ] pushVariables + [(CurrentRingp) (Homogenize_vec)] pushEnv + [ + /aa arg1 def + gb.verbose { (Getting in isSameIdeal_h) message } { } ifelse + %% comparison of hilbert series has not yet been implemented. + aa length 3 eq { } + { ([ii jj vv] isSameIdeal_h) error } ifelse + /ii aa 0 get def + /jj aa 1 get def + /vv aa 2 get def + ii length 0 eq jj length 0 eq and + { /ans 1 def /LLL.isSame_h goto } { } ifelse + + [ii vv] gb_h /iigg set + [jj vv] gb_h /jjgg set + + iigg getRing ring_def + + getOptions /isSameIdeal_h.opt set + (grade) (module1v) switch_function + [(Homogenize_vec) 0] system_variable + /ans 1 def + iigg 0 get { [ (toe_) 3 -1 roll ] gbext } map + /iigg set + 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 { + /k set + iigg k get + jjgg reduction 0 get + (0). eq not { /ans 0 def /LLL.isSame_h 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 reduction 0 get + (0). eq not { /ans 0 def /LLL.isSame_h goto} { } ifelse + gb.verbose { (o) messagen } { } ifelse + } for + /LLL.isSame_h + gb.verbose { ( Done) message } { } ifelse + isSameIdeal_h.opt restoreOptions + /arg1 ans def + ] pop + popEnv + popVariables + arg1 +} def +(isSameIdeal_h ) messagen-quiet + +[(isSameIdeal_h) +[([ii jj vv] isSameIdeal_h bool) + (ii, jj : ideal, vv : variables) + (Note that ii and jj will be compared in the ring) + (of homogenized differential operators. Each element of the vector must be) + (homogenized.) + $Example 1: [ [(x Dx - h^2) (Dx^2)] [(Dx^3) (x Dx-h^2)] (x)] isSameIdeal_h $ + $Example 2: [ [[(x Dx -h^2) (0)] [(Dx^2) (1)]] $ + $ [[(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 + + + 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