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

Diff for /OpenXM/src/kan96xx/Doc/ecart.sm1 between version 1.4 and 1.39

version 1.4, 2003/07/30 09:00:51 version 1.39, 2004/09/14 11:51:20
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.3 2003/07/29 08:36:39 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.38 2004/09/14 10:50:49 takayama Exp $
 %[(parse) (hol.sm1) pushfile] extension  (hol_loaded) boundp { }
   { [(parse) (hol.sm1) pushfile] extension } ifelse
 %[(parse) (appell.sm1) pushfile] extension  %[(parse) (appell.sm1) pushfile] extension
   
 (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet  (ecart.sm1 : ecart division for D, 2003/07/25, 2004/09/14 ) message-quiet
 /ecart.begin { beginEcart } def  /ecart.begin { beginEcart } def
 /ecart.end   { endEcart } def  /ecart.end   { endEcart } def
 /ecart.autoHomogenize 1 def  /ecart.autoHomogenize 1 def
 /ecart.needSyz 0 def  /ecart.needSyz 0 def
   /ecartd.gb.oxRingStructure [[ ] [ ] ] def
   /ecart.partialEcartGlobalVarX [ ] def
   
   /ecart.gb.verbose 1 def
   /ecart.message.quiet 0 def
   
   /ecartd.begin {
     ecart.begin
     [(EcartAutomaticHomogenization) 1] system_variable
   } def
   /ecartd.end {
     ecart.end
     [(EcartAutomaticHomogenization) 0] system_variable
   } def
   
   /ecart.message {
     ecart.message.quiet { pop } { message } ifelse
   } def
   /ecart.messagen {
     ecart.message.quiet { pop } { messagen } ifelse
   } def
   /ecart.setOpt.init {
   % Initialize
       /ecart.partialEcartGlobalVarX [ ] def
   } def
   /ecart.setOpt {
     /arg1 set
     [/in-ecart.setOpt /opt /i /n /ans] pushVariables
     [
       /opt arg1 def
       /ans [ ] def
       /n opt length def
   
       ecart.setOpt.init
   
       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
   
   % Global:  ecart.partialEcartGlobalVarX
         opt i get (partialEcartGlobalVarX) eq {
           /ecart.partialEcartGlobalVarX opt , i 1 add , get def
           % do not exit.
         } {  } ifelse
   
         ans [opt i get opt i 1 add get ]  join /ans set
         exit
        } loop
       } for
   
       ecart.gb.verbose {
         (ecart.setOpt:) ecart.message
         (degreeShift=) ecart.messagen degreeShift ecart.message
         $hdShift(startingShift)=$ ecart.messagen hdShift ecart.message
         (sugar=) ecart.messagen ecart.useSugar ecart.message
         (Other options=) ecart.messagen ans ecart.message
       } {  } ifelse
   
       /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   
 /ecart.dehomogenize {  /ecart.dehomogenize {
  /arg1 set   /arg1 set
  [/in.ecart.dehomogenize /ll /rr] pushVariables   [/in.ecart.dehomogenize /ll /rr] pushVariables
Line 19 
Line 106 
      ll (0). eq {       ll (0). eq {
      } {       } {
        ll getRing /rr set         ll getRing /rr set
        ll [ [ (H) rr ,, (1) rr ,, ]         ll [ [ @@@.Hsymbol rr __ (1) rr __ ]
             [ (h) rr ,, (1) rr ,, ]] replace              [ (h) rr __ (1) rr __ ]] replace
        /ll set         /ll set
      } ifelse       } ifelse
    } ifelse     } ifelse
Line 45 
Line 132 
      ll (0). eq {       ll (0). eq {
      } {       } {
        ll getRing /rr set         ll getRing /rr set
        ll [ [ (H) rr ,, (1) rr ,, ] ] replace         ll [ [ @@@.Hsymbol rr __ (1) rr __ ] ] replace
        /ll set         /ll set
      } ifelse       } ifelse
    } ifelse     } ifelse
