=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/hol.sm1,v retrieving revision 1.7 retrieving revision 1.30 diff -u -p -r1.7 -r1.30 --- OpenXM/src/kan96xx/Doc/hol.sm1 2000/06/12 08:03:56 1.7 +++ OpenXM/src/kan96xx/Doc/hol.sm1 2019/09/13 05:21:33 1.30 @@ -1,4 +1,4 @@ -% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.6 2000/06/09 08:02:01 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.29 2019/08/31 06:36:28 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. @@ -14,6 +14,7 @@ $hol.sm1, basic package for holonomic systems (C) N.Ta 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 @@ -269,21 +270,49 @@ 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 + /ggall ] 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 @@ -295,6 +324,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 @@ -312,53 +346,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 { - 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 - 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 /ggall set ggall 0 get /gg set + }{ + f { {___ dehomogenize} map} map /f set + gb.autoHomogenize { + f fromVectors { homogenize } map /f set + } { } ifelse + [f groebnerOptions] groebner /ggall set ggall 0 get /gg set }ifelse wv isInteger { /ans [gg gg {init} map] def @@ -372,7 +440,13 @@ message-quiet /ans set }{ } ifelse + ans getRing (oxRingStructure) dc /gb.oxRingStructure set + %% gg getAttributeList message + ans + gg getAttributeList , [(all) ggall] join + setAttributeList /ans set %% + env1 restoreOptions %% degreeShift changes "grade" /arg1 ans def ] pop @@ -386,12 +460,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 @@ -440,12 +516,12 @@ 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 } { @@ -461,17 +537,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 { (groebnerOptions = ) 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 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 gb.options] groebner 0 get /gg set + [f groebnerOptions] groebner 0 get /gg set [(UseCriterion1) 0] system_variable }ifelse wv isInteger { @@ -487,6 +564,7 @@ message-quiet }{ } ifelse %% + ans gg getAttributeList setAttributeList /ans set /arg1 ans def ] pop @@ -714,7 +792,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: ) @@ -728,6 +811,19 @@ 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 ::$ + ( ) + $Example 8: /gb.options [(StopDegree) 11] def Onverbose $ + $ [ [(x^10+y^10-1) (x^5*y^5 -1)] (x,y) $ + $ [ [ (x) 1 ] ]] gb pmat ; $ + ( ) (cf. gb, groebner, groebner_sugar, syz. ) ]] putUsages @@ -744,6 +840,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 @@ -775,6 +873,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 @@ -786,6 +889,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 @@ -800,7 +909,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 @@ -853,7 +966,14 @@ message-quiet [vsize gtmp] toVectors /gtmp set ggall 0 gtmp put }{ } ifelse - /arg1 [gg dehomogenize ggall] def + + gg length 0 eq { % there is no syzygy + ggall getRing (oxRingStructure) dc /gb.oxRingStructure set + }{ + gg getRing (oxRingStructure) dc /gb.oxRingStructure set + } ifelse + + /arg1 [gg dehomogenize ggall] def ] pop popEnv popVariables @@ -870,6 +990,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 :: $ @@ -954,6 +1075,10 @@ message-quiet (Example 5: [((x1+x2+x3)(x1 x2 + x2 x3 + x1 x3) - t x1 x2 x3 ) ) ( (t,x1,x2,x3) -1 -2] annfs :: ) ( Note that the example 4 uses huge memory space.) + ( ) + (Note: This implementation is stable but obsolete. ) + (As to faster implementation, we refer to ann0 and ann of Risa/Asir ) + (Visit http://www.math.kobe-u.ac.jp/Asir ) ]] putUsages ( annfs ) messagen-quiet /annfs.verbose fs.verbose def @@ -1302,7 +1427,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 [ @@ -1310,6 +1435,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 @@ -1323,6 +1449,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 @@ -1346,7 +1477,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 @@ -1382,14 +1517,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 @@ -1403,6 +1539,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 %% @@ -1429,6 +1566,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) $ @@ -1442,6 +1580,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) 1] setAttributeList gb_h pmat $ ( ) (cf. gb, groebner, syz_h. ) ]] putUsages @@ -1471,6 +1611,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 @@ -1496,7 +1641,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 @@ -1580,6 +1729,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 ; $ @@ -1693,6 +1843,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 { @@ -1733,11 +1885,337 @@ 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 + +%% 2019.09 +/toe_ { + /arg1 set + [/L /ans] pushVariables + [ + arg1 /L set + L length 0 eq { + /ans [ ] def + }{ + L 0 get tag 6 eq { + L toe_.for_vec_of_vec /ans set + }{ + /ans [(toe_) L] gbext def + } ifelse + } ifelse + ans /arg1 set + ] pop + arg1 +} def +[(toe_) + [(vector toe_ <>) + (<> toe_ <>) + (Example: [[[(x*y+1) (x*y)] , [(1) (x)]] (x,y)] gb /gg set , gg 0 get toe_ reducedBase { 2 tovec.with_size } map ::) + (cf. tovec.with_size, toVectors) + ] +] putUsages + +/toe_.for_vec_of_vec { + /arg1 set + [/i /L] pushVariables + [ + arg1 /L set + [ 1 1 L length { + /i set + [(toe_) L i 1 sub get] gbext + } for + ] /arg1 set + ]pop + popVariables + arg1 +} def + +/tovec.with_size { + /arg2 set + /arg1 set + [/L /nn /ans /L2 ] pushVariables + [ + arg1 /L set + arg2 /nn set + L tag 6 eq { + L {nn tovec.with_size} map /ans set + } { + L nn tovec.with_size.single /ans set + } ifelse + ans /arg1 set + ] pop + popVariables + arg1 +} def + +[(tovec.with_size) + [ (<> size tovec.with_size vector) + (<> size tovec.with_size <>) + (cf. toe_) + ] +] putUsages + +/tovec.with_size.single { + /arg2 set + /arg1 set + [/L /nn /ans /L2 /myenv] pushVariables + [ + arg1 /L set + arg2 /nn set +% [ (CurrentRingp) ] pushEnv /myenv set L getRing ring_def + L toVectors /L set + L length nn lt { + L [L length 1 nn 1 sub {pop (0).} for] join /L2 set + } { /L2 L def } ifelse +% myenv popEnv + ] pop + L2 /arg1 set + popVariables + arg1 +} def + +/mod_reduction { + /arg2 set + /arg1 set + [/hh /gg /nn /gge /hhe /rr] pushVariables + [ + arg1 /hh set + arg2 /gg set + [hh gg] message %%%for debug + [hh {tag} map gg { {tag} map } map] message %%% for debug + hh length /nn set + gg toe_ /gge set + [(toe_) hh] gbext /hhe set + [hhe gge] message + hhe gge reduction /rr set + + [rr 0 get nn tovec.with_size , + rr 1 get , + rr 2 get {nn tovec.with_size} map , + rr 3 get {nn tovec.with_size} map + ] + /arg1 set + ] pop + popVariables + arg1 +} def + +%% test input. +%[ [[(x^2) (y)] [(0) (y^2)]] (x,y)] gb /ff set ff getRing ring_def [(x^2+1). (y^2+1).] /hh set hh ff 0 get mod_reduction /ans set + +[(mod_reduction) + [(vector <> mod_reduction [r c0 s reducers] ) + $r = c0 <> + <>$ + $vector and gb must be given by the non-sparse form (without e_)$ + (String input is not accepted.) + (Example: [(AutoReduce) 1] system_variable [ [[(x^2) (y)] [(0) (y^2)]] (x,y)] gb /ff set ff getRing ring_def [(x^2+1). (y^2+1).] /hh set hh ff 0 get mod_reduction /ans set) + (cf. toe_) + ] +] putUsages + +%% 2019.09.08 transform string to poly recursively. cf. misc-2019/09/hgs/sred.sm1 +/to_poly { + /arg1 set + [/L /ans] pushVariables + [ + arg1 /L set + L tag 5 eq { % string + L . /ans set + } { + L tag 6 eq { % list + L { to_poly } map /ans set + }{ + L tag 1 eq , L tag 15 eq , or { % int32 or univInt + L toString to_poly /ans set + }{ + L /ans set + } ifelse + }ifelse + } ifelse + ans /arg1 set + ] pop + popVariables + arg1 +} def + +% +/mod_reduction* { + /arg1 set + [/in-mod_reduction* /aa /ans /vv + ] pushVariables + [(CurrentRingp) (KanGBmessage)] pushEnv + [ + + /aa arg1 def + aa isArray { } { ( << array >> mod_reduction*) error } ifelse + aa length 2 lt { + (<< array whose length >= 2 >> mod_reduction*) error + } { } ifelse + aa 0 get isArray { } + { + /mod_reduction*.LLL2 goto + } ifelse + aa length 2 eq { + aa mod_reduction*.two.args /ans set + /mod_reduction*.LLL goto + } { } ifelse + + /mod_reduction*.LLL2 + aa 2 get /vv set + aa 2 get tag , StringP eq { + aa 2 , [vv to_records pop], put + } { } ifelse + aa reduction* /ans set + + /mod_reduction*.LLL + /arg1 ans def + ] pop + popEnv + popVariables + arg1 +} def + + +[(mod_reduction*) +[([f base] mod_reduction* [h c0 syz input]) + ([f base v] mod_reduction* [h c0 syz input]) + ([f base v weight] mod_reduction* [h c0 syz input]) + (mod_reduction* is an user interface for mod_reduction.) + (cf. reduction*) + (Example 1. [ [(x) (y+1)] [ [(x) (0)] [(0) (y)]] (x,y)] mod_reduction* ::) + (Example 2. [ [[(x^2) (y)] [(0) (y^2)]] (x,y)] gb /ff set ff getRing ring_def [(x^2+1). (y^2+1).] /hh set, [hh, ff 0 get] mod_reduction* /ans set) +]] putUsages + +/mod_reduction*.two.args { + /arg1 set + [/L ] pushVariables + [ + arg1 /L set + L 0 get to_poly , L 1 get to_poly , mod_reduction + /arg1 set + ] popVariables + arg1 +} def + +( ) message-quiet ; + +/hol_loaded 1 def