[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.22 and 1.33

version 1.22, 2004/05/05 06:57:09 version 1.33, 2004/09/10 13:20:22
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.21 2004/05/04 08:29:35 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.32 2004/08/31 05:30:20 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 7 
Line 8 
 /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.gb.oxRingStructure [[ ] [ ] ] def
   
 /ecartd.begin {  /ecartd.begin {
   ecart.begin    ecart.begin
   [(EcartAutomaticHomogenization) 1] system_variable    [(EcartAutomaticHomogenization) 1] system_variable
Line 87 
Line 90 
      ll (0). eq {       ll (0). eq {
      } {       } {
        ll getRing /rr set         ll getRing /rr set
        ll [ [ (H) 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 113 
Line 116 
      ll (0). eq {       ll (0). eq {
      } {       } {
        ll getRing /rr set         ll getRing /rr set
        ll [ [ (H) rr ,, (1) rr ,, ] ] replace         ll [ [ @@@.Hsymbol rr __ (1) rr __ ] ] replace
        /ll set         /ll set
      } ifelse       } ifelse
    } ifelse     } ifelse
Line 195 
Line 198 
   [/in.ecart.wv1 /v] pushVariables    [/in.ecart.wv1 /v] pushVariables
   [    [
     /v arg1 def      /v arg1 def
     [(H) (h) v to_records pop] /v set      [@@@.Hsymbol (h) v to_records pop] /v set
     v { 1 } map /v set      v { 1 } map /v set
     /arg1 v def      /arg1 v def
   ] pop    ] pop
Line 244 
Line 247 
   $  [(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), ecartd.reduction $    $cf. ecarth.gb (homogenized),  ecartd.gb (dehomogenize), ecartd.reduction $
     (    ecartd.gb.oxRingStructure )
   ( )    ( )
   $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 919 
Line 923 
        (ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) ecart.message         (ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) ecart.message
        f { {. ecart.dehomogenize} map} map /f set         f { {. ecart.dehomogenize} map} map /f set
        f ecart.homogenize01 /f set         f ecart.homogenize01 /f set
        f { { [[(H). (1).]] replace } map } map /f set         f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set
      } ifelse       } ifelse
    } {     } {
 % Automatic h-homogenization with degreeShift  % Automatic h-homogenization with degreeShift
        (ecartd.gb : Input polynomial or vectors are automatically homogenized with degreeShift) message         (ecartd.gb : Input polynomial or vectors are automatically homogenized with degreeShift) message
        f { {. ecart.dehomogenize} map} map /f set         f { {. ecart.dehomogenize} map} map /f set
        f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set         f {/fi set [(degreeShift) hdShift fi] homogenize} map /f set
        f { { [[(H). (1).]] replace } map } map /f set         f { { [[@@@.Hsymbol . (1).]] replace } map } map /f set
    }ifelse     }ifelse
   
     ecart.useSugar {      ecart.useSugar {
Line 971 
Line 975 
   
     ecartd.end      ecartd.end
   
       ans getRing (oxRingStructure) dc /ecartd.gb.oxRingStructure set
     %%      %%
     env1 restoreOptions  %% degreeShift changes "grade"      env1 restoreOptions  %% degreeShift changes "grade"
   
Line 1552 
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 1587 
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 1624 
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 1644 
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 1678 
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 1692 
Line 1739 
      dvv { 1 } map /wv1 set       dvv { 1 } map /wv1 set
      vv { -1 } map dvv { 1 } map join /wv2 set       vv { -1 } map dvv { 1 } map join /wv2 set
      /arg1 [wv1 wv2 ] def       /arg1 [wv1 wv2 ] def
   ] popVariables    ] pop
     popVariables
   arg1    arg1
 } def  } def
   
Line 1775 
Line 1823 
  $Example 1: [ [((1-x) Dx + h)]  [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $   $Example 1: [ [((1-x) Dx + h)]  [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $
 ]] putUsages  ]] putUsages
   
   /ecart.01Order {
     /arg1 set
     [/in-ecart.01Order /vv /tt /dvv /wv1 /wv2
     ] pushVariables
     [
        /vv arg1 def
        vv isString { [ vv to_records pop] /vv set }
        { } ifelse
        vv { toString} map /vv set
   
        vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set
        dvv { 1 } map /wv1 set
        /arg1 [wv1] def
     ] pop
     popVariables
     arg1
   } def
   /ecart.homogenize01Ideal {
    /arg1 set
    [/in.ecart.homogenize01Ideal /ll /vv /wv /ans] pushVariables
    [
      /ll arg1 0 get def
      /vv arg1 1 get def
      vv isArray { vv from_records /vv set } {  } ifelse
      vv ecart.01Order /wv set
      [vv ring_of_differential_operators 0] define_ring
      ll ___ /ll set ll dehomogenize /ll set
      [ll vv wv] gb 0 get /ll set
   
      ecart.begin
      [vv ring_of_differential_operators
       vv ecart.stdOrder weight_vector 0
       [(weightedHomogenization) 1]] define_ring
      ll ___ {ecart.homogenize01 ecart.dehomogenizeH} map /ans set
      ecart.end
      /arg1 ans def
    ] pop
    popVariables
    arg1
   } def
   [(ecart.homogenize01Ideal)
   [([ii vv] ecartd.homogenize01Ideal)
    (ii : ideal, vv : variables)
    $The ideal ii is homogenized in h[0,1](D).$
    $Example 1: [ [((1-x) Dx + 1)] (x)] ecart.homogenize01Ideal $
   ]] putUsages
   
   
   
 ( ) message-quiet  ( ) message-quiet
   
   /ecart_loaded 1 def
   
Legend:
Removed from v.1.22  
changed lines
  Added in v.1.33
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>