version 1.1, 2004/09/05 10:19:29 |
version 1.2, 2004/09/09 08:50:12 |
|
|
% $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 |
|
|
[(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? |
|
|
|
|
% 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 |
|
|
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 |
|
|
} 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 |
|
|
%< |
%< |
% 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 |
|
|
[ |
[ |
/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 |
|
|
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 |
|
|
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 |
|
|
/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 |
|
|
[ |
[ |
/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 |
|
|
(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 |
|
|
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 |