[BACK]Return to hol.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Doc

Diff for /OpenXM/src/kan96xx/Doc/hol.sm1 between version 1.5 and 1.30

version 1.5, 2000/06/08 08:35:01 version 1.30, 2019/09/13 05:21:33
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Doc/hol.sm1,v 1.4 2000/03/14 13:01:28 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  %% hol.sm1, 1998, 11/8, 11/10, 11/14, 11/25, 1999, 5/18, 6/5. 2000, 6/8
 %% rank, rrank, characteristic  %% rank, rrank, characteristic
 %% This file is error clean.  %% This file is error clean.
Line 13  hol.version [(Version)] system_variable gt
Line 13  hol.version [(Version)] system_variable gt
 $hol.sm1, basic package for holonomic systems (C) N.Takayama, 2000, 06/08 $  $hol.sm1, basic package for holonomic systems (C) N.Takayama, 2000, 06/08 $
 message-quiet  message-quiet
   
   /gb.warning 0 def
   /gb.oxRingStructure [[ ] [ ]] def
 /rank.v [(x) (y) (z)] def   %% default value of v (variables).  /rank.v [(x) (y) (z)] def   %% default value of v (variables).
 /rank.ch [ ] def  %% characteristic variety.  /rank.ch [ ] def  %% characteristic variety.
 /rank.verbose 0 def  /rank.verbose 0 def
