[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.5 and 1.20

version 1.5, 2003/08/04 11:42:42 version 1.20, 2004/05/04 08:03:30
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.4 2003/07/30 09:00:51 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.19 2004/04/29 12:04:45 takayama Exp $
 %[(parse) (hol.sm1) pushfile] extension  %[(parse) (hol.sm1) pushfile] extension
 %[(parse) (appell.sm1) pushfile] extension  %[(parse) (appell.sm1) pushfile] extension
   
Line 7 
Line 7 
 /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.begin {
     ecart.begin
     [(EcartAutomaticHomogenization) 1] system_variable
   } def
   /ecartd.end {
     ecart.end
     [(EcartAutomaticHomogenization) 0] system_variable
   } def
   
   /ecart.setOpt {
     /arg1 set
     [/in-ecart.setOpt /opt /i /n /ans] pushVariables
     [
       /opt arg1 def
       /ans [ ] def
       /n opt length def
       0 2 n 1 sub {
         /i set
         opt i get tag StringP eq not {
            (ecart.setOpt : [keyword value keyword value ....] ) error
         } {  } ifelse
        {  % start of the loop
   % Global:  degreeShift
         opt i get (degreeShift) eq {
           /degreeShift opt i 1 add get def
           exit
         } {  } ifelse
   % Global:  hdShift
         opt i get (startingShift) eq {
           /hdShift opt i 1 add get def
           exit
         } {  } ifelse
   % Global:  hdShift
         opt i get (noAutoHomogenize) eq {
           /hdShift -1 def
           exit
         } {  } ifelse
   % Global:  ecart.useSugar
         opt i get (sugar) eq {
           /ecart.useSugar opt i 1 add get def
           exit
         } {  } ifelse
   
         ans [opt i get opt i 1 add get ]  append /ans set
         exit
        } loop
       } for
   
       ecart.gb.verbose {
         (ecart.setOpt:) message
         (degreeShift=) messagen degreeShift message
         $hdShift(startingShift)=$ messagen hdShift message
         (sugar=) messagen ecart.useSugar message
         (Other options=) messagen ans message
       } {  } ifelse
   
       /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   
 /ecart.dehomogenize {  /ecart.dehomogenize {
  /arg1 set   /arg1 set
  [/in.ecart.dehomogenize /ll /rr] pushVariables   [/in.ecart.dehomogenize /ll /rr] pushVariables
Line 61 
Line 122 
   
 /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 146 
   (    [(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 133 
Line 209 
   arg1    arg1
 } def  } def
   
   /ecart.gb {ecartd.gb}  def
   
   [(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 $
     ( )
     $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 ; $
     (  )
     (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
   
 /ecart.gb.verbose 1 def  /ecart.gb.verbose 1 def
 /ecart.gb {  %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
     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 316 
        /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 356 
       } {  } 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 393 
     %%% 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 271 
Line 410 
     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 319 
Line 481 
   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 385 
Line 548 
   (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 415 
Line 580 
   [(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
Line 453 
Line 618 
        /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 491 
Line 657 
       } {  } 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 565 
Line 731 
        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 599 
Line 769 
   [/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
     aa { tag } map /typev set      aa { tag } map /typev set
     typev [ ArrayP ] eq      typev [ ArrayP ] eq
Line 641 
Line 815 
        /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 683 
Line 858 
       }{        }{
        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 721 
Line 896 
     %%BUG: case of v is integer      %%BUG: case of v is integer
     v ecart.checkOrder      v ecart.checkOrder
   
     ecart.begin      ecartd.begin
     [(EcartAutomaticHomogenization) 1] system_variable  
   
     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse      ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
   
     f { {. ecart.dehomogenize} map} map /f set      hdShift tag 1 eq {
     f ecart.homogenize01 /f set       ecart.autoHomogenize not hdShift -1 eq  or {
     f { { [[(H). (1).]] replace } map } map /f set  % 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) message
          f { {. ecart.dehomogenize} map} map /f set
          f ecart.homogenize01 /f set
          f { { [[(H). (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
      }ifelse
   
     ecart.needSyz {      ecart.useSugar {
       [f [(needSyz)] gb.options join ] groebner /gg set        ecart.needSyz {
     } {          [f [(needSyz)] gb.options join ] groebner_sugar /gg set
       [f gb.options] groebner 0 get /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 741 
Line 938 
        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 757 
Line 959 
       ifelse        ifelse
     } ifelse      } ifelse
   
     ecart.end      ecartd.end
     [(EcartAutomaticHomogenization) 0] system_variable  
   
     %%      %%
     env1 restoreOptions  %% degreeShift changes "grade"      env1 restoreOptions  %% degreeShift changes "grade"
Line 792 
Line 993 
        /i set         /i set
        vv i get . /tt set         vv i get . /tt set
        tt (1). add init (1). eq { }         tt (1). add init (1). eq { }
        { [vv i get ( is larger than 1) vv i get] cat error} ifelse         { [vv i get ( is larger than 1 ) ] cat error} ifelse
     } for      } for
     /arg1 1 def      /arg1 1 def
   ] pop    ] pop
Line 828 
Line 1029 
   (if ecart.checkOrder complains about the order given.)    (if ecart.checkOrder complains about the order given.)
  ]   ]
 ] putUsages  ] putUsages
   
   /ecart.mimimalBase.test {
    [
       [    (0) , (-2*Dx) , (2*t) , (y) , (x^2) ]
       [    (3*t ) , ( -3*Dy ) , ( 0 ) , ( -x ) , ( -y) ]
       [    (3*y ) , ( 6*Dt ) , ( 2*x ) , ( 0 ) , ( 1) ]
       [    (-3*x^2 ) , ( 0 ) , ( -2*y ) , ( 1 ) , ( 0 )]
       [    (Dx ) , ( 0 ) , ( -Dy ) , ( Dt ) , ( 0) ]
       [  (0 ) , ( 0 ) , ( 6*t*Dt+2*x*Dx+3*y*Dy+8*h ) , ( 0 ) , ( 3*x^2*Dt+Dx) ]
       [  (6*t*Dx ) , ( 0 ) , ( -6*t*Dy ) , ( -2*x*Dx-3*y*Dy-5*h ) , ( -2*y*Dx-3*x^2*Dy) ]
       [  (6*t*Dt+3*y*Dy+9*h ) , ( 0 ) , ( 2*x*Dy ) , ( -2*x*Dt ) , ( -2*y*Dt+Dy) ]
     ]
     /ff set
   
     /nmshift [ [1 0 1 1 1] [1 0 1 0 0] ] def
     /shift [ [1 0 1 0 0] ] def
     /weight [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] def
   
     [ff (t,x,y) weight [(degreeShift) shift (startingShift) nmshift]] ecart.minimalBase
   
   
   }  def
   /test {ecart.mimimalBase.test} def
   
   %(x,y) ==> [(Dx) 1 (Dy) 1 (h) 1]
   /ecart.minimalBase.D1 {
     /arg1 set
     [/in-ecart.minimalBase.D1  /tt /v]  pushVariables
     [
       /v arg1 def
       [ v to_records pop] /v set
       v { /tt set [@@@.Dsymbol tt] cat 1 } map /v set
       v [(h) 1] join /arg1 set
     ] pop
     popVariables
     arg1
   } def
   
   % [0 1 2] 1 ecart.removeElem [0 2]
   /ecart.removeElem {
     /arg2 set
     /arg1 set
     [/in-ecart.removeElem /v /q /i /ans /j] pushVariables
     [
       /v arg1 def
       /q arg2 def
       /ans v length 1 sub newVector def
       /j 0 def
       0 1 v length 1 sub {
         /i set
         i q eq not {
           ans j  v i get put
           /j j 1 add def
         } {  } ifelse
       } for
     ] pop
     popVariables
     arg1
   } def
   
   /ecart.isZeroRow {
     /arg1 set
     [/in-ecart.isZeroRow /aa /i /n /yes] pushVariables
     [
        /aa arg1 def
        aa length /n set
        /yes 1 def
        0 1 n 1 sub {
          /i set
          aa i get (0). eq {
          } {
            /yes 0 def
          } ifelse
        } for
        /arg1 yes def
     ] pop
     popVariables
     arg1
   } def
   
   /ecart.removeZeroRow {
     /arg1 set
     [/in-ecart.removeZeroRow /aa /i /n /ans] pushVariables
     [
        /aa arg1 def
        aa length /n set
        /ans [ ] def
        0 1 n 1 sub {
          /i set
          aa i get ecart.isZeroRow {
          } {
            ans aa i get append /ans set
          } ifelse
        } for
        /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   
   /ecart.gen_input {
     /arg1 set
     [/in-ecart.gen_input  /aa /typev /setarg /f /v
      /gg /wv /vec /ans /rr /mm
      /degreeShift  /env2 /opt /ss0
      /hdShift /ff
      ] pushVariables
     [
       /aa arg1 def
       aa isArray { } { ( << array >> ecart.gen_input) error } ifelse
       /setarg 0 def
       /wv 0 def
       /degreeShift 0 def
       /hdShift 0 def
       /opt [ ] def
       aa { tag } map /typev set
       typev [ArrayP StringP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /wv aa 2 get def
          opt aa 3 get ecart.setOpt join /opt set
          /setarg 1 def
       } { } ifelse
       typev [ArrayP ArrayP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get from_records def
          /wv aa 2 get def
          opt aa 3 get ecart.setOpt join /opt set
          /setarg 1 def
       } { } ifelse
       setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse
   
       [(KanGBmessage) ecart.gb.verbose ] system_variable
   
       f 0 get tag ArrayP eq {  }
       {  f { /tt set [ tt ] } map /f set } ifelse
   
       [f v wv [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join]
       ecart.gb /ff set
       ff getRing ring_def
   
       ff 0 get { {toString } map } map /ff set
   
       [ff v wv
         [(degreeShift) degreeShift (startingShift) [hdShift 0 get degreeShift 0 get]] opt join
       ] /arg1 set
     ] pop
     popVariables
     arg1
   } def
   [(ecart.gen_input)
   [$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]] ]  ecart.gen_input $
    $               [gg_h v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] $
    (It generates the input for the minimal filtered free resolution.)
    (Current ring is changed to the ring of gg_h.)
    (cf. ecart.minimalBase)
     $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
     $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
     $          [(degreeShift) [ [0] ] $
     $           (startingShift) [ [0] [0] ]] ] ecart.gen_input /gg set gg pmat $
   ]] putUsages
   
   
   [(ecart.minimalBase)
   [$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalBase $
    (  [mbase gr_of_mbase )
    $     [syz v ecart.weight_vector [(degreeShift) new_uv_shift_m (startingShift) [new_D_shift_n new_uv_shift_m]]]$
    (     gr_of_syz ])
    (mbase is the minimal generators of ff in D^h in the sense of filtered minimal)
    (generators.)
     $Example: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
     $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
     $           [(degreeShift) [ [0] ] $
     $            (startingShift) [ [0] [0] ] ] ] ecart.gen_input /gg0 set $
     $         gg0 ecart.minimalBase /ss0 set $
     $         ss0 2 get ecart.minimalBase /ss1 set $
     $         ss1 2 get ecart.minimalBase /ss2 set $
     $     (---------  minimal filtered resolution -------) message $
     $     ss0 0 get pmat ss1 0 get pmat ss2 0 get pmat  $
     $     (---------  degree shift (n,m) n:D-shift m:uv-shift  -------) message $
     $     gg0       3 get 3 get message $
     $     ss0 2 get 3 get 3 get message $
     $     ss1 2 get 3 get 3 get message $
     $     ss2 2 get 3 get 3 get message ; $
   
   ]] putUsages
   /ecart.minimalBase {
     /arg1 set
     [/in-ecart.minimalBase /ai1 /ai  /aa /typev /setarg /f /v
      /gg /wv /vec /ans /rr /mm
      /degreeShift  /env2 /opt /ss0
      /hdShift
       /degreeShiftD /degreeShiftUV
       /degreeShiftDnew /degreeShiftUVnew
       /tt
       /ai1_gr  /ai_gr
       /s /r /p /q /i /j /k
        /ai1_new /ai_new /ai_new2
      ] pushVariables
     [
       /aa arg1 def
       aa isArray { } { ( << array >> ecart.minimalBase) error } ifelse
       /setarg 0 def
       /wv 0 def
       /degreeShift 0 def
       /hdShift 0 def
       /opt [ ] def
       aa { tag } map /typev set
       typev [ArrayP StringP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /wv aa 2 get def
          opt aa 3 get ecart.setOpt join /opt set
          /setarg 1 def
       } { } ifelse
       typev [ArrayP ArrayP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get from_records def
          /wv aa 2 get def
          opt aa 3 get ecart.setOpt join /opt set
          /setarg 1 def
       } { } ifelse
       setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse
   
       [(KanGBmessage) ecart.gb.verbose ] system_variable
   
       f 0 get tag ArrayP eq {  }
       {  f { /tt set [ tt ] } map /f set } ifelse
       [f v wv [(degreeShift) degreeShift (noAutoHomogenize) 1] opt join] ecart.syz /ss0 set
   
       ss0 getRing ring_def
       /degreeShiftD  hdShift 0 get def
       /degreeShiftUV hdShift 1 get def
   %      -- ai --> D^r -- ai1 --> D^rr
       /ai1  f  { { . } map } map def
       /ai  ss0 0 get def
   
      {
       /degreeShiftUVnew
          ai1 { [ << wv 0 get weightv >> degreeShiftUV ] ord_ws_all  } map
       def
       (degreeShiftUVnew=) messagen degreeShiftUVnew message
   
       /degreeShiftDnew
          ai1 { [ << v ecart.minimalBase.D1 weightv >> degreeShiftD ]  ord_ws_all}
               map
       def
       (degreeShiftDnew=) messagen degreeShiftDnew message
   
       ai {[wv 0 get weightv  degreeShiftUVnew] init} map /ai_gr set
   
   %C  Note 2003.8.26
   
       ai [ ] eq {
         exit
       } {  } ifelse
   
       /s ai length def
       /r ai 0 get length def
   
       /itIsMinimal 1 def
       0 1 s 1 sub {
         /i set
         0 1 r 1 sub {
           /j set
   
           [(isConstantAll) ai_gr i get j get] gbext
           ai_gr i get j get (0). eq not and
           {
              /itIsMinimal 0 def
              /p i def /q j def
           } {  } ifelse
         } for
       } for
   
   
       itIsMinimal { exit } { } ifelse
   
   %    construct new ai and ai1 (A_i and A_{i-1})
        /ai1_new  r 1 sub newVector def
        /j 0 def
        0 1 r 1 sub {
          /i set
          i q eq not {
             ai1_new j ai1 i get put
             /j  j 1 add def
          } { } ifelse
        } for
   
        /ai_new [s  r] newMatrix def
        0 1 s 1 sub {
          /j set
          0 1 r 1 sub {
            /k set
            ai_new [j k]
               << ai p get q get >> << ai j get k get >> mul
               << ai j get q get >> << ai p get k get >> mul
               sub
            put
          } for
        } for
   
   % remove 0 column
        /ai_new2 [s 1 sub r 1 sub] newMatrix def
        /j 0 def
        0 1 s 1 sub {
          /i set
          i p eq not {
             ai_new2 j << ai_new i get q ecart.removeElem >> put
             /j  j 1 add def
          } { } ifelse
        } for
   
   %   ( ) error
        /ai1 ai1_new  def
        /ai ai_new2  ecart.removeZeroRow def
   
      } loop
      /arg1
        [  ai1
           ai1 {[wv 0 get weightv  degreeShift 0 get] init} map %Getting gr of A_{i-1}
           [ai v wv [(degreeShift) [degreeShiftUVnew] (startingShift) [degreeShiftDnew degreeShiftUVnew]]]
           ai {[wv 0 get weightv  degreeShiftUVnew] init} map %Getting gr of A_i
        ]
      def
     ] pop
     popVariables
     arg1
   } def
   
   /ecart.minimalResol {
     /arg1 set
     [/in-ecart.minimalResol /aa /ans /gg0 /ansds /ans_gr /c] pushVariables
     [
        /aa arg1 def
        /ans [ ] def
        /ansds [ ] def
        /ans_gr [ ] def
        /c 0 def
   
       (---- ecart.gen_input ----) message
        aa ecart.gen_input /gg0 set
        ansds gg0 3 get 3 get append /ansds set
        (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set
        gg0 ecart.minimalBase /ssi set
        ansds ssi 2 get 3 get 3 get append /ansds set
        ans ssi 0 get  append /ans set
        ans_gr ssi 1 get append /ans_gr set
        {
          ssi 3 get [ ] eq { exit } { } ifelse
          (---- ecart.minimalBase --- Degree ) messagen c message c 1 add /c set
          ssi 2 get ecart.minimalBase /ssi_new set
          ans ssi_new 0 get append /ans set
          ansds ssi_new 2 get 3 get 3 get append /ansds set
          ans_gr ssi_new 1 get append /ans_gr set
          /ssi ssi_new def
        } loop
        /arg1 [ans ansds ans_gr] def
     ] pop
     popVariables
     arg1
   } def
   
   (ecart.minimalResol) message
   
   [(ecart.minimalResol)
   [
   
    $[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalResol $
    (  [resol degree_shifts gr_of_resol_by_uv_shift_m] )
     $Example1: [ [(t-x^3+y^2) (Dx+ 3 x^2 Dt) (Dy - 2 y Dt)] (t,x,y) $
     $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
     $           [(degreeShift) [ [0] ] $
     $            (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $
   ]] putUsages
   
   %% for ecart.weight_vector
   /ecart.eliminationOrderTemplate  { %% esize >= 1
   %% if esize == 0, it returns reverse lexicographic order.
   %%  m esize eliminationOrderTemplate mat
     /arg2 set /arg1 set
     [/m  /esize /m1 /m2 /k /om /omtmp] pushVariables
     [
       /m arg1 def  /esize arg2 def
       /m1 m esize sub 1 sub def
       /m2 esize 1 sub def
        [esize 0 gt
         {
          [1 1 esize
           { pop 1 } for
           esize 1 << m 1 sub >>
           { pop 0 } for
          ]  %% 1st vector
         }
         { } ifelse
   
         m esize gt
         {
          [1 1  esize
           { pop 0 } for
           esize 1 << m 1 sub >>
           { pop 1 } for
          ]  %% 2nd vector
         }
         { } ifelse
   
         m1 0 gt
         {
            m 1 sub -1 << m m1 sub >>
            {
                 /k set
                 m  k  evec_neg
            } for
         }
         { } ifelse
   
         m2 0 gt
         {
            << esize 1 sub >> -1 1
            {
                 /k set
                 m  k  evec_neg
            } for
         }
         { } ifelse
   
       ] /om set
        om [ 0 << m 2 idiv >> 1 sub] 0 put
        om [ << m 2 idiv >> 1 add  << m 2 idiv >> 1 sub] 0 put
       /arg1 om def
      ] pop
      popVariables
      arg1
   } def
   
   %note  2003.09.29
   /ecart.elimination_order {
   %% [x-list d-list params]  (x,y,z) elimination_order
   %%  vars                    evars
   %% [x-list d-list params order]
     /arg2 set  /arg1 set
     [/vars /evars /univ /order /perm /univ0 /compl /m /omtmp] pushVariables
     /vars arg1 def /evars [arg2 to_records pop] def
     [
       /univ vars 0 get reverse
             vars 1 get reverse join
       def
   
       << univ length 2 sub >>
       << evars length >>
       ecart.eliminationOrderTemplate /order set
   
       [[1]] order oplus [[1]] oplus /order set
   
       /m order length 2 sub def
       /omtmp [1 1 m 2 add { pop 0 } for ] def
       omtmp << m 2 idiv >> 1 put
       order  omtmp append /order set
       % order pmat
   
       /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y,h] --> [x,y,h]
   
       /compl
         [univ 0 get] evars join evars univ0 complement join
       def
       compl univ
       getPerm /perm set
       %%perm :: univ :: compl ::
   
       order perm permuteOrderMatrix /order set
   
   
       vars [order] join /arg1 set
     ] pop
     popVariables
     arg1
   } def
   
   /ecart.define_ring {
      /arg1 set
      [/rp /param /foo] pushVariables
      [/rp arg1 def
   
        rp 0 get length 3 eq {
          rp 0  [rp 0 get 0 get rp 0 get 1 get rp 0 get 2 get ]
                ( ) ecart.elimination_order put
        } { } ifelse
   
       [
         rp 0 get 0 get             %% x-list
         rp 0 get 1 get             %% d-list
         rp 0 get 2 get /param set
         param 0 << rp 1 get >> put %% << rp 1 get >> is 17 in the example.
         param                      %% parameters.
         rp 0 get 3 get             %% order matrix.
         rp length 2 eq
         { [  ] }                   %% null optional argument.
         { rp 2 get }
         ifelse
       ]  /foo set
       foo aload pop set_up_ring@
      ] pop
      popVariables
      [(CurrentRingp)] system_variable
   } def
   /ecart.weight_vector {
     /arg2 set  /arg1 set
     [/vars /univ /w-vectors /www /k /order1 /order2] pushVariables
     /vars arg1 def /w-vectors arg2 def
     [
       /univ vars 0 get reverse
             vars 1 get reverse join
       def
       [
       0 1 << w-vectors length 1 sub >>
       {
         /k set
         univ w-vectors k get w_to_vec
       } for
       ] /order1 set
       %% order1 ::
   
       vars ( ) ecart.elimination_order 3 get /order2 set
       vars [ << order1 order2 join >> ] join /arg1 set
     ] pop
     popVariables
     arg1
   } def
   
   %% end of for ecart.define_ring
   
   /ecartd.reduction {
     /arg2 set
     /arg1 set
     [/in-ecartd.reduction /gbasis /flist /ans /gbasis2] pushVariables
     [(CurrentRingp) (KanGBmessage)] pushEnv
     [
        /gbasis arg2  def
        /flist  arg1  def
        gbasis 0 get tag 6 eq { }
        { (ecartd.reduction: the second argument must be a list of lists) error }
        ifelse
   
        gbasis length 1 eq {
          gbasis getRing ring_def
          /gbasis2 gbasis 0 get def
        } {
          [ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def
          /gbasis2 gbasis 0 get ,,, def
        } ifelse
        ecartd.begin
   
        flist ,,, /flist set
        flist tag 6 eq {
          flist { gbasis2 reduction } map /ans set
        }{
          flist gbasis2 reduction /ans set
        } ifelse
        /arg1 ans def
   
        ecartd.end
     ] pop
     popEnv
     popVariables
     arg1
   } def
   
   /ecartd.reduction.test {
     [
       [( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )]
       (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]]
     ecartd.gb /gg set
   
     (Dx) [gg 0 get] ecartd.reduction /gg2 set
     gg2 message
     (-----------------------------) message
   
     [(Dx) (Dy) (Dx+x*Dy)] [gg 0 get] ecartd.reduction /gg3 set
     gg3 message
   
     (-----------------------------) message
       [[( 2*(1-x-y) Dx + h ) ( 2*(1-x-y) Dy + h )]
         (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set
      (Dx) ggg ecartd.reduction /gg4 set
      gg4 message
     [gg2  gg3 gg4]
   } def
   
   /ecarth.reduction {
     /arg2 set
     /arg1 set
     [/in-ecarth.reduction /gbasis /flist /ans /gbasis2] pushVariables
     [(CurrentRingp) (KanGBmessage)] pushEnv
     [
        /gbasis arg2  def
        /flist  arg1  def
        gbasis 0 get tag 6 eq { }
        { (ecarth.reduction: the second argument must be a list of lists) error }
        ifelse
   
        gbasis length 1 eq {
          gbasis getRing ring_def
          /gbasis2 gbasis 0 get def
        } {
          [ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def
          /gbasis2 gbasis 0 get ,,, def
        } ifelse
        ecarth.begin
   
        flist ,,, /flist set
        flist tag 6 eq {
          flist { gbasis2 reduction } map /ans set
        }{
          flist gbasis2 reduction /ans set
        } ifelse
        /arg1 ans def
   
        ecarth.end
     ] pop
     popEnv
     popVariables
     arg1
   } def
   
   [(ecartd.reduction)
   [ (f basis ecartd.reduction r)
     (f is reduced by basis by the tangent cone algorithm.)
     (The first element of basis <g_1,...,g_m> must be a standard basis.)
     (r is the return value format of reduction.)
     (r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i)
     (basis is given in the argument format of ecartd.gb.)
     (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
   
   
 ( ) message-quiet  ( ) message-quiet
   
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.20
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>