Line 61 
Line 148 
   
 /ecart.homogenize01 {  /ecart.homogenize01 {
  /arg1 set   /arg1 set
  [/in.ecart.homogenize01 /ll ] pushVariables   [/in.ecart.homogenize01 /ll /ll0] pushVariables
  [   [
    /ll arg1 def     /ll arg1 def
    [(degreeShift) [ ] ll ] homogenize     ll tag ArrayP eq {
    /arg1 set       ll 0 get tag ArrayP eq not {
          [(degreeShift) [ ] ll ] homogenize   /arg1 set
        } {
          ll { ecart.homogenize01 } map /arg1 set
        } ifelse
      } {
          [(degreeShift) [ ] ll ] homogenize   /arg1 set
      } ifelse
  ] pop   ] pop
  popVariables   popVariables
  arg1   arg1
Line 78 
Line 172 
   (    [(h) 1 (Dx1) 1 (Dx2) 1] )    (    [(h) 1 (Dx1) 1 (Dx2) 1] )
   (    [(Dx1) 1 (Dx2) 1]   )    (    [(Dx1) 1 (Dx2) 1]   )
   (    [(x1) -1 (x2) -1])    (    [(x1) -1 (x2) -1])
   (   ] weight_vector )    (   ] ecart.weight_vector )
   (   0  )    (   0  )
   (   [(degreeShift) [[0 0 0]]])    (   [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]])
   (  ] define_ring)    (  ] define_ring)
   ( ecart.begin)    ( ecart.begin)
   ( [[1 -4 -2 5]] appell4 0 get /eqs set)    ( [[1 -4 -2 5]] appell4 0 get /eqs set)
   ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )    ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
   ( ecart.homogenize01 /eqs2 set)    ( {ecart.homogenize01} map /eqs2 set)
   ( [eqs2] groebner )    ( [eqs2] groebner )
 ]] putUsages  ]] putUsages
   
 /ecart.homogenize01_with_shiftVector {  /ecart.homogenize01_with_shiftVector {
  /arg2.set   /arg2.set
  /arg1 set   /arg1 set
  [/in.ecart.homogenize01 /ll /sv] pushVariables   [/in.ecart.homogenize01 /ll /sv /ll0] pushVariables
  [   [
    /sv arg2 def     /sv arg2 def
    /ll arg1 def     /ll arg1 def
    [(degreeShift) sv ll ] homogenize     ll tag ArrayP eq {
    /arg1 set       ll 0 get tag ArrayP eq not {
          [(degreeShift) sv ll ] homogenize   /arg1 set
        } {
          ll { ecart.homogenize01_with_shiftVector } map /arg1 set
        } ifelse
      } {
          [(degreeShift) sv ll ] homogenize   /arg1 set
      } ifelse
  ] pop   ] pop
  popVariables   popVariables
  arg1   arg1
 } def  } def
 [(ecart.dehomogenize01_with_degreeShift)  [(ecart.dehomogenize01_with_degreeShift)
  [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)   [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
     (cf. homogenize)
 ]] putUsages  ]] putUsages
   
 %% Aux functions to return the default weight vectors.  %% Aux functions to return the default weight vectors.
Line 112 
Line 214 
   [/in.ecart.wv1 /v] pushVariables    [/in.ecart.wv1 /v] pushVariables
   [    [
     /v arg1 def      /v arg1 def
     [(H) (h) v to_records pop] /v set      [@@@.Hsymbol (h) v to_records pop] /v set
     v { 1 } map /v set      v { 1 } map /v set
     /arg1 v def      /arg1 v def
   ] pop    ] pop
