[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.10 and 1.13

version 1.10, 2005/07/07 01:31:21 version 1.13, 2009/08/26 04:54:17
Line 1 
Line 1 
 %  $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.9 2005/06/30 08:39:39 takayama Exp $  %  $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.12 2005/07/07 07:53:37 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
Line 17 
Line 17 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 /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 129  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 413  cone.comment message
Line 415  cone.comment message
 %>  %>
 /cone.DhH  0 def  /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.  % Default $B$N(B cone.gb $B$NDj5A(B. $B3F%W%m%0%i%`$G:FEYDj5A$7$F$b$h$$(B.
 /cone.gb {  /cone.gb {
   cone.DhH {    cone.DhH {
Line 1015  def
Line 1024  def
   [    [
      /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
   
      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.
Line 1869  def
Line 1883  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 2046  def
Line 2065  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] ff getAttributeList setAttributeList      %(---) messagen ff getAttributeList message
     groebner 0 get /gg set      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 2384  def   
Line 2408  def   
 %  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 3453  def   
Line 3477  def   
 %  gb $B$N(B check $B$r$d$k$N$G(B, $B$=$l$K<:GT$7$?$i(B null $B$rLa$9(B.  %  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  %  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.  %  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 {  /ckmFlip {
   /arg1 set    /arg1 set
Line 3499  def   
Line 3524  def   
 % $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2]  % $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2]
     facetWeight { dup isString { . rTable replace toString }      facetWeight { dup isString { . rTable replace toString }
                                { } ifelse } map /facetWeight_gr set                                 { } 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.  % 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  % $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      %% [ch1 vlist_gr oldWeight_gr] /ttt set
Line 3507  def   
Line 3538  def   
     ch1 {toString .} map  /ch1 set      ch1 {toString .} map  /ch1 set
 %% $B$3$3$^$G$G$H$j$"$($:%F%9%H$r$7$h$&(B.  %% $B$3$3$^$G$G$H$j$"$($:%F%9%H$r$7$h$&(B.
 %%    ch1 /arg1 set  %%    ch1 /arg1 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  
     [ch1 { toString } map vlist_gr newWeight_gr] cone.gb_gr /ch2 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.  % Dx x = x Dx + h H  or Dx x = x Dx + h^2 $B$G7W;;(B.
Line 3536  def   
Line 3563  def   
     %gNew $B$,(B newWeight $B$G$N(B GB $B$+(B check. Yes $B$J$i(B reduced basis $B$X(B.      %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.      %No $B$J$i(B null $B$rLa$9(B.
 %%Ref: note @s/2005/06/30-note-gfan.pdf  %%Ref: note @s/2005/06/30-note-gfan.pdf
     gNew [(gbCheck) 1] setAttributeList newWeight      cone.do_gbCheck not {
        cone.gb (gb) getAttribute         (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 {      1 eq {
      gNew [(reduceOnly) 1] setAttributeList newWeight cone.gb /arg1 set       gNew [(reduceOnly) 1] setAttributeList newWeight cone.gb /arg1 set
     }{ /arg1 null def } ifelse      }{ /arg1 null def } ifelse
Line 3625  def   
Line 3659  def   
 %>  %>
 /cone.gb_gr_Dh {  /cone.gb_gr_Dh {
   /arg1 set    /arg1 set
   [/ff /ww /vv] pushVariables    [/ff /ww /vv /gg /envtmp] pushVariables
   [    [
      /ff arg1 0 get def       /ff arg1 0 get def
      /vv arg1 1 get def       /vv arg1 1 get def
      /ww arg1 2 get def       /ww arg1 2 get def
      /gb.verbose 1 def  
      /gb.autoHomogenize 0 def       [(AutoReduce) (KanGBmessage)] pushEnv /envtmp set
      [(AutoReduce) 1] system_variable       [(AutoReduce) 1] system_variable
      [ff { toString } map vv       [(KanGBmessage) 1] system_variable
       [ww vv generateD1_1]] gb 0 get /arg1 set       [vv ring_of_differential_operators
      /gb.autoHomogenize 1 def       [ww] weight_vector 0] define_ring
        [ff {toString .} map] ff getAttributeList setAttributeList
        groebner 0 get /gg set
        envtmp popEnv
   
        /arg1 gg def
   ] pop    ] pop
   popVariables    popVariables
   arg1    arg1
Line 3710  def   
Line 3749  def   
  [ff (t1,t2,x,y) wOld wFacet wNew] ckmFlip /ff2 set   [ff (t1,t2,x,y) wOld wFacet wNew] ckmFlip /ff2 set
  (See ff and ff2) message   (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  } def
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.13
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>