Line 268  message-quiet
Line 270  message-quiet
 ] putUsages  ] putUsages
 (rrank ) messagen-quiet  (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.v 1 def
 /gb.verbose 0 def  /gb.verbose 0 def
 /gb.options [ ] def  /gb.options [ ] def
   /gb.characteristic 0 def
   /gb.homogenized 0 def
   /gb.autoHomogenize 1 def
 /gb {  /gb {
   /arg1 set    /arg1 set
   [/in-gb /aa /typev /setarg /f /v    [/in-gb /aa /typev /setarg /f /v
    /gg /wv /termorder /vec /ans /rr /mm     /gg /wv /termorder /vec /ans /rr /mm
      /degreeShift  /env2 /groebnerOptions
      /ggall
   ] pushVariables    ] pushVariables
   [(CurrentRingp) (KanGBmessage)] pushEnv    [(CurrentRingp) (KanGBmessage)] pushEnv
   [    [
   
     /aa arg1 def      /aa arg1 def
     aa isArray { } { ( << array >> gb) error } ifelse      aa isArray { } { ( << array >> gb) error } ifelse
       aa getAttributeList configureGroebnerOption /groebnerOptions set
     /setarg 0 def      /setarg 0 def
     /wv 0 def      /wv 0 def
       /degreeShift 0 def
     aa { tag } map /typev set      aa { tag } map /typev set
     typev [ ArrayP ] eq      typev [ ArrayP ] eq
     {  /f aa 0 get def      {  /f aa 0 get def
Line 294  message-quiet
Line 324  message-quiet
        /v aa 1 get def         /v aa 1 get def
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
       typev [ArrayP RingP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /setarg 1 def
       } { } ifelse
     typev [ArrayP ArrayP] eq      typev [ArrayP ArrayP] eq
     {  /f aa 0 get def      {  /f aa 0 get def
        /v aa 1 get from_records def         /v aa 1 get from_records def
Line 311  message-quiet
Line 346  message-quiet
        /wv aa 2 get def         /wv aa 2 get def
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } 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      setarg { } { (gb : Argument mismatch) error } ifelse
   
     [(KanGBmessage) gb.verbose ] system_variable      [(KanGBmessage) gb.verbose ] system_variable
   
     %%% Start of the preprocess      %%% 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.      %% To the normal form : matrix expression.
     f gb.toMatrixOfString /f set      f gb.toMatrixOfString /f set
     /mm gb.itWasMatrix def      /mm gb.itWasMatrix def
   
     rr tag 0 eq {      rr tag 0 eq
       v isInteger not
       or {
       %% Define our own ring        %% Define our own ring
       v isInteger {        v isInteger {
         (Error in gb: Specify variables) error          (Error in gb: Specify variables) error
       } {  } ifelse        } {  } ifelse
       wv isInteger {        wv isInteger {
         [v ring_of_differential_operators          [v ring_of_differential_operators
         0] define_ring          gb.characteristic] define_ring
         /termorder 1 def          /termorder 1 def
       }{        }{
         [v ring_of_differential_operators         degreeShift isInteger {
          wv weight_vector           [v ring_of_differential_operators
         0] define_ring            wv weight_vector
         wv gb.isTermOrder /termorder set           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        } ifelse
     } {      } {
       %% Use the ring structre given by the input.        %% Use the ring structre given by the input.
       v isInteger not {  
         (Warning : the given ring definition is not used.) message  
       } {  } ifelse  
       rr ring_def        rr ring_def
       /wv rr gb.getWeight def        /wv rr gb.getWeight def
       wv gb.isTermOrder /termorder set        wv gb.isTermOrder /termorder set
     } ifelse      } ifelse
     %%% Enf of the preprocess      %%% Enf of the preprocess
   
     gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse  
     termorder {      termorder {
       f { {. dehomogenize} map } map /f set        /gb.homogenized 0 def
       [f gb.options] groebner_sugar 0 get /gg set  
     }{      }{
       f { {. dehomogenize} map} map /f set       /gb.homogenized 1 def
       f fromVectors { homogenize } map /f set      } ifelse
       [f gb.options] groebner 0 get /gg set      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      }ifelse
     wv isInteger {      wv isInteger {
       /ans [gg gg {init} map] def        /ans [gg gg {init} map] def
Line 369  message-quiet
Line 440  message-quiet
       /ans set        /ans set
     }{ }      }{ }
     ifelse      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      /arg1 ans def
   ] pop    ] pop
Line 383  message-quiet
Line 460  message-quiet
   /arg1 set    /arg1 set
   [/in-pgb /aa /typev /setarg /f /v    [/in-pgb /aa /typev /setarg /f /v
    /gg /wv /termorder /vec /ans /rr /mm     /gg /wv /termorder /vec /ans /rr /mm
      /groebnerOptions
   ] pushVariables    ] pushVariables
   [(CurrentRingp) (KanGBmessage) (UseCriterion1)] pushEnv    [(CurrentRingp) (KanGBmessage) (UseCriterion1)] pushEnv
   [    [
   
     /aa arg1 def      /aa arg1 def
     aa isArray { } { (<< array >> pgb) error } ifelse      aa isArray { } { (<< array >> pgb) error } ifelse
       aa getAttributeList configureGroebnerOption /groebnerOptions set
     /setarg 0 def      /setarg 0 def
     /wv 0 def      /wv 0 def
     aa { tag } map /typev set      aa { tag } map /typev set
Line 437  message-quiet
Line 516  message-quiet
       } {  } ifelse        } {  } ifelse
       wv isInteger {        wv isInteger {
         [v ring_of_polynomials          [v ring_of_polynomials
         0] define_ring          gb.characteristic] define_ring
         /termorder 1 def          /termorder 1 def
       }{        }{
         [v ring_of_polynomials          [v ring_of_polynomials
          wv weight_vector           wv weight_vector
         0] define_ring          gb.characteristic] define_ring
         wv gb.isTermOrder /termorder set          wv gb.isTermOrder /termorder set
       } ifelse        } ifelse
     } {      } {
       %% Use the ring structre given by the input.        %% Use the ring structre given by the input.
       v isInteger not {        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        } {  } ifelse
       rr ring_def        rr ring_def
       /wv rr gb.getWeight def        /wv rr gb.getWeight def
Line 456  message-quiet
Line 537  message-quiet
     } ifelse      } ifelse
     %%% Enf of the preprocess      %%% 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 {      termorder {
       f { {. dehomogenize} map } map /f set        f { {. dehomogenize} map } map /f set
       [(UseCriterion1) 1] system_variable        [(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        [(UseCriterion1) 0] system_variable
     }{      }{
       f { {. dehomogenize} map} map /f set        f { {. dehomogenize} map} map /f set
       f fromVectors { homogenize } map /f set        f fromVectors { homogenize } map /f set
       [(UseCriterion1) 1] system_variable        [(UseCriterion1) 1] system_variable
       [f gb.options] groebner 0 get /gg set        [f groebnerOptions] groebner 0 get /gg set
       [(UseCriterion1) 0] system_variable        [(UseCriterion1) 0] system_variable
     }ifelse      }ifelse
     wv isInteger {      wv isInteger {
Line 482  message-quiet
Line 564  message-quiet
     }{ }      }{ }
     ifelse      ifelse
     %%      %%
       ans gg getAttributeList setAttributeList /ans set
   
     /arg1 ans def      /arg1 ans def
   ] pop    ] pop
Line 709  message-quiet
Line 792  message-quiet
   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)    (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];   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]; 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) $    $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
   $             [ [ (Dx) 1 ] ] ] gb pmat ; $    $             [ [ (Dx) 1 ] ] ] gb pmat ; $
   (Example 2: )    (Example 2: )
Line 723  message-quiet
Line 811  message-quiet
   $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $    $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 ; $    $             [ [ (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. )    (cf. gb, groebner, groebner_sugar, syz. )
 ]] putUsages  ]] putUsages
   
