| version 1.1, 2004/09/05 10:19:29 |
version 1.5, 2004/09/16 06:16:44 |
|
|
| % $OpenXM$ |
% $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.4 2004/09/15 07:41:59 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 |
| |
|
| |
% |
| |
% cone.fan, cone.gblist $B$K(B fan $B$N%G!<%?$,$O$$$k(B. |
| |
% |
| |
|
| |
%%%%<<<< $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 |
|
|
| ww to_int32 /ww set % univNum $B$,$"$l$P(B int32 $B$KD>$7$F$*$/(B. |
ww to_int32 /ww set % univNum $B$,$"$l$P(B int32 $B$KD>$7$F$*$/(B. |
| /ww2 ww weightv def % v-w $B7A<0$r(B $B?t;z$N%Y%/%H%k$K(B. (init $BMQ(B) |
/ww2 ww weightv def % v-w $B7A<0$r(B $B?t;z$N%Y%/%H%k$K(B. (init $BMQ(B) |
| |
|
| /eqs [ ] def % $BITEy<07O$N78?t(B |
/eqs null def % $BITEy<07O$N78?t(B |
| /gsize g length def |
/gsize g length def |
| 0 1 gsize 1 sub { |
0 1 gsize 1 sub { |
| /i set |
/i set |
|
|
| % in_ww(f) > f_j $B$H$J$k9`$N=hM}(B. |
% in_ww(f) > f_j $B$H$J$k9`$N=hM}(B. |
| iterms 1 exps length 1 sub { |
iterms 1 exps length 1 sub { |
| /j set |
/j set |
| eqs [expsTop exps j get sub] join /eqs set |
expsTop exps j get sub eqs cons /eqs set |
| % exps[0]-exps[j] $B$r(B eqs $B$X3JG<$7$F$$$/(B. |
% exps[0]-exps[j] $B$r(B eqs $B$X3JG<$7$F$$$/(B. |
| } for |
} for |
| % in_ww(f) = f_j $B$H$J$k9`$N=hM}(B. |
% in_ww(f) = f_j $B$H$J$k9`$N=hM}(B. |
| [(exponents) f ww2 init cone.type] gbext /exps set % exps $B$O(B in(f) |
[(exponents) f ww2 init cone.type] gbext /exps set % exps $B$O(B in(f) |
| 1 1 iterms 1 sub { |
1 1 iterms 1 sub { |
| /j set |
/j set |
| eqs [exps j get expsTop sub] join /eqs set |
exps j get expsTop sub eqs cons /eqs set |
| eqs [expsTop exps j get sub] join /eqs set |
expsTop exps j get sub eqs cons /eqs set |
| % exps[j]-exps[0], exps[0]-exps[j] $B$r3JG<(B. |
% exps[j]-exps[0], exps[0]-exps[j] $B$r3JG<(B. |
| % $B7k2LE*$K(B (exps[j]-exps[0]).w = 0 $B$H$J$k(B. |
% $B7k2LE*$K(B (exps[j]-exps[0]).w = 0 $B$H$J$k(B. |
| } for |
} for |
| } { } ifelse |
} { } ifelse |
| } for |
} for |
| |
eqs listToArray reverse /eqs set |
| /arg1 eqs def |
/arg1 eqs def |
| ] pop |
] pop |
| popVariables |
popVariables |
|
|
| $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. |
| |
|
| %< |
%< |
|
|
| 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 |
|
|
| { 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 |
| ] |
] |
|
|
| } 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 |
|
|
| 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. |
|
|
| 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 |
|
|
| %> |
%> |
| /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 |
|
|
| /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 |
|
|
| 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. |
|
|
| (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 /rr set |
| |
% ring $B$r(B save $B$7$F$J$$$N$GEv:B$NBP=h(B. |
| |
[ ([) cone.vv inputForm ( ring_of_differential_operators 0 ] define_ring ) |
| |
nl nl 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 |
| |
|
| |
%< |
| |
% Usages: [vlist vw_vector] getGrRing [vlist vGlobal sublist] |
| |
% example: [(x,y,z) [(x) -1 (Dx) 1 (y) 1 (Dy) 2]] getGrRing |
| |
% [(x,y,z,y') [(x)] [[(Dy) (y')]]] |
| |
% h[0,1](D_0) $B@lMQ$N(B getGrRing. |
| |
% u_i + v_i > 0 $B$J$i(B Dx_i ==> x_i' ($B2D49$JJQ?t(B). sublist $B$X(B. |
| |
% u_i < 0 $B$J$i(B x_i $B$O(B vGlobal $B$X(B. |
| |
% ii [vlist vGlobal sublist] toGrRing /ii set |
| |
% [ii jj vlist [(partialEcartGlobalVarX) vGlobal]] ecart.isSameIdeal $B$H;H$&(B. |
| |
%> |
| |
/getGrRing { |
| |
/arg1 set |
| |
[/vlist /vw_vector /ans /vGlobal /sublist /newvlist |
| |
/dlist /tt /i /u /v /k |
| |
] pushVariables |
| |
[ |
| |
/vlist arg1 0 get def |
| |
/vw_vector arg1 1 get def |
| |
|
| |
vlist isString { [vlist to_records pop] /vlist set } { } ifelse |
| |
vlist { toString } map /vlist set |
| |
% dlist $B$O(B [(Dx) (Dy) (Dz)] $B$N%j%9%H(B. |
| |
vlist { /tt set [@@@.Dsymbol tt] cat } map /dlist set |
| |
|
| |
/newvlist [ ] def /sublist [ ] def /vGlobal [ ] def |
| |
% $B2D49$J?7$7$$JQ?t$r(B newvlist $B$X(B. $BCV49I=$r(B sublist $B$X(B. |
| |
0 1 vlist length 1 sub { |
| |
/i set |
| |
% (u,v) $B$O(B (x_i, Dx_i) $B$KBP$9$k(B weight vector |
| |
/u vlist i get , vw_vector getGrRing.find def |
| |
u -1 gt { |
| |
vw_vector , u 1 add , get /u set |
| |
} { /u 0 def } ifelse |
| |
|
| |
/v dlist i get , vw_vector getGrRing.find def |
| |
v -1 gt { |
| |
vw_vector , v 1 add , get /v set |
| |
} { /v 0 def } ifelse |
| |
u to_int32 /u set , v to_int32 /v set |
| |
|
| |
u v add , 0 gt { |
| |
newvlist [vlist i get] join /newvlist set |
| |
} { } ifelse |
| |
u 0 lt { |
| |
vGlobal [vlist i get] join /vGlobal set |
| |
} { } ifelse |
| |
} for |
| |
|
| |
newvlist { /tt set [ [@@@.Dsymbol tt] cat [tt (')] cat ] } map |
| |
/sublist set |
| |
|
| |
/ans [ vlist , newvlist { /tt set [tt (')] cat } map , join from_records |
| |
vGlobal sublist] def |
| |
/arg1 ans def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
%< |
| |
% Usages: a uset getGrRing.find index |
| |
%> |
| |
/getGrRing.find { |
| |
/arg2 set /arg1 set |
| |
[/a /uset /ans /i] pushVariables |
| |
[ |
| |
/a arg1 def /uset arg2 def |
| |
/ans -1 def |
| |
{ /ans -1 def |
| |
0 1 , uset length 1 sub { |
| |
/i set |
| |
a tag , uset i get tag eq { |
| |
a , uset i get eq { |
| |
/ans i def exit |
| |
} { } ifelse |
| |
} { } ifelse |
| |
} for |
| |
exit |
| |
} loop |
| |
/arg1 ans def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
%< |
| |
% Usages: g1 g2 isSameGrRing bool |
| |
% g1, g2 $B$O(B getGrRing $B$NLa$jCM(B. |
| |
%> |
| |
/isSameGrRing { |
| |
/arg2 set /arg1 set |
| |
[/g1 /g2 /ans] pushVariables |
| |
[ |
| |
/g1 arg1 def /g2 arg2 def |
| |
{ |
| |
/ans 1 def |
| |
g1 0 get , g2 0 get eq { } { /ans 0 def exit } ifelse |
| |
exit |
| |
g1 1 get , g2 1 get eq { } { /ans 0 def exit } ifelse |
| |
} loop |
| |
/arg1 ans def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
%< |
| |
% Usages: [[ii i_vw_vector] [jj j_vw_vector] vlist] isSameInGrRing_h |
| |
% It computes gb. |
| |
%> |
| |
/isSameInGrRing_h { |
| |
/arg1 set |
| |
[/ii /i_vw_vector /jj /j_vw_vector /vlist |
| |
/i_gr /j_gr /rrule /ans] pushVariables |
| |
[ |
| |
/ii arg1 [0 0] get def |
| |
/i_vw_vector arg1 [0 1] get def |
| |
/jj arg1 [1 0] get def |
| |
/j_vw_vector arg1 [1 1] get def |
| |
/vlist arg1 2 get def |
| |
{ |
| |
[vlist i_vw_vector] getGrRing /i_gr set |
| |
[vlist j_vw_vector] getGrRing /j_gr set |
| |
i_gr j_gr isSameGrRing { } { /ans [0 [i_gr j_gr]] def exit} ifelse |
| |
|
| |
% 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 |
| |
ii { toString . rrule replace toString } map /ii set |
| |
jj { toString . rrule replace toString } map /jj set |
| |
|
| |
[ii jj i_gr 0 get , i_gr 1 get] ecartd.isSameIdeal_h /ans set |
| |
[ans [i_gr] rrule ecartd.isSameIdeal_h.failed] /ans set |
| |
|
| |
exit |
| |
} loop |
| |
/arg1 ans def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
/test1.isSameInGrRing_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 |
| |
|
| |
cone.gblist 1 get (initial) getNode 2 get /jj set |
| |
cone.gblist 1 get (weight) getNode [2 0 2] get /jjw set |
| |
|
| |
(Doing [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ff set) message |
| |
[ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ff set |
| |
|
| |
ff pmat |
| |
|
| |
} def |
| |
|
| |
|
| |
%< |
| |
% 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.0 |
| |
% gb $B$r:FEY7W;;$9$k(B stand alone $BHG(B. gr(Local ring) $B$GHf3S(B. |
| |
%> |
| |
/isSameCone_h.0 { |
| |
/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.debug { (Comparing ) messagen [i j] message } { } ifelse |
| |
|
| |
cone.gblist i get (initial) getNode 2 get /ii set |
| |
cone.gblist i get (weight) getNode [2 0 2] get /iiw set |
| |
|
| |
cone.gblist j get (initial) getNode 2 get /jj set |
| |
cone.gblist j get (weight) getNode [2 0 2] get /jjw set |
| |
|
| |
[ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ans set |
| |
|
| |
ans /arg1 set |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} 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) [ ] nextcid] arrayToTree |
| |
[(nextfid) [ ] nextfid] arrayToTree |
| |
[(coneid) [ ] coneid] 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 |
| |
|
| |
%< |
| |
% Usages: dhcone.rtable |
| |
% dhcone $B$NHV9f$H(B cone $B$NHV9f$N(B $BCV49I=$r@8@.$7(B dhcone2.fan (merge $B$7$?(B cone $B$N>pJs(B) |
| |
% $B$r(B dhcone.fan $B$+$i:n$k(B. dhcone2.gblist $B$b:n$kJd=u4X?t(B. |
| |
% dhCones_h $B$7$F$+$i(B dhcone.rable $B$9$k(B. |
| |
%> |
| |
/dhcone.rtable { |
| |
[/i /j /vv /cones /facets /facets2 /merged /nextcid /nextcid2 /ii /ww] pushVariables |
| |
[ |
| |
% $BCV49I=(B dhcone.h2dh $B$r:n$k(B. |
| |
/dhcone.h2dh cone.fan length newVector.with-1 def |
| |
0 1 , dhcone.fan length 1 sub { |
| |
/i set |
| |
dhcone.fan i get , (cones) getNode 2 get /vv set |
| |
0 1 vv length 1 sub { |
| |
/j set |
| |
dhcone.h2dh , vv j get , i to_univNum , put |
| |
} for |
| |
} for |
| |
% merge $B$7$?(B dhcone $B$r@0M}$7$?$b$N(B, dhcone2.fan $B$r:n$k(B. |
| |
/dhcone2.fan dhcone.fan length newVector def |
| |
0 1 , dhcone.fan length 1 sub { |
| |
/i set |
| |
dhcone.fan i get (facets) getNode 2 get /facets set |
| |
dhcone.fan i get (merged) getNode 2 get /merged set |
| |
dhcone.fan i get (nextcid) getNode 2 get /nextcid set |
| |
dhcone.fan i get (cones) getNode 2 get /cones set |
| |
/facets2 [ ] def |
| |
/nextcid2 [ ] def |
| |
0 1 , facets length 1 sub { |
| |
/j set |
| |
merged j get , (3).. eq { |
| |
facets2 [ facets j get ] join /facets2 set |
| |
% $B$H$J$j$N(B cone $B$,$"$k$H$-(B $BJQ49I=$K$7$?$,$$(B, cone $BHV9f$rJQ49(B |
| |
nextcid2 [ dhcone.h2dh , nextcid j get , get ] join /nextcid2 set |
| |
} { } ifelse |
| |
merged j get , (2).. eq { |
| |
facets2 [ facets j get ] join /facets2 set |
| |
% $B6-3&$N$H$-(B -2 $B$rF~$l$k(B. |
| |
nextcid2 [ (-2).. ] join /nextcid2 set |
| |
} { } ifelse |
| |
} for |
| |
|
| |
dhcone2.fan i , |
| |
[(dhcone) [ ] |
| |
[ |
| |
[(facets) [ ] facets2] arrayToTree |
| |
[(nextcid) [ ] nextcid2] arrayToTree |
| |
[(cones) [ ] cones] arrayToTree |
| |
] |
| |
] arrayToTree , put |
| |
|
| |
} for |
| |
|
| |
% $B:G8e$K(B dhcone2.gblist $B$r:n$k(B. |
| |
/dhcone2.gblist , dhcone2.fan length newVector , def |
| |
0 1 , dhcone2.fan length 1 sub { |
| |
/i set |
| |
dhcone2.fan i get (cones) getNode 2 get /cones set |
| |
cone.grGblist , cones 0 get , get , /ii set % GB of initial (H->1). |
| |
cone.gblist i get , (weight) getNode , [ 2 0 2 ] get /ww set |
| |
|
| |
dhcone2.gblist i, |
| |
[(gbasis) [ ] |
| |
[ |
| |
[(initial) [ ] ii] arrayToTree |
| |
[(weight) [ ] ww] arrayToTree |
| |
] |
| |
] arrayToTree , put |
| |
|
| |
} for |
| |
(dhcone2.fan, dhcone2.gblist, dhcone.h2dh are set.) message |
| |
|
| |
] pop |
| |
popVariables |
| |
} def |
| |
|
| |
%< |
| |
% $BI=$N8+J}$N2r@b$r0u:~$9$k4X?t(B. |
| |
% Usages: dhcone.explain |
| |
%> |
| |
/dhcone.explain { |
| |
[ |
| |
( ) nl |
| |
(Data format in << dhcone2.fan >>, which is a dehomogenized Grobner fan.) nl nl |
| |
(<< cone.vlist >> is the list of the variables.) nl |
| |
@@@.Hsymbol ( is the homogenization variable to be dehomogenized.) nl nl |
| |
(<< cone.input >> is generators of a given ideal.) nl nl |
| |
(<< cone.d >> is the dimension of parametrization space of the weights P_w) nl |
| |
( P_w is a cone in R^m where the number m is stored in << cone.m >>) nl |
| |
( P_w --- W ---> R^n [weight space]. ) nl |
| |
( W is stored in << cone.W >> ) nl |
| |
( << u cone.W mul >> gives the weight vector standing for u) nl nl |
| |
(All cones in the data lie in the weight parametrization space P_w.) nl |
| |
( "facets" are the inner normal vector of the cone. ) nl |
| |
( "nextcid" is a list of the cone id's of the adjacent cones.) nl |
| |
( -2 in "nextcid" means that this facet lies on the border of the weight space.) nl |
| |
( "cones" is a list of the cone id's of the NON-dehomonized Grobner fan) nl |
| |
( stored in << cone.fan >>) nl |
| |
] cat |
| |
} def |
| |
|
| |
%< |
| |
% dhcone.printGrobnerFan |
| |
% dhcone $B$N0u:~4X?t(B |
| |
%> |
| |
/dhcone.printGrobnerFan { |
| |
[/i] pushVariables |
| |
[ |
| |
(========== Grobner Fan (for dehomogenized cones) ============) 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 |
| |
(The number of cones = ) messagen dhcone.fan length message |
| |
( ) message |
| |
0 1 dhcone2.fan length 1 sub { |
| |
/ii set |
| |
ii messagen ( : ) messagen |
| |
dhcone2.fan ii get printTree |
| |
} for |
| |
1 { |
| |
0 1 dhcone2.gblist length 1 sub { |
| |
/ii set |
| |
ii messagen ( : ) messagen |
| |
dhcone2.gblist ii get printTree |
| |
} for |
| |
} { } ifelse |
| |
|
| |
|
| |
(=========================================) message |
| |
%(cone.withGblist = ) messagen cone.withGblist message |
| |
dhcone.explain message |
| |
( ) message |
| |
] pop |
| |
popVariables |
| |
} def |
| |
|
| |
% |
| |
% $B;n$7J}(B test14, 22, 25 |
| |
% |
| |
% (data/test14.sm1) run (data/test14-data.sm1) run |
| |
% printGrobnerFan ; % H $BIU$-$G0u:~(B. |
| |
% dhCones_h ; % dehomogenize Cones. |
| |
% dhcone.rtable ; % dhcone2.fan $BEy$r@8@.(B. |
| |
% dhcone.printGrobnerFan ; % $B0u:~(B. |
| |
% $B0u:~$7$?$b$N$O(B test*-print.txt $B$X3JG<$7$F$"$k(B. |
| |
% |
| |
|
| |
% Todo: save functions. |
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to gfan.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc