===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/ecart.sm1,v
retrieving revision 1.11
retrieving revision 1.27
diff -u -p -r1.11 -r1.27
--- OpenXM/src/kan96xx/Doc/ecart.sm1	2003/08/24 05:19:44	1.11
+++ OpenXM/src/kan96xx/Doc/ecart.sm1	2004/05/15 12:00:48	1.27
@@ -1,4 +1,4 @@
-% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.10 2003/08/23 02:28:40 takayama Exp $ 
+% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.26 2004/05/14 02:35:03 takayama Exp $ 
 %[(parse) (hol.sm1) pushfile] extension
 %[(parse) (appell.sm1) pushfile] extension
 
@@ -7,6 +7,8 @@
 /ecart.end   { endEcart } def
 /ecart.autoHomogenize 1 def
 /ecart.needSyz 0 def
+/ecartd.gb.oxRingStructure [[ ] [ ] ] def
+
 /ecartd.begin { 
   ecart.begin
   [(EcartAutomaticHomogenization) 1] system_variable
@@ -16,6 +18,66 @@
   [(EcartAutomaticHomogenization) 0] system_variable
 } def
 
+/ecart.message.quiet 0 def
+/ecart.message {
+  ecart.message.quiet { pop } { message } ifelse
+} def
+/ecart.messagen {
+  ecart.message.quiet { pop } { messagen } ifelse
+} def
+/ecart.setOpt {
+  /arg1 set
+  [/in-ecart.setOpt /opt /i /n /ans] pushVariables
+  [
+    /opt arg1 def
+    /ans [ ] def
+    /n opt length def
+    0 2 n 1 sub {
+      /i set
+      opt i get tag StringP eq not {
+         (ecart.setOpt : [keyword value keyword value ....] ) error
+      } {  } ifelse
+     {  % start of the loop
+% Global:  degreeShift
+      opt i get (degreeShift) eq {
+        /degreeShift opt i 1 add get def 
+        exit
+      } {  } ifelse
+% Global:  hdShift
+      opt i get (startingShift) eq {
+        /hdShift opt i 1 add get def
+        exit
+      } {  } ifelse
+% Global:  hdShift
+      opt i get (noAutoHomogenize) eq {
+        /hdShift -1 def
+        exit
+      } {  } ifelse
+% Global:  ecart.useSugar
+      opt i get (sugar) eq {
+        /ecart.useSugar opt i 1 add get def
+        exit
+      } {  } ifelse
+
+      ans [opt i get opt i 1 add get ]  append /ans set
+      exit
+     } loop
+    } for 
+
+    ecart.gb.verbose {
+      (ecart.setOpt:) message
+      (degreeShift=) messagen degreeShift message
+      $hdShift(startingShift)=$ messagen hdShift message
+      (sugar=) messagen ecart.useSugar message
+      (Other options=) messagen ans message
+    } {  } ifelse
+
+    /arg1 ans def
+  ] pop
+  popVariables
+  arg1
+} def
+
 /ecart.dehomogenize {
  /arg1 set
  [/in.ecart.dehomogenize /ll /rr] pushVariables
@@ -27,7 +89,7 @@
      ll (0). eq {
      } {
        ll getRing /rr set
-       ll [ [ (H) rr ,, (1) rr ,, ] 
+       ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] 
             [ (h) rr ,, (1) rr ,, ]] replace
        /ll set
      } ifelse
@@ -53,7 +115,7 @@
      ll (0). eq {
      } {
        ll getRing /rr set
-       ll [ [ (H) rr ,, (1) rr ,, ] ] replace
+       ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] ] replace
        /ll set
      } ifelse
    } ifelse
@@ -80,7 +142,7 @@
      } ifelse
    } {
        [(degreeShift) [ ] ll ] homogenize   /arg1 set
-   }
+   } ifelse
  ] pop
  popVariables
  arg1
@@ -93,7 +155,7 @@
   (    [(h) 1 (Dx1) 1 (Dx2) 1] )
   (    [(Dx1) 1 (Dx2) 1]   )
   (    [(x1) -1 (x2) -1])
-  (   ] weight_vector )
+  (   ] ecart.weight_vector )
   (   0  )
   (   [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]])
   (  ] define_ring)
@@ -119,7 +181,7 @@
      } ifelse
    } {
        [(degreeShift) sv ll ] homogenize   /arg1 set
-   }
+   } ifelse
  ] pop
  popVariables
  arg1
@@ -135,7 +197,7 @@
   [/in.ecart.wv1 /v] pushVariables
   [
     /v arg1 def
-    [(H) (h) v to_records pop] /v set
+    [@@@.Hsymbol (h) v to_records pop] /v set
     v { 1 } map /v set
     /arg1 v def
   ] pop
@@ -158,6 +220,9 @@
 
 /ecart.gb {ecartd.gb}  def
 
+[(ecartd.gb)
+[(See ecart.gb)]] putUsages
+
 [(ecart.gb)
  [(a ecart.gb b)
   (array a; array b;)
@@ -171,15 +236,17 @@
   (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.)
+  $a : [f v w [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$
   (                array ds; ds is the degree shift for the ring. )
-  (a : [f v w ds hdShift]; array f; string v; array of array w; w is the weight matirx.)
+  $a : [f v w [(degreeShift) ds (startingShift) hdShift]]; array f; string v; array of array w; w is the weight matirx.$
   (        array ds; ds is the degree shift for the ring. )
   (        array hsShift is the degree shift for the homogenization. cf.homogenize )
-  $a : [f v w ds (no)]; array f; string v; array of array w; w is the weight matirx.$
+  $a : [f v w [(degreeShift) ds (noAutoHomogenize) 1]]; array f; string v; array of array w; w is the weight matirx.$
   (       No automatic homogenization.)
+  $  [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $
   (  )
-  $cf. ecarth.gb (homogenized),  ecartd.gb (dehomogenize) $
+  $cf. ecarth.gb (homogenized),  ecartd.gb (dehomogenize), ecartd.reduction $
+  (    ecartd.gb.oxRingStructure )
   ( )
   $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
   $             [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
@@ -198,7 +265,8 @@
   (   This example will cause an error on order.)
   (  )
   $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
-  $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  [[0 1] [-3 1] ] ] ecart.gb pmat ; $
+  $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  $
+  $             [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $
   (  )
   (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
   (    ecart.dehomogenize, ecart.dehomogenizeH)
@@ -209,20 +277,25 @@
 ]] putUsages
 
 /ecart.gb.verbose 1 def
+%ecarth.gb  s(H)-homogenized outputs.  GG's original version of ecart gb.
 /ecarth.gb {
   /arg1 set
   [/in-ecarth.gb /aa /typev /setarg /f /v 
    /gg /wv /vec /ans /rr /mm
    /degreeShift  /env2 /opt /ans.gb
+   /hdShift
+   /ecart.useSugar
   ] pushVariables 
   [(CurrentRingp) (KanGBmessage)] pushEnv
   [
     /aa arg1 def
-    aa isArray { } { ( << array >> gb) error } ifelse
+    aa isArray { } { ( << array >> ecarth.gb) error } ifelse
     /setarg 0 def
     /wv 0 def
     /degreeShift 0 def
+    /hdShift 0 def 
     /opt [(weightedHomogenization) 1] def
+    /ecart.useSugar 0 def
     aa { tag } map /typev set
     typev [ ArrayP ] eq
     {  /f aa 0 get def
@@ -256,24 +329,26 @@
        /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
+       opt aa 3 get ecart.setOpt join /opt set
        /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
+       opt aa 3 get ecart.setOpt join /opt set
        /setarg 1 def
     } { } ifelse
 
     /env1 getOptions def
 
-    setarg { } { (ecart.gb : Argument mismatch) error } ifelse
+    ecart.gb.verbose { $ecarth.gb computes std basis with h-s(H)-homogenized buchberger algorithm.$ message } {  } ifelse
+    setarg { } { (ecarth.gb : Argument mismatch) error } ifelse
     
     [(KanGBmessage) ecart.gb.verbose ] system_variable
 
@@ -294,23 +369,23 @@
       } {  } ifelse
       wv isInteger {        
         [v ring_of_differential_operators 
-%         [ v ecart.wv1 v ecart.wv2 ] weight_vector
+%         [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector
          gb.characteristic
          opt
         ] define_ring
       }{
        degreeShift isInteger {
          [v ring_of_differential_operators 
-%          [v ecart.wv1 v ecart.wv2] wv join weight_vector
-          wv weight_vector
+%          [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
+          wv ecart.weight_vector
           gb.characteristic
           opt
          ] define_ring
 
        }{
          [v ring_of_differential_operators 
-%          [v ecart.wv1 v ecart.wv2] wv join weight_vector
-          wv  weight_vector
+%          [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
+          wv  ecart.weight_vector
           gb.characteristic
           [(degreeShift) degreeShift] opt join 
           ] define_ring
@@ -348,21 +423,40 @@
     ecart.begin
 
     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
-    ecart.autoHomogenize {
-      (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
+
+
+    hdShift tag 1 eq {
+     ecart.autoHomogenize not hdShift -1 eq or {
+% No automatic h-s-homogenization.
+       f { {. } map} map /f set   
+     } {
+% Automatic h-s-homogenization without degreeShift
+    (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized without degree shift.)
       message
-    } { } ifelse
-    ecart.autoHomogenize {
-      f { {. ecart.dehomogenize} map} map /f set   
-      f ecart.homogenize01 /f set
-    }{
-      f { {. } map } map /f set
+       f { {. ecart.dehomogenize} map} map /f set   
+       f ecart.homogenize01 /f set
+     } ifelse
+   } {
+% Automatic h-s-homogenization with degreeShift
+    (ecarth.gb: Input polynomial or vectors are automatically h-H-homogenized with degree shift.)
+      message
+       f { {. ecart.dehomogenize} map} map /f set   
+       f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
+   }ifelse
+
+    ecart.useSugar {
+      ecart.needSyz {
+        [f [(needSyz)] gb.options join ] groebner_sugar /gg set
+      } {  
+        [f gb.options] groebner_sugar 0 get /gg set
+      } ifelse
+    } { 
+      ecart.needSyz {
+        [f [(needSyz)] gb.options join ] groebner /gg set
+      } {  
+        [f gb.options] groebner 0 get /gg set
+      } ifelse
     } ifelse
-    ecart.needSyz {
-      [f [(needSyz)] gb.options join ] groebner /gg set
-    } {  
-      [f gb.options] groebner 0 get /gg set
-    } ifelse
 
     ecart.needSyz {
       mm {
@@ -407,15 +501,16 @@
   (array a; array b;)
   $b : [g ii];  array g; array in; g is a standard (Grobner) basis of f$
   (             in the ring of differential operators.)
-  (The computation is done by using Ecart division algorithm and )
-  (the double homogenization.)
+  (The computation is done by using Ecart division algorithm.)
+  $Buchberger algorithm is applied for double h-H(s)-homogenized elements and$
+  (they are not dehomogenized.)
   (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
    $            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.$
   (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.)
+  $a : [f v w [(degreeShift) ds]]; array f; string v; array of array w; w is the weight matirx.$
   (                array ds; ds is the degree shift )
   (  )
   (/ecart.autoHomogenize 0 def )
@@ -435,7 +530,8 @@
   $             [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
   (  )
   $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
-  $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  [[0 1] [-3 1] ] ] ecarth.gb pmat ; (buggy infinite loop)$
+  $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $
+  $            [(degreeShift) [[0 1] [-3 1] ]]  ] ecarth.gb pmat ; $
   (  )
   (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
   (    ecart.dehomogenize, ecart.dehomogenizeH)
@@ -443,7 +539,6 @@
   (                                                          define_ring )
 ]] putUsages
 
-%% BUG:  " f weight init " works well in case of vectors with degree shift ?
 
 /ecart.syz {
   /arg1 set
@@ -498,7 +593,7 @@
   [(CurrentRingp) (KanGBmessage)] pushEnv
   [
     /aa arg1 def
-    aa isArray { } { ( << array >> gb) error } ifelse
+    aa isArray { } { ( << array >> ecartn.gb) error } ifelse
     /setarg 0 def
     /wv 0 def
     /degreeShift 0 def
@@ -536,18 +631,19 @@
        /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
+       opt aa 3 get ecart.setOpt join /opt set
        /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
+       opt aa 3 get ecart.setOpt join /opt set
        /setarg 1 def
     } { } ifelse
 
@@ -574,21 +670,21 @@
       } {  } ifelse
       wv isInteger {        
         [v ring_of_differential_operators 
-         [ v ecart.wv1 v ecart.wv2 ] weight_vector
+         [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector
          gb.characteristic
          opt
         ] define_ring
       }{
        degreeShift isInteger {
          [v ring_of_differential_operators 
-          [v ecart.wv1 v ecart.wv2] wv join weight_vector
+          [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
           gb.characteristic
           opt
          ] define_ring
 
        }{
          [v ring_of_differential_operators 
-          [v ecart.wv1 v ecart.wv2] wv join weight_vector
+          [v ecart.wv1 v ecart.wv2] wv join ecart.weight_vector
           gb.characteristic
           [(degreeShift) degreeShift] opt join 
           ] define_ring
@@ -687,15 +783,17 @@
    /gg /wv /vec /ans /rr /mm
    /degreeShift  /env2 /opt /ans.gb
    /hdShift
+   /ecart.useSugar
   ] pushVariables 
   [(CurrentRingp) (KanGBmessage)] pushEnv
   [
     /aa arg1 def
-    aa isArray { } { ( << array >> gb) error } ifelse
+    aa isArray { } { ( << array >> ecartd.gb) error } ifelse
     /setarg 0 def
     /wv 0 def
     /degreeShift 0 def
     /hdShift 0 def
+    /ecart.useSugar 0 def
     /opt [(weightedHomogenization) 1] def
     aa { tag } map /typev set
     typev [ ArrayP ] eq
@@ -730,55 +828,28 @@
        /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
+       opt aa 3 get ecart.setOpt join /opt set
        /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
+       opt aa 3 get ecart.setOpt join /opt set
        /setarg 1 def
     } { } ifelse
-    typev [ArrayP StringP ArrayP ArrayP ArrayP] eq
-    {  /f aa 0 get def
-       /v aa 1 get def
-       /wv aa 2 get def
-       /degreeShift aa 3 get def
-       /hdShift aa 4 get def
-       /setarg 1 def
-    } { } ifelse
-    typev [ArrayP 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
-       /hdShift aa 4 get def
-       /setarg 1 def
-    } { } ifelse
-    typev [ArrayP ArrayP ArrayP ArrayP StringP] eq
-    {  /f aa 0 get def
-       /v aa 1 get from_records def
-       /wv aa 2 get def
-       /degreeShift aa 3 get def
-       aa 4 get (no) eq {
-         /hdShift -1 def
-       } {  
-         (Unknown keyword for the 5th argument) error
-       } ifelse
-       /setarg 1 def
-    } { } ifelse
 
     /env1 getOptions def
 
     setarg { } { (ecart.gb : Argument mismatch) error } ifelse
     
     [(KanGBmessage) ecart.gb.verbose ] system_variable
-    $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message
+    $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ ecart.message
 
     %%% Start of the preprocess
     v tag RingP eq {
@@ -796,18 +867,18 @@
         (Error in gb: Specify variables) error
       } {  } ifelse
       wv isInteger {        
-        (Give an weight vector such that x < 1) error
+        (Give a weight vector such that x < 1) error
       }{
        degreeShift isInteger {
          [v ring_of_differential_operators 
-           wv weight_vector
+           wv ecart.weight_vector
           gb.characteristic
           opt
          ] define_ring
 
        }{
          [v ring_of_differential_operators 
-           wv weight_vector
+           wv ecart.weight_vector
           gb.characteristic
           [(degreeShift) degreeShift] opt join 
           ] define_ring
@@ -840,29 +911,39 @@
 
     ecartd.begin
 
-    ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
+    ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse
 
     hdShift tag 1 eq {
-     hdShift -1 eq {
+     ecart.autoHomogenize not hdShift -1 eq  or {
 % No automatic h-homogenization.
        f { {. } map} map /f set   
      } {
 % Automatic h-homogenization without degreeShift
+       (ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) ecart.message
        f { {. ecart.dehomogenize} map} map /f set   
        f ecart.homogenize01 /f set
-       f { { [[(H). (1).]] replace } map } map /f set
+       f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set
      } ifelse
    } {
 % Automatic h-homogenization with degreeShift
+       (ecartd.gb : Input polynomial or vectors are automatically homogenized with degreeShift) message
        f { {. ecart.dehomogenize} map} map /f set   
        f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
-       f { { [[(H). (1).]] replace } map } map /f set
+       f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set
    }ifelse
 
-    ecart.needSyz {
-      [f [(needSyz)] gb.options join ] groebner /gg set
-    } {  
-      [f gb.options] groebner 0 get /gg set
+    ecart.useSugar {
+      ecart.needSyz {
+        [f [(needSyz)] gb.options join ] groebner_sugar /gg set
+      } {  
+        [f gb.options] groebner_sugar 0 get /gg set
+      } ifelse
+    } { 
+      ecart.needSyz {
+        [f [(needSyz)] gb.options join ] groebner /gg set
+      } {  
+        [f gb.options] groebner 0 get /gg set
+      } ifelse
     } ifelse
 
     ecart.needSyz {
@@ -893,6 +974,7 @@
 
     ecartd.end
 
+    ans getRing (oxRingStructure) dc /ecartd.gb.oxRingStructure set
     %% 
     env1 restoreOptions  %% degreeShift changes "grade"
 
@@ -961,6 +1043,791 @@
   (if ecart.checkOrder complains about the order given.)
  ]
 ] putUsages 
+
+/ecart.mimimalBase.test {
+ [ 
+    [    (0) , (-2*Dx) , (2*t) , (y) , (x^2) ] 
+    [    (3*t ) , ( -3*Dy ) , ( 0 ) , ( -x ) , ( -y) ] 
+    [    (3*y ) , ( 6*Dt ) , ( 2*x ) , ( 0 ) , ( 1) ] 
+    [    (-3*x^2 ) , ( 0 ) , ( -2*y ) , ( 1 ) , ( 0 )] 
+    [    (Dx ) , ( 0 ) , ( -Dy ) , ( Dt ) , ( 0) ] 
+    [  (0 ) , ( 0 ) , ( 6*t*Dt+2*x*Dx+3*y*Dy+8*h ) , ( 0 ) , ( 3*x^2*Dt+Dx) ] 
+    [  (6*t*Dx ) , ( 0 ) , ( -6*t*Dy ) , ( -2*x*Dx-3*y*Dy-5*h ) , ( -2*y*Dx-3*x^2*Dy) ] 
+    [  (6*t*Dt+3*y*Dy+9*h ) , ( 0 ) , ( 2*x*Dy ) , ( -2*x*Dt ) , ( -2*y*Dt+Dy) ] 
+  ]
+  /ff set
+
+  /nmshift [ [1 0 1 1 1] [1 0 1 0 0] ] def
+  /shift [ [1 0 1 0 0] ] def
+  /weight [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] def
+
+  [ff (t,x,y) weight [(degreeShift) shift (startingShift) nmshift]] ecart.minimalBase
+
+
+}  def
+/test {ecart.mimimalBase.test} def
+
+%(x,y) ==> [(Dx) 1 (Dy) 1 (h) 1]
+/ecart.minimalBase.D1 {
+  /arg1 set
+  [/in-ecart.minimalBase.D1  /tt /v]  pushVariables
+  [
+    /v arg1 def
+    [ v to_records pop] /v set
+    v { /tt set [@@@.Dsymbol tt] cat 1 } map /v set
+    v [(h) 1] join /arg1 set
+  ] pop
+  popVariables
+  arg1
+} def
+
+% [0 1 2] 1 ecart.removeElem [0 2]
+/ecart.removeElem {
+  /arg2 set
+  /arg1 set
+  [/in-ecart.removeElem /v /q /i /ans /j] pushVariables
+  [
+    /v arg1 def
+    /q arg2 def
+    /ans v length 1 sub newVector def
+    /j 0 def
+    0 1 v length 1 sub {
+      /i set
+      i q eq not {
+        ans j  v i get put
+        /j j 1 add def
+      } {  } ifelse
+    } for
+  ] pop
+  popVariables
+  arg1
+} def
+
+/ecart.isZeroRow {
+  /arg1 set
+  [/in-ecart.isZeroRow /aa /i /n /yes] pushVariables
+  [ 
+     /aa arg1 def
+     aa length /n set 
+     /yes 1 def
+     0 1 n 1 sub {
+       /i set
+       aa i get (0). eq {
+       } {
+         /yes 0 def
+       } ifelse
+     } for
+     /arg1 yes def
+  ] pop
+  popVariables
+  arg1
+} def
+
+/ecart.removeZeroRow {
+  /arg1 set
+  [/in-ecart.removeZeroRow /aa /i /n /ans] pushVariables
+  [ 
+     /aa arg1 def
+     aa length /n set 
+     /ans [ ] def
+     0 1 n 1 sub {
+       /i set
+       aa i get ecart.isZeroRow {
+       } {
+         ans aa i get append /ans set
+       } ifelse
+     } for
+     /arg1 ans def
+  ] pop
+  popVariables
+  arg1
+} def
+
+/ecart.gen_input {
+  /arg1 set
+  [/in-ecart.gen_input  /aa /typev /setarg /f /v 
+   /gg /wv /vec /ans /rr /mm
+   /degreeShift  /env2 /opt /ss0
+   /hdShift /ff 
+   ] pushVariables
+  [
+    /aa arg1 def
+    aa isArray { } { ( << array >> ecart.gen_input) error } ifelse
+    /setarg 0 def
+    /wv 0 def
+    /degreeShift 0 def
+    /hdShift 0 def 
+    /opt [ ] def
+    aa { tag } map /typev set
+    typev [ArrayP StringP ArrayP ArrayP] eq
+    {  /f aa 0 get def
+       /v aa 1 get def
+       /wv aa 2 get def
+       opt aa 3 get ecart.setOpt join /opt set
+       /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
+       opt aa 3 get ecart.setOpt join /opt set
+       /setarg 1 def
+    } { } ifelse
+    setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse
+    
+    [(KanGBmessage) ecart.gb.verbose ] system_variable
+
+    f 0 get tag ArrayP eq {  }
+    {  f { /tt set [ tt ] } map /f set } ifelse
+
+    [f v wv [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join]
+    ecart.gb /ff set
+    ff getRing ring_def 
+
+    ff 0 get { {toString } map } map /ff set
+ 
+    [ff v wv 
+      [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join
+    ] /arg1 set
+  ] pop
+  popVariables
+  arg1
+} def
+[(ecart.gen_input)
+[$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]] ]  ecart.gen_input $
+ $               [gg_h v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] $
+ (It generates the input for the minimal filtered free resolution.)
+ (Current ring is changed to the ring of gg_h.)
+ (cf. ecart.minimalBase)
+  $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
+  $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
+  $          [(degreeShift) [ [0] ] $
+  $           (startingShift) [ [0] [0] ]] ] ecart.gen_input /gg set gg pmat $
+]] putUsages
+
+  
+[(ecart.minimalBase)
+[$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalBase $
+ (  [mbase gr_of_mbase )
+ $     [syz v ecart.weight_vector [(degreeShift) new_uv_shift_m (startingShift) [new_D_shift_n new_uv_shift_m]]]$
+ (     gr_of_syz ])
+ (mbase is the minimal generators of ff in D^h in the sense of filtered minimal)
+ (generators.)
+  $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
+  $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
+  $           [(degreeShift) [ [0] ] $
+  $            (startingShift) [ [0] [0] ] ] ] ecart.gen_input /gg0 set $
+  $         gg0 ecart.minimalBase /ss0 set $
+  $         ss0 2 get ecart.minimalBase /ss1 set $
+  $         ss1 2 get ecart.minimalBase /ss2 set $
+  $     (---------  minimal filtered resolution -------) message $
+  $     ss0 0 get pmat ss1 0 get pmat ss2 0 get pmat  $
+  $     (---------  degree shift (n,m) n:D-shift m:uv-shift  -------) message $
+  $     gg0       3 get 3 get message $
+  $     ss0 2 get 3 get 3 get message $
+  $     ss1 2 get 3 get 3 get message $
+  $     ss2 2 get 3 get 3 get message ; $
+
+]] putUsages
+/ecart.minimalBase {
+  /arg1 set
+  [/in-ecart.minimalBase /ai1 /ai  /aa /typev /setarg /f /v 
+   /gg /wv /vec /ans /rr /mm
+   /degreeShift  /env2 /opt /ss0
+   /hdShift
+    /degreeShiftD /degreeShiftUV 
+    /degreeShiftDnew /degreeShiftUVnew 
+    /tt
+    /ai1_gr  /ai_gr
+    /s /r /p /q /i /j /k
+     /ai1_new /ai_new /ai_new2 
+   ] pushVariables
+  [
+    /aa arg1 def
+    aa isArray { } { ( << array >> ecart.minimalBase) error } ifelse
+    /setarg 0 def
+    /wv 0 def
+    /degreeShift 0 def
+    /hdShift 0 def 
+    /opt [ ] def
+    aa { tag } map /typev set
+    typev [ArrayP StringP ArrayP ArrayP] eq
+    {  /f aa 0 get def
+       /v aa 1 get def
+       /wv aa 2 get def
+       opt aa 3 get ecart.setOpt join /opt set
+       /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
+       opt aa 3 get ecart.setOpt join /opt set
+       /setarg 1 def
+    } { } ifelse
+    setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse
+    
+    [(KanGBmessage) ecart.gb.verbose ] system_variable
+
+    f 0 get tag ArrayP eq {  }
+    {  f { /tt set [ tt ] } map /f set } ifelse
+    [f v wv [(degreeShift) degreeShift (noAutoHomogenize) 1] opt join] ecart.syz /ss0 set
+
+    ss0 getRing ring_def
+    /degreeShiftD  hdShift 0 get def
+    /degreeShiftUV hdShift 1 get def
+%      -- ai --> D^r -- ai1 --> D^rr  
+    /ai1  f  { { . } map } map def
+    /ai  ss0 0 get def
+   
+   {
+    /degreeShiftUVnew 
+       ai1 { [ << wv 0 get weightv >> degreeShiftUV ] ord_ws_all  } map
+    def
+    (degreeShiftUVnew=) messagen degreeShiftUVnew message
+
+    /degreeShiftDnew 
+       ai1 { [ << v ecart.minimalBase.D1 weightv >> degreeShiftD ]  ord_ws_all}
+            map
+    def
+    (degreeShiftDnew=) messagen degreeShiftDnew message
+
+    ai {[wv 0 get weightv  degreeShiftUVnew] init} map /ai_gr set   
+
+%C  Note 2003.8.26
+
+    ai [ ] eq {
+      exit
+    } {  } ifelse
+
+    /s ai length def
+    /r ai 0 get length def
+
+    /itIsMinimal 1 def
+    0 1 s 1 sub {
+      /i set
+      0 1 r 1 sub {
+        /j set
+
+        [(isConstantAll) ai_gr i get j get] gbext
+        ai_gr i get j get (0). eq not and
+        {
+           /itIsMinimal 0 def
+           /p i def /q j def
+        } {  } ifelse
+      } for
+    } for    
+
+
+    itIsMinimal { exit } { } ifelse
+
+%    construct new ai and ai1 (A_i and A_{i-1})
+     /ai1_new  r 1 sub newVector def
+     /j 0 def     
+     0 1 r 1 sub {
+       /i set
+       i q eq not {
+          ai1_new j ai1 i get put
+          /j  j 1 add def
+       } { } ifelse
+     } for 
+
+     /ai_new [s  r] newMatrix def
+     0 1 s 1 sub {
+       /j set
+       0 1 r 1 sub {
+         /k set
+         ai_new [j k] 
+            << ai p get q get >> << ai j get k get >> mul
+            << ai j get q get >> << ai p get k get >> mul
+            sub
+         put
+       } for
+     } for 
+    
+% remove 0 column
+     /ai_new2 [s 1 sub r 1 sub] newMatrix def
+     /j 0 def     
+     0 1 s 1 sub {
+       /i set
+       i p eq not {
+          ai_new2 j << ai_new i get q ecart.removeElem >> put
+          /j  j 1 add def
+       } { } ifelse
+     } for 
+
+%   ( ) error
+     /ai1 ai1_new  def
+     /ai ai_new2  ecart.removeZeroRow def 
+
+   } loop   
+   /arg1 
+     [  ai1 
+        ai1 {[wv 0 get weightv  degreeShift 0 get] init} map %Getting gr of A_{i-1}
+        [ai v wv [(degreeShift) [degreeShiftUVnew] (startingShift) [degreeShiftDnew degreeShiftUVnew]]] 
+        ai {[wv 0 get weightv  degreeShiftUVnew] init} map %Getting gr of A_i
+     ] 
+   def
+  ] pop 
+  popVariables
+  arg1
+} def
+
+/ecart.minimalResol {
+  /arg1 set
+  [/in-ecart.minimalResol /aa /ans /gg0 /ansds /ans_gr /c] pushVariables
+  [
+     /aa arg1 def
+     /ans [ ] def
+     /ansds [ ] def
+     /ans_gr [ ] def
+     /c 0 def
+
+    (---- ecart.gen_input ----) message
+     aa ecart.gen_input /gg0 set
+     ansds gg0 3 get 3 get append /ansds set
+     (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set
+     gg0 ecart.minimalBase /ssi set
+     ansds ssi 2 get 3 get 3 get append /ansds set
+     ans ssi 0 get  append /ans set
+     ans_gr ssi 1 get append /ans_gr set 
+     {
+       ssi 3 get [ ] eq { exit } { } ifelse
+       (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set
+       ssi 2 get ecart.minimalBase /ssi_new set
+       ans ssi_new 0 get append /ans set
+       ansds ssi_new 2 get 3 get 3 get append /ansds set
+       ans_gr ssi_new 1 get append /ans_gr set
+       /ssi ssi_new def
+     } loop
+     /arg1 [ans ansds ans_gr] def
+  ] pop
+  popVariables
+  arg1
+} def
+
+(ecart.minimalResol) message
+
+[(ecart.minimalResol)
+[
+
+ $[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalResol $
+ (  [resol degree_shifts gr_of_resol_by_uv_shift_m] )
+  $Example1: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
+  $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
+  $           [(degreeShift) [ [0] ] $
+  $            (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $
+]] putUsages
+
+%% for ecart.weight_vector
+/ecart.eliminationOrderTemplate  { %% esize >= 1
+%% if esize == 0, it returns reverse lexicographic order.
+%%  m esize eliminationOrderTemplate mat
+  /arg2 set /arg1 set
+  [/m  /esize /m1 /m2 /k /om /omtmp] pushVariables
+  [
+    /m arg1 def  /esize arg2 def
+    /m1 m esize sub 1 sub def
+    /m2 esize 1 sub def
+     [esize 0 gt
+      {
+       [1 1 esize
+        { pop 1 } for
+        esize 1 << m 1 sub >>
+        { pop 0 } for
+       ]  %% 1st vector
+      }
+      { } ifelse
+
+      m esize gt
+      {    
+       [1 1  esize 
+        { pop 0 } for
+        esize 1 << m 1 sub >>
+        { pop 1 } for
+       ]  %% 2nd vector
+      }
+      { } ifelse
+
+      m1 0 gt
+      {
+         m 1 sub -1 << m m1 sub >>
+         {
+              /k set
+              m  k  evec_neg
+         } for
+      }
+      { } ifelse
+
+      m2 0 gt
+      {
+         << esize 1 sub >> -1 1
+         {
+              /k set
+              m  k  evec_neg
+         } for
+      }
+      { } ifelse
+
+    ] /om set
+     om [ 0 << m 2 idiv >> 1 sub] 0 put
+     om [ << m 2 idiv >> 1 add  << m 2 idiv >> 1 sub] 0 put
+    /arg1 om def
+   ] pop
+   popVariables
+   arg1
+} def
+
+%note  2003.09.29
+/ecart.elimination_order {
+%% [x-list d-list params]  (x,y,z) elimination_order 
+%%  vars                    evars
+%% [x-list d-list params order]
+  /arg2 set  /arg1 set
+  [/vars /evars /univ /order /perm /univ0 /compl /m /omtmp] pushVariables
+  /vars arg1 def /evars [arg2 to_records pop] def
+  [
+    /univ vars 0 get reverse
+          vars 1 get reverse join
+    def
+
+    << univ length 2 sub >>
+    << evars length >>
+    ecart.eliminationOrderTemplate /order set
+
+    [[1]] order oplus [[1]] oplus /order set
+
+    /m order length 2 sub def
+    /omtmp [1 1 m 2 add { pop 0 } for ] def
+    omtmp << m 2 idiv >> 1 put
+    order  omtmp append /order set
+    % order pmat    
+
+    /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y,h] --> [x,y,h]
+
+    /compl 
+      [univ 0 get] evars join evars univ0 complement join
+    def
+    compl univ
+    getPerm /perm set
+    %%perm :: univ :: compl ::
+
+    order perm permuteOrderMatrix /order set
+
+    
+    vars [order] join /arg1 set
+  ] pop
+  popVariables
+  arg1
+} def
+
+/ecart.define_ring {
+   /arg1 set
+   [/rp /param /foo] pushVariables
+   [/rp arg1 def
+
+     rp 0 get length 3 eq {
+       rp 0  [rp 0 get 0 get rp 0 get 1 get rp 0 get 2 get ]
+             ( ) ecart.elimination_order put
+     } { } ifelse
+
+    [
+      rp 0 get 0 get             %% x-list
+      rp 0 get 1 get             %% d-list
+      rp 0 get 2 get /param set
+      param 0 << rp 1 get >> put %% << rp 1 get >> is 17 in the example.
+      param                      %% parameters.
+      rp 0 get 3 get             %% order matrix.
+      rp length 2 eq
+      { [  ] }                   %% null optional argument.
+      { rp 2 get }
+      ifelse  
+    ]  /foo set
+    foo aload pop set_up_ring@
+   ] pop
+   popVariables
+   [(CurrentRingp)] system_variable
+} def
+/ecart.weight_vector {
+  /arg2 set  /arg1 set
+  [/vars /univ /w-vectors /www /k /order1 /order2] pushVariables
+  /vars arg1 def /w-vectors arg2 def
+  [
+    /univ vars 0 get reverse
+          vars 1 get reverse join
+    def
+    [
+    0 1 << w-vectors length 1 sub >> 
+    {
+      /k set
+      univ w-vectors k get w_to_vec
+    } for
+    ] /order1 set
+    %% order1 ::
+    
+    vars ( ) ecart.elimination_order 3 get /order2 set
+    vars [ << order1 order2 join >> ] join /arg1 set
+  ] pop
+  popVariables
+  arg1
+} def
+
+%% end of for ecart.define_ring
+
+/ecartd.reduction {
+  /arg2 set
+  /arg1 set
+  [/in-ecartd.reduction /gbasis /flist /ans /gbasis2] pushVariables
+  [(CurrentRingp) (KanGBmessage)] pushEnv
+  [
+     /gbasis arg2  def
+     /flist  arg1  def
+     gbasis 0 get tag 6 eq { }
+     { (ecartd.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 ecartd.gb 0 get getRing ring_def
+       /gbasis2 gbasis 0 get ,,, def
+     } ifelse
+     ecartd.begin
+
+     flist ,,, /flist set
+     flist tag 6 eq {
+       flist { gbasis2 reduction } map /ans set
+     }{
+       flist gbasis2 reduction /ans set
+     } ifelse
+     /arg1 ans def
+
+     ecartd.end
+  ] pop
+  popEnv
+  popVariables
+  arg1
+} def
+
+/ecartd.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]]]
+  ecartd.gb /gg set
+
+  (Dx) [gg 0 get] ecartd.reduction /gg2 set
+  gg2 message
+  (-----------------------------) message
+
+  [(Dx) (Dy) (Dx+x*Dy)] [gg 0 get] ecartd.reduction /gg3 set
+  gg3 message
+
+  (-----------------------------) message
+    [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )]
+      (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set
+   (Dx) ggg ecartd.reduction /gg4 set
+   gg4 message
+  [gg2  gg3 gg4]
+} def
+
+/ecarth.reduction {
+  /arg2 set
+  /arg1 set
+  [/in-ecarth.reduction /gbasis /flist /ans /gbasis2] pushVariables
+  [(CurrentRingp) (KanGBmessage)] pushEnv
+  [
+     /gbasis arg2  def
+     /flist  arg1  def
+     gbasis 0 get tag 6 eq { }
+     { (ecarth.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 ecarth.gb 0 get getRing ring_def
+       /gbasis2 gbasis 0 get ,,, def
+     } ifelse
+     ecarth.begin
+
+     flist ,,, /flist set
+     flist tag 6 eq {
+       flist { gbasis2 reduction } map /ans set
+     }{
+       flist gbasis2 reduction /ans set
+     } ifelse
+     /arg1 ans def
+
+     ecarth.end
+  ] pop
+  popEnv
+  popVariables
+  arg1
+} def
+
+[(ecartd.reduction)
+[ (f basis ecartd.reduction r)
+  (f is reduced by basis by the tangent cone algorithm.)
+  (The first element of basis <g_1,...,g_m> must be a standard 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 ecartd.gb.)
+  $h[0,1](D)-homogenization is used.$
+  (cf. reduction, ecartd.gb, ecartd.reduction.test )
+  $Example:$
+  $ [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )] $
+  $   (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $
+  $ (Dx+Dy) ggg ecartd.reduction :: $
+]] putUsages
+
+/ecart.stdOrder {
+  /arg1 set
+  [/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2
+  ] pushVariables
+  [
+     /vv arg1 def
+     vv isString { [ vv to_records pop] /vv set }
+     { } ifelse
+     vv { toString} map /vv set
+
+     vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set
+     dvv { 1 } map /wv1 set
+     vv { -1 } map dvv { 1 } map join /wv2 set
+     /arg1 [wv1 wv2 ] def
+  ] pop
+  popVariables
+  arg1
+} def
+
+/ecartd.isSameIdeal_h {
+  /arg1 set
+  [/in-ecartd.isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f
+   /ecartd.isSameIdeal_h.opt
+   /save-ecart.autoHomogenize  /wv /save-ecart.message.quiet
+   ] pushVariables
+  [(CurrentRingp) (Homogenize_vec)] pushEnv
+  [
+    /aa arg1 def
+    gb.verbose { (Getting in ecartd.isSameIdeal_h) message } { } ifelse
+    %% comparison of hilbert series has not yet been implemented.
+    /save-ecart.message.quiet ecart.message.quiet def
+    aa length 3 eq {    }
+    { ([ii jj vv] ecartd.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.ecartd.isSame_h goto } {  } ifelse
+
+    vv ecart.stdOrder /wv set
+
+    /save-ecart.autoHomogenize ecart.autoHomogenize def
+    /ecart.autoHomogenize 0 def
+    [ii vv wv] ecartd.gb  /iigg set
+    [jj vv wv] ecartd.gb  /jjgg set
+    save-ecart.autoHomogenize /ecart.autoHomogenize set
+
+    iigg getRing ring_def
+
+    getOptions /ecartd.isSameIdeal_h.opt set
+
+    /ans 1 def
+    iigg 0 get /iigg set
+    jjgg 0 get /jjgg set
+    %%Bug: not implemented for the case of module.
+
+    /save-ecart.message.quiet ecart.message.quiet def
+    /ecart.message.quiet 1 def
+    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 vv wv] ecartd.reduction 0 get
+      (0). eq not { /ans 0 def /LLL.ecartd.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 vv wv] ecartd.reduction 0 get
+      (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} {  } ifelse
+      gb.verbose { (o) messagen } {  } ifelse
+    } for
+    /LLL.ecartd.isSame_h
+    gb.verbose { ( Done) message } {  } ifelse
+    save-ecart.message.quiet /ecart.message.quiet set
+    ecartd.isSameIdeal_h.opt restoreOptions 
+    /arg1 ans def
+  ] pop
+  popEnv
+  popVariables
+  arg1
+} def
+(ecartd.isSameIdeal_h ) messagen-quiet
+
+[(ecartd.isSameIdeal_h)
+[([ii jj vv] ecartd.isSameIdeal_h bool)
+ (ii, jj : ideal, vv : variables)
+ $The ideals ii and jj will be compared in the ring h[0,1](D).$
+ $ii and jj are re-parsed.$
+ $Example 1: [ [((1-x) Dx + h)]  [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $
+]] putUsages
+
+/ecart.01Order {
+  /arg1 set
+  [/in-ecart.01Order /vv /tt /dvv /wv1 /wv2 
+  ] pushVariables
+  [
+     /vv arg1 def
+     vv isString { [ vv to_records pop] /vv set }
+     { } ifelse
+     vv { toString} map /vv set
+
+     vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set
+     dvv { 1 } map /wv1 set
+     /arg1 [wv1] def
+  ] pop 
+  popVariables
+  arg1
+} def
+/ecart.homogenize01Ideal {
+ /arg1 set
+ [/in.ecart.homogenize01Ideal /ll /vv /wv /ans] pushVariables
+ [
+   /ll arg1 0 get def
+   /vv arg1 1 get def
+   vv isArray { vv from_records /vv set } {  } ifelse
+   vv ecart.01Order /wv set
+   [vv ring_of_differential_operators 0] define_ring
+   ll ,,, /ll set ll dehomogenize /ll set
+   [ll vv wv] gb 0 get /ll set
+
+   ecart.begin
+   [vv ring_of_differential_operators
+    vv ecart.stdOrder weight_vector 0
+    [(weightedHomogenization) 1]] define_ring
+   ll ,,, {ecart.homogenize01 ecart.dehomogenizeH} map /ans set
+   ecart.end
+   /arg1 ans def
+ ] pop
+ popVariables
+ arg1
+} def
+[(ecart.homogenize01Ideal)
+[([ii vv] ecartd.homogenize01Ideal)
+ (ii : ideal, vv : variables)
+ $The ideal ii is homogenized in h[0,1](D).$
+ $Example 1: [ [((1-x) Dx + 1)] (x)] ecart.homogenize01Ideal $
+]] putUsages
+
+
 
 ( ) message-quiet