===================================================================
RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/ecart.sm1,v
retrieving revision 1.16
retrieving revision 1.31
diff -u -p -r1.16 -r1.31
--- OpenXM/src/kan96xx/Doc/ecart.sm1	2003/09/12 02:52:49	1.16
+++ OpenXM/src/kan96xx/Doc/ecart.sm1	2004/08/31 04:45:42	1.31
@@ -1,5 +1,6 @@
-% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.15 2003/08/29 04:34:07 takayama Exp $ 
-%[(parse) (hol.sm1) pushfile] extension
+% $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.30 2004/07/29 08:13:42 takayama Exp $ 
+(hol_loaded) boundp { }
+{ [(parse) (hol.sm1) pushfile] extension } ifelse
 %[(parse) (appell.sm1) pushfile] extension
 
 (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet
@@ -7,6 +8,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 +19,13 @@
   [(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
@@ -80,7 +90,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
@@ -106,7 +116,7 @@
      ll (0). eq {
      } {
        ll getRing /rr set
-       ll [ [ (H) rr ,, (1) rr ,, ] ] replace
+       ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] ] replace
        /ll set
      } ifelse
    } ifelse
@@ -146,7 +156,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)
@@ -188,7 +198,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
@@ -211,6 +221,9 @@
 
 /ecart.gb {ecartd.gb}  def
 
+[(ecartd.gb)
+[(See ecart.gb)]] putUsages
+
 [(ecart.gb)
  [(a ecart.gb b)
   (array a; array b;)
@@ -233,7 +246,8 @@
   (       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 ; $
@@ -271,6 +285,7 @@
    /gg /wv /vec /ans /rr /mm
    /degreeShift  /env2 /opt /ans.gb
    /hdShift
+   /ecart.useSugar
   ] pushVariables 
   [(CurrentRingp) (KanGBmessage)] pushEnv
   [
@@ -281,6 +296,7 @@
     /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
@@ -354,23 +370,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
@@ -429,10 +445,18 @@
        f {/fi set [(degreeShift) hdShift fi] homogenize} 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 {
@@ -647,21 +671,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
@@ -826,7 +850,7 @@
     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 {
@@ -844,18 +868,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
@@ -888,7 +912,7 @@
 
     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 {
      ecart.autoHomogenize not hdShift -1 eq  or {
@@ -896,17 +920,17 @@
        f { {. } map} map /f set   
      } {
 % Automatic h-homogenization without degreeShift
-       (ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) message
+       (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.useSugar {
@@ -951,6 +975,7 @@
 
     ecartd.end
 
+    ans getRing (oxRingStructure) dc /ecartd.gb.oxRingStructure set
     %% 
     env1 restoreOptions  %% degreeShift changes "grade"
 
@@ -1170,8 +1195,8 @@
   arg1
 } def
 [(ecart.gen_input)
-[$[ff v weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]] ]  ecart.gen_input $
- $               [gg_h v weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] $
+[$[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)
@@ -1183,9 +1208,9 @@
 
   
 [(ecart.minimalBase)
-[$[ff v weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  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 weight_vector [(degreeShift) new_uv_shift_m (startingShift) [new_D_shift_n new_uv_shift_m]]]$
+ $     [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.)
@@ -1387,7 +1412,7 @@
 [(ecart.minimalResol)
 [
 
- $[ff v weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  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]] $
@@ -1395,5 +1420,458 @@
   $            (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
+    w-vectors to_int /w-vectors set
+    [
+    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
+
+  (----------- reduction by h=1 ---------------) message
+    [[( 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]]] /ggg set
+   [(Homogenize) 0]  system_variable
+   (Dx) ggg ecartd.reduction /gg5 set
+   [(Homogenize) 1]  system_variable
+   gg5 message
+
+  [gg2  gg3 gg4 gg5]
+} 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
+
+/ecartd.reduction_noh {
+  /arg2 set
+  /arg1 set
+  [/in-ecarth.reduction_noh /gbasis /flist] pushVariables
+  [(Homogenize)] pushEnv
+  [
+     /gbasis arg2  def
+     /flist  arg1  def
+     [(Homogenize) 0] system_variable
+     flist gbasis ecartd.reduction /arg1 set
+  ] pop
+  popEnv
+  popVariables
+  arg1
+} def
+
+[(ecartd.reduction_noh)
+[ (f basis ecartd.reduction_noh 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 and)
+  (it should not contain the variable h.  cf. dehomogenize)
+  $h[0,1](D)-homogenization is NOT used.$
+  (cf. reduction, ecartd.gb, ecartd.reduction )
+  $Example:$
+  $ [[( 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]]] /ggg set $
+  $ (Dx+Dy) ggg ecartd.reduction_noh :: $
+]] 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 
 
+/ecart_loaded 1 def
\ No newline at end of file