[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.1 and 1.2

version 1.1, 2004/09/05 10:19:29 version 1.2, 2004/09/09 08:50:12
Line 1 
Line 1 
 % $OpenXM$  %  $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.1 2004/09/05 10:19:29 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 10 
Line 10 
  [(parse) (ox.sm1) pushfile] extension   [(parse) (ox.sm1) pushfile] extension
 } ifelse  } ifelse
   
   %%%%<<<<  $B=i4|%G!<%?$N@_DjNc(B  data/test13 $B$h$j(B.  <<<<<<<<<<<<<<
   /cone.sample.test13 {
    /cone.loaded boundp { }
    {
     [(parse) (cohom.sm1) pushfile] extension
     [(parse) (cone.sm1) pushfile] extension
     /cone.loaded 1 def
    } ifelse
   /cone.comment [
     (Toric ideal for 1-simplex x 2-simplex, in k[x]) nl
   ] cat def
   %------------------Globals----------------------------------------
 % Global: cone.type  % Global: cone.type
 % $B$I$N(B exponents $B$r<h$j=P$9$N$+;XDj$9$k(B.  % $B$I$N(B exponents $B$r<h$j=P$9$N$+;XDj$9$k(B.
 % cf. exponents, gbext  h $B$d(B H $B$b8+$k$+(B?  % cf. exponents, gbext  h $B$d(B H $B$b8+$k$+(B?
Line 20 
Line 32 
   
 % Global: cone.local  % Global: cone.local
 % cone.local: Local $B$+(B?  1 $B$J$i(B local  % cone.local: Local $B$+(B?  1 $B$J$i(B local
   /cone.local 0 def
   
   
   % Global: cone.h0
   % cone.h0:  1 $B$J$i(B h $B$N(B weight 0 $B$G$N(B Grobner fan $B$r7W;;$9$k(B.
   /cone.h0 1 def
   
   % ---------------  $BF~NO%G!<%?MQBg0hJQ?t$N@_Dj(B --------------------------
   %
   % cone.input : $BF~NOB?9`<07O(B
   /cone.input
     [
       (x11 x22 - x12 x21) (x12 x23 - x13 x22)
       (x11 x23 - x13 x21)
     ]
   def
   
   % cone.vlist : $BA4JQ?t$N%j%9%H(B
   /cone.vlist [(x11) (x12) (x13) (x21) (x22) (x23)
                (Dx11) (Dx12) (Dx13) (Dx21) (Dx22) (Dx23) (h)] def
   
   % cone.vv : define_ring $B7A<0$NJQ?t%j%9%H(B.
   /cone.vv (x11,x12,x13,x21,x22,x23) def
   
   % cone.parametrizeWeightSpace : weight $B6u4V$r(B parametrize $B$9$k4X?t(B.
   %   $BBg0hJQ?t(B cone.W , cone.Wpos $B$b$-$^$k(B.
   /cone.parametrizeWeightSpace {
     6 6 parametrizeSmallFan
   } def
   
   % cone.w_start : weight$B6u4V$K$*$1$k(B weight $B$N=i4|CM(B.
   % $B$3$NCM$G(B max dim cone $B$,F@$i$l$J$$$H(B random weight $B$K$h$k(B $B%5!<%A$,;O$^$k(B.
   % random $B$K$d$k$H$-$O(B null $B$K$7$F$*$/(B.
   /cone.w_start
     [9 8 5 4 5 6]
   def
   
   % cone.gb : gb $B$r7W;;$9$k4X?t(B.
   /cone.gb {
     cone.gb_Dh
   } def
   
   
   
   ( ) message
   cone.comment message
   (cone.input = ) messagen cone.input message
   (Type in getGrobnerFan) message
   (Do clearGlobals if necessary) message
   (printGrobnerFan ; saveGrobnerFan /ff set ff output ) message
   
   } def
   %%%%%%>>>>>  $B=i4|%G!<%?$N@_DjNc$*$o$j(B >>>>>>>>>>>>>>>>>>>>>>
   
   % Global: cone.type
   % $B$I$N(B exponents $B$r<h$j=P$9$N$+;XDj$9$k(B.
   % cf. exponents, gbext  h $B$d(B H $B$b8+$k$+(B?
   % 0 : x,y,Dx,Dy
   % 1 : x,y,Dx,Dy,h,H
   % 2 : x,y,Dx,Dy,h
   /cone.type 2 def
   
   % Global: cone.local
   % cone.local: Local $B$+(B?  1 $B$J$i(B local
 /cone.local 1 def  /cone.local 1 def
   
 % Global: cone.h0  % Global: cone.h0
Line 720  def
Line 796  def
     polydata (FACETS) getNode 2 get 0 get to_univNum      polydata (FACETS) getNode 2 get 0 get to_univNum
     { nnormalize_vec} map /facets set      { nnormalize_vec} map /facets set
     [[ ] ] facets join shell rest removeFirstFromPolymake /facets set      [[ ] ] facets join shell rest removeFirstFromPolymake /facets set
       facets length 0 eq
       {(Internal  error. Facet data is not obtained. See OpenXM_tmp.) error} { } ifelse
 % vertices $B$O(B cone $B$N>e$K$"$k$N$G@0?tG\(B OK. $B@55,$+$9$k(B.  % vertices $B$O(B cone $B$N>e$K$"$k$N$G@0?tG\(B OK. $B@55,$+$9$k(B.
     polydata (VERTICES) getNode 2 get 0 get to_univNum      polydata (VERTICES) getNode 2 get 0 get to_univNum
     { nnormalize_vec} map /vertices set      { nnormalize_vec} map /vertices set
Line 787  def
Line 865  def
 } def  } def
   
 %<  %<
   % Usages: [gb weight] newConeGB
   %  gb $B$H(B weight $B$r(B tree $B7A<0$K$7$F3JG<$9$k(B.
   %>
   /newConeGB {
     /arg1 set
     [/gbdata  /gg /ww /rr] pushVariables
     [
       /gbdata arg1 def
   % gb
       gbdata 0 get /gg set
   % weight
       gbdata 1 get /ww set
   %
       [(coneGB) [ ]
        [
         [(grobnerBasis) [ ] gg]  arrayToTree
         [(weight) [ ] [ww]] arrayToTree
         [(initial) [ ] gg { ww 2 get weightv init } map ] arrayToTree
        ]
       ] arrayToTree /rr set
       /arg1 rr def
     ] pop
     popVariables
     arg1
   } def
   
   %<
 % Usages: cone_random  % Usages: cone_random
 %>  %>
 /cone_random.start  (2)..  def  /cone_random.start  (2)..  def
Line 1196  def
Line 1301  def
 %<  %<
 % Usages:  pruneZeroVector  % Usages:  pruneZeroVector
 %    genPo, getConeInfo $BEy$NA0$K;H$&(B.  0 $B%Y%/%H%k$O0UL#$N$J$$@)Ls$J$N$G=|$/(B.  %    genPo, getConeInfo $BEy$NA0$K;H$&(B.  0 $B%Y%/%H%k$O0UL#$N$J$$@)Ls$J$N$G=|$/(B.
   %    $BF1$8@)Ls>r7o$b$N$>$/(B. polymake FACET $B$,@5$7$/F0$+$J$$>l9g$,$"$k$N$G(B.
   %    cf. pear/OpenXM_tmp/x3y2.poly, x^3+y^2, x^2+y^3 data/test15.sm1
 %>  %>
 /pruneZeroVector {  /pruneZeroVector {
   /arg1 set    /arg1 set
Line 1203  def
Line 1310  def
   [    [
     /mm arg1 def      /mm arg1 def
     mm to_univNum /mm set      mm to_univNum /mm set
       [ [ ] ] mm join shell rest uniq /mm set
     [      [
       0 1 mm length 1 sub {        0 1 mm length 1 sub {
          /ii set           /ii set
Line 1711  def   
Line 1819  def   
      wv_start pmat       wv_start pmat
 %[3] reduced GB $B$N7W;;(B.  %[3] reduced GB $B$N7W;;(B.
      cone.input wv_start cone.gb /reduced_G set       cone.input wv_start cone.gb /reduced_G set
      (Reduced GB : ) message       (Reduced GB is obtained: ) message
      reduced_G pmat       %reduced_G pmat
        /cone.cgb reduced_G def
        [cone.w_start w_start wv_start] /cone.cgb_weight set
   
 %[4] $B<M1F$7$F$+$i(B polytope $B$N%G!<%?$r7W;;(B.  %[4] $B<M1F$7$F$+$i(B polytope $B$N%G!<%?$r7W;;(B.
      wv_start reduced_G coneEq /cone.g_ineq set       wv_start reduced_G coneEq /cone.g_ineq set
Line 1731  def   
Line 1841  def   
      cone.cinit 0 get 0 get to_int32 cone.m eq { exit }       cone.cinit 0 get 0 get to_int32 cone.m eq { exit }
      {       {
        (Failed to get the max dim cone. Updating the weight ...) messagen         (Failed to get the max dim cone. Updating the weight ...) messagen
        /w_start  cone.m cone_random_vec cone.W mul def         cone.m cone_random_vec /cone.w_start set
          /w_start  cone.w_start cone.W mul def
 % cone.cinit $B$r:FEY7W;;$9$k$?$a$K(B clear $B$9$k(B.  % cone.cinit $B$r:FEY7W;;$9$k$?$a$K(B clear $B$9$k(B.
        /cone.cinit null def         /cone.cinit null def
      } ifelse       } ifelse
Line 1833  def   
Line 1944  def   
 /cone.fan [  ] def  /cone.fan [  ] def
 % global: cone.incidence  % global: cone.incidence
 /cone.incidence [ ] def  /cone.incidence [ ] def
   % global: cone.gblist   gb's standing for each cones in cone.fan.
   /cone.gblist [ ] def
   
 /updateFan {  /updateFan {
   /arg1 set    /arg1 set
Line 1840  def   
Line 1953  def   
   [    [
     /ncone arg1 def      /ncone arg1 def
     /cone.fan.n  cone.fan length def      /cone.fan.n  cone.fan length def
   % -1.  cone.cgb ($BD>A0$K7W;;$5$l$?(B gb) $B$H(B cone.cgb_weight ($BD>A0$N7W;;$N(B weight)
   %    $B$r(B cone.gblist $B$X3JG<$9$k(B.
       cone.gblist [ [cone.cgb cone.cgb_weight] newConeGB ] join /cone.gblist set
 % 0. ncone $B$,(B cone.fan $B$K$9$G$K$"$l$P%(%i!<(B  % 0. ncone $B$,(B cone.fan $B$K$9$G$K$"$l$P%(%i!<(B
     0 1 cone.fan.n 1 sub {      0 1 cone.fan.n 1 sub {
       /kk set        /kk set
Line 1922  def   
Line 2038  def   
    (Trying new weight [w,wv] is ) messagen next_weight_w_wv message     (Trying new weight [w,wv] is ) messagen next_weight_w_wv message
   
    cone.input next_weight_w_wv 1 get cone.gb /cone.cgb set     cone.input next_weight_w_wv 1 get cone.gb /cone.cgb set
      [w] next_weight_w_wv join /cone.cgb_weight set
    next_weight_w_wv 1 get cone.cgb coneEq /cone.g_ineq 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     cone.g_ineq cone.w_ineq join cone.Wt mul cone.Lpt mul
    pruneZeroVector /cone.gw_ineq_projectedWtLpt set     pruneZeroVector /cone.gw_ineq_projectedWtLpt set
Line 1975  def   
Line 2092  def   
     cone.nextflip tag 0 eq { exit } { } ifelse      cone.nextflip tag 0 eq { exit } { } ifelse
     cone.nextflip getNextCone /cone.ncone set      cone.nextflip getNextCone /cone.ncone set
   } loop    } loop
   (Construction  is completed. See cone.fan and cone.incidence.) message  
 } def  
   
     (Construction  is completed. See cone.fan, cone.incidence and cone.gblist.)
     message
   } def
   
   %<
   % Usages: vlist generateD1_1
   %  -1,1  weight $B$r@8@.$9$k(B.
   %  vlist $B$O(B (t,x,y) $B$+(B [(t) (x) (y)]
   %
   %>
   /generateD1_1 {
     /arg1 set
     [/vlist /rr /rr /ii /vv] pushVariables
     [
       /vlist arg1 def
       vlist isString {
         [vlist to_records pop] /vlist set
       } {  } ifelse
       [
         0 1 vlist length 1 sub {
           /ii set
           vlist ii get /vv set
           vv -1
           [@@@.Dsymbol vv] cat 1
         } for
       ] /rr set
       /arg1 rr def
     ] pop
     popVariables
     arg1
   } def
   
   /listNodes {
     /arg1 set
     [/in-listNodes /ob /rr /rr /ii] pushVariables
     [
       /ob arg1 def
       /rr [ ] def
       {
         ob isClass {
           ob (array) dc /ob set
         } { exit } ifelse
         rr [ob 0 get] join /rr set
         ob 2 get /ob set
         0 1 ob length 1 sub {
            /ii set
            rr ob ii get listNodes join /rr set
         } for
         exit
       } loop
       /arg1 rr def
     ] pop
     popVariables
     arg1
   } def
   [(listNodes)
   [(ob listNodes)
    (cf. getNode)
    (Example:)
    (  /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def)
    (  /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def)
    (  /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def)
    (  ma listNodes )
   ]] putUsages
   
   %<
   % Usages:  obj printTree
   %>
   /printTree {
     /arg1 set
     [/ob /rr /rr /ii /keys /tt] pushVariables
     [
       /ob arg1 def
       /rr [ ] def
       /keys ob listNodes def
       keys 0 get /tt set
       keys rest /keys set
       keys { ob 2 1 roll getNode } map /rr set
       (begin ) messagen  tt messagen
       ( ---------------------------------------) message
       0 1 rr length 1 sub {
          /ii set
          keys ii get messagen (=) message
          rr ii get 2 get pmat
       } for
       (--------------------------------------- end ) messagen
       tt message
       /arg1 rr def
     ] pop
     popVariables
     arg1
   } def
   
   %<
   % Usages $B$O(B (inputForm) usages $B$r$_$h(B.
   %>
   /inputForm {
     /arg1 set
     [/ob /rr /i ] pushVariables
     [
       /ob  arg1 def
       /rr [ ] def
       {
        ob isArray {
          rr [ ([) ] join /rr set
          0 1 ob length 1 sub {
            /i set
            i ob length 1 sub lt {
              rr [ob i get inputForm $ , $] join /rr set
            } {
              rr [ob i get inputForm] join /rr set
            } ifelse
          } for
          rr [ (]) ] join cat /rr set
          exit
        } { } ifelse
        ob isClass {
          ob etag 263 eq { % tree
            /rr ob inputForm.tree def exit
          } { /rr [( $ this etag is not implemented $ )] cat def exit  } ifelse
        } {  } ifelse
        ob isUniversalNumber {
          [$($ ob toString $)..$] cat /rr set
          exit
        } {  } ifelse
        ob isPolynomial {
          [$($ ob toString $).$] cat /rr set
          exit
        } {  } ifelse
        ob isRational {
          [$ $ ob (numerator) dc inputForm $ $
               ob (denominator) dc inputForm $ div $ ] cat /rr set
          exit
        } {  } ifelse
        ob isString {
          [$($ ob $)$ ] cat /rr set
          exit
        } {  } ifelse
        ob toString /rr set
        exit
       } loop
       rr /arg1 set
     ] pop
     popVariables
     arg1
   } def
   [(inputForm)
    [(obj inputForm str)
   ]] putUsages
   % should be moved to dr.sm1
   
   /inputForm.tree {
     /arg1 set
     [/ob /key /rr /rr /ii] pushVariables
     [
       /ob arg1 def
       /rr [ ] def
       {
         ob (array) dc /ob set
         /rr [ $[$ ob 0 get inputForm $ , $
               ob 1 get inputForm $ , $
             ] def
         rr  [ob 2 get inputForm ] join /rr set
         rr [$ ] $] join /rr set
         rr [ $ [(class) (tree)] dc $ ] join /rr set
         rr cat /rr set
         exit
       } loop
       /arg1 rr def
     ] pop
     popVariables
     arg1
   } def
   
   %<
   % Usages: str inputForm.value str
   %>
   /inputForm.value {
     /arg1 set
     [/key /val /valstr /rr] pushVariables
     [
       arg1 /key set
       key isString { } {(inputForm.value: argument must be a string) error } ifelse
       key boundp {
        [(parse) key] extension pop
        /val set
        val inputForm /valstr set
        [( ) valstr ( /) key ( set )] cat /rr set
       } {
        /valstr [] cat /rr set
       } ifelse
       rr /arg1 set
     ] pop
     popVariables
     arg1
   } def
   
   % global: cone.withGblist
   /cone.withGblist 0 def
   %<
   % Usages:  saveGrobnerFan  str
   %  GrobnerFan $B$N%G!<%?$r(B inputForm $B$KJQ99$7$FJ8;zNs$KJQ$($k(B.
   %  $B$3$N%G!<%?$r(B parse $B$9$k$H(B GrobnerFan $B$rF@$k$3$H$,2DG=(B.
   %  BUG: $BB?9`<0$NB0$9$k4D$N%G!<%?$NJ]B8$O$^$@$7$F$J$$(B.
   %>
   /saveGrobnerFan {
     [/rr] pushVariables
     [
       (cone.withGblist=) messagen cone.withGblist message
       [
   % $B%f!<%6$N@_Dj$9$k%Q%i%a!<%?(B. cone.gb, cone.parametrizeWeightSpace $BEy$N4X?t$b$"$j(B.
         (cone.comment)
         (cone.type)  (cone.local) (cone.h0)
         (cone.vlist) (cone.vv)
         (cone.input)
   
   % $B%W%m%0%i%`Cf$GMxMQ$9$k(B, $BBg;v$JBg0hJQ?t(B.  weight vector $B$N<M1F9TNs$,=EMW(B.
         (cone.n) (cone.m) (cone.d)
         (cone.W) (cone.Wpos) (cone.Wt)
         (cone.L) (cone.Lp) (cone.Lpt)
         (cone.weightBorder)
         (cone.w_ineq)
         (cone.w_ineq_projectedWt)
         (cone.epsilon)
   
   % $B7k2L$NMWLs(B.
         (cone.fan)
         cone.withGblist { (cone.gblist) } {  } ifelse
         (cone.incidence)
   
       ] { inputForm.value  nl } map /rr set
       rr cat /arg1 set
     ] pop
     popVariables
     arg1
   } def
   
   /printGrobnerFan.1 {
     /arg1 set
     [/key /rr] pushVariables
     [
       /key arg1 def
       key boundp {
         [(parse) key] extension pop /rr set
         rr isArray {
           key messagen ( = ) message  rr pmat
         } {
           key messagen ( = ) messagen rr message
         } ifelse
       }{
         key  messagen ( = ) message
       } ifelse
     ] pop
     popVariables
   } def
   
   /printGrobnerFan {
     [/i] pushVariables
     [
     (==========  Grobner Fan ====================) message
      [
         (cone.comment)
         (cone.vlist) (cone.vv)
         (cone.input)
         (cone.type)  (cone.local) (cone.h0)
         (cone.n) (cone.m) (cone.d)
         (cone.W) (cone.Wpos) (cone.Wt)
         (cone.L) (cone.Lp) (cone.Lpt)
         (cone.weightBorder)
         (cone.incidence)
      ] { printGrobnerFan.1 } map
      (   ) message
      0 1 cone.fan length 1 sub {
        /ii set
        ii messagen ( : ) messagen
        cone.fan ii get printTree
      } for
      cone.withGblist {
       0 1 cone.gblist length 1 sub {
         /ii set
         ii messagen ( : ) messagen
         cone.gblist ii get printTree
       } for
     } {  } ifelse
   
   
     (=========================================) message
     (cone.withGblist = ) messagen cone.withGblist message
     (  ) message
     ] pop
     popVariables
   } def
   
   %<
   % Usages:  m uniq
   % Remove duplicated lines.
   %>
   /uniq  {
     /arg1 set
     [/mm /prev /i /rr] pushVariables
     [
       /mm arg1 def
      {
        mm length 0 eq { [ ] /rr set exit } {  } ifelse
        /prev mm 0 get def
        [
          prev
          1 1 mm length 1 sub {
            /i set
            mm i get prev sub isZero { }
            { /prev mm i get def prev } ifelse
          } for
         ] /rr set
         exit
       } loop
       rr /arg1 set
     ] pop
     popVariables
     arg1
   } def
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>