[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.13 and 1.19

version 1.13, 2003/08/26 12:46:03 version 1.19, 2004/04/29 12:04:45
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.12 2003/08/26 05:06:00 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.18 2003/09/30 00:06:56 takayama Exp $
 %[(parse) (hol.sm1) pushfile] extension  %[(parse) (hol.sm1) pushfile] extension
 %[(parse) (appell.sm1) pushfile] extension  %[(parse) (appell.sm1) pushfile] extension
   
Line 16 
Line 16 
   [(EcartAutomaticHomogenization) 0] system_variable    [(EcartAutomaticHomogenization) 0] system_variable
 } def  } 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 93 
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  )
   (   [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]])    (   [(weightedHomogenization) 1 (degreeShift) [[0 0 0]]])
   (  ] define_ring)    (  ] define_ring)
Line 171 
Line 224 
   (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 for the ring. )    (                array ds; ds is the degree shift for the ring. )
   (a : [f v w ds hdShift]; array f; string v; array of array w; w is the weight matirx.)    $a : [f v w [(degreeShift) ds (startingShift) hdShift]]; array f; string v; array of array w; w is the weight matirx.$
   (        array ds; ds is the degree shift for the ring. )    (        array ds; ds is the degree shift for the ring. )
   (        array hsShift is the degree shift for the homogenization. cf.homogenize )    (        array hsShift is the degree shift for the homogenization. cf.homogenize )
   $a : [f v w ds (no)]; array f; string v; array of array w; w is the weight matirx.$    $a : [f v w [(degreeShift) ds (noAutoHomogenize) 1]]; array f; string v; array of array w; w is the weight matirx.$
   (       No automatic homogenization.)    (       No automatic homogenization.)
     $  [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $
   (  )    (  )
   $cf. ecarth.gb (homogenized),  ecartd.gb (dehomogenize) $    $cf. ecarth.gb (homogenized),  ecartd.gb (dehomogenize), ecartd.reduction $
   ( )    ( )
   $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 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $    $             [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
Line 198 
Line 252 
   (   This example will cause an error on order.)    (   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) $    $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
   $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  [[0 1] [-3 1] ] ] ecart.gb pmat ; $    $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  $
     $             [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $
   (  )    (  )
   (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )    (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
   (    ecart.dehomogenize, ecart.dehomogenizeH)    (    ecart.dehomogenize, ecart.dehomogenizeH)
Line 216 
Line 271 
    /gg /wv /vec /ans /rr /mm     /gg /wv /vec /ans /rr /mm
    /degreeShift  /env2 /opt /ans.gb     /degreeShift  /env2 /opt /ans.gb
    /hdShift     /hdShift
      /ecart.useSugar
   ] pushVariables    ] pushVariables
   [(CurrentRingp) (KanGBmessage)] pushEnv    [(CurrentRingp) (KanGBmessage)] pushEnv
   [    [
Line 226 
Line 282 
     /degreeShift 0 def      /degreeShift 0 def
     /hdShift 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 259 
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 StringP ArrayP ArrayP ArrayP] eq  
     {  /f aa 0 get def  
        /v aa 1 get def  
        /wv aa 2 get def  
        /degreeShift aa 3 get def  
        /hdShift aa 4 get def  
        /setarg 1 def  
     } { } ifelse  
     typev [ArrayP ArrayP ArrayP ArrayP] 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
     typev [ArrayP ArrayP ArrayP ArrayP ArrayP] eq  
     {  /f aa 0 get def  
        /v aa 1 get from_records def  
        /wv aa 2 get def  
        /degreeShift aa 3 get def  
        /hdShift aa 4 get def  
        /setarg 1 def  
     } { } ifelse  
     typev [ArrayP ArrayP ArrayP ArrayP StringP] eq  
     {  /f aa 0 get def  
        /v aa 1 get from_records def  
        /wv aa 2 get def  
        /degreeShift aa 3 get def  
        aa 4 get (no) eq {  
          /hdShift -1 def  
        } {  
          (Unknown keyword for the 5th argument) error  
        } ifelse  
        /setarg 1 def  
     } { } ifelse  
     typev [ArrayP StringP ArrayP ArrayP StringP] eq  
     {  /f aa 0 get def  
        /v aa 1 get  def  
        /wv aa 2 get def  
        /degreeShift aa 3 get def  
        aa 4 get (no) eq {  
          /hdShift -1 def  
        } {  
          (Unknown keyword for the 5th argument) error  
        } ifelse  
        /setarg 1 def  
     } { } ifelse  
   
     /env1 getOptions def      /env1 getOptions def
   
Line 339 
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 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  weight_vector            wv  ecart.weight_vector
           gb.characteristic            gb.characteristic
           [(degreeShift) degreeShift] opt join            [(degreeShift) degreeShift] opt join
           ] define_ring            ] define_ring
Line 414 
Line 431 
        f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set         f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
    }ifelse     }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 472 
Line 497 
   (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 )
