[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.24 and 1.40

version 1.24, 2004/05/13 05:33:10 version 1.40, 2012/08/26 01:38:02
Line 1 
Line 1 
 % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.23 2004/05/05 07:32:54 takayama Exp $  % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.39 2004/09/14 11:51: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, 2004/09/14 ) message-quiet
 /ecart.begin { beginEcart } def  /ecart.begin { beginEcart } def
 /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.gb.oxRingStructure [[ ] [ ] ] def
   /ecart.partialEcartGlobalVarX [ ] def
   
   /ecart.gb.verbose 1 def
   /ecart.message.quiet 0 def
   
 /ecartd.begin {  /ecartd.begin {
   ecart.begin    ecart.begin
   [(EcartAutomaticHomogenization) 1] system_variable    [(EcartAutomaticHomogenization) 1] system_variable
Line 18 
Line 23 
   [(EcartAutomaticHomogenization) 0] system_variable    [(EcartAutomaticHomogenization) 0] system_variable
 } def  } def
   
 /ecart.message.quiet 0 def  
 /ecart.message {  /ecart.message {
   ecart.message.quiet { pop } { message } ifelse    ecart.message.quiet { pop } { message } ifelse
 } def  } def
 /ecart.messagen {  /ecart.messagen {
   ecart.message.quiet { pop } { messagen } ifelse    ecart.message.quiet { pop } { messagen } ifelse
 } def  } def
   /ecart.setOpt.init {
   % Initialize
       /ecart.partialEcartGlobalVarX [ ] def
   } 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 32 
Line 40 
     /opt arg1 def      /opt arg1 def
     /ans [ ] def      /ans [ ] def
     /n opt length def      /n opt length def
   
       ecart.setOpt.init
   
     0 2 n 1 sub {      0 2 n 1 sub {
       /i set        /i set
       opt i get tag StringP eq not {        opt i get tag StringP eq not {
Line 59 
Line 70 
         exit          exit
       } {  } ifelse        } {  } ifelse
   
       ans [opt i get opt i 1 add get ]  append /ans set  % Global:  ecart.partialEcartGlobalVarX
         opt i get (partialEcartGlobalVarX) eq {
           /ecart.partialEcartGlobalVarX opt , i 1 add , get def
           % do not exit.
         } {  } ifelse
   
         ans [opt i get opt i 1 add get ]  join /ans set
       exit        exit
      } loop       } loop
     } for      } for
   
     ecart.gb.verbose {      ecart.gb.verbose {
       (ecart.setOpt:) message        (ecart.setOpt:) ecart.message
       (degreeShift=) messagen degreeShift message        (degreeShift=) ecart.messagen degreeShift ecart.message
       $hdShift(startingShift)=$ messagen hdShift message        $hdShift(startingShift)=$ ecart.messagen hdShift ecart.message
       (sugar=) messagen ecart.useSugar message        (sugar=) ecart.messagen ecart.useSugar ecart.message
       (Other options=) messagen ans message        (Other options=) ecart.messagen ans ecart.message
     } {  } ifelse      } {  } ifelse
   
     /arg1 ans def      /arg1 ans def
Line 89 
Line 106 
      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 132 
      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 150 