Line 739  message-quiet
Line 840  message-quiet
   $Example 1: [(x,y) ring_of_polynomials 0] define_ring $    $Example 1: [(x,y) ring_of_polynomials 0] define_ring $
   $           [ [(x^2+y^2-4). (x y -1).] ] pgb :: $    $           [ [(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 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. )    (cf. gb, groebner, groebner_sugar, syz. )
 ]] putUsages  ]] putUsages
   
Line 770  message-quiet
Line 873  message-quiet
        /v aa 1 get def         /v aa 1 get def
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
       typev [ArrayP RingP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /setarg 1 def
       } { } ifelse
     typev [ArrayP ArrayP] eq      typev [ArrayP ArrayP] eq
     {  /f aa 0 get def      {  /f aa 0 get def
        /v aa 1 get from_records def         /v aa 1 get from_records def
Line 781  message-quiet
Line 889  message-quiet
        /wv aa 2 get def         /wv aa 2 get def
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } 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      typev [ArrayP ArrayP ArrayP] eq
     {  /f aa 0 get def      {  /f aa 0 get def
        /v aa 1 get from_records def         /v aa 1 get from_records def
Line 795  message-quiet
Line 909  message-quiet
   
   
     %%% Start of the preprocess      %%% 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.      %% To the normal form : matrix expression.
     f gb.toMatrixOfString /f set      f gb.toMatrixOfString /f set
     /mm gb.itWasMatrix def      /mm gb.itWasMatrix def
Line 823  message-quiet
Line 941  message-quiet
     }{      }{
       %% Use the ring structre given by the input.        %% Use the ring structre given by the input.
       v isInteger not {        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        } {  } ifelse
       rr ring_def        rr ring_def
       /wv rr gb.getWeight def        /wv rr gb.getWeight def
Line 846  message-quiet
Line 966  message-quiet
        [vsize gtmp] toVectors /gtmp set         [vsize gtmp] toVectors /gtmp set
        ggall 0 gtmp put         ggall 0 gtmp put
     }{  } ifelse      }{  } 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    ] pop
   popEnv    popEnv
   popVariables    popVariables
