[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.27 and 1.34

version 1.27, 2004/05/15 12:00:48 version 1.34, 2004/09/13 11:24:10
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.26 2004/05/14 02:35:03 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.33 2004/09/10 13:20:22 takayama Exp $
 %[(parse) (hol.sm1) pushfile] extension  (hol_loaded) boundp { }
   { [(parse) (hol.sm1) pushfile] extension } ifelse
 %[(parse) (appell.sm1) pushfile] extension  %[(parse) (appell.sm1) pushfile] extension
   
 (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet  (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet
Line 59 
Line 60 
         exit          exit
       } {  } ifelse        } {  } ifelse
   
       ans [opt i get opt i 1 add get ]  append /ans set        ans [opt i get opt i 1 add get ]  join /ans set
       exit        exit
      } loop       } loop
     } for      } for
Line 89 
Line 90 
      ll (0). eq {       ll (0). eq {
      } {       } {
        ll getRing /rr set         ll getRing /rr set
        ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ]         ll [ [ @@@.Hsymbol rr __ (1) rr __ ]
             [ (h) rr ,, (1) rr ,, ]] replace              [ (h) rr __ (1) rr __ ]] replace
        /ll set         /ll set
      } ifelse       } ifelse
    } ifelse     } ifelse
Line 115 
Line 116 
      ll (0). eq {       ll (0). eq {
      } {       } {
        ll getRing /rr set         ll getRing /rr set
        ll [ [ @@@.Hsymbol rr ,, (1) rr ,, ] ] replace         ll [ [ @@@.Hsymbol rr __ (1) rr __ ] ] replace
        /ll set         /ll set
      } ifelse       } ifelse
    } ifelse     } ifelse
Line 1556 
Line 1557 
     /univ vars 0 get reverse      /univ vars 0 get reverse
           vars 1 get reverse join            vars 1 get reverse join
     def      def
       w-vectors to_int32 /w-vectors set
     [      [
     0 1 << w-vectors length 1 sub >>      0 1 << w-vectors length 1 sub >>
     {      {
Line 1591 
Line 1593 
        /gbasis2 gbasis 0 get def         /gbasis2 gbasis 0 get def
      } {       } {
        [ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def         [ [(1)] ] gbasis rest join ecartd.gb 0 get getRing ring_def
        /gbasis2 gbasis 0 get ,,, def         /gbasis2 gbasis 0 get ___ def
      } ifelse       } ifelse
      ecartd.begin       ecartd.begin
   
      flist ,,, /flist set       flist ___ /flist set
      flist tag 6 eq {       flist tag 6 eq {
        flist { gbasis2 reduction } map /ans set         flist { gbasis2 reduction } map /ans set
      }{       }{
Line 1628 
Line 1630 
       (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set        (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set
    (Dx) ggg ecartd.reduction /gg4 set     (Dx) ggg ecartd.reduction /gg4 set
    gg4 message     gg4 message
   [gg2  gg3 gg4]  
     (----------- reduction by h=1 ---------------) message
       [[( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )]
         (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set
      [(Homogenize) 0]  system_variable
      (Dx) ggg ecartd.reduction /gg5 set
      [(Homogenize) 1]  system_variable
      gg5 message
   
     [gg2  gg3 gg4 gg5]
 } def  } def
   
 /ecarth.reduction {  /ecarth.reduction {
Line 1648 
Line 1659 
        /gbasis2 gbasis 0 get def         /gbasis2 gbasis 0 get def
      } {       } {
        [ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def         [ [(1)] ] gbasis rest join ecarth.gb 0 get getRing ring_def
        /gbasis2 gbasis 0 get ,,, def         /gbasis2 gbasis 0 get ___ def
      } ifelse       } ifelse
      ecarth.begin       ecarth.begin
   
      flist ,,, /flist set       flist ___ /flist set
      flist tag 6 eq {       flist tag 6 eq {
        flist { gbasis2 reduction } map /ans set         flist { gbasis2 reduction } map /ans set
      }{       }{
Line 1682 
Line 1693 
   $ (Dx+Dy) ggg ecartd.reduction :: $    $ (Dx+Dy) ggg ecartd.reduction :: $
 ]] putUsages  ]] putUsages
   
   /ecartd.reduction_noh {
     /arg2 set
     /arg1 set
     [/in-ecarth.reduction_noh /gbasis /flist] pushVariables
     [(Homogenize)] pushEnv
     [
        /gbasis arg2  def
        /flist  arg1  def
        [(Homogenize) 0] system_variable
        flist gbasis ecartd.reduction /arg1 set
     ] pop
     popEnv
     popVariables
     arg1
   } def
   
   [(ecartd.reduction_noh)
   [ (f basis ecartd.reduction_noh r)
     (f is reduced by basis by the tangent cone algorithm.)
     (The first element of basis <g_1,...,g_m> must be a standard basis.)
     (r is the return value format of reduction.)
     (r=[h,c0,syz,input], h = c0 f + \sum syz_i g_i)
     (basis is given in the argument format of ecartd.gb and)
     (it should not contain the variable h.  cf. dehomogenize)
     $h[0,1](D)-homogenization is NOT used.$
     (cf. reduction, ecartd.gb, ecartd.reduction )
     $Example:$
     $ [[( 2*(1-x-y) Dx + 1 ) ( 2*(1-x-y) Dy + 1 )] $
     $   (x,y) [[(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]]] /ggg set $
     $ (Dx+Dy) ggg ecartd.reduction_noh :: $
   ]] putUsages
   
 /ecart.stdOrder {  /ecart.stdOrder {
   /arg1 set    /arg1 set
   [/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2    [/in-ecart.stdOrder /vv /tt /dvv /wv1 /wv2
Line 1806 
Line 1849 
    vv isArray { vv from_records /vv set } {  } ifelse     vv isArray { vv from_records /vv set } {  } ifelse
    vv ecart.01Order /wv set     vv ecart.01Order /wv set
    [vv ring_of_differential_operators 0] define_ring     [vv ring_of_differential_operators 0] define_ring
    ll ,,, /ll set ll dehomogenize /ll set     ll ___ /ll set ll dehomogenize /ll set
    [ll vv wv] gb 0 get /ll set     [ll vv wv] gb 0 get /ll set
   
    ecart.begin     ecart.begin
    [vv ring_of_differential_operators     [vv ring_of_differential_operators
     vv ecart.stdOrder weight_vector 0      vv ecart.stdOrder weight_vector 0
     [(weightedHomogenization) 1]] define_ring      [(weightedHomogenization) 1]] define_ring
    ll ,,, {ecart.homogenize01 ecart.dehomogenizeH} map /ans set     ll ___ {ecart.homogenize01 ecart.dehomogenizeH} map /ans set
    ecart.end     ecart.end
    /arg1 ans def     /arg1 ans def
  ] pop   ] pop
Line 1831 
Line 1874 
   
 ( ) message-quiet  ( ) message-quiet
   
   /ecart_loaded 1 def
   
Legend:
Removed from v.1.27  
changed lines
  Added in v.1.34
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>