version 1.3, 2004/09/14 08:30:47 |
version 1.4, 2004/09/15 07:41:59 |
|
|
% $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. |
|
|
%< |
%< |
|
|
{ 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 |
] |
] |
|
|
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. |
|
|
%> |
%> |
/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 |
|
|
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. |
|
|
|
|
%< |
%< |
% 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 |
|
|
|
|
|
|
%< |
%< |
% 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 |
|
|
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. |