[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.1 and 1.7

version 1.1, 2003/07/25 01:00:38 version 1.7, 2003/08/18 06:36:50
Line 1 
Line 1 
 % $OpenXM$  % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.6 2003/08/13 03:52:25 takayama Exp $
 %[(parse) (hol.sm1) pushfile] extension  %[(parse) (hol.sm1) pushfile] extension
 %[(parse) (appell.sm1) pushfile] extension  %[(parse) (appell.sm1) pushfile] extension
   
Line 133 
Line 133 
   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 ds]; array f; string v; array of array w; w is the weight matirx.)
     (                array ds; ds is the degree shift )
     (  )
     $cf. ecarth.gb (homogenized),  ecartd.gb (dehomogenize) $
     ( )
     $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  pmat ;$
     (  )
     $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) (  x y Dx Dy -1)] (x,y) $
     $             [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
     (  )
     $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 ; $
     (  )
     $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 ; $
     (  )
     (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 {
   /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
   ] pushVariables    ] pushVariables
Line 219 
Line 262 
       } {  } 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 ] weight_vector
          0           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 weight_vector
           0            wv weight_vector
             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 weight_vector
           0            wv  weight_vector
             gb.characteristic
           [(degreeShift) degreeShift] opt join            [(degreeShift) degreeShift] opt join
           ] define_ring            ] define_ring
   
Line 254 
Line 299 
     %%% 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 310 
        } ifelse         } ifelse
     } { } ifelse      } { } ifelse
   
       %%BUG: case of v is integer
       v 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
Line 316 
Line 364 
   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.)
Line 338 
Line 386 
   (               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] ]  [[0 1] [-3 1] ] ] ecarth.gb pmat ; (buggy infinite loop)$
   (  )    (  )
   (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 )