Line 863  message-quiet
Line 990  message-quiet
   (a : [f ];    array f;  f is a set of generators of an ideal in a ring.)    (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];   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]; 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 $    $Example 1: [(x,y) ring_of_polynomials 0] define_ring $
   $           [ [(x^2+y^2-4). (x y -1).] ] syz :: $    $           [ [(x^2+y^2-4). (x y -1).] ] syz :: $
   $Example 2: [ [(x^2+y^2) (x y)]   (x,y)  [ [(x) -1 (y) -1] ] ] syz :: $    $Example 2: [ [(x^2+y^2) (x y)]   (x,y)  [ [(x) -1 (y) -1] ] ] syz :: $
Line 947  message-quiet
Line 1075  message-quiet
   (Example 5: [((x1+x2+x3)(x1 x2 + x2 x3 + x1 x3) - t x1 x2 x3 ) )    (Example 5: [((x1+x2+x3)(x1 x2 + x2 x3 + x1 x3) - t x1 x2 x3 ) )
   (            (t,x1,x2,x3) -1 -2] annfs :: )    (            (t,x1,x2,x3) -1 -2] annfs :: )
   (           Note that the example 4 uses huge memory space.)    (           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  ]] putUsages
 ( annfs ) messagen-quiet  ( annfs ) messagen-quiet
 /annfs.verbose fs.verbose def  /annfs.verbose fs.verbose def
Line 1225  message-quiet
Line 1357  message-quiet
     } {      } {
       %% Use the ring structre given by the input.        %% Use the ring structre given by the input.
       v isInteger not {        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        } {  } ifelse
       rr ring_def        rr ring_def
       /wv rr gb.getWeight def        /wv rr gb.getWeight def
Line 1293  message-quiet
Line 1427  message-quiet
   /arg1 set    /arg1 set
   [/in-gb_h /aa /typev /setarg /f /v    [/in-gb_h /aa /typev /setarg /f /v
    /gg /wv /termorder /vec /ans /rr /mm     /gg /wv /termorder /vec /ans /rr /mm
    /gb_h.opt     /gb_h.opt  /groebnerOptions
   ] pushVariables    ] pushVariables
   [(CurrentRingp) (KanGBmessage) (Homogenize_vec)] pushEnv    [(CurrentRingp) (KanGBmessage) (Homogenize_vec)] pushEnv
   [    [
   
     /aa arg1 def      /aa arg1 def
       gb.verbose { (Getting in gb_h) message } {  } ifelse
     aa isArray { } { ( << array >> gb_h) error } ifelse      aa isArray { } { ( << array >> gb_h) error } ifelse
       aa getAttributeList configureGroebnerOption /groebnerOptions set
     /setarg 0 def      /setarg 0 def
     /wv 0 def      /wv 0 def
     aa { tag } map /typev set      aa { tag } map /typev set
Line 1313  message-quiet
Line 1449  message-quiet
        /v aa 1 get def         /v aa 1 get def
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
       typev [ArrayP RingP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /setarg 1 def
       } { } ifelse
     typev [ArrayP ArrayP] eq      typev [ArrayP ArrayP] eq
     {  /f aa 0 get def      {  /f aa 0 get def
        /v aa 1 get from_records def         /v aa 1 get from_records def
Line 1334  message-quiet
Line 1475  message-quiet
     setarg { } { (gb_h : Argument mismatch) error } ifelse      setarg { } { (gb_h : Argument mismatch) error } ifelse
   
     [(KanGBmessage) gb.verbose ] system_variable      [(KanGBmessage) gb.verbose ] system_variable
     [(Homogenize_vec) 0] system_variable  
   
     %%% Start of the preprocess      %%% 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.      %% To the normal form : matrix expression.
     f gb.toMatrixOfString /f set      f gb.toMatrixOfString /f set
     /mm gb.itWasMatrix def      /mm gb.itWasMatrix def
Line 1360  message-quiet
Line 1504  message-quiet
     } {      } {
       %% Use the ring structre given by the input.        %% Use the ring structre given by the input.
       v isInteger not {        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        } {  } ifelse
       rr ring_def        rr ring_def
       /wv rr gb.getWeight def        /wv rr gb.getWeight def
Line 1368  message-quiet
Line 1514  message-quiet
     } ifelse      } ifelse
     getOptions /gb_h.opt set      getOptions /gb_h.opt set
     (grade) (module1v) switch_function      (grade) (module1v) switch_function
       [(Homogenize_vec) 0] system_variable
     %%% End of the preprocess      %%% 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 {      termorder {
       f { {. } map } map /f set        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 { {. } map} map /f set
       f fromVectors /f set        f fromVectors /f set
       [f gb.options] groebner 0 get /gg set        [f groebnerOptions] groebner 0 get /gg set
     }ifelse      }ifelse
     wv isInteger {      wv isInteger {
       /ans [gg gg {init} map] def        /ans [gg gg {init} map] def
Line 1391  message-quiet
Line 1539  message-quiet
       /ans set        /ans set
     }{ }      }{ }
     ifelse      ifelse
       ans gg getAttributeList setAttributeList /ans set
     gb_h.opt restoreOptions      gb_h.opt restoreOptions
       gb.verbose { (Getting out of gb_h) message } {  } ifelse
     %%      %%
   
     /arg1 ans def      /arg1 ans def
Line 1416  message-quiet
Line 1566  message-quiet
   $ [(Homogenize_vec) 0] system_variable (grade) (module1v) switch_function$    $ [(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 ];    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];   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.)    (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) $    $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -h^4) ( x y Dx Dy -h^4)] (x,y) $