Line 167 
 [(ecart.homogenize01)  [(ecart.homogenize01)
  [(obj ecart.homogenize01 r)   [(obj ecart.homogenize01 r)
   (Example:  )    (Example:  )
     $(appell.sm1) run ; $
   (  [(x1,x2) ring_of_differential_operators )    (  [(x1,x2) ring_of_differential_operators )
   (   [[(H) 1 (h) 1 (x1) 1 (x2) 1] )    (   [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
   (    [(h) 1 (Dx1) 1 (Dx2) 1] )    (    [(h) 1 (Dx1) 1 (Dx2) 1] )
Line 246 
Line 264 
   $  [(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 267 
Line 286 
   $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  $    $             [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ]  $
   $             [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $    $             [(degreeShift) [[0 1] [-3 1]]] ] ecart.gb pmat ; $
   (  )    (  )
     $Example 6:  [ [(1-z) (-x+1-y-z)] (x,y,z)  $
     $              [[(y) -1 (z) -1 (Dy) 1 (Dz) 1] [(x) 1 (Dx) 1]] $
     $              [(partialEcartGlobalVarX) [(x)]] ] /std set $
     $             std ecart.gb pmat ; $
     $             std ecart.gb getRing :: $
     (  )
   (cf. gb, groebner, ecarth.gb, ecartd.gb, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )    (cf. gb, groebner, ecarth.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 )
Line 275 
Line 300 
   (               not to dehomogenize and homogenize)    (               not to dehomogenize and homogenize)
 ]] putUsages  ]] putUsages
   
 /ecart.gb.verbose 1 def  
 %ecarth.gb  s(H)-homogenized outputs.  GG's original version of ecart gb.  %ecarth.gb  s(H)-homogenized outputs.  GG's original version of ecart gb.
 /ecarth.gb {  /ecarth.gb {
   /arg1 set    /arg1 set
Line 295 
Line 319 
     /hdShift 0 def      /hdShift 0 def
     /opt [(weightedHomogenization) 1] def      /opt [(weightedHomogenization) 1] def
     /ecart.useSugar 0 def      /ecart.useSugar 0 def
       ecart.setOpt.init
     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 417 
Line 442 
     } { } ifelse      } { } ifelse
   
     %%BUG: case of v is integer      %%BUG: case of v is integer
     v ecart.checkOrder      [v ecart.partialEcartGlobalVarX] ecart.checkOrder
   
     ecart.begin      ecart.begin
   
Line 597 
Line 622 
     /wv 0 def      /wv 0 def
     /degreeShift 0 def      /degreeShift 0 def
     /opt [(weightedHomogenization) 1] def      /opt [(weightedHomogenization) 1] def
       ecart.setOpt.init
     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 716 
Line 742 
     } { } ifelse      } { } ifelse
   
     %%BUG: case of v is integer      %%BUG: case of v is integer
     v ecart.checkOrder      [v ecart.partialEcartGlobalVarX] ecart.checkOrder
   
     ecartn.begin      ecartn.begin
   
Line 794 
Line 820 
     /hdShift 0 def      /hdShift 0 def
     /ecart.useSugar 0 def      /ecart.useSugar 0 def
     /opt [(weightedHomogenization) 1] def      /opt [(weightedHomogenization) 1] def
       ecart.setOpt.init
     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 849 
Line 876 
   
     [(KanGBmessage) ecart.gb.verbose ] system_variable      [(KanGBmessage) ecart.gb.verbose ] system_variable
     $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ ecart.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 906 
Line 934 
     } { } ifelse      } { } ifelse
   
     %%BUG: case of v is integer      %%BUG: case of v is integer
     v ecart.checkOrder      [v ecart.partialEcartGlobalVarX] ecart.checkOrder
   
   
     ecartd.begin      ecartd.begin
   
     ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse      ecart.gb.verbose { (gb.options = ) ecart.messagen gb.options ecart.message } { } ifelse
Line 987 
Line 1016 
   
 /ecart.checkOrder {  /ecart.checkOrder {
   /arg1 set    /arg1 set
   [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables    [/vv] pushVariables
   [    [
     /vv arg1 def      /vv arg1 def
       vv length 1 eq {
         vv 0 get ecart.checkOrder.noGlobal /arg1 set
       }{
         vv ecart.checkOrder.global /arg1 set
       } ifelse
     ] pop
     popVariables
     /arg1
   } def
   /ecart.checkOrder.noGlobal {
     /arg1 set
     [/vv /tt /dd /n /i] pushVariables
     [
       /vv arg1 def
     vv isArray      vv isArray
     { } { [vv to_records pop] /vv set } ifelse      { } { [vv to_records pop] /vv set } ifelse
     vv {toString} map /vv set      vv {toString} map /vv set
Line 1013 
Line 1056 
   popVariables    popVariables
   arg1    arg1
 } def  } def
   
   /ecart.checkOrder.global {
     /arg1 set
     [/vv /vvGlobal /tt /dd /n /i] pushVariables
     [
       /vv arg1 def
       /vvGlobal vv 1 get def
       vv 0 get /vv set
       vv isArray
       { } { [vv to_records pop] /vv set } ifelse
       vv {toString} map /vv set
       vvGlobal isArray
       { } { [vvGlobal to_records pop] /vvGlobal set } ifelse
       vvGlobal {toString} map /vvGlobal set
   
       vv vvGlobal setMinus /vv set
       vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
       % Starting the checks.  Check for local variables.
       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
   
       % check for global variables.
       0 1 vvGlobal length 1 sub {
          /i set
          vvGlobal i get . /tt set
          tt (1). add init (1). eq { [vvGlobal i get ( is smaller than 1 ) ] cat error }
          { } ifelse
       } for
   
   
       /arg1 1 def
     ] pop
     popVariables
     arg1
   } def
 [(ecart.checkOrder)  [(ecart.checkOrder)
  [(v ecart.checkOrder bool checks if the given order is relevant)   [([v vGlobal] ecart.checkOrder bool checks if the given order is relevant)
   (for the ecart division.)    (for the ecart division.)
   (cf. ecartd.gb, ecart.gb, ecartn.gb)    (cf. ecartd.gb, ecart.gb, ecartn.gb)
  ]   ]
Line 1555 
Line 1644 
     /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 1590 
Line 1680 
        /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 1627 
Line 1717 
       (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 1647 
Line 1746 
        /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 1681 
Line 1780 
   $ (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 1694 
Line 1825 
      vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set       vv { /tt set [@@@.Dsymbol tt] cat } map /dvv set
      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       vv length 0 eq {
          /arg1 [ ] def
        } {
          /arg1 [wv1 wv2 ] def
        } ifelse
   ] pop    ] pop
   popVariables    popVariables
   arg1    arg1
Line 1705 
Line 1840 
   [/in-ecartd.isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f    [/in-ecartd.isSameIdeal_h /aa /ii /jj /iigg /jjgg /vv /ans /k /n /f
    /ecartd.isSameIdeal_h.opt     /ecartd.isSameIdeal_h.opt
    /save-ecart.autoHomogenize  /wv /save-ecart.message.quiet     /save-ecart.autoHomogenize  /wv /save-ecart.message.quiet
      /vvGlobal  /rng /noRecomputation
    ] pushVariables     ] pushVariables
   [(CurrentRingp) (Homogenize_vec)] pushEnv    [(CurrentRingp) (Homogenize_vec)] pushEnv
   [    [
Line 1712 
Line 1848 
     gb.verbose { (Getting in ecartd.isSameIdeal_h) message } { } ifelse      gb.verbose { (Getting in ecartd.isSameIdeal_h) message } { } ifelse
     %% comparison of hilbert series has not yet been implemented.      %% comparison of hilbert series has not yet been implemented.
     /save-ecart.message.quiet ecart.message.quiet def      /save-ecart.message.quiet ecart.message.quiet def
     aa length 3 eq {    }      aa length 2 gt {    }
     { ([ii jj vv] ecartd.isSameIdeal_h) error } ifelse      { ([ii jj vv] ecartd.isSameIdeal_h) error } ifelse
     /ii aa 0 get def      /ii aa 0 get def
     /jj aa 1 get def      /jj aa 1 get def
     /vv aa 2 get def      /vv aa 2 get def
   
       aa length 3 gt {
         /vvGlobal aa 3 get def
         vvGlobal isString { [vvGlobal to_records pop] /vvGlobal set }
         { vvGlobal { toString } map /vvGlobal set } ifelse
       } { /vvGlobal [ ] def } ifelse
   
     ii length 0 eq jj length 0 eq and      ii length 0 eq jj length 0 eq and
     { /ans 1 def /LLL.ecartd.isSame_h goto } {  } ifelse      { /ans 1 def /LLL.ecartd.isSame_h goto } {  } ifelse
   
     vv ecart.stdOrder /wv set      [vv vvGlobal] ecart.stdBlockOrder /wv set
       vvGlobal length 0 eq {
         /rng [vv wv ] def
       }{
         /rng [vv wv [(partialEcartGlobalVarX) vvGlobal]] def
       } ifelse
   
     /save-ecart.autoHomogenize ecart.autoHomogenize def      aa (noRecomputation) getNode /noRecomputation set
     /ecart.autoHomogenize 0 def      noRecomputation tag 0 eq { /noRecomputation 0 def } {
     [ii vv wv] ecartd.gb  /iigg set        /noRecomputation 1 def
     [jj vv wv] ecartd.gb  /jjgg set      } ifelse
     save-ecart.autoHomogenize /ecart.autoHomogenize set      noRecomputation {
         [ii] /iigg set  [jj] /jjgg set
       } {
         /save-ecart.autoHomogenize ecart.autoHomogenize def
         /ecart.autoHomogenize 0 def
         [ii] rng join  ecartd.gb  /iigg set
         [jj] rng join ecartd.gb  /jjgg set
         save-ecart.autoHomogenize /ecart.autoHomogenize set
       } ifelse
   
     iigg getRing ring_def      iigg getRing ring_def
   
Line 1736 
Line 1892 
     iigg 0 get /iigg set      iigg 0 get /iigg set
     jjgg 0 get /jjgg set      jjgg 0 get /jjgg set
     %%Bug: not implemented for the case of module.      %%Bug: not implemented for the case of module.
       /ecartd.isSameIdeal_h.gb [iigg jjgg] def
   
     /save-ecart.message.quiet ecart.message.quiet def      /save-ecart.message.quiet ecart.message.quiet def
     /ecart.message.quiet 1 def      /ecart.message.quiet 1 def
     gb.verbose { (Comparing) message iigg message (and) message jjgg message }      gb.verbose { (Comparing) message iigg message (and) message jjgg message }
     {  } ifelse      {  } ifelse
     gb.verbose { ( ii < jj ?) messagen } {  } ifelse      gb.verbose { ( ii < jj ?) messagen } {  } ifelse
       /ecartd.isSameIdeal_h.failed [ ] def
     iigg length /n set      iigg length /n set
     0 1 n 1 sub {      0 1 n 1 sub {
       /k set        /k set
       iigg  k get        iigg  k get
       [jjgg vv wv] ecartd.reduction 0 get        [jjgg] ecartd.reduction 0 get
       (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} {  } ifelse        (0). eq not {
           /ecartd.isSameIdeal_h.failed [ iigg k get jjgg] def
           /ans 0 def /LLL.ecartd.isSame_h goto
         } {  } ifelse
       gb.verbose { (o) messagen } {  } ifelse        gb.verbose { (o) messagen } {  } ifelse
     } for      } for
     gb.verbose { ( jj < ii ?) messagen } {  } ifelse      gb.verbose { ( jj < ii ?) messagen } {  } ifelse
Line 1755 
Line 1916 
     0 1 n 1 sub {      0 1 n 1 sub {
       /k set        /k set
       jjgg k get        jjgg k get
       [iigg vv wv] ecartd.reduction 0 get        [iigg] ecartd.reduction 0 get
       (0). eq not { /ans 0 def /LLL.ecartd.isSame_h goto} {  } ifelse        (0). eq not {
            /ecartd.isSameIdeal_h.failed [ iigg jjgg k get] def
            /ans 0 def /LLL.ecartd.isSame_h goto
         } {  } ifelse
       gb.verbose { (o) messagen } {  } ifelse        gb.verbose { (o) messagen } {  } ifelse
     } for      } for
     /LLL.ecartd.isSame_h      /LLL.ecartd.isSame_h
Line 1774 
Line 1938 
 [(ecartd.isSameIdeal_h)  [(ecartd.isSameIdeal_h)
 [([ii jj vv] ecartd.isSameIdeal_h bool)  [([ii jj vv] ecartd.isSameIdeal_h bool)
  (ii, jj : ideal, vv : variables)   (ii, jj : ideal, vv : variables)
  $The ideals ii and jj will be compared in the ring h[0,1](D).$   $The ideals ii and jj will be compared in the ring h[0,1](D_0).$
  $ii and jj are re-parsed.$   $ii and jj are re-parsed.$
  $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 $
    ( )
    ([ii jj vv vvGlobal] ecartd.isSameIdeal_h bool)
    $ Ideals are compared in Q(x')_0 [x''] <Dx',Dx'',h> $
    (  where x'' is specified in vvGlobal.)
    (cf. partialEcartGlobalVarX option)
    ( )
    $Option list: [(noRecomputation) 1] $
    $Example 2: [ [((1-x) Dx + h)]  [((1-x)^2 Dx + h (1-x))] (x)] ecartd.isSameIdeal_h $
    $    ecartd.isSameIdeal_h.gb 0 get /ii set $
    $    ecartd.isSameIdeal_h.gb 1 get /jj set $
    $   [ ii jj (x) [[(noRecomputation) 1]] ] ecartd.isSameIdeal_h $
 ]] putUsages  ]] putUsages
   
   /ecartd.isSameIdeal_noh {
     /arg1 set
     [/aa /ii /jj /iigg /jjgg /vv /ans /k /n /f
      /ecartd.isSameIdeal_h.opt
      /save-ecart.autoHomogenize  /wv /save-ecart.message.quiet
      /vvGlobal  /rng /noRecomputation
      ] pushVariables
     [(CurrentRingp) (Homogenize_vec)] pushEnv
     [
       /aa arg1 def
       gb.verbose { (Getting in ecartd.isSameIdeal_noh) message } { } ifelse
       %% comparison of hilbert series has not yet been implemented.
       /save-ecart.message.quiet ecart.message.quiet def
       aa length 2 gt {    }
       { ([ii jj vv] ecartd.isSameIdeal_noh) error } ifelse
       /ii aa 0 get def
       /jj aa 1 get def
       /vv aa 2 get def
   
       aa length 3 gt {
         /vvGlobal aa 3 get def
         vvGlobal isString { [vvGlobal to_records pop] /vvGlobal set }
         { vvGlobal { toString } map /vvGlobal set } ifelse
       } { /vvGlobal [ ] def } ifelse
   
       ii length 0 eq jj length 0 eq and
       { /ans 1 def /LLL.ecartd.isSame_h goto } {  } ifelse
   
       [vv vvGlobal] ecart.stdBlockOrder /wv set
       vvGlobal length 0 eq {
         /rng [vv wv ] def
       }{
         /rng [vv wv [(partialEcartGlobalVarX) vvGlobal]] def
       } ifelse
   
       aa (noRecomputation) getNode /noRecomputation set
       noRecomputation tag 0 eq { /noRecomputation 0 def } {
         /noRecomputation 1 def
       } ifelse
       noRecomputation {
         [ii] /iigg set  [jj] /jjgg set
       } {
         /save-ecart.autoHomogenize ecart.autoHomogenize def
         /ecart.autoHomogenize 0 def
         [ii] rng join  ecartd.gb  /iigg set
         [jj] rng join ecartd.gb  /jjgg set
         save-ecart.autoHomogenize /ecart.autoHomogenize set
       } ifelse
   
       iigg getRing ring_def
   
       getOptions /ecartd.isSameIdeal_h.opt set
   
       /ans 1 def
       iigg 0 get /iigg set
       jjgg 0 get /jjgg set
       /ecartd.isSameIdeal_noh.gb [iigg jjgg] def
       %%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
       /ecartd.isSameIdeal_noh.failed [ ] def
       iigg length /n set
       0 1 n 1 sub {
         /k set
         iigg  k get
         [jjgg] ecartd.reduction_noh 0 get
         (0). eq not {
            /ecartd.isSameIdeal_noh.failed [ iigg k get jjgg] def
            /ans 0 def /LLL.ecartd.isSame_noh 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] ecartd.reduction_noh 0 get
         (0). eq not {
           /ecartd.isSameIdeal_noh.failed [ iigg jjgg k get] def
           /ans 0 def /LLL.ecartd.isSame_noh goto
         } {  } ifelse
         gb.verbose { (o) messagen } {  } ifelse
       } for
       /LLL.ecartd.isSame_noh
       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_noh)
   [([ii jj vv] ecartd.isSameIdeal_noh bool)
    (ii, jj : ideal, vv : variables)
    $The ideals ii and jj will be compared in the ring D_0.$
    $ii and jj are re-parsed.$
    $Example 1: [ [((1-x) Dx + 1)]  [((1-x)^2 Dx + (1-x))] (x)] ecartd.isSameIdeal_noh $
    ([ii jj vv vvGlobal] ecartd.isSameIdeal_noh bool)
    $ Ideals are compared in Q(x')_0 [x''] <Dx',Dx''> $
    (  where x'' is specified in vvGlobal.)
    (cf. partialEcartGlobalVarX option, ecartd.reduction_noh, ecartd.isSameIdeal_h)
    $Example 2: [ [(1-z) (1-x-y-z)]  [(1-x) (1-y)] (x,y,z) [(x)]] $
    $            ecartd.isSameIdeal_noh $
    $Option list: [(noRecomputation) 1] $
    $Example 2': [ [(1-z) (1-x-y-z)]  [(1-x) (1-y)] (x,y,z) [(x)]] ecartd.isSameIdeal_noh$
    $    ecartd.isSameIdeal_noh.gb 0 get /ii set $
    $    ecartd.isSameIdeal_noh.gb 1 get /jj set $
    $   [ ii jj (x) [[(noRecomputation) 1]] ] ecartd.isSameIdeal_noh $
   ]] putUsages
   (ecartd.isSameIdeal_noh ) messagen-quiet
   
 /ecart.01Order {  /ecart.01Order {
   /arg1 set    /arg1 set
   [/in-ecart.01Order /vv /tt /dvv /wv1 /wv2    [/in-ecart.01Order /vv /tt /dvv /wv1 /wv2
Line 1798 
Line 2092 
 } def  } def
 /ecart.homogenize01Ideal {  /ecart.homogenize01Ideal {
  /arg1 set   /arg1 set
  [/in.ecart.homogenize01Ideal /ll /vv /wv] pushVariables   [/in.ecart.homogenize01Ideal /ll /vv /wv /ans] pushVariables
  [   [
    /ll arg1 0 get def     /ll arg1 0 get def
    /vv arg1 1 get def     /vv arg1 1 get def
    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 /arg1 set     ll ___ {ecart.homogenize01 ecart.dehomogenizeH} map /ans set
      ecart.end
      /arg1 ans def
  ] pop   ] pop
  popVariables   popVariables
  arg1   arg1
Line 1824 
Line 2120 
  $Example 1: [ [((1-x) Dx + 1)] (x)] ecart.homogenize01Ideal $   $Example 1: [ [((1-x) Dx + 1)] (x)] ecart.homogenize01Ideal $
 ]] putUsages  ]] putUsages
   
   % Example: [(x,y,z) (x)] ecart.stdBlockOrder
   %            [[(Dy) 1 (Dz) 1] [(y) -1 (z) -1 (Dy) 1 (Dz) 1] [(x) 1 (Dx) 1]]
   % Example: [(x,y,z) [ ]] ecart.stdBlockOrder
   /ecart.stdBlockOrder {
     /arg1 set
     [/vv /vvGlobal /tt /dd /rr] pushVariables
     [
       /vv arg1 0 get def
       /vvGlobal arg1 1 get def
       {
         vv isArray
         { } { [vv to_records pop] /vv set } ifelse
         vv {toString} map /vv set
         vvGlobal isArray
         { } { [vvGlobal to_records pop] /vvGlobal set } ifelse
         vvGlobal {toString} map /vvGlobal set
   
         vvGlobal length 0 eq {
            vv ecart.stdOrder /rr set exit
         } {  } ifelse
   
         vv vvGlobal setMinus /vv set
         vv ecart.stdOrder /rr set
   
         vvGlobal { /tt set [@@@.Dsymbol tt] cat } map /dd set
         [[
            0 1 vvGlobal length 1 sub {
              /tt set
              vvGlobal tt get , 1
            } for
            0 1 dd length 1 sub {
              /tt set
              dd tt get , 1
            } for
         ]] rr join /rr set
         exit
       } loop
       /arg1 rr def
     ] pop
     popVariables
     arg1
   } def
   
 ( ) message-quiet  ( ) message-quiet
   
   /ecart_loaded 1 def
   
Legend:
Removed from v.1.24  
changed lines
  Added in v.1.40
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>