Line 392 
Line 440 
   (cf. ecart.gb)    (cf. ecart.gb)
   (    /ecart.autoHomogenize 0 def )    (    /ecart.autoHomogenize 0 def )
 ]] putUsages  ]] putUsages
   
   
   /ecartn.begin {
     (red@) (standard) switch_function
   %%  (red@) (ecart) switch_function
     [(Ecart) 1] system_variable
     [(CheckHomogenization) 0] system_variable
     [(ReduceLowerTerms) 0] system_variable
     [(AutoReduce) 0] system_variable
     [(EcartAutomaticHomogenization) 0] system_variable
   } def
   /ecartn.gb {
     /arg1 set
     [/in-ecartn.gb /aa /typev /setarg /f /v
      /gg /wv /vec /ans /rr /mm
      /degreeShift  /env2 /opt /ans.gb
     ] pushVariables
     [(CurrentRingp) (KanGBmessage)] pushEnv
     [
       /aa arg1 def
       aa isArray { } { ( << array >> gb) error } ifelse
       /setarg 0 def
       /wv 0 def
       /degreeShift 0 def
       /opt [(weightedHomogenization) 1] def
       aa { tag } map /typev set
       typev [ ArrayP ] eq
       {  /f aa 0 get def
          /v gb.v def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP StringP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP RingP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get from_records def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP StringP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /wv aa 2 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get from_records def
          /wv aa 2 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP StringP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /wv aa 2 get def
          /degreeShift aa 3 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP ArrayP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get from_records def
          /wv aa 2 get def
          /degreeShift aa 3 get def
          /setarg 1 def
       } { } ifelse
   
       /env1 getOptions def
   
       setarg { } { (ecart.gb : Argument mismatch) error } ifelse
   
       [(KanGBmessage) ecart.gb.verbose ] system_variable
   
       %%% Start of the preprocess
       v tag RingP eq {
          /rr v def
       }{
         f getRing /rr set
       } ifelse
       %% To the normal form : matrix expression.
       f gb.toMatrixOfString /f set
       /mm gb.itWasMatrix def
   
       rr tag 0 eq {
         %% Define our own ring
         v isInteger {
           (Error in gb: Specify variables) error
         } {  } ifelse
         wv isInteger {
           [v ring_of_differential_operators
            [ v ecart.wv1 v ecart.wv2 ] weight_vector
            gb.characteristic
            opt
           ] define_ring
         }{
          degreeShift isInteger {
            [v ring_of_differential_operators
             [v ecart.wv1 v ecart.wv2] wv join weight_vector
             gb.characteristic
             opt
            ] define_ring
   
          }{
            [v ring_of_differential_operators
             [v ecart.wv1 v ecart.wv2] wv join weight_vector
             gb.characteristic
             [(degreeShift) degreeShift] opt join
             ] define_ring
   
          } ifelse
         } ifelse
       } {
         %% Use the ring structre given by the input.
         v isInteger not {
           gb.warning {
            (Warning : the given ring definition is not used.) message
           } { } ifelse
         } {  } ifelse
         rr ring_def
         /wv rr gb.getWeight def
   
       } ifelse
       %%% Enf of the preprocess
   
       ecart.gb.verbose {
         (The first and the second weight vectors are automatically set as follows)
          message
          v ecart.wv1 message
          v ecart.wv2 message
          degreeShift isInteger { }
          {
            (The degree shift is ) messagen
            degreeShift message
          } ifelse
       } { } ifelse
   
       %%BUG: case of v is integer
       v ecart.checkOrder
   
       ecartn.begin
   
       ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) 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.)
         message
       } { } ifelse
       ecart.autoHomogenize {
         f { {. ecart.dehomogenize} map} map /f set
         f ecart.homogenize01 /f set
       }{
         f { {. } map } map /f set
       } ifelse
       ecart.needSyz {
         [f [(needSyz)] gb.options join ] groebner /gg set
       } {
         [f gb.options] groebner 0 get /gg set
       } ifelse
   
       ecart.needSyz {
         mm {
          gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
         } { /ans.gb gg 0 get def } ifelse
         /ans [gg 2 get , ans.gb , gg 1 get , f ] def
         ans pmat ;
       } {
         wv isInteger {
           /ans [gg gg {init} map] def
         }{
           /ans [gg gg {wv 0 get weightv init} map] def
         }ifelse
   
         %% Postprocess : recover the matrix expression.
         mm {
           ans { /tmp set [mm tmp] toVectors } map
           /ans set
         }{ }
         ifelse
       } ifelse
   
       ecart.end
   
       %%
       env1 restoreOptions  %% degreeShift changes "grade"
   
       /arg1 ans def
     ] pop
     popEnv
     popVariables
     arg1
   } def
   (ecartn.gb[gb by non-ecart division] ) messagen-quiet
   
   /ecartd.gb {
     /arg1 set
     [/in-ecart.gb /aa /typev /setarg /f /v
      /gg /wv /vec /ans /rr /mm
      /degreeShift  /env2 /opt /ans.gb
     ] pushVariables
     [(CurrentRingp) (KanGBmessage)] pushEnv
     [
       /aa arg1 def
       aa isArray { } { ( << array >> gb) error } ifelse
       /setarg 0 def
       /wv 0 def
       /degreeShift 0 def
       /opt [(weightedHomogenization) 1] def
       aa { tag } map /typev set
       typev [ ArrayP ] eq
       {  /f aa 0 get def
          /v gb.v def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP StringP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP RingP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get from_records def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP StringP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /wv aa 2 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get from_records def
          /wv aa 2 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP StringP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get def
          /wv aa 2 get def
          /degreeShift aa 3 get def
          /setarg 1 def
       } { } ifelse
       typev [ArrayP ArrayP ArrayP ArrayP] eq
       {  /f aa 0 get def
          /v aa 1 get from_records def
          /wv aa 2 get def
          /degreeShift aa 3 get def
          /setarg 1 def
       } { } ifelse
   
       /env1 getOptions def
   
       setarg { } { (ecart.gb : Argument mismatch) error } ifelse
   
       [(KanGBmessage) ecart.gb.verbose ] system_variable
       $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message
   
       %%% Start of the preprocess
       v tag RingP eq {
          /rr v def
       }{
         f getRing /rr set
       } ifelse
       %% To the normal form : matrix expression.
       f gb.toMatrixOfString /f set
       /mm gb.itWasMatrix def
   
       rr tag 0 eq {
         %% Define our own ring
         v isInteger {
           (Error in gb: Specify variables) error
         } {  } ifelse
         wv isInteger {
           (Give an weight vector such that x < 1) error
         }{
          degreeShift isInteger {
            [v ring_of_differential_operators
              wv weight_vector
             gb.characteristic
             opt
            ] define_ring
   
          }{
            [v ring_of_differential_operators
              wv weight_vector
             gb.characteristic
             [(degreeShift) degreeShift] opt join
             ] define_ring
   
          } ifelse
         } ifelse
       } {
         %% Use the ring structre given by the input.
         v isInteger not {
           gb.warning {
            (Warning : the given ring definition is not used.) message
           } { } ifelse
         } {  } ifelse
         rr ring_def
         /wv rr gb.getWeight def
   
       } ifelse
       %%% Enf of the preprocess
   
       ecart.gb.verbose {
          degreeShift isInteger { }
          {
            (The degree shift is ) messagen
            degreeShift message
          } ifelse
       } { } ifelse
   
       %%BUG: case of v is integer
       v ecart.checkOrder
   
       ecart.begin
       [(EcartAutomaticHomogenization) 1] system_variable
   
       ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
   
       f { {. ecart.dehomogenize} map} map /f set
       f ecart.homogenize01 /f set
       f { { [[(H). (1).]] replace } map } map /f set
   
       ecart.needSyz {
         [f [(needSyz)] gb.options join ] groebner /gg set
       } {
         [f gb.options] groebner 0 get /gg set
       } ifelse
   
       ecart.needSyz {
         mm {
          gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
         } { /ans.gb gg 0 get def } ifelse
         /ans [gg 2 get , ans.gb , gg 1 get , f ] def
         ans pmat ;
       } {
         wv isInteger {
           /ans [gg gg {init} map] def
         }{
           /ans [gg gg {wv 0 get weightv init} map] def
         }ifelse
   
         %% Postprocess : recover the matrix expression.
         mm {
           ans { /tmp set [mm tmp] toVectors } map
           /ans set
         }{ }
         ifelse
       } ifelse
   
       ecart.end
       [(EcartAutomaticHomogenization) 0] system_variable
   
       %%
       env1 restoreOptions  %% degreeShift changes "grade"
   
       /arg1 ans def
     ] pop
     popEnv
     popVariables
     arg1
   } def
   (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
   
   /ecart.checkOrder {
     /arg1 set
     [/in-ecart.checkOrder /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)
    [(v 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
   
   ( ) message-quiet
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>