===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/hol.sm1,v
retrieving revision 1.1
retrieving revision 1.13
diff -u -p -r1.1 -r1.13
--- OpenXM/src/kan96xx/Doc/hol.sm1	1999/10/08 02:12:02	1.1
+++ OpenXM/src/kan96xx/Doc/hol.sm1	2003/07/29 08:36:39	1.13
@@ -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.12 2003/07/05 01:53:32 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,10 @@ 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
 /rank.v [(x) (y) (z)] def   %% default value of v (variables).
 /rank.ch [ ] def  %% characteristic variety.
 /rank.verbose 0 def
@@ -269,10 +271,13 @@ message-quiet
 
 /gb.v 1 def
 /gb.verbose 0 def
+/gb.options [ ] def
+/gb.characteristic 0 def
 /gb {
   /arg1 set
   [/in-gb /aa /typev /setarg /f /v 
    /gg /wv /termorder /vec /ans /rr /mm
+   /degreeShift  /env2
   ] pushVariables 
   [(CurrentRingp) (KanGBmessage)] pushEnv
   [
@@ -281,6 +286,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
@@ -292,6 +298,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,13 +320,33 @@ 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
@@ -327,18 +358,29 @@ message-quiet
       } {  } 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
+        gb.warning {
+         (Warning : the given ring definition is not used.) message
+        } { } ifelse
       } {  } ifelse
       rr ring_def
       /wv rr gb.getWeight def
@@ -346,14 +388,14 @@ message-quiet
     } ifelse
     %%% Enf of the preprocess
 
-
+    gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
     termorder {
       f { {. dehomogenize} map } map /f set
-      [f] groebner_sugar 0 get /gg set
+      [f gb.options] groebner_sugar 0 get /gg set
     }{
       f { {. dehomogenize} map} map /f set
       f fromVectors { homogenize } map /f set
-      [f] groebner 0 get /gg set
+      [f gb.options] groebner 0 get /gg set
     }ifelse
     wv isInteger {
       /ans [gg gg {init} map] def
@@ -368,6 +410,7 @@ message-quiet
     }{ }
     ifelse
     %% 
+    env1 restoreOptions  %% degreeShift changes "grade"
 
     /arg1 ans def
   ] pop
@@ -435,18 +478,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 +499,17 @@ message-quiet
     } ifelse
     %%% Enf of the preprocess
 
-
+    gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
     termorder {
       f { {. dehomogenize} map } map /f set
       [(UseCriterion1) 1] system_variable
-      [f] groebner_sugar 0 get /gg set
+      [f gb.options] 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 gb.options] groebner 0 get /gg set
       [(UseCriterion1) 0] system_variable
     }ifelse
     wv isInteger {
@@ -707,6 +752,8 @@ 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 )
   (  )
   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
   $             [ [ (Dx) 1 ] ] ] gb pmat ; $
@@ -721,6 +768,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
 
@@ -768,6 +818,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 +834,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 +854,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 +886,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
@@ -861,6 +928,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,7 +1231,590 @@ 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
- 
+
+/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
+  ] pushVariables 
+  [(CurrentRingp) (KanGBmessage) (Homogenize_vec)] pushEnv
+  [
+
+    /aa arg1 def
+    gb.verbose { (Getting in gb_h) message } {  } ifelse
+    aa isArray { } { ( << array >> gb_h) error } ifelse
+    /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
+
+    gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
+    termorder {
+      f { {. } map } map /f set
+      [f gb.options] 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
+    }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
+    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 <<a>> 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. $
+  (  )
+  (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
+
+
 
 ( ) message-quiet ;