[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.18 and 1.22

version 1.18, 2003/09/30 00:06:56 version 1.22, 2004/05/05 06:57:09
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.17 2003/09/20 22:10:04 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.21 2004/05/04 08:29:35 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.message.quiet 0 def
   /ecart.message {
     ecart.message.quiet { pop } { message } ifelse
   } def
   /ecart.messagen {
     ecart.message.quiet { pop } { messagen } ifelse
   } def
 /ecart.setOpt {  /ecart.setOpt {
   /arg1 set    /arg1 set
   [/in-ecart.setOpt /opt /i /n /ans] pushVariables    [/in-ecart.setOpt /opt /i /n /ans] pushVariables
Line 211 
Line 218 
   
 /ecart.gb {ecartd.gb}  def  /ecart.gb {ecartd.gb}  def
   
   [(ecartd.gb)
   [(See ecart.gb)]] putUsages
   
 [(ecart.gb)  [(ecart.gb)
  [(a ecart.gb b)   [(a ecart.gb b)
   (array a; array b;)    (array a; array b;)
Line 233 
Line 243 
   (       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 836 
Line 846 
     setarg { } { (ecart.gb : Argument mismatch) error } ifelse      setarg { } { (ecart.gb : Argument mismatch) error } ifelse
   
     [(KanGBmessage) ecart.gb.verbose ] system_variable      [(KanGBmessage) ecart.gb.verbose ] system_variable
     $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message      $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ ecart.message
   
     %%% Start of the preprocess      %%% Start of the preprocess
     v tag RingP eq {      v tag RingP eq {
Line 854 
Line 864 
         (Error in gb: Specify variables) error          (Error in gb: Specify variables) error
       } {  } ifelse        } {  } ifelse
       wv isInteger {        wv isInteger {
         (Give an weight vector such that x < 1) error          (Give a weight vector such that x < 1) error
       }{        }{
        degreeShift isInteger {         degreeShift isInteger {
          [v ring_of_differential_operators           [v ring_of_differential_operators
Line 898 
Line 908 
   
     ecartd.begin      ecartd.begin
   
     ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse      ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse
   
     hdShift tag 1 eq {      hdShift tag 1 eq {
      ecart.autoHomogenize not hdShift -1 eq  or {       ecart.autoHomogenize not hdShift -1 eq  or {
Line 906 
Line 916 
        f { {. } map} map /f set         f { {. } map} map /f set
      } {       } {
 % Automatic h-homogenization without degreeShift  % Automatic h-homogenization without degreeShift
        (ecartd.gb : Input polynomial or vectors are automatically homogenized without degreeShift) 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 { { [[(H). (1).]] replace } map } map /f set
Line 1559 
Line 1569 
 } def  } def
   
 %% end of for ecart.define_ring  %% 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.)
     (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.)
     $h[0,1](D)-homogenization is used.$
     (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
   
   /ecart.stdOrder {
     /arg1 set
     [/in-ecart.stdOrder /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
        vv { -1 } map dvv { 1 } map join /wv2 set
        /arg1 [wv1 wv2 ] def
     ] popVariables
     arg1
   } def
   
   /ecartd.isSameIdeal_h {
     /arg1 set
     [/in-ecartd.isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f
      /ecartd.isSameIdeal_h.opt
      /save-ecart.autoHomogenize  /wv /save-ecart.message.quiet
      ] pushVariables
     [(CurrentRingp) (Homogenize_vec)] pushEnv
     [
       /aa arg1 def
       gb.verbose { (Getting in ecartd.isSameIdeal_h) message } { } ifelse
       %% comparison of hilbert series has not yet been implemented.
       /save-ecart.message.quiet ecart.message.quiet def
       aa length 3 eq {    }
       { ([ii jj vv] ecartd.isSameIdeal_h) error } ifelse
       /ii aa 0 get def
       /jj aa 1 get def
       /vv aa 2 get def
       ii length 0 eq jj length 0 eq and
       { /ans 1 def /LLL.ecartd.isSame_h goto } {  } ifelse
   
       vv ecart.stdOrder /wv set
   
       /save-ecart.autoHomogenize ecart.autoHomogenize def
       /ecart.autoHomogenize 0 def
       [ii vv wv] ecartd.gb  /iigg set
       [jj vv wv] ecartd.gb  /jjgg set
       save-ecart.autoHomogenize /ecart.autoHomogenize set
   
       iigg getRing ring_def
   
       getOptions /ecartd.isSameIdeal_h.opt set
   
       /ans 1 def
       iigg 0 get /iigg set
       jjgg 0 get /jjgg set
       %%Bug: not implemented for the case of module.
   
       /save-ecart.message.quiet ecart.message.quiet def
       /ecart.message.quiet 1 def
       gb.verbose { (Comparing) message iigg message (and) message jjgg message }
       {  } ifelse
       gb.verbose { ( ii < jj ?) messagen } {  } ifelse
       iigg length /n set
       0 1 n 1 sub {
         /k set
         iigg  k get
         [jjgg vv wv] ecartd.reduction 0 get
         (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} {  } ifelse
         gb.verbose { (o) messagen } {  } ifelse
       } for
       gb.verbose { ( jj < ii ?) messagen } {  } ifelse
       jjgg length /n set
       0 1 n 1 sub {
         /k set
         jjgg k get
         [iigg vv wv] ecartd.reduction 0 get
         (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} {  } ifelse
         gb.verbose { (o) messagen } {  } ifelse
       } for
       /LLL.ecartd.isSame_h
       gb.verbose { ( Done) message } {  } ifelse
       save-ecart.message.quiet /ecart.message.quiet set
       ecartd.isSameIdeal_h.opt restoreOptions
       /arg1 ans def
     ] pop
     popEnv
     popVariables
     arg1
   } def
   (ecartd.isSameIdeal_h ) messagen-quiet
   
   [(ecartd.isSameIdeal_h)
   [([ii jj vv] ecartd.isSameIdeal_h bool)
    (ii, jj : ideal, vv : variables)
    $The ideals ii and jj will be compared in the ring h[0,1](D).$
    $ii and jj are re-parsed.$
    $Example 1: [ [((1-x) Dx + h)]  [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $
   ]] putUsages
   
   
   
 ( ) message-quiet  ( ) message-quiet
Legend:
Removed from v.1.18  
changed lines
  Added in v.1.22
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>