[BACK]Return to gfan.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / kan96xx / Doc

Diff for /OpenXM/src/kan96xx/Doc/gfan.sm1 between version 1.6 and 1.15

version 1.6, 2004/09/30 07:39:42 version 1.15, 2009/09/04 00:53:48
Line 1 
Line 1 
 %  $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.5 2004/09/16 06:16:44 takayama Exp $  %  $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.14 2009/08/26 05:03:49 takayama Exp $
 % cp cone.sm1 $OpenXM_HOME/src/kan96xx/Doc/gfan.sm1  % cp cone.sm1 $OpenXM_HOME/src/kan96xx/Doc/gfan.sm1
 % $Id$  % $Id$
 % iso-2022-jp  % iso-2022-jp
   %%Ref:  @s/2004/08/21-note.pdf
   
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% Two examples are given below to get a global Grobner fan and  %% Two examples are given below to get a global Grobner fan and
Line 12 
Line 13 
 %% How to input data?  An example.   (cf. test13.sm1)  %% How to input data?  An example.   (cf. test13.sm1)
 %%  Modify the following or copy the /cone.sample { ... } def  %%  Modify the following or copy the /cone.sample { ... } def
 %%  to your own file,  %%  to your own file,
 %%  edit it, and execute if by  " cone.sample ; "  %%  edit it, and execute it by  " cone.sample ; "
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 /cone.sample {  /cone.sample {
   cone.load.cohom    cone.load.cohom
     /cone.ckmFlip  1 def
 % write a comment about the problem.  "nl" means new line.  % write a comment about the problem.  "nl" means new line.
 /cone.comment [  /cone.comment [
   (Toric ideal for 1-simplex x 2-simplex, in k[x]) nl    (Toric ideal for 1-simplex x 2-simplex, in k[x]) nl
Line 75  def   
Line 77  def   
   ]    ]
 def  def
   
   /cone.DhH  0 def
 % Set a function to compute Grobner basis.  % Set a function to compute Grobner basis.
 %  cone.gb_Dh   : For computing in Homogenized Weyl algebra h[1,1](D).  %  cone.gb_Dh   : For computing in Homogenized Weyl algebra h[1,1](D).
 %  cone.gb_DhH  : For computing in doubly homogenized Weyl algebra.  %  cone.gb_DhH  : For computing in doubly homogenized Weyl algebra.
Line 96  getGrobnerFan
Line 99  getGrobnerFan
 printGrobnerFan  printGrobnerFan
   
 %%%% If you want to save the data to the file sm1out.txt, then uncomment.  %%%% If you want to save the data to the file sm1out.txt, then uncomment.
 % /cone.wightGblist 1 def saveGrobnerFan /ff set ff output  % /cone.withGblist 1 def saveGrobnerFan /ff set ff output
   
 %%%% Step 2. Dehomogenize the Grobner Cones  %%%% Step 2. Dehomogenize the Grobner Cones
 %%%%  by the equivalence relation in a local ring (uncomment).  %%%%  by the equivalence relation in a local ring (uncomment).
Line 127  printGrobnerFan 
Line 130  printGrobnerFan 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 /cone.sample2 {  /cone.sample2 {
   cone.load.cohom    cone.load.cohom
     /cone.ckmFlip  1 def
 % write a comment about the problem.  "nl" means new line.  % write a comment about the problem.  "nl" means new line.
 /cone.comment [  /cone.comment [
   (BS for y and y-(x-1)^2, t1, t2 space, in doubly homogenized Weyl algebra.) nl    (BS for y and y-(x-1)^2, t1, t2 space, in doubly homogenized Weyl algebra.) nl
Line 193  def
Line 197  def
   cone.input { . homogenize toString } map /cone.input set    cone.input { . homogenize toString } map /cone.input set
   dh.end    dh.end
   
   /cone.DhH  1 def
 % Set a function to compute Grobner basis.  % Set a function to compute Grobner basis.
 %  cone.gb_Dh   : For computing in Homogenized Weyl algebra h[1,1](D).  %  cone.gb_Dh   : For computing in Homogenized Weyl algebra h[1,1](D).
 %  cone.gb_DhH  : For computing in doubly homogenized Weyl algebra.  %  cone.gb_DhH  : For computing in doubly homogenized Weyl algebra.
Line 213  getGrobnerFan
Line 218  getGrobnerFan
 printGrobnerFan  printGrobnerFan
   
 %%%% If you want to save the data to the file sm1out.txt, then uncomment.  %%%% If you want to save the data to the file sm1out.txt, then uncomment.
 % /cone.wightGblist 1 def saveGrobnerFan /ff set ff output  % /cone.withGblist 1 def saveGrobnerFan /ff set ff output
   
 %%%% Step 2. Dehomogenize the Grobner Cones  %%%% Step 2. Dehomogenize the Grobner Cones
 %%%%  by the equivalence relation in a local ring (uncomment).  %%%%  by the equivalence relation in a local ring (uncomment).
Line 243  dhcone.printGrobnerFan 
Line 248  dhcone.printGrobnerFan 
   
 % If you use local polymake, then comment out.  % If you use local polymake, then comment out.
 % If you use the cgi/polymake on the net, then uncomment out.  % If you use the cgi/polymake on the net, then uncomment out.
 %/doPolymake {doPolymake.OoHG} def  %/doPolymake {doPolymake.OoHG} def    (Using doPolymake.OoHG ) message
   %/polymake.start {polymake.start.OoHG} def (Using polymake.start.OoHG ) message
   %% Choose it automatically.
   [(which) (polymake)] oxshell tag 0 eq {
     (Polymake is not installed in this system.)  message
     /doPolymake {doPolymake.OoHG} def
     (Using doPolymake.OoHG ) message
     /polymake.start {polymake.start.OoHG} def
     (Using polymake.start.OoHG ) message
   } { (Local polymake will be used.) message } ifelse
   
 % My setting.  
 [(getenv) (HOST)] extension /cone.hostname set  
 cone.hostname tag 0 eq { /cone.hostname (?) def }  { } ifelse  
 cone.hostname (orange2.math.sci.kobe-u.ac.jp) eq  
 cone.hostname (orange2-clone.math.sci.kobe-u.ac.jp) eq  
 or  
 {  
    (Using doPolymake.OoHG ) message  
    /doPolymake {doPolymake.OoHG} def  
 } {  } ifelse  
   
 /cone.debug 1 def  /cone.debug 1 def
   
 /ox.k0.loaded boundp {  /ox.k0.loaded boundp {
Line 267  or
Line 270  or
  /cone.loaded boundp { }   /cone.loaded boundp { }
  {   {
   [(parse) (cohom.sm1) pushfile] extension    [(parse) (cohom.sm1) pushfile] extension
   [(parse) (cone.sm1) pushfile] extension  %  [(parse) (cone.sm1) pushfile] extension   % BUG? cone.sm1 overrides a global
                                                % in cohom.sm1?
   [(parse) (dhecart.sm1) pushfile] extension    [(parse) (dhecart.sm1) pushfile] extension
   /cone.loaded 1 def    /cone.loaded 1 def
   oxNoX polymake.start  (  ) message    oxNoX
     polymake.start  (  ) message
  } ifelse   } ifelse
 } def  } def
   
Line 290  or
Line 295  or
      /dh.autoHomogenize 0 def       /dh.autoHomogenize 0 def
      [(AutoReduce) 1] system_variable       [(AutoReduce) 1] system_variable
      [ff { toString } map cone.vv       [ff { toString } map cone.vv
       [ww cone.vv generateD1_1]] dh.gb 0 get /arg1 set        [ww cone.vv generateD1_1]] ff getAttributeList setAttributeList
        dh.gb 0 get /arg1 set
   ] pop    ] pop
     popVariables
   arg1    arg1
 } def  } def
   
Line 395  cone.comment message
Line 402  cone.comment message
 %         cone.d (pointed cones lies in this space. cf. cone.Lp)  %         cone.d (pointed cones lies in this space. cf. cone.Lp)
 % These are set during getting the cone.startingCone  % These are set during getting the cone.startingCone
   
   %<
   % global
   %cone.ckmFlip. Collar-Kalkbrener-Mall $B$N(B flip $B%"%k%4%j%:%`$r;H$o$J$$(B 0. $B;H$&(B 1.
   %  Default $B$O(B 0.
   %>
   /cone.ckmFlip 0 def
   
 %<  %<
   % global
   % cone.DhH  dx x = x dx + h H $B$J$i(B 1. dx x = x dx + h^2 $B$J$i(B 0. Default 0.
   %>
   /cone.DhH  0 def
   
   %<
   % Global
   % gbCheck $B$r$9$k$+(B? $B$7$J$$$H7k2L$O$"$d$U$d(B. $B$7$+$7%a%b%j(B exhaust $B$OKI$2$k(B.
   % $B;H$&$H$-$O(B /cone.epsilon,  /cone.epsilon.limit $B$r==J,>.$5$/$7$F$*$/(B.
   %>
   /cone.do_gbCheck 1 def
   
   % Default $B$N(B cone.gb $B$NDj5A(B. $B3F%W%m%0%i%`$G:FEYDj5A$7$F$b$h$$(B.
   /cone.gb {
     cone.DhH {
        cone.gb_DhH
     } {
        cone.gb_Dh
     } ifelse
   } def
   
   %<
 % Usage:  wv g coneEq1  % Usage:  wv g coneEq1
 % in(f) $B$,(B monomial $B@lMQ(B.  in_w(f) = LT(f) $B$H$J$k(B weight w $B$NK~$?$9(B  % in(f) $B$,(B monomial $B@lMQ(B.  in_w(f) = LT(f) $B$H$J$k(B weight w $B$NK~$?$9(B
 % $BITEy<0@)Ls$r5a$a$k(B.  % $BITEy<0@)Ls$r5a$a$k(B.
Line 985  def
Line 1020  def
 %>  %>
 /getConeInfo {  /getConeInfo {
   /arg1 set    /arg1 set
   [/ww /g /ceq /ceq2 /cdim /mmc /mmL /rr /ineq /ppt] pushVariables    [/ww /g /ceq /ceq2 /cdim /mmc /mmL /rr /ineq /ppt /rr0 /mm0 /mm1] pushVariables
   [    [
      /ceq arg1 def       /ceq arg1 def
      ceq pruneZeroVector /ceq set       ceq pruneZeroVector /ceq set
   
        ceq length 0 eq {
          (Monomial ideal is not accepted as an input.) cone_ir_input
        } { } ifelse
   
       /mm1
        ( Use [(keep_tmp_files) 1] oxshell to check the input to polymake2tfb. See /tmp or $TMP )
       def
   
      ceq genPo2 /ceq2 set       ceq genPo2 /ceq2 set
      % ceq2 $B$O(B polymake.data(polymake.INEQUALITIES(...)) $B7A<0(B       % ceq2 $B$O(B polymake.data(polymake.INEQUALITIES(...)) $B7A<0(B
      % polymake $B$G(B ceq2 $B$N<!85$N7W;;(B.       % polymake $B$G(B ceq2 $B$N<!85$N7W;;(B.
      /getConeInfo.ceq  ceq def /getConeInfo.ceq2 ceq2 def       /getConeInfo.ceq  ceq def /getConeInfo.ceq2 ceq2 def
   
      cone.debug { (Calling polymake DIM.) message } { } ifelse       cone.debug { (Calling polymake DIM.) message } { } ifelse
      [(DIM) ceq2] doPolymake 1 get /rr set       [(DIM) ceq2] doPolymake /rr0 set
        % rr0 2 get message
        rr0 2 get 1 get 0 get /mm0 set
        mm0 length 0 eq { }
        { [mm0 mm1] cat error } ifelse
        rr0 1 get /rr set
      cone.debug {(Done.) message } {  } ifelse       cone.debug {(Done.) message } {  } ifelse
 % test5 $B$K$O<!$N%3%a%s%H$H$j$5$k(B. $B>e$N9T$r%3%a%s%H%"%&%H(B.  % test5 $B$K$O<!$N%3%a%s%H$H$j$5$k(B. $B>e$N9T$r%3%a%s%H%"%&%H(B.
 %     test5.data tfbToTree /rr set  %     test5.data tfbToTree /rr set
Line 1010  def
Line 1059  def
      % FACETS $B$r;}$C$F$$$J$$$J$i:FEY7W;;$9$k(B.       % FACETS $B$r;}$C$F$$$J$$$J$i:FEY7W;;$9$k(B.
      % POINTED, NOT__POINTED $B$bF@$i$l$k(B       % POINTED, NOT__POINTED $B$bF@$i$l$k(B
        cone.debug { (Calling polymake FACETS.) message } { } ifelse         cone.debug { (Calling polymake FACETS.) message } { } ifelse
        [(FACETS) ceq2] doPolymake 1 get /rr set         [(FACETS) ceq2] doPolymake /rr0 set
   
        % rr0 2 get message
        rr0 2 get 1 get 0 get /mm0 set
        mm0 length 0 eq { }
        { [mm0 mm1] cat error } ifelse
   
          rr0 1 get /rr set
        cone.debug { (Done.) message } { } ifelse         cone.debug { (Done.) message } { } ifelse
    } {  } ifelse     } {  } ifelse
   
Line 1586  def
Line 1642  def
     /vlist arg1 def      /vlist arg1 def
     /wlist arg2 def      /wlist arg2 def
     wlist length vlist length eq {      wlist length vlist length eq {
     } {  (cone_wtowv: length of the argument must be the same.) error} ifelse      } {  (cone_wtowv: length of the argument must be the same. Please check the values of cone.vlist cone.vv cone.type parametrizeWeightSpace) error} ifelse
   
     wlist to_int32 /wlist set      wlist to_int32 /wlist set
     [      [
Line 1843  def
Line 1899  def
 % note: 2004.9.2  % note: 2004.9.2
     cone (facetsv) getNode 2 get facet_i get /v set      cone (facetsv) getNode 2 get facet_i get /v set
     cone (facets)  getNode 2 get facet_i get /f set      cone (facets)  getNode 2 get facet_i get /f set
   
       v length 0 eq {
          (The codimension of the linarity space of the Grobner cone seems to be 1 or 0.) cone_ir_input
        } { } ifelse
   
     /vp v 0 get def      /vp v 0 get def
     1 1 v length 1 sub {      1 1 v length 1 sub {
       /ii set        /ii set
Line 2020  def
Line 2081  def
 %>  %>
 /cone.gb_Dh {  /cone.gb_Dh {
   /arg2 set /arg1 set    /arg2 set /arg1 set
   [/ff /ww /gg] pushVariables    [/ff /ww /gg /gbopt] pushVariables
   [    [
     /ff arg1 def      /ff arg1 def
     /ww arg2 def      /ww arg2 def
     [(AutoReduce) 1] system_variable      [(AutoReduce) 1] system_variable
     [cone.vv ring_of_differential_operators      [cone.vv ring_of_differential_operators
      [ww] weight_vector 0] define_ring       [ww] weight_vector 0] define_ring
     [ff {toString .} map] groebner 0 get /gg set      %(---) messagen ff getAttributeList message
       ff getAttributeList tag 0 eq {/gbopt [ ] def }
       {
          /gbopt ff getAttributeList def
       } ifelse
      [ff {toString .} map gbopt]
       groebner 0 get /gg set   %% groenber $B$O(B attribute $B$r<u$1IU$1$J$$(B.
     /cone.gb_Dh.g gg def      /cone.gb_Dh.g gg def
     /arg1 gg def      /arg1 gg def
   ] pop    ] pop
Line 2323  def   
Line 2390  def   
 } def  } def
   
 %<  %<
 % usages: getNextFlip [cone, k]  % usages: getNextFlip [cone, k, cid]
 % cone.fan $B$r8!:w$7$F(B $B$^$@(B flip $B$7$F$J$$(B cone $B$H(B facet $B$NAH$rLa$9(B.  % cone.fan $B$r8!:w$7$F(B $B$^$@(B flip $B$7$F$J$$(B cone $B$H(B facet $B$NAH$rLa$9(B.
 % $B$b$&$J$$$H$-$K$O(B null $B$rLa$9(B.  % $B$b$&$J$$$H$-$K$O(B null $B$rLa$9(B.
   % cid $B$O(B cone $B$,(B cone.fan $B$N(B $B2?HVL\$G$"$k$+$N(B index.  cone.gblist $B$N8!:wEy$K(B
   % $BMQ$$$k(B.
 %>  %>
 /getNextFlip {  /getNextFlip {
   [/tcone /ans /ii ] pushVariables    [/tcone /ans /ii /cid] pushVariables
   [    [
     /ans null def      /ans null def /cid -1 def
     0 1 cone.fan length 1 sub {      0 1 cone.fan length 1 sub {
       /ii set        /ii set
       cone.fan  ii get /tcone set        cone.fan  ii get /tcone set
         /cid ii def
       tcone getNextFacet /ans set        tcone getNextFacet /ans set
       ans tag 0 eq { } { exit } ifelse        ans tag 0 eq { } { exit } ifelse
     } for      } for
     ans tag 0 eq { /arg1 null def }      ans tag 0 eq { /arg1 null def }
     { /arg1 [tcone ans] def } ifelse      { /arg1 [tcone ans cid] def } ifelse
   ] pop    ] pop
   popVariables    popVariables
   arg1    arg1
Line 2348  def   
Line 2418  def   
 %   flip $B$N;~$N(B epsilon  %   flip $B$N;~$N(B epsilon
 /cone.epsilon (1).. (10).. div def  /cone.epsilon (1).. (10).. div def
 /cone.epsilon.limit (1).. (100).. div def  /cone.epsilon.limit (1).. (100).. div def
   % cone.epsilon.limit $B$rIi$K$9$l$PDd;_$7$J$$(B.
   
 %<  %<
 %  Usages: result_getNextFlip getNextCone ncone  %  Usages: result_getNextFlip getNextCone ncone
 %  flip $B$7$F?7$7$$(B ncone $B$rF@$k(B.  %  flip $B$7$F?7$7$$(B ncone $B$rF@$k(B.
 %>  %>
 /getNextCone {  /getNextCone.orig {
  /arg1 set   /arg1 set
  [/ncone /ccone /kk /w /next_weight_w_wv] pushVariables   [/ncone /ccone /kk /w /next_weight_w_wv] pushVariables
  [   [
Line 3412  def   
Line 3483  def   
 %  %
   
 % Todo: save functions.  % Todo: save functions.
   
   %<
   % Collart, Kalkbrener, Mall $B$N%"%k%4%j%:%`$K$h$k(B gb $B$N(B flip.
   % See also Sturmfels' book, p.22, 23.
   % Usages: [reducedGb, vlist, oldWeight, facetWeight, newWeight] ckmFlip rGb
   %  If it fails, then it returns null, else it returns the reducedGb for the
   %  newWeight.
   %  gb $B$N(B check $B$r$d$k$N$G(B, $B$=$l$K<:GT$7$?$i(B null $B$rLa$9(B.
   %  weight $B$O$9$Y$F(B vw $B7A<0$G(B. vw $B7A<0(B = variable weight $B$N7+$jJV$7$N7A<0(B
   %  reducedGb $B$OJ8;zNs$N%j%9%H$G$O$J$/B?9`<0$N7A<0$N$3$H(B.
   %   $BM}M3$O(B reducedGb $B$h$j(B ring $B$N9=B$$rFI$`$?$a(B.
   %>
   /ckmFlip {
     /arg1 set
     [/arg_ckmFlip /gOld /vlist /oldWeight /facetWeight /newWeight
      /gNew
      /ww /ww1 /ww2  % $BK\$NCf$N(B w1, w, w2  ($B8E$$(B, facet, $B?7$7$$(B)
      /ch1 /ch2      % $BK\$NCf$N(B {\cal H}_1, {\cal H}_2
      /grData  /rTable
      /rTable2 % rTable $B$NH?BP$NJQ49(B.
      /facetWeight_gr /vlist_gr  % graded ring $BMQ(B.
      /oldWeight_gr
      /ccf  % reduction $B$7$?78?t(B.
      /rwork /ccf2 /gNew
     ] pushVariables
     [
       arg1 /arg_ckmFlip set
       arg_ckmFlip 0 get /gOld set
       arg_ckmFlip 1 get /vlist set
       arg_ckmFlip 2 get /oldWeight set
       arg_ckmFlip 3 get /facetWeight set
       arg_ckmFlip 4 get /newWeight set
   
   % facet weight vector ww $B$K$D$$$F$N(B initial $B$r<h$j=P$9(B. ch1 $B$X$$$l$k(B.
       gOld getRing ring_def
       facetWeight weightv /ww set
       gOld { ww init } map /ch1 set  % facetWeight $B$K$h$k(B initial $B$N<h$j=P$7(B.
   
   
   %  $BNc(B: [(x,y) [(x) -1 (Dx) 1 (y) -1 (Dy) 2]] getGrRing
   %      [$x,y,y',$ , [    $x$ , $y$ ]  , [    [    $Dy$ , $y'$ ]  ]  ]
   %       $BJQ?t%j%9%H(B                            $BCV49I=(B
   %  ch1 $B$r(B gr_ww $B$N85$KJQ49(B.
       [vlist facetWeight] getGrRing /grData set
       [grData 0 get ring_of_differential_operators 0]  define_ring /rwork set
       grData 2 get { { . } map } map /rTable set
       rTable { reverse } map /rTable2 set
       grData 0 get /vlist_gr set
       ch1 { toString . rTable replace toString } map /ch1 set
   
       oldWeight { dup isString { . rTable replace toString }
                                  { } ifelse } map /oldWeight_gr set
   
   % facetWeight $B$b(B $B?7$7$$4D(B gr_ww  $B$N(B weight $B$KJQ49(B.
   % $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2]
       facetWeight { dup isString { . rTable replace toString }
                                  { } ifelse } map /facetWeight_gr set
   
   % newWeight $B$b(B $B?7$7$$4D(B gr_ww  $B$N(B weight $B$KJQ49(B.
   % $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2]
       newWeight { dup isString { . rTable replace toString }
                                  { } ifelse } map /newWeight_gr set
   
   % Dx x = x Dx + h H  or Dx x = x Dx + h^2 $B$G7W;;(B.
   % $B$I$A$i$r$H$k$+$O(B cone.gb_gr $B$G6hJL$9$k$7$+$J$7(B
       %% [ch1 vlist_gr oldWeight_gr] /ttt set
       %% ttt cone.gb_gr /ch1 set %$B:FEY$N7W;;$OITMW(B.
       [[(1)] vlist_gr oldWeight_gr] cone.gb_gr getRing ring_def % Set Ring.
       ch1 {toString .} map  /ch1 set
   %% $B$3$3$^$G$G$H$j$"$($:%F%9%H$r$7$h$&(B.
   %%    ch1 /arg1 set
       [ch1 { toString } map vlist_gr newWeight_gr] cone.gb_gr /ch2 set
   
   % Dx x = x Dx + h H  or Dx x = x Dx + h^2 $B$G7W;;(B.
   % $B$I$A$i$r$H$k$+$O(B cone.reduction_gr $B$G6hJL$9$k$7$+$J$7(B
       ch1 getRing ring_def ;
       ch2 {toString .} map {ch1 cone.reduction} map /ccf set
       %ccf pmat
       % $B$H$j$"$($:%F%9%H(B.
       % [ch1 ch2] /arg1 set
       %% ccf[i][0] $B$O(B 0 $B$G$J$$$HL7=b(B.  check $B$^$@$7$F$J$$(B.
   
       %% ccf[i][2] (syzygy) $B$r(B gr $B$+$i(B $B$b$H$N(B ring $B$XLa$7(B,
       %% $B?7$7$$(B reduced gbasis $B$r(B ccf[i][2] * gOld $B$G:n$k(B.
       rwork ring_def
       ccf { 2 get {toString  . rTable2 replace toString} map } map /ccf2 set
       %% ccf2 $B$O(B gr $B$G$J$$(B ring $B$N85(B.
       gOld getRing ring_def
       cone.DhH { cone.begin_DhH } {  } ifelse % Hh $B$+(B h^2 $B$+(B.
       ccf2 { {.} map gOld mul } map /gNew set
       gNew { toString } map /gNew set
       cone.DhH { cone.end_DhH } {  } ifelse % Hh $B$+(B h^2 $B$+(B.
       % gNew /arg1 set
       %gNew $B$,(B newWeight $B$G$N(B GB $B$+(B check. Yes $B$J$i(B reduced basis $B$X(B.
       %No $B$J$i(B null $B$rLa$9(B.
   %%Ref: note @s/2005/06/30-note-gfan.pdf
       cone.do_gbCheck not {
          (Warning! gbCheck is skipped.) message
       } {
          (Doing gbCheck.) message
       } ifelse
       cone.do_gbCheck {
        gNew [(gbCheck) 1] setAttributeList newWeight
           cone.gb (gb) getAttribute
       } { 1 } ifelse
       1 eq {
        gNew [(reduceOnly) 1] setAttributeList newWeight cone.gb /arg1 set
       }{ /arg1 null def } ifelse
     ] pop
     popVariables
     arg1
   } def
   
   %<
   % Usages: f gbasis cone.reduction_DhH
   %       dx x = x dx + h H $B$G$N(B reduction.
   %>
   /cone.reduction_DhH {
     /arg2 set /arg1 set
     [/ff /ggbasis /eenv /ans] pushVariables
     [
       /ff arg1 def /ggbasis arg2 def
       cone.begin_DhH
       ff ggbasis reduction /ans set
       cone.end_DhH
       /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   
   %<
   % Usages: f gbasis cone.reduction_Dh
   %       dx x = x dx + h^2 $B$G$N(B reduction.
   %>
   /cone.reduction_Dh {
     /arg2 set /arg1 set
     [/ff /ggbasis /eenv /ans] pushVariables
     [
       /ff arg1 def /ggbasis arg2 def
       ff ggbasis reduction /ans set
       /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   
   %<
   % Usages: cone.begin_DhH   dx x = x dx + h H $B$r3+;O(B.
   %>
   /cone.begin_DhH {
     [(Homogenize) (AutoReduce) (KanGBmessage)] pushEnv /cone.eenv set
     [(Homogenize) 3] system_variable
   } def
   
   %<
   % Usages: cone.begin_DhH   dx x = x dx + h H $B$r=*N;(B.
   %>
   /cone.end_DhH {
     cone.eenv popEnv
   } def
   
   %<
   % Usages: ff vv ww cone.gb_gr_DhH   dx x = x dx + h H $B$G7W;;(B.
   %   dh.gb $B$O(B dhecart.sm1 $B$GDj5A$5$l$F$*$j(B, dx x = x dx + h H $B$G$N7W;;(B.
   %   gr $B$r$H$C$F$b(B, -w,w $B$N>l9g$O(B $BHyJ,:nMQAG4D$N$^$^$G$"$j(B, $B$3$l$,I,MW(B.
   %   bug? cone.gb $B$G==J,(B?
   %>
   /cone.gb_gr_DhH {
     /arg1 set
     [/ff /ww /vv] pushVariables
     [
        /ff arg1 0 get def
        /vv arg1 1 get def
        /ww arg1 2 get def
        /dh.gb.verbose 1 def
        /dh.autoHomogenize 0 def
        [(AutoReduce) 1] system_variable
        [ff { toString } map vv
         [ww vv generateD1_1]] dh.gb 0 get /arg1 set
     ] pop
     popVariables
     arg1
   } def
   %<
   % Usages: ff vv ww cone.gb_gr_Dh   dx x = x dx + h^2 $B$G7W;;(B.
   %   gb $B$O(B dhecart.sm1 $B$GDj5A$5$l$F$*$j(B, dx x = x dx + h^2 $B$G$N7W;;(B.
   %   gr $B$r$H$C$F$b(B, -w,w $B$N>l9g$O(B $BHyJ,:nMQAG4D$N$^$^$G$"$j(B, $B$3$l$,I,MW(B.
   %   bug? cone.gb $B$G==J,(B?
   %>
   /cone.gb_gr_Dh {
     /arg1 set
     [/ff /ww /vv /gg /envtmp] pushVariables
     [
        /ff arg1 0 get def
        /vv arg1 1 get def
        /ww arg1 2 get def
   
        [(AutoReduce) (KanGBmessage)] pushEnv /envtmp set
        [(AutoReduce) 1] system_variable
        [(KanGBmessage) 1] system_variable
        [vv ring_of_differential_operators
        [ww] weight_vector 0] define_ring
        [ff {toString .} map] ff getAttributeList setAttributeList
        groebner 0 get /gg set
        envtmp popEnv
   
        /arg1 gg def
     ] pop
     popVariables
     arg1
   } def
   
   
   % $B$3$l$i$O(B cone.ckmFlip 1 $B$N;~$7$+;H$o$:(B.
   /cone.reduction {
     cone.DhH {
       cone.reduction_DhH
     }{
       cone.reduction_Dh
     } ifelse
   } def
   /cone.gb_gr {
     cone.DhH {
       cone.gb_gr_DhH
     }{
       cone.gb_gr_Dh
     } ifelse
   } def
   
   
   /test1.ckmFlip {
    % cf. cone.sample2
      cone.load.cohom
    /cone.comment [
      (BS for y and y-(x-1)^2, t1, t2 space, in doubly homogenized Weyl algebra.) nl
      (The Grobner cones are dehomogenized to get local Grobner fan.) nl
    ] cat def
    /cone.vlist [(t1) (t2) (x) (y) (Dt1) (Dt2) (Dx) (Dy) (h) (H)] def
    /cone.vv (t1,t2,x,y) def
    /cone.type 1 def
    /cone.parametrizeWeightSpace {
      4 2 parametrizeSmallFan
    } def
   
    /cone.DhH 1 def
    /cone.ckmFlip 1 def
   
    /cone.local 1 def
    /cone.w_start  null def
    /cone.h0 1 def
    /cone.input
      [
        (t1-y) (t2 - (y-(x-1)^2))
        ((-2 x + 2)*Dt2+Dx)
        (Dt1+Dt2+Dy)
      ]
    def
    % homogenize
      [cone.vv ring_of_differential_operators
       [[(t1) -1 (t2) -1 (Dt1) 1 (Dt2) 1]] ecart.weight_vector
      0] define_ring
      dh.begin
      cone.input { . homogenize toString } map /cone.input set
      dh.end
   
   
   % $B%F%9%H$r3+;O$9$k(B.
   % getStartingCone /cone.ncone set
   % cone.ncone updateFan
   % cone.gblist 0 get message
   % cone.ncone /cone.ccone set
   % getNextFlip /cone.nextflip set
   % cone.nextflip message
   
    /wOld  [(t1) , -29 , (t2) , -38 , (Dt1) , 29 , (Dt2) , 38 ]  def
    /wFacet [(t1) , -1 , (t2) , -1 , (Dt1) , 1 , (Dt2) , 1 ]  def
    /wNew  [(t1) , -39 , (t2) , -38 , (Dt1) , 39 , (Dt2) , 38 ]  def
    cone.input wOld cone.gb /ff set
    [ff (t1,t2,x,y) wOld wFacet wNew] ckmFlip /ff2 set
    (See ff and ff2) message
   
   } def
   
   %<
   % Usages: cone i getaVectorOnFacet
   % cone $B$N(B i $BHVL\$N(B facet $B$N>e$N(B vector $B$r5a$a$k(B.
   % cf. liftWeight
   %>
   /getaVectorOnFacet {
     /arg2 set /arg1 set
     [/cone /facet_i /ep /vp /v /v /ii] pushVariables
     [
       /cone arg1 def /facet_i arg2 def
       facet_i to_int32 /facet_i set
   
       cone (facetsv) getNode 2 get facet_i get /v set
       /vp v 0 get def
       1 1 v length 1 sub {
         /ii set
         vp v ii get  add /vp set
       } for
       vp nnormalize_vec /vp set
       /arg1 vp def
     ] pop
     popVariables
     arg1
   } def
   
   /getNextCone {
     getNextCone_ckm
   } def
   
   %<
   %  Usages: result_getNextFlip getNextCone_ckm ncone
   %  flip $B$7$F?7$7$$(B ncone $B$rF@$k(B.  Collar-Kalkbrener-Moll $B$N%"%k%4%j%:%`$r;H$&(B
   %  if (cone.ckmFlip == 0) $BIaDL$N7W;;(B else CKM.
   %>
   /getNextCone_ckm {
    /arg1 set
    [/ncone /ccone /kk /w /next_weight_w_wv /cid /ttt] pushVariables
    [
     /ccone arg1 def
     /ncone null def
     /kk ccone 1 get def  % kk $B$O(B cid $BHVL\$N(B cone $B$N(B kk $BHVL\$N(B facet $B$rI=$9(B.
     /cid ccone 2 get def % cid $B$O(B cone $B$N(B $BHV9f(B.
     ccone 0 get /ccone set
     {
      ccone tag 0 eq { exit } {  } ifelse
   
   % ccone $B$N(B kk $BHVL\$N(B facet $B$K$D$$$F(B flip $B$9$k(B.
      ccone kk cone.epsilon flipWeight  /w set
      (Trying new weight is ) messagen w message
      w liftWeight /next_weight_w_wv set
      (Trying new weight [w,wv] is ) messagen next_weight_w_wv message
   
      cone.ckmFlip {
       [
        cone.gblist cid get (grobnerBasis) getNode 2 get % reduce gb
        cone.vv
        cone.gblist cid get (weight) getNode [2 0 2] get % weight
        ccone kk getaVectorOnFacet liftWeight 1 get  % weight on facet
        next_weight_w_wv 1 get  % new weight
       ] /ttt set
        ttt message
        ttt ckmFlip /cone.cgb set
      }{
        cone.input next_weight_w_wv 1 get cone.gb /cone.cgb set
      } ifelse
   
     cone.cgb tag 0 eq not {
      [w] next_weight_w_wv join /cone.cgb_weight set
      next_weight_w_wv 1 get cone.cgb coneEq /cone.g_ineq set
      cone.g_ineq cone.w_ineq join cone.Wt mul cone.Lpt mul
      pruneZeroVector /cone.gw_ineq_projectedWtLpt set
   
      (cone.gw_ineq_projectedWtLpt is obtained.) message
   
      cone.gw_ineq_projectedWtLpt getConeInfo /cone.nextConeInfo set
   % $B<!85$rD4$Y$k(B.  $B$@$a$J$i(B retry
      cone.nextConeInfo 0 get 0 get to_int32 cone.d eq {
        cone.nextConeInfo 1 get newCone /ncone set
        ccone ncone getCommonFacet 0 get {
          (Flip succeeded.) message
          exit
        } { } ifelse
      } { } ifelse
   % common face $B$,$J$1$l$P(B $B$d$O$j(B epsilon $B$r>.$5$/(B.
      cone.nextConeInfo 0 get 0 get to_int32 cone.d eq {
       (ccone and ncone do not have a common facet.) message
      } {
       (ncone is not maximal dimensional. ) message
      } ifelse
     }{ } ifelse
   
      (Decreasing epsilon to ) messagen
      cone.epsilon (1).. (2).. div mul /cone.epsilon set
        cone.epsilon cone.epsilon.limit sub numerator (0).. lt {
          (Too small cone.epsilon ) error
        }  {  } ifelse
      cone.epsilon message
     } loop
     /arg1 ncone def
    ] pop
    popVariables
    arg1
   } def
   
   %%change
   /cone_ir_input {
     /arg1 set
     [/msg ] pushVariables
     [
       /msg arg1 def
       (---------------) message
       msg message
       (  ) message
       (Please also refer to the value of the variables cone.getConeInfo.rr0) message
       ( cone.getConeInfo.rr1 cone.Lp cone.cinit) message
       $ cone.cinit (FACETS) getNode ::  $  message
       (We are sorry that we cannot accept this input.) error
     ] pop
     popVariables
   } def
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.15
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>