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

version 1.16, 2003/09/12 02:52:49 version 1.19, 2004/04/29 12:04:45
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.15 2003/08/29 04:34:07 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 146 
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 233 
Line 233 
   (       No automatic homogenization.)    (       No automatic homogenization.)
   $  [(degreeShift) ds (noAutoHomogenize) 1 (sugar) 1] -->use the sugar strate $    $  [(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 271 
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 281 
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 354 
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 429 
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 647 
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 848 
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 1170 
Line 1180 
   arg1    arg1
 } def  } def
 [(ecart.gen_input)  [(ecart.gen_input)
 [$[ff v weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]] ]  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 weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]] $   $               [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.)   (It generates the input for the minimal filtered free resolution.)
  (Current ring is changed to the ring of gg_h.)   (Current ring is changed to the ring of gg_h.)
  (cf. ecart.minimalBase)   (cf. ecart.minimalBase)
Line 1183 
Line 1193 
   
   
 [(ecart.minimalBase)  [(ecart.minimalBase)
 [$[ff v weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalBase $  [$[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalBase $
  (  [mbase gr_of_mbase )   (  [mbase gr_of_mbase )
  $     [syz v weight_vector [(degreeShift) new_uv_shift_m (startingShift) [new_D_shift_n new_uv_shift_m]]]$   $     [syz v ecart.weight_vector [(degreeShift) new_uv_shift_m (startingShift) [new_D_shift_n new_uv_shift_m]]]$
  (     gr_of_syz ])   (     gr_of_syz ])
  (mbase is the minimal generators of ff in D^h in the sense of filtered minimal)   (mbase is the minimal generators of ff in D^h in the sense of filtered minimal)
  (generators.)   (generators.)
Line 1387 
Line 1397 
 [(ecart.minimalResol)  [(ecart.minimalResol)
 [  [
   
  $[ff v weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalResol $   $[ff v ecart.weight_vector [(degreeShift) uv_shift_m (startingShift) [D_shift_n uv_shift_m]]]  ecart.minimalResol $
  (  [resol degree_shifts gr_of_resol_by_uv_shift_m] )   (  [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) $    $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]] $    $           [ [(t) -1 (Dt) 1] [(t) -1 (x) -1 (y) -1 (Dt) 1 (Dx) 1 (Dy) 1]] $
   $           [(degreeShift) [ [0] ] $    $           [(degreeShift) [ [0] ] $
   $            (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $    $            (startingShift) [ [0] [0] ] ] ] ecart.minimalResol /gg set gg pmat $
 ]] putUsages  ]] 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.16  
changed lines
  Added in v.1.19
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>