Line 492 
Line 517 
   $             [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecarth.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) $
   $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  [[0 1] [-3 1] ] ] ecarth.gb pmat ; (buggy infinite loop)$    $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] $
     $            [(degreeShift) [[0 1] [-3 1] ]]  ] ecarth.gb pmat ; $
   (  )    (  )
   (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )    (cf. gb, groebner, ecart.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
   (    ecart.dehomogenize, ecart.dehomogenizeH)    (    ecart.dehomogenize, ecart.dehomogenizeH)
Line 592 
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 630 
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 743 
Line 770 
    /gg /wv /vec /ans /rr /mm     /gg /wv /vec /ans /rr /mm
    /degreeShift  /env2 /opt /ans.gb     /degreeShift  /env2 /opt /ans.gb
    /hdShift     /hdShift
      /ecart.useSugar
   ] pushVariables    ] pushVariables
   [(CurrentRingp) (KanGBmessage)] pushEnv    [(CurrentRingp) (KanGBmessage)] pushEnv
   [    [
Line 752 
Line 780 
     /wv 0 def      /wv 0 def
     /degreeShift 0 def      /degreeShift 0 def
     /hdShift 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 786 
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
     typev [ArrayP StringP ArrayP ArrayP ArrayP] eq  
     {  /f aa 0 get def  
        /v aa 1 get def  
        /wv aa 2 get def  
        /degreeShift aa 3 get def  
        /hdShift aa 4 get def  
        /setarg 1 def  
     } { } ifelse  
     typev [ArrayP ArrayP ArrayP ArrayP ArrayP] eq  
     {  /f aa 0 get def  
        /v aa 1 get from_records def  
        /wv aa 2 get def  
        /degreeShift aa 3 get def  
        /hdShift aa 4 get def  
        /setarg 1 def  
     } { } ifelse  
     typev [ArrayP ArrayP ArrayP ArrayP StringP] eq  
     {  /f aa 0 get def  
        /v aa 1 get from_records def  
        /wv aa 2 get def  
        /degreeShift aa 3 get def  
        aa 4 get (no) eq {  
          /hdShift -1 def  
        } {  
          (Unknown keyword for the 5th argument) error  
        } ifelse  
        /setarg 1 def  
     } { } ifelse  
     typev [ArrayP StringP ArrayP ArrayP StringP] eq  
     {  /f aa 0 get def  
        /v aa 1 get def  
        /wv aa 2 get def  
        /degreeShift aa 3 get def  
        aa 4 get (no) eq {  
          /hdShift -1 def  
        } {  
          (Unknown keyword for the 5th argument) error  
        } ifelse  
        /setarg 1 def  
     } { } ifelse  
   
     /env1 getOptions def      /env1 getOptions def
   
Line 868 
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 929 
Line 919 
        f { { [[(H). (1).]] replace } map } map /f set         f { { [[(H). (1).]] replace } map } map /f set
    }ifelse     }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 1049 
Line 1047 
   /shift [ [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    /weight [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] def
   
   [ff (t,x,y) weight shift nmshift] ecart.minimalBase    [ff (t,x,y) weight [(degreeShift) shift (startingShift) nmshift]] ecart.minimalBase
   
   
 }  def  }  def
Line 1091 
Line 1089 
   arg1    arg1
 } def  } 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)  [(ecart.minimalBase)
 [([ff v weight_vector degreeShift [D_shift_n uv_shift_m]]  ecart.minimalBase mbase)  [$[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  ]] putUsages
 /ecart.minimalBase {  /ecart.minimalBase {
   /arg1 set    /arg1 set
Line 1114 
Line 1235 
     /wv 0 def      /wv 0 def
     /degreeShift 0 def      /degreeShift 0 def
     /hdShift 0 def      /hdShift 0 def
       /opt [ ] def
     aa { tag } map /typev set      aa { tag } map /typev set
     typev [ArrayP StringP ArrayP 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
        /hdShift aa 4 get def  
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
     typev [ArrayP 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
        /hdShift aa 4 get def  
        /setarg 1 def         /setarg 1 def
     } { } ifelse      } { } ifelse
     setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse      setarg { } { (ecart.minimalBase : Argument mismatch) error } ifelse
Line 1137 
Line 1257 
   
     f 0 get tag ArrayP eq {  }      f 0 get tag ArrayP eq {  }
     {  f { /tt set [ tt ] } map /f set } ifelse      {  f { /tt set [ tt ] } map /f set } ifelse
     [f v wv degreeShift (no)] ecart.syz /ss0 set      [f v wv [(degreeShift) degreeShift (noAutoHomogenize) 1] opt join] ecart.syz /ss0 set
   
     ss0 getRing ring_def      ss0 getRing ring_def
     /degreeShiftD  hdShift 0 get def      /degreeShiftD  hdShift 0 get def
Line 1162 
Line 1282 
   
 %C  Note 2003.8.26  %C  Note 2003.8.26
   
       ai [ ] eq {
         exit
       } {  } ifelse
   
     /s ai length def      /s ai length def
     /r ai 0 get length def      /r ai 0 get length def
   
Line 1219 
Line 1343 
      } for       } for
   
 %   ( ) error  %   ( ) error
      /ai1 ai1_new def       /ai1 ai1_new  def
      /ai ai_new2 def       /ai ai_new2  ecart.removeZeroRow def
   
    } loop     } loop
    /arg1 ai1 def     /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    ] pop
   popVariables    popVariables
   arg1    arg1
 } def  } 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.)
     (r is the return value format of reduction.)
     (basis is the argument format of ecartd.gb.)
     (The first element of basis must be a standard basis.)
     (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.13  
changed lines
  Added in v.1.19
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>