Line 1429  message-quiet
Line 1580  message-quiet
   $              [(2 x^5+x y^4) (y h^3 +x h^3 +x y^3)]] (x,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 ; $    $             [ [ (x) -1 (y) -1] ] ] gb_h pmat ; $
   $  This is fine because grade(v_1) = grade(v_2)+1 for all vectors. $    $  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. )    (cf. gb, groebner, syz_h. )
 ]] putUsages  ]] putUsages
Line 1458  message-quiet
Line 1611  message-quiet
        /v aa 1 get def         /v aa 1 get def
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
       typev [ArrayP RingP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /setarg 1 def
       } { } ifelse
     typev [ArrayP ArrayP] eq      typev [ArrayP ArrayP] eq
     {  /f aa 0 get def      {  /f aa 0 get def
        /v aa 1 get from_records def         /v aa 1 get from_records def
Line 1483  message-quiet
Line 1641  message-quiet
   
   
     %%% Start of the preprocess      %%% 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.      %% To the normal form : matrix expression.
     f gb.toMatrixOfString /f set      f gb.toMatrixOfString /f set
     /mm gb.itWasMatrix def      /mm gb.itWasMatrix def
Line 1511  message-quiet
Line 1673  message-quiet
     }{      }{
       %% Use the ring structre given by the input.        %% Use the ring structre given by the input.
       v isInteger not {        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        } {  } ifelse
       rr ring_def        rr ring_def
       /wv rr gb.getWeight def        /wv rr gb.getWeight def
Line 1565  message-quiet
Line 1729  message-quiet
   $ [(Homogenize_vec) 0] system_variable (grade) (module1v) switch_function$    $ [(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 ];    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];   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.)    (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) $    $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -h^4) ( x y Dx Dy -h^4)] (x,y) $
   $             [ [ (Dx) 1 ] ] ] syz_h pmat ; $    $             [ [ (Dx) 1 ] ] ] syz_h pmat ; $
