[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.3 and 1.4

version 1.3, 2004/09/14 08:30:47 version 1.4, 2004/09/15 07:41:59
Line 1 
Line 1 
 %  $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.2 2004/09/09 08:50:12 takayama Exp $  %  $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.3 2004/09/14 08:30:47 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 520  cone.comment message
Line 520  cone.comment message
  $It translates null to (0)..$   $It translates null to (0)..$
 ]] putUsages  ]] putUsages
   
   %<
   % Usages: newVector.with-1
   % (-1).. $B$GKd$a$?%Y%/%H%k$r:n$k(B.
   %>
   /newVector.with-1 {
     newVector { pop (-1).. } map
   } def
   
   
 % [2 0] lcm $B$O(B 0 $B$r$b$I$9$,$$$$$+(B? --> OK.  % [2 0] lcm $B$O(B 0 $B$r$b$I$9$,$$$$$+(B? --> OK.
   
 %<  %<
Line 812  def
Line 821  def
     { nnormalize_vec } map /ineq set      { nnormalize_vec } map /ineq set
     [[ ] ] ineq join shell rest removeFirstFromPolymake /ineq set      [[ ] ] ineq join shell rest removeFirstFromPolymake /ineq set
   
   % nextcid, nextfid $B$r2C$($k(B.  nextcid $B$O(B nextConeId $B$NN,(B. $B$H$J$j$N(B cone $BHV9f(B.
   %                           nextfid $B$O(B nextFacetId $B$NN,(B. $B$H$J$j$N(B cone $B$N(B facet
   %                            $BHV9f(B.
     [(cone) [ ]      [(cone) [ ]
      [       [
       [(facets) [ ] facets]  arrayToTree        [(facets) [ ] facets]  arrayToTree
       [(flipped) [ ] facets length newVector null_to_zero] arrayToTree        [(flipped) [ ] facets length newVector null_to_zero] arrayToTree
       [(facetsv) [ ] facets vertices newCone_facetsv] arrayToTree        [(facetsv) [ ] facets vertices newCone_facetsv] arrayToTree
         [(nextcid) [ ] facets length newVector.with-1 ] arrayToTree
         [(nextfid) [ ] facets length newVector.with-1 ] arrayToTree
       [(vertices) [ ] vertices]  arrayToTree        [(vertices) [ ] vertices]  arrayToTree
       [(inequalities) [ ] ineq] arrayToTree        [(inequalities) [ ] ineq] arrayToTree
      ]       ]
Line 1480  def
Line 1494  def
   popVariables    popVariables
 } def  } def
   
   %<
   % Usages: cone i [cid fid] markNext
   % cone $B$N(B i $BHVL\$N(B facet $B$N$H$J$j$N(B cone id (cid) $B$H(B face id (fid) $B$r@_Dj$9$k(B.
   %   cone $B$N(B nextcid[i] = cid; nextfid[i] = fid $B$H$J$k(B.
   % cone $B<+BN$,JQ99$5$l$k(B.
   % cone $B$O(B class-tree.
   %>
   /markNext {
     /arg3 set /arg2 set /arg1 set
     [/cone /facet_i /vv /nextid] pushVariables
     [
       /cone arg1 def /facet_i arg2 def /nextid arg3 def
       facet_i to_int32 /facet_i set
       cone (nextcid) getNode 2 get /vv set
       vv facet_i , nextid 0 get to_univNum , put
   
       cone (nextfid) getNode 2 get /vv set
       vv facet_i , nextid 1 get to_univNum , put
     ] pop
     popVariables
   } def
   
   
   
 %<  %<
 % Usages: cone getNextFacet i  % Usages: cone getNextFacet i
 % flipped $B$N(B mark $B$N$J$$(B facet $B$N(B index facet_i $B$rLa$9(B.  % flipped $B$N(B mark $B$N$J$$(B facet $B$N(B index facet_i $B$rLa$9(B.
Line 1919  def   
Line 1955  def   
 %>  %>
 /markBorder {  /markBorder {
   /arg1 set    /arg1 set
   [/cone /facets_t /flipped_t /kk] pushVariables    [/cone /facets_t /flipped_t /kk /nextcid_t /nextfid_t] pushVariables
   [    [
     /cone arg1 def      /cone arg1 def
     cone (facets) getNode 2 get /facets_t set      cone (facets) getNode 2 get /facets_t set
     cone (flipped) getNode 2 get /flipped_t set      cone (flipped) getNode 2 get /flipped_t set
       cone (nextcid) getNode 2 get /nextcid_t set
       cone (nextfid) getNode 2 get /nextfid_t set
     0 1 flipped_t length 1 sub {      0 1 flipped_t length 1 sub {
       /kk set        /kk set
       flipped_t kk get (0).. eq {        flipped_t kk get (0).. eq {
          cone kk isOnWeightBorder {           cone kk isOnWeightBorder {
 % Border $B$N>e$K$"$k$N$G(B flip $B:Q$N%^!<%/$r$D$1$k(B.  % Border $B$N>e$K$"$k$N$G(B flip $B:Q$N%^!<%/$r$D$1$k(B.
            flipped_t kk (2).. put             flipped_t kk (2).. put
   % $B$H$J$j$N(B cone $B$N(B id (nextcid, nextfid) $B$O(B -2 $B$H$9$k(B.
              nextcid_t kk (-2).. put
              nextfid_t kk (-2).. put
          } {  } ifelse           } {  } ifelse
       } {  } ifelse        } {  } ifelse
     } for      } for
Line 1986  def   
Line 2027  def   
          ncone ii markFlipped           ncone ii markFlipped
          cone.fan kk get /tcone set           cone.fan kk get /tcone set
          tcone jj markFlipped           tcone jj markFlipped
   % nextcid, nextfid $B$r@_Dj$9$k(B.
            ncone ii [kk jj] markNext
            tcone jj [cone.fan.n ii] markNext
       } {  } ifelse        } {  } ifelse
     } for      } for
 % 3. ncone $B$r2C$($k(B.  % 3. ncone $B$r2C$($k(B.
Line 2529  def   
Line 2573  def   
   
 %<  %<
 % Usages:  [[ii i_vw_vector] [jj j_vw_vector] vlist] isSameInGrRing_h  % Usages:  [[ii i_vw_vector] [jj j_vw_vector] vlist] isSameInGrRing_h
   % It computes gb.
 %>  %>
 /isSameInGrRing_h {  /isSameInGrRing_h {
   /arg1 set    /arg1 set
Line 2587  def   
Line 2632  def   
   
   
 %<  %<
 % Usages: i j IsSameCone_h  [bool, ...]  % Usages: i j isSameCone_h.0  [bool, ...]
 % $B%F%9%HJ}K!(B.  (data/test8.sm1) run  (data/test8-data.sm1) run 0 1 IsSameCone_h  % $B%F%9%HJ}K!(B.  (data/test8.sm1) run  (data/test8-data.sm1) run 0 1 isSameCone_h.0
   % gb $B$r:FEY7W;;$9$k(B stand alone $BHG(B.  gr(Local ring) $B$GHf3S(B.
 %>  %>
 /IsSameCone_h {  /isSameCone_h.0 {
   /arg2 set /arg1 set    /arg2 set /arg1 set
   [/i /j /ans /ii /iiw /jj /jjw] pushVariables    [/i /j /ans /ii /iiw /jj /jjw] pushVariables
   [    [
     /i arg1 def /j arg2 def      /i arg1 def /j arg2 def
       i to_int32 /i set , j to_int32 /j set
     cone.debug { (Comparing ) messagen [i j]  message } { } ifelse      cone.debug { (Comparing ) messagen [i j]  message } { } ifelse
   
     cone.gblist i get (initial) getNode 2 get /ii set      cone.gblist i get (initial) getNode 2 get /ii set
Line 2611  def   
Line 2658  def   
   arg1    arg1
 } def  } def
   
   %<
   % Usages: [ii vv i_vw_vector] getGbInGrRing_h [ii_gr  i_gr]
   % Get Grobner Basis of ii in the graded ring.
   % The graded ring is obtained automatically from vv and i_vw_vector.
   % ii_gr is the Grobner basis. i_gr is the output of getGrRing.
   % cf. isSameInGrRing_h,   ecart.isSameIdeal_h with [(noRecomputation) 1]
   %>
   /getGbInGrRing_h {
     /arg1 set
     [/ii /i_vw_vector /vlist  /rng /vv /vvGlobal /wv /iigg
      /i_gr  /rrule /ans] pushVariables
     [
       /ii arg1 0 get def
       /vlist arg1 1 get def
       /i_vw_vector arg1 2 get def
       [vlist i_vw_vector] getGrRing /i_gr set
   
   % bug: in case of module
       [i_gr 0 get , ring_of_differential_operators 0] define_ring
   
   % H $B$r(B 1 $B$K(B.
       /rrule [ [@@@.Hsymbol . (1).] ] def
   
       i_gr 2 get length 0 eq {
       } {
         rrule i_gr 2 get  { { . } map } map join /rrule set
       } ifelse
       /vvGlobal i_gr 1 get def
       /vv i_gr 0 get def
   
       ii { toString . rrule replace toString } map /ii set
   
       [vv vvGlobal] ecart.stdBlockOrder /wv set
         vvGlobal length 0 eq {
         /rng [vv wv ] def
       }{
         /rng [vv wv [(partialEcartGlobalVarX) vvGlobal]] def
       } ifelse
       /save-cone.autoHomogenize ecart.autoHomogenize def
       /ecart.autoHomogenize 0 def
       [ii] rng join  ecartd.gb  /iigg set
       save-cone.autoHomogenize /ecart.autoHomogenize set
       /ans [iigg 0 get i_gr] def
       /arg1 ans def
     ] pop
     popVariables
     arg1
   } def
   
   /test1.getGbInGrRing_h {
     [(parse) (data/test8-data.sm1) pushfile] extension
   
     cone.gblist 0 get (initial) getNode 2 get /ii set
     cone.gblist 0 get (weight) getNode [2 0 2] get    /iiw set
     [ii cone.vv iiw] getGbInGrRing_h /ff1 set
   
     cone.gblist 1 get (initial) getNode 2 get /jj set
     cone.gblist 1 get (weight) getNode [2 0 2] get    /jjw set
     [jj cone.vv jjw] getGbInGrRing_h /ff2 set
   
     (ff1 and ff2) message
   
   } def
   
   
   %<
   % setGrGblist
   %  cone.grGblist $B$r@_Dj$9$k(B.
   %>
   /setGrGblist {
     [/ii /ww /gg] pushVariables
     [
       cone.gblist {
         /gg set
         gg (initial) getNode 2 get /ii set
         gg (weight) getNode [2 0 2] get /ww set
         [ii cone.vv ww] getGbInGrRing_h
       } map /cone.grGblist set
     ] pop
     popVariables
   } def
   
   %<
   % Usages: i j isSameCone_h.2  [bool, ...]
   % gb $B$r:FEY7W;;$7$J$$(B.
   %>
   /isSameCone_h.2 {
     /arg2 set /arg1 set
     [/i /j /ans /ii /iiw /jj /jjw] pushVariables
     [
       /i arg1 def /j arg2 def
        i to_int32 /i set , j to_int32 /j set
       (cone.grGblist) boundp { } { setGrGblist } ifelse
       cone.debug { (Comparing ) messagen [i j]  message } { } ifelse
   
       cone.grGblist i get /ii set
       cone.grGblist j get /jj set
   
       ii 1 get ,  jj 1 get isSameGrRing {  }
       { /ans [0 [ii 1 get jj 1 get]] def exit} ifelse
   
       [ii 0 get , jj 0 get cone.vv [[(noRecomputation) 1]] ]
       ecartd.isSameIdeal_h /ans set
       [ans [ii 1 get] ii 1 get , ecartd.isSameIdeal_h.failed]  /ans set
   
       ans /arg1 set
     ] pop
     popVariables
     arg1
   } def
   
   %<
   %  test1.isSameCone_h.2 $B$O(B cone.grGblist $B$K(B initial $B$N(B gb $B$r(B graded ring
   %  $B$G$^$:7W;;$7(B, $B$=$l$+$i(B ideal $B$NHf3S$r$*$3$J$&(B. isSameCone_h.1 $B$KHf$Y$F(B
   %  gb $B$N:FEY$N7W;;$,$J$$$N$G7P:QE*(B.
   %>
   /test1.isSameCone_h.2 {
     /cone.loaded boundp { }
     {
       [(parse) (cohom.sm1) pushfile] extension
       [(parse) (dhecart.sm1) pushfile] extension
       /cone.loaded 1 def
     } ifelse
     %[(parse) (cone.sm1) pushfile] extension
     [(parse) (data/test8-data.sm1) pushfile] extension
     setGrGblist
     (cone.grGblist is set.) message
     0 1 isSameCone_h.2 pmat
   } def
   
   %<
   % dhcone $B$O(B  DeHomogenized Cone $B$NN,(B.  H->1 $B$H$7$F(B cone $B$r(B merge $B$7$F$$$/4X?t(B
   % $B$dBg0hJQ?t$K;H$&(B.
   % cone.gblist, cone.fan $B$,@5$7$/@_Dj$5$l$F$$$k$3$H(B.
   % (setGrGblist $B$r<B9T:Q$G$"$k$3$H(B. $B<+F0<B9T$5$l$k$,(B... )
   %
   %>
   
   /isSameCone_h {  isSameCone_h.2 } def
   
   %<
   % Usages: genDhcone.init
   %   dhcone.checked (dehomogenized $B:Q$N(B cone$BHV9f(B),  dhcone.unchecked $B$N=i4|2=(B.
   %>
   /genDhcone.init {
     /dhcone.checked [ ] def
     /dhcone.unchecked [
        0 1 cone.fan length 1 sub {
           to_univNum
        } for
     ] def
   } def
   
   %<
   % Usages: k genDhcone dhcone
   % cone.fan[k] $B$r=PH/E@$H$7$F(B cone $B$r(B dehomogenize $B$9$k(B (merge $B$9$k(B).
   %
   % $B%F%9%H(B1.  (data/test14.sm1) run (data/test14-data.sm1) run
   %          genDhcone.init
   %          0 genDhcone /ff set
   %>
   
   /genDhcone {
     /arg1 set
     [/k /facets /merged /nextcid /nextfid /coneid
         /newfacets /newmerged /newnextcid /newnextfid /newconeid /vv
      /i /j /p /q /rr /cones /differentC
     ] pushVariables
     [
       /k arg1 def
       /facets [ ] def /merged [ ] def /nextcid [ ] def
       /nextfid [ ] def /coneid [ ] def
       /cones [ ] def
       /differentC [ ] def
   
       k to_univNum /k set
   
       {
   % Step1. cone.fan[k] $B$r(B $B2C$($k(B.  new... $B$X=i4|%G!<%?$r=q$-9~$`(B.
        cone.debug {(Step 1. Adding ) messagen k messagen (-th cone.) message} { } ifelse
         cones [k to_univNum] join /cones set
         cone.fan k get , (facets) getNode 2 get /vv set
         /newfacets [ ] vv join def
   
         cone.fan k get , (nextcid) getNode 2 get /vv set
         /newnextcid [ ] vv join def
   
         cone.fan k get , (nextfid) getNode 2 get /vv set
         /newnextfid [ ] vv join def
   
   % newmerged $B$O$^$:(B 0 $B$G$&$a$k(B.  0 : $B$^$@D4$Y$F$J$$(B.
   % 1 : merged $B$G>C$($?(B. 2 : boundary. 3 : $B$H$J$j$O0[$J$k(B.
   % [ ] join $B$r$d$C$F(B $B%Y%/%H%k$N(B clone $B$r:n$k(B.
         cone.fan k get , (flipped) getNode 2 get /vv set
         /newmerged [ ] vv join def
         0 1 , newmerged length 1 sub {
            /i set
            newmerged i get , (2).. eq { }
            { newmerged i (0).. put } ifelse
         } for
   % newconeid $B$O(B k $B$G$&$a$k(B.
         /newconeid newfacets length newVector { pop k to_univNum } map def
   
   % merged $B$H(B newmerged $B$r(B cone $B$NNY@\4X78$N$_$G99?7$9$k(B.
   % $BF1$8(B init $B$r;}$D$3$H$O$o$+$C$F$$$k$N$G(B  facet vector $B$N$_$N(B check $B$G==J,(B.
   % merged $B$N(B i $BHVL\(B $B$H(B newmerged $B$N(B j $BHVL\$GHf3S(B.
         0 1 , merged length 1 sub {
           /i set
           0 1 , newmerged length 1 sub {
             /j set
             merged i get , (0).. eq ,
             newmerged j get , (0).. eq , and
             nextcid i get , k to_univNum eq , and
             {
                facets i get , newfacets j get , add isZero {
   % merged[i], newmerged[j] $B$K(B 1 $B$rF~$l$F>C$9(B.
   % $B>e$NH=Dj$O(B nextfid, newnextfid $B$rMQ$$$F$b$h$$$N$G$O(B?
                  merged i (1).. put
                  newmerged j (1).. put
                } {  } ifelse
             } { } ifelse
           } for
         } for
   
   % Step2. $B7k9g$7$F$+$i(B, $B$^$@D4$Y$F$J$$(B facet $B$rC5$9(B.
         cone.debug { (Step 2. Joining *** and new***) message } { } ifelse
         /facets facets newfacets join def
         /merged merged newmerged join def
         /nextcid nextcid newnextcid join def
         /nextfid nextfid newnextfid join
         /coneid  coneid newconeid join def
   
         cone.debug{ (   Checking facets.) message } { } ifelse
         /k null def
         0 1 , merged length 1 sub {
           /i set
           % i message
           merged i get (0).. eq {
   % i $BHVL\$r$^$@D4$Y$F$$$J$$(B.
             coneid i get ,  /p set
             nextcid i get , /q set
             cone.debug { [p q] message } {  } ifelse
             q (0).. ge {
   % cone.fan [p] $B$H(B cone.fan [q] $B$N(B initial $B$rHf3S$9$k(B.
   % $BF1$8$J$i(B k $B$r@_Dj(B. exit for. $B0c$($P(B merged[i] = 3 ($B0c$&(B) $B$rBeF~(B.
   % differentC $B$O$9$G$K(B $B8=:_$N(B dhcone $B$H0c$&$H(B check $B$5$l$?(B cone $BHV9f(B.
   % dhcone.checked $B$O(B dhcone $B$,$9$G$K@8@.$5$l$F$$$k(B cone $BHV9f$N%j%9%H(B.
   % $B$3$l$K$O$$$C$F$$$F$b0c$&(B.
               q differentC memberQ , q dhcone.checked memberQ , or
               { /rr [0 ] def }
               { p q isSameCone_h /rr set } ifelse
   
               rr 0 get 1 eq {
                 cone.debug { (Found next cone. ) message } { } ifelse
                 /k q to_univNum def exit
               } {
                 cone.debug { ( It is a different cone. ) message } { } ifelse
                 differentC [ q ]  join /differentC set
                 merged i (3).. put
               } ifelse
             } {  } ifelse
           } {  } ifelse
         } for
   
         k tag 0 eq { exit } {  } ifelse
      } loop
   
      [(-1)..] cones join shell rest /cones set
   %     dhcone.checked, dhcone.unchecked $B$r99?7(B.
      dhcone.checked cones join /dhcone.checked set
      dhcone.unchecked cones setMinus /dhcone.unchecked set
   
      [(dhcone) [ ]
        [
          [(cones) [ ] cones] arrayToTree
          [(facets) [ ] facets] arrayToTree
          [(merged) [ ] merged] arrayToTree
          [(nextcid) [ ] merged] arrayToTree
          [(nextfid) [ ] merged] arrayToTree
          [(coneid) [ ] merged] arrayToTree
        ]
      ] arrayToTree /arg1 set
     ] pop
     popVariables
     arg1
   } def
   
   
   %<
   % Usages: dhCones_h
   % cone.fan $B$O(B doubly homogenized (local) $B$G@8@.$5$l$?(B Grobner fan.
   % cone.fan $B$r(B dehomogenize (H->1) $B$7$F(B init $B$rHf$Y$F(B dhcone.fan $B$r@8@.$9$k(B.
   %
   % $B%F%9%H(B1.  (data/test14.sm1) run (data/test14-data.sm1) run
   %          dhCones_h
   %          test22
   %>
   /dhCones_h {
     (cone.grGblist) boundp { } {setGrGblist} ifelse
     genDhcone.init
     /dhcone.fan [ ] def
     {
        (-----------------------------------------) message
        (#dhcone.unchecked = ) messagen dhcone.unchecked length message
        dhcone.unchecked length 0 eq { exit } { } ifelse
        dhcone.fan
        [ dhcone.unchecked 0 get , genDhcone ] join /dhcone.fan set
        (#dhcone.fan = ) messagen dhcone.fan length message
     } loop
     dhcone.fan
   } def
   
   % Todo: print, save functions.  Representative of weight & init.
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>