Line 133 
Line 235 
   arg1    arg1
 } def  } def
   
 /ecart.gb.verbose 1 def  /ecart.gb {ecartd.gb}  def
 /ecart.gb {  
   [(ecartd.gb)
   [(See ecart.gb)]] putUsages
   
   [(ecart.gb)
    [(a ecart.gb b)
     (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.)
     (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 [(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 [(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 [(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), 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 ; $
     (Example 2: )
     $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
     $   [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb  /ff set ff pmat ;$
     (To set the current ring to the ring in which ff belongs )
     (      ff getRing ring_def  )
     (  )
     $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
     $             [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
     (   This example will cause an error on order.)
     (  )
     $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] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
     (   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] ]  $
     $             [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $
     (  )
     $Example 6:  [ [(1-z) (-x+1-y-z)] (x,y,z)  $
     $              [[(y) -1 (z) -1 (Dy) 1 (Dz) 1] [(x) 1 (Dx) 1]] $
     $              [(partialEcartGlobalVarX) [(x)]] ] /std set $
     $             std ecart.gb pmat ; $
     $             std ecart.gb getRing :: $
     (  )
     (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
     (    ecart.dehomogenize, ecart.dehomogenizeH)
     ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
     (                                                          define_ring )
     (/ecart.autoHomogenize 0 def )
     (               not to dehomogenize and homogenize)
   ]] putUsages
   
   %ecarth.gb  s(H)-homogenized outputs.  GG's original version of ecart gb.
   /ecarth.gb {
   /arg1 set    /arg1 set
   [/in-ecart.gb /aa /typev /setarg /f /v    [/in-ecarth.gb /aa /typev /setarg /f /v
    /gg /wv /vec /ans /rr /mm     /gg /wv /vec /ans /rr /mm
    /degreeShift  /env2 /opt /ans.gb     /degreeShift  /env2 /opt /ans.gb
      /hdShift
      /ecart.useSugar
   ] pushVariables    ] pushVariables
   [(CurrentRingp) (KanGBmessage)] pushEnv    [(CurrentRingp) (KanGBmessage)] pushEnv
   [    [
     /aa arg1 def      /aa arg1 def
     aa isArray { } { ( << array >> gb) error } ifelse      aa isArray { } { ( << array >> ecarth.gb) error } ifelse
     /setarg 0 def      /setarg 0 def
     /wv 0 def      /wv 0 def
     /degreeShift 0 def      /degreeShift 0 def
       /hdShift 0 def
     /opt [(weightedHomogenization) 1] def      /opt [(weightedHomogenization) 1] def
       /ecart.useSugar 0 def
       ecart.setOpt.init
     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 181 
Line 352 
        /wv aa 2 get def         /wv aa 2 get def
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
   
     typev [ArrayP StringP ArrayP ArrayP] eq      typev [ArrayP StringP ArrayP ArrayP] eq
     {  /f aa 0 get def      {  /f aa 0 get def
        /v aa 1 get def         /v aa 1 get def
        /wv aa 2 get def         /wv aa 2 get def
        /degreeShift aa 3 get def         opt aa 3 get ecart.setOpt join /opt set
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
     typev [ArrayP ArrayP ArrayP ArrayP] eq      typev [ArrayP 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
        /wv aa 2 get def         /wv aa 2 get def
        /degreeShift aa 3 get def         opt aa 3 get ecart.setOpt join /opt set
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
   
     /env1 getOptions def      /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      [(KanGBmessage) ecart.gb.verbose ] system_variable
   
Line 219 
Line 392 
       } {  } ifelse        } {  } ifelse
       wv isInteger {        wv isInteger {
         [v ring_of_differential_operators          [v ring_of_differential_operators
          [ v ecart.wv1 v ecart.wv2 ] weight_vector  %         [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector
          gb.characteristic           gb.characteristic
          opt           opt
         ] define_ring          ] define_ring
       }{        }{
        degreeShift isInteger {         degreeShift isInteger {
          [v ring_of_differential_operators           [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
             wv ecart.weight_vector
           gb.characteristic            gb.characteristic
           opt            opt
          ] define_ring           ] define_ring
   
        }{         }{
          [v ring_of_differential_operators           [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
             wv  ecart.weight_vector
           gb.characteristic            gb.characteristic
           [(degreeShift) degreeShift] opt join            [(degreeShift) degreeShift] opt join
           ] define_ring            ] define_ring
Line 254 
Line 429 
     %%% Enf of the preprocess      %%% Enf of the preprocess
   
     ecart.gb.verbose {      ecart.gb.verbose {
       (The first and the second weight vectors are automatically set as follows)        (The first and the second weight vectors for automatic homogenization: )
        message         message
        v ecart.wv1 message         v ecart.wv1 message
        v ecart.wv2 message         v ecart.wv2 message
Line 265 
Line 440 
        } ifelse         } ifelse
     } { } ifelse      } { } ifelse
   
       %%BUG: case of v is integer
       [v ecart.partialEcartGlobalVarX] ecart.checkOrder
   
     ecart.begin      ecart.begin
   
     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse      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        message
     } { } ifelse         f { {. ecart.dehomogenize} map} map /f set
     ecart.autoHomogenize {         f ecart.homogenize01 /f set
       f { {. ecart.dehomogenize} map} map /f set       } ifelse
       f ecart.homogenize01 /f set     } {
     }{  % Automatic h-s-homogenization with degreeShift
       f { {. } map } map /f set      (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      } ifelse
     ecart.needSyz {  
       [f [(needSyz)] gb.options join ] groebner /gg set  
     } {  
       [f gb.options] groebner 0 get /gg set  
     } ifelse  
   
     ecart.needSyz {      ecart.needSyz {
       mm {        mm {
        gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set         gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
       } { /ans.gb gg 0 get def } ifelse         } { /ans.gb gg 0 get def } ifelse
       /ans [gg 2 get , ans.gb , gg 1 get , f ] def         /ans [gg 2 get , ans.gb , gg 1 get , f ] def
       ans pmat ;  %      ans pmat ;
     } {      } {
       wv isInteger {        wv isInteger {
         /ans [gg gg {init} map] def          /ans [gg gg {init} map] def
       }{        }{
         /ans [gg gg {wv 0 get weightv init} map] def         degreeShift isInteger {
            /ans [gg gg {wv 0 get weightv init} map] def
          } {
            /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
          } ifelse
       }ifelse        }ifelse
   
       %% Postprocess : recover the matrix expression.        %% Postprocess : recover the matrix expression.
Line 316 
Line 517 
   popVariables    popVariables
   arg1    arg1
 } def  } def
 (ecart.gb ) messagen-quiet  (ecarth.gb ) messagen-quiet
   
 [(ecart.gb)  [(ecarth.gb)
  [(a ecart.gb b)   [(a ecarth.gb b)
   (array a; array b;)    (array a; array b;)
   $b : [g ii];  array g; array in; g is a standard (Grobner) basis of f$    $b : [g ii];  array g; array in; g is a standard (Grobner) basis of f$
   (             in the ring of differential operators.)    (             in the ring of differential operators.)
   (The computation is done by using Ecart division algorithm and )    (The computation is done by using Ecart division algorithm.)
   (the double homogenization.)    $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)    (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$     $            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.$     $            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 ];    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.)    $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 )    (                array ds; ds is the degree shift )
   (  )    (  )
   (/ecart.autoHomogenize 0 def )    (/ecart.autoHomogenize 0 def )
   (               not to dehomogenize and homogenize)    (               not to dehomogenize and homogenize)
   ( )    ( )
   $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 ] ] ] ecart.gb pmat ; $    $             [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.gb pmat ; $
   (Example 2: )    (Example 2: )
   (To put H and h=1, type in, e.g., )    (To put H and h=1, type in, e.g., )
   $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $    $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
   $   [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /gg set gg ecart.dehomogenize pmat ;$    $   [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecarth.gb /gg set gg ecart.dehomogenize pmat ;$
   (  )    (  )
   $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $    $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
   $             [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $    $             [ [ (Dx) 1 (Dy) 1] ] ] ecarth.gb pmat ; $
   (  )    (  )
   $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] ] ] ecart.gb pmat ; $    $             [ [ (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) $    $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] ] ] ecart.gb pmat ; $    $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $
     $            [(degreeShift) [[0 1] [-3 1] ]]  ] ecarth.gb pmat ; $
   (  )    (  )
   (cf. gb, groebner, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )    (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
   (    ecart.dehomogenize, ecart.dehomogenizeH)    (    ecart.dehomogenize, ecart.dehomogenizeH)
   ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )    ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
   (                                                          define_ring )    (                                                          define_ring )
 ]] putUsages  ]] putUsages
   
 %% BUG:  " f weight init " works well in case of vectors with degree shift ?  
   
 /ecart.syz {  /ecart.syz {
   /arg1 set    /arg1 set
Line 382 
Line 584 
   (array a; array b;)    (array a; array b;)
   $b : [syzygy gb tmat input];  gb = tmat * input $    $b : [syzygy gb tmat input];  gb = tmat * input $
   $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 (Dy) 1] ] ] ecart.syz /ff set $    $             [ [ (Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.syz /ff set $
   $ ff 0 get ff 3 get mul pmat $    $ ff 0 get ff 3 get mul pmat $
   $ ff 2 get  ff 3 get mul [ff 1 get ] transpose sub pmat ; $    $ ff 2 get  ff 3 get mul [ff 1 get ] transpose sub pmat ; $
   (  )    (  )
     (To set the current ring to the ring in which ff belongs )
     (      ff getRing ring_def  )
   $Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $    $Example 2: [[ [(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] ] ] ecart.syz pmat ; $    $             [ [(Dx) 1 (Dy) 1] [ (x) -1 (y) -1] ]  [[0 1] [-3 1] ] ] ecart.syz pmat ; $
   (  )    (  )
   (cf. ecart.gb)    (cf. ecart.gb)
   (    /ecart.autoHomogenize 0 def )    (    /ecart.autoHomogenize 0 def )
Line 412 
Line 616 
   [(CurrentRingp) (KanGBmessage)] pushEnv    [(CurrentRingp) (KanGBmessage)] pushEnv
   [    [
     /aa arg1 def      /aa arg1 def
     aa isArray { } { ( << array >> gb) error } ifelse      aa isArray { } { ( << array >> ecartn.gb) error } ifelse
     /setarg 0 def      /setarg 0 def
     /wv 0 def      /wv 0 def
     /degreeShift 0 def      /degreeShift 0 def
     /opt [(weightedHomogenization) 1] def      /opt [(weightedHomogenization) 1] def
       ecart.setOpt.init
     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 450 
Line 655 
        /wv aa 2 get def         /wv aa 2 get def
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
   
     typev [ArrayP StringP ArrayP ArrayP] eq      typev [ArrayP StringP ArrayP ArrayP] eq
     {  /f aa 0 get def      {  /f aa 0 get def
        /v aa 1 get def         /v aa 1 get def
        /wv aa 2 get def         /wv aa 2 get def
        /degreeShift aa 3 get def         opt aa 3 get ecart.setOpt join /opt set
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
     typev [ArrayP ArrayP ArrayP ArrayP] eq      typev [ArrayP 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
        /wv aa 2 get def         /wv aa 2 get def
        /degreeShift aa 3 get def         opt aa 3 get ecart.setOpt join /opt set
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
   
Line 488 
Line 694 
       } {  } ifelse        } {  } ifelse
       wv isInteger {        wv isInteger {
         [v ring_of_differential_operators          [v ring_of_differential_operators
          [ v ecart.wv1 v ecart.wv2 ] weight_vector           [ v ecart.wv1 v ecart.wv2 ] ecart.weight_vector
          gb.characteristic           gb.characteristic
          opt           opt
         ] define_ring          ] define_ring
       }{        }{
        degreeShift isInteger {         degreeShift isInteger {
          [v ring_of_differential_operators           [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            gb.characteristic
           opt            opt
          ] define_ring           ] define_ring
   
        }{         }{
          [v ring_of_differential_operators           [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            gb.characteristic
           [(degreeShift) degreeShift] opt join            [(degreeShift) degreeShift] opt join
           ] define_ring            ] define_ring
Line 534 
Line 740 
        } ifelse         } ifelse
     } { } ifelse      } { } ifelse
   
       %%BUG: case of v is integer
       [v ecart.partialEcartGlobalVarX] ecart.checkOrder
   
     ecartn.begin      ecartn.begin
   
     ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse      ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
Line 559 
Line 768 
        gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set         gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
       } { /ans.gb gg 0 get def } ifelse        } { /ans.gb gg 0 get def } ifelse
       /ans [gg 2 get , ans.gb , gg 1 get , f ] def        /ans [gg 2 get , ans.gb , gg 1 get , f ] def
       ans pmat ;  %      ans pmat ;
     } {      } {
       wv isInteger {        wv isInteger {
         /ans [gg gg {init} map] def          /ans [gg gg {init} map] def
       }{        }{
         /ans [gg gg {wv 0 get weightv init} map] def         degreeShift isInteger {
            /ans [gg gg {wv 0 get weightv init} map] def
          } {
            /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
          } ifelse
       }ifelse        }ifelse
   
       %% Postprocess : recover the matrix expression.        %% Postprocess : recover the matrix expression.
Line 593 
Line 806 
   [/in-ecart.gb /aa /typev /setarg /f /v    [/in-ecart.gb /aa /typev /setarg /f /v
    /gg /wv /vec /ans /rr /mm     /gg /wv /vec /ans /rr /mm
    /degreeShift  /env2 /opt /ans.gb     /degreeShift  /env2 /opt /ans.gb
      /hdShift
      /ecart.useSugar
   ] pushVariables    ] pushVariables
   [(CurrentRingp) (KanGBmessage)] pushEnv    [(CurrentRingp) (KanGBmessage)] pushEnv
   [    [
     /aa arg1 def      /aa arg1 def
     aa isArray { } { ( << array >> gb) error } ifelse      aa isArray { } { ( << array >> ecartd.gb) error } ifelse
     /setarg 0 def      /setarg 0 def
     /wv 0 def      /wv 0 def
     /degreeShift 0 def      /degreeShift 0 def
       /hdShift 0 def
       /ecart.useSugar 0 def
     /opt [(weightedHomogenization) 1] def      /opt [(weightedHomogenization) 1] def
       ecart.setOpt.init
     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 635 
Line 853 
        /wv aa 2 get def         /wv aa 2 get def
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
   
     typev [ArrayP StringP ArrayP ArrayP] eq      typev [ArrayP StringP ArrayP ArrayP] eq
     {  /f aa 0 get def      {  /f aa 0 get def
        /v aa 1 get def         /v aa 1 get def
        /wv aa 2 get def         /wv aa 2 get def
        /degreeShift aa 3 get def         opt aa 3 get ecart.setOpt join /opt set
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
     typev [ArrayP ArrayP ArrayP ArrayP] eq      typev [ArrayP 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
        /wv aa 2 get def         /wv aa 2 get def
        /degreeShift aa 3 get def         opt aa 3 get ecart.setOpt join /opt set
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
   
Line 655 
Line 874 
     setarg { } { (ecart.gb : Argument mismatch) error } ifelse      setarg { } { (ecart.gb : Argument mismatch) error } ifelse
   
     [(KanGBmessage) ecart.gb.verbose ] system_variable      [(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      %%% Start of the preprocess
     v tag RingP eq {      v tag RingP eq {
Line 673 
Line 893 
         (Error in gb: Specify variables) error          (Error in gb: Specify variables) error
       } {  } ifelse        } {  } ifelse
       wv isInteger {        wv isInteger {
         (Give an weight vector such that x < 1) error          (Give a weight vector such that x < 1) error
       }{        }{
        degreeShift isInteger {         degreeShift isInteger {
          [v ring_of_differential_operators           [v ring_of_differential_operators
            wv weight_vector             wv ecart.weight_vector
           gb.characteristic            gb.characteristic
           opt            opt
          ] define_ring           ] define_ring
   
        }{         }{
          [v ring_of_differential_operators           [v ring_of_differential_operators
            wv weight_vector             wv ecart.weight_vector
           gb.characteristic            gb.characteristic
           [(degreeShift) degreeShift] opt join            [(degreeShift) degreeShift] opt join
           ] define_ring            ] define_ring
Line 712 
Line 932 
        } ifelse         } ifelse
     } { } ifelse      } { } ifelse
   
     ecart.begin      %%BUG: case of v is integer
     [(EcartAutomaticHomogenization) 1] system_variable      [v ecart.partialEcartGlobalVarX] ecart.checkOrder
   
     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse  
   
     f { {. ecart.dehomogenize} map} map /f set      ecartd.begin
     f ecart.homogenize01 /f set  
     f { { [[(H). (1).]] replace } map } map /f set  
   
     ecart.needSyz {      ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse
       [f [(needSyz)] gb.options join ] groebner /gg set  
     } {      hdShift tag 1 eq {
       [f gb.options] groebner 0 get /gg set       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 { { [[@@@.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 { { [[@@@.Hsymbol . (1).]] replace } map } 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      } ifelse
   
     ecart.needSyz {      ecart.needSyz {
Line 732 
Line 978 
        gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set         gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
       } { /ans.gb gg 0 get def } ifelse        } { /ans.gb gg 0 get def } ifelse
       /ans [gg 2 get , ans.gb , gg 1 get , f ] def        /ans [gg 2 get , ans.gb , gg 1 get , f ] def
       ans pmat ;  %      ans pmat ;
     } {      } {
       wv isInteger {        wv isInteger {
         /ans [gg gg {init} map] def          /ans [gg gg {init} map] def
       }{        }{
         /ans [gg gg {wv 0 get weightv init} map] def  %% Get the initial ideal
          degreeShift isInteger {
            /ans [gg gg {wv 0 get weightv init} map] def
          } {
            /ans [gg gg {[wv 0 get weightv degreeShift 0 get ] init} map] def
          } ifelse
       }ifelse        }ifelse
   
       %% Postprocess : recover the matrix expression.        %% Postprocess : recover the matrix expression.
Line 748 
Line 999 
       ifelse        ifelse
     } ifelse      } ifelse
   
     ecart.end      ecartd.end
     [(EcartAutomaticHomogenization) 0] system_variable  
   
       ans getRing (oxRingStructure) dc /ecartd.gb.oxRingStructure set
     %%      %%
     env1 restoreOptions  %% degreeShift changes "grade"      env1 restoreOptions  %% degreeShift changes "grade"
   
Line 762 
Line 1013 
 } def  } def
 (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet  (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
   
   /ecart.checkOrder {
     /arg1 set
     [/vv] pushVariables
     [
       /vv arg1 def
       vv length 1 eq {
         vv 0 get ecart.checkOrder.noGlobal /arg1 set
       }{
         vv ecart.checkOrder.global /arg1 set
       } ifelse
     ] pop
     popVariables
     /arg1
   } def
   /ecart.checkOrder.noGlobal {
     /arg1 set
     [/vv /tt /dd /n /i] pushVariables
     [
       /vv arg1 def
       vv isArray
       { } { [vv to_records pop] /vv set } ifelse
       vv {toString} map /vv set
       vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
       % Starting the checks.
       0 1 vv length 1 sub {
          /i set
          vv i get . dd i get . mul /tt set
          tt @@@.hsymbol . add init tt eq { }
          { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
       } for
   
       0 1 vv length 1 sub {
          /i set
          vv i get . /tt set
          tt (1). add init (1). eq { }
          { [vv i get ( is larger than 1 ) ] cat error} ifelse
       } for
       /arg1 1 def
     ] pop
     popVariables
     arg1
   } def
   
   /ecart.checkOrder.global {
     /arg1 set
     [/vv /vvGlobal /tt /dd /n /i] pushVariables
     [
       /vv arg1 def
       /vvGlobal vv 1 get def
       vv 0 get /vv set
       vv isArray
       { } { [vv to_records pop] /vv set } ifelse
       vv {toString} map /vv set
       vvGlobal isArray
       { } { [vvGlobal to_records pop] /vvGlobal set } ifelse
       vvGlobal {toString} map /vvGlobal set
   
       vv vvGlobal setMinus /vv set
       vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
       % Starting the checks.  Check for local variables.
       0 1 vv length 1 sub {
          /i set
          vv i get . dd i get . mul /tt set
          tt @@@.hsymbol . add init tt eq { }
          { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
       } for
   
       0 1 vv length 1 sub {
          /i set
          vv i get . /tt set
          tt (1). add init (1). eq { }
          { [vv i get ( is larger than 1 ) ] cat error} ifelse
       } for
   
       % check for global variables.
       0 1 vvGlobal length 1 sub {
          /i set
          vvGlobal i get . /tt set
          tt (1). add init (1). eq { [vvGlobal i get ( is smaller than 1 ) ] cat error }
          { } ifelse
       } for
   
   
       /arg1 1 def
     ] pop
     popVariables
     arg1
   } def
   [(ecart.checkOrder)
    [([v vGlobal] ecart.checkOrder bool checks if the given order is relevant)
     (for the ecart division.)
     (cf. ecartd.gb, ecart.gb, ecartn.gb)
    ]
   ] putUsages
   
   /ecart.wv_last {
     /arg1 set
     [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables
     [
       /vv arg1 def
       vv isArray
       { } { [vv to_records pop] /vv set } ifelse
       vv {toString} map /vv set
       vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
       vv {  -1 } map
       dd {   1 } map join /arg1 set
     ] pop
     popVariables
     arg1
   } def
   [(ecart.wv_last)
    [(v ecart.wv_last wt )
     (It returns the weight vector -1,-1,...-1; 1,1, ..., 1)
     (Use this weight vector as the last weight vector for ecart division)
     (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
       w-vectors to_int32 /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
        vv length 0 eq {
          /arg1 [ ] def
        } {
          /arg1 [wv1 wv2 ] def
        } ifelse
     ] 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
      /vvGlobal  /rng /noRecomputation
      ] 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 2 gt {    }
       { ([ii jj vv] ecartd.isSameIdeal_h) error } ifelse
       /ii aa 0 get def
       /jj aa 1 get def
       /vv aa 2 get def
   
       aa length 3 gt {
         /vvGlobal aa 3 get def
         vvGlobal isString { [vvGlobal to_records pop] /vvGlobal set }
         { vvGlobal { toString } map /vvGlobal set } ifelse
       } { /vvGlobal [ ] def } ifelse
   
       ii length 0 eq jj length 0 eq and
       { /ans 1 def /LLL.ecartd.isSame_h goto } {  } ifelse
   
       [vv vvGlobal] ecart.stdBlockOrder /wv set
       vvGlobal length 0 eq {
         /rng [vv wv ] def
       }{
         /rng [vv wv [(partialEcartGlobalVarX) vvGlobal]] def
       } ifelse
   
       aa (noRecomputation) getNode /noRecomputation set
       noRecomputation tag 0 eq { /noRecomputation 0 def } {
         /noRecomputation 1 def
       } ifelse
       noRecomputation {
         [ii] /iigg set  [jj] /jjgg set
       } {
         /save-ecart.autoHomogenize ecart.autoHomogenize def
         /ecart.autoHomogenize 0 def
         [ii] rng join  ecartd.gb  /iigg set
         [jj] rng join ecartd.gb  /jjgg set
         save-ecart.autoHomogenize /ecart.autoHomogenize set
       } ifelse
   
       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.
       /ecartd.isSameIdeal_h.gb [iigg jjgg] def
   
       /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
       /ecartd.isSameIdeal_h.failed [ ] def
       iigg length /n set
       0 1 n 1 sub {
         /k set
         iigg  k get
         [jjgg] ecartd.reduction 0 get
         (0). eq not {
           /ecartd.isSameIdeal_h.failed [ iigg k get jjgg] def
           /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] ecartd.reduction 0 get
         (0). eq not {
            /ecartd.isSameIdeal_h.failed [ iigg jjgg k get] def
            /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_0).$
    $ii and jj are re-parsed.$
    $Example 1: [ [((1-x) Dx + h)]  [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $
    ( )
    ([ii jj vv vvGlobal] ecartd.isSameIdeal_h bool)
    $ Ideals are compared in Q(x')_0 [x''] <Dx',Dx'',h> $
    (  where x'' is specified in vvGlobal.)
    (cf. partialEcartGlobalVarX option)
    ( )
    $Option list: [(noRecomputation) 1] $
    $Example 2: [ [((1-x) Dx + h)]  [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $
    $    ecartd.isSameIdeal_h.gb 0 get /ii set $
    $    ecartd.isSameIdeal_h.gb 1 get /jj set $
    $   [ ii jj (x) [[(noRecomputation) 1]] ] ecartd.isSameIdeal_h $
   ]] putUsages
   
   /ecartd.isSameIdeal_noh {
     /arg1 set
     [/aa /ii /jj /iigg /jjgg /vv /ans /k /n /f
      /ecartd.isSameIdeal_h.opt
      /save-ecart.autoHomogenize  /wv /save-ecart.message.quiet
      /vvGlobal  /rng /noRecomputation
      ] pushVariables
     [(CurrentRingp) (Homogenize_vec)] pushEnv
     [
       /aa arg1 def
       gb.verbose { (Getting in ecartd.isSameIdeal_noh) message } { } ifelse
       %% comparison of hilbert series has not yet been implemented.
       /save-ecart.message.quiet ecart.message.quiet def
       aa length 2 gt {    }
       { ([ii jj vv] ecartd.isSameIdeal_noh) error } ifelse
       /ii aa 0 get def
       /jj aa 1 get def
       /vv aa 2 get def
   
       aa length 3 gt {
         /vvGlobal aa 3 get def
         vvGlobal isString { [vvGlobal to_records pop] /vvGlobal set }
         { vvGlobal { toString } map /vvGlobal set } ifelse
       } { /vvGlobal [ ] def } ifelse
   
       ii length 0 eq jj length 0 eq and
       { /ans 1 def /LLL.ecartd.isSame_h goto } {  } ifelse
   
       [vv vvGlobal] ecart.stdBlockOrder /wv set
       vvGlobal length 0 eq {
         /rng [vv wv ] def
       }{
         /rng [vv wv [(partialEcartGlobalVarX) vvGlobal]] def
       } ifelse
   
       aa (noRecomputation) getNode /noRecomputation set
       noRecomputation tag 0 eq { /noRecomputation 0 def } {
         /noRecomputation 1 def
       } ifelse
       noRecomputation {
         [ii] /iigg set  [jj] /jjgg set
       } {
         /save-ecart.autoHomogenize ecart.autoHomogenize def
         /ecart.autoHomogenize 0 def
         [ii] rng join  ecartd.gb  /iigg set
         [jj] rng join ecartd.gb  /jjgg set
         save-ecart.autoHomogenize /ecart.autoHomogenize set
       } ifelse
   
       iigg getRing ring_def
   
       getOptions /ecartd.isSameIdeal_h.opt set
   
       /ans 1 def
       iigg 0 get /iigg set
       jjgg 0 get /jjgg set
       /ecartd.isSameIdeal_noh.gb [iigg jjgg] def
       %%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
       /ecartd.isSameIdeal_noh.failed [ ] def
       iigg length /n set
       0 1 n 1 sub {
         /k set
         iigg  k get
         [jjgg] ecartd.reduction_noh 0 get
         (0). eq not {
            /ecartd.isSameIdeal_noh.failed [ iigg k get jjgg] def
            /ans 0 def /LLL.ecartd.isSame_noh 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] ecartd.reduction_noh 0 get
         (0). eq not {
           /ecartd.isSameIdeal_noh.failed [ iigg jjgg k get] def
           /ans 0 def /LLL.ecartd.isSame_noh goto
         } {  } ifelse
         gb.verbose { (o) messagen } {  } ifelse
       } for
       /LLL.ecartd.isSame_noh
       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_noh)
   [([ii jj vv] ecartd.isSameIdeal_noh bool)
    (ii, jj : ideal, vv : variables)
    $The ideals ii and jj will be compared in the ring D_0.$
    $ii and jj are re-parsed.$
    $Example 1: [ [((1-x) Dx + 1)]  [((1-x)^2 Dx + (1-x))] (x)] ecartd.isSameIdeal_noh $
    ([ii jj vv vvGlobal] ecartd.isSameIdeal_noh bool)
    $ Ideals are compared in Q(x')_0 [x''] <Dx',Dx''> $
    (  where x'' is specified in vvGlobal.)
    (cf. partialEcartGlobalVarX option, ecartd.reduction_noh, ecartd.isSameIdeal_h)
    $Example 2: [ [(1-z) (1-x-y-z)]  [(1-x) (1-y)] (x,y,z) [(x)]] $
    $            ecartd.isSameIdeal_noh $
    $Option list: [(noRecomputation) 1] $
    $Example 2': [ [(1-z) (1-x-y-z)]  [(1-x) (1-y)] (x,y,z) [(x)]] ecartd.isSameIdeal_noh$
    $    ecartd.isSameIdeal_noh.gb 0 get /ii set $
    $    ecartd.isSameIdeal_noh.gb 1 get /jj set $
    $   [ ii jj (x) [[(noRecomputation) 1]] ] ecartd.isSameIdeal_noh $
   ]] putUsages
   (ecartd.isSameIdeal_noh ) messagen-quiet
   
   /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
   
   % Example: [(x,y,z) (x)] ecart.stdBlockOrder
   %            [[(Dy) 1 (Dz) 1] [(y) -1 (z) -1 (Dy) 1 (Dz) 1] [(x) 1 (Dx) 1]]
   % Example: [(x,y,z) [ ]] ecart.stdBlockOrder
   /ecart.stdBlockOrder {
     /arg1 set
     [/vv /vvGlobal /tt /dd /rr] pushVariables
     [
       /vv arg1 0 get def
       /vvGlobal arg1 1 get def
       {
         vv isArray
         { } { [vv to_records pop] /vv set } ifelse
         vv {toString} map /vv set
         vvGlobal isArray
         { } { [vvGlobal to_records pop] /vvGlobal set } ifelse
         vvGlobal {toString} map /vvGlobal set
   
         vvGlobal length 0 eq {
            vv ecart.stdOrder /rr set exit
         } {  } ifelse
   
         vv vvGlobal setMinus /vv set
         vv ecart.stdOrder /rr set
   
         vvGlobal { /tt set [@@@.Dsymbol tt] cat } map /dd set
         [[
            0 1 vvGlobal length 1 sub {
              /tt set
              vvGlobal tt get , 1
            } for
            0 1 dd length 1 sub {
              /tt set
              dd tt get , 1
            } for
         ]] rr join /rr set
         exit
       } loop
       /arg1 rr def
     ] pop
     popVariables
     arg1
   } def
   
 ( ) message-quiet  ( ) message-quiet
   
   /ecart_loaded 1 def
   
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.39
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>