Line 1591  message-quiet
Line 1756  message-quiet
     %% comparison of hilbert series has not yet been implemented.      %% comparison of hilbert series has not yet been implemented.
     aa length 3 eq {    }      aa length 3 eq {    }
     { ([ii jj vv] isSameIdeal) error } ifelse      { ([ii jj vv] isSameIdeal) error } ifelse
     gb.verbose { (isSameIdeal) message } { } ifelse      gb.verbose { (Getting in isSameIdeal) message } { } ifelse
     /ii aa 0 get def      /ii aa 0 get def
     /jj aa 1 get def      /jj aa 1 get def
     /vv aa 2 get def      /vv aa 2 get def
Line 1648  message-quiet
Line 1813  message-quiet
   
 /isSameIdeal_h {  /isSameIdeal_h {
   /arg1 set    /arg1 set
   [/in-isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f] pushVariables    [/in-isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f
   [(CurrentRingp)] pushEnv     /isSameIdeal_h.opt
      ] pushVariables
     [(CurrentRingp) (Homogenize_vec)] pushEnv
   [    [
     /aa arg1 def      /aa arg1 def
       gb.verbose { (Getting in isSameIdeal_h) message } { } ifelse
     %% comparison of hilbert series has not yet been implemented.      %% comparison of hilbert series has not yet been implemented.
     aa length 3 eq {    }      aa length 3 eq {    }
     { ([ii jj vv] isSameIdeal_h) error } ifelse      { ([ii jj vv] isSameIdeal_h) error } ifelse
     gb.verbose { (isSameIdeal_h) message } { } ifelse  
     /ii aa 0 get def      /ii aa 0 get def
     /jj aa 1 get def      /jj aa 1 get def
     /vv aa 2 get def      /vv aa 2 get def
Line 1667  message-quiet
Line 1834  message-quiet
   
     iigg getRing ring_def      iigg getRing ring_def
   
       getOptions /isSameIdeal_h.opt set
       (grade) (module1v) switch_function
       [(Homogenize_vec) 0] system_variable
     /ans 1 def      /ans 1 def
     iigg 0 get { [ (toe_) 3 -1 roll ] gbext } map      iigg 0 get { [ (toe_) 3 -1 roll ] gbext } map
     /iigg set      /iigg set
     jjgg 0 get { [ (toe_) 3 -1 roll ] gbext } map      jjgg 0 get { [ (toe_) 3 -1 roll ] gbext } map
     /jjgg set      /jjgg set
   
       gb.verbose { (Comparing) message iigg message (and) message jjgg message }
       {  } ifelse
     gb.verbose { ( ii < jj ?) messagen } {  } ifelse      gb.verbose { ( ii < jj ?) messagen } {  } ifelse
     iigg length /n set      iigg length /n set
     0 1 n 1 sub {      0 1 n 1 sub {
Line 1693  message-quiet
Line 1865  message-quiet
     } for      } for
     /LLL.isSame_h      /LLL.isSame_h
     gb.verbose { ( Done) message } {  } ifelse      gb.verbose { ( Done) message } {  } ifelse
       isSameIdeal_h.opt restoreOptions
     /arg1 ans def      /arg1 ans def
   ] pop    ] pop
   popEnv    popEnv
Line 1712  message-quiet
Line 1885  message-quiet
  $       [[(x Dx -h^2) (0)] [(Dx^2) (1)] [(Dx^3) (Dx)]] (x,y)] isSameIdeal_h $   $       [[(x Dx -h^2) (0)] [(Dx^2) (1)] [(Dx^3) (Dx)]] (x,y)] isSameIdeal_h $
 ]] putUsages  ]] 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 <g_1,...,g_m> 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 <g_1,...,g_m> 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_ <<sparse form of the vector>>)
     (<<list of vectors>> toe_ <<sparse form of the vectors>>)
     (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)
    [ (<<sparse vector>> size tovec.with_size vector)
      (<<vector of sparse vectors>> size tovec.with_size <<vector of vectors>>)
      (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 <<gb of submodules>> mod_reduction [r c0 s reducers] )
     $r = c0 <<vector>> + <<inner product of s and reducers>>$
     $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
   
   
   
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.30
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>