| version 1.3, 2004/09/14 08:30:47 |
version 1.17, 2009/09/04 11:13:11 |
|
|
| % $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.16 2009/09/04 02:59:55 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 |
| |
%%Ref: @s/2004/08/21-note.pdf |
| |
|
| |
%% gfan.sm1 works only for polymake 2.0 Use webservice of 2.0. |
| |
[(gfan) |
| |
[ |
| |
(gfan.sm1 is a package to compute global and local Grobner fans.) |
| |
(See R.Bahloul and N.Takayama, arxiv, math.AG/0412044 and references as to algorithms.) |
| |
(At the beginning of gfan.sm1, there are sample inputs cone.sample and cone.sample2.) |
| |
( ) |
| |
(gfan.sm1 works only with polymake 2.0. We provides a web service of computing ) |
| |
(with polymake 2.0. /@@@polymake.web 1 def is set by default in gfan.sm1.) |
| |
(See changelog-ja.tex as to details on the difference between 2.0 and later versions.) |
| |
( ) |
| |
( cone.Wt cone.Lpt {vertices in the output} are weights on the rays of the Grobner cone.) |
| |
( cone.L gives a basis of the linearity space.) |
| |
] |
| |
] putUsages |
| |
|
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%% Two examples are given below to get a global Grobner fan and |
| |
%% a local Grobner fan ; cone.sample and cone.sample2 |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%%% Global Grobner Fan |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%% How to input data? An example. (cf. test13.sm1) |
| |
%% Modify the following or copy the /cone.sample { ... } def |
| |
%% to your own file, |
| |
%% edit it, and execute it by " cone.sample ; " |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
/cone.sample { |
| |
cone.load.cohom |
| |
/cone.ckmFlip 1 def |
| |
% write a comment about the problem. "nl" means new line. |
| |
/cone.comment [ |
| |
(Toric ideal for 1-simplex x 2-simplex, in k[x]) nl |
| |
] cat def |
| |
|
| |
% List of variables |
| |
% If cone.type=1, then (H) should be added. |
| |
/cone.vlist [(x11) (x12) (x13) (x21) (x22) (x23) |
| |
(Dx11) (Dx12) (Dx13) (Dx21) (Dx22) (Dx23) (h)] def |
| |
|
| |
% List of variables in the form for define_ring. |
| |
/cone.vv (x11,x12,x13,x21,x22,x23) def |
| |
|
| |
% If cone.type=0, then x,Dx, |
| |
% If cone.type=1, then x,Dx,h,H (Doubly homogenized) |
| |
% If cone.type=2, then x,Dx,h |
| |
/cone.type 2 def |
| |
|
| |
% Set how to parametrize the weight space. |
| |
% In the example below, 6 means the number of variables x11,x12,x13,x21,x22,x33 |
| |
% p q parametrizeSmallFan (p >= q) : Enumerate Grobner cones in the Small |
| |
% Grobner fan. |
| |
% The weights for the last p-q variables |
| |
% are 0. |
| |
% Example. 6 2 parametrizeSmallFan weights for x12,x21,x22,x23 are 0. |
| |
% |
| |
% p q parametrizeTotalFan (p = q = number of variables in cone.vv) |
| |
% p > q has not yet been implemented. |
| |
% |
| |
/cone.parametrizeWeightSpace { |
| |
6 6 parametrizeSmallFan |
| |
} def |
| |
|
| |
% If you want to enumerate Grobner cones in local order (i.e., x^e <= 0), |
| |
% then cone.local = 1 else cone.local = 0. |
| |
/cone.local 0 def |
| |
|
| |
% Initial value of the weight in the weight space of which dimension is |
| |
% cone.m |
| |
% If it is null, then a random weight is used. |
| |
/cone.w_start |
| |
null |
| |
def |
| |
|
| |
% If cone.h0=1, then the weight for h is 0. |
| |
% It is usally set to 1. |
| |
/cone.h0 1 def |
| |
|
| |
% Set input polynomials which generate the ideal. |
| |
% Input must be homogenized. |
| |
% (see also data/test14.sm1 for double homogenization.) |
| |
/cone.input |
| |
[ |
| |
(x11 x22 - x12 x21) |
| |
(x12 x23 - x13 x22) |
| |
(x11 x23 - x13 x21) |
| |
] |
| |
def |
| |
|
| |
/cone.DhH 0 def |
| |
% Set a function to compute Grobner basis. |
| |
% cone.gb_Dh : For computing in Homogenized Weyl algebra h[1,1](D). |
| |
% cone.gb_DhH : For computing in doubly homogenized Weyl algebra. |
| |
% ( Computation in ^O and h[0,1](^D) need this |
| |
% as the first step. /cone.local 1 def ) |
| |
/cone.gb { |
| |
cone.gb_Dh |
| |
} def |
| |
|
| |
|
| |
cone.comment message |
| |
(cone.input = ) message |
| |
cone.input message |
| |
%%%% Step 1. Enumerating the Grobner Cones in a global ring. |
| |
%%%% The result is stored in cone.fan |
| |
getGrobnerFan |
| |
|
| |
%%%% If you want to print the output, then uncomment. |
| |
printGrobnerFan |
| |
|
| |
%%%% If you want to save the data to the file sm1out.txt, then uncomment. |
| |
% /cone.withGblist 1 def saveGrobnerFan /ff set ff output |
| |
|
| |
%%%% Step 2. Dehomogenize the Grobner Cones |
| |
%%%% by the equivalence relation in a local ring (uncomment). |
| |
% dhCones_h |
| |
|
| |
%%%% Generate the final data dhcone2.fan (a list of local Grobner cones.) |
| |
% dhcone.rtable |
| |
|
| |
%%%% Output dhcone2.fan with explanations |
| |
% dhcone.printGrobnerFan |
| |
|
| |
} def |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%% End of " How to input data? An example. " |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
|
| |
|
| |
|
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%%% Local Grobner Fan |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%% How to input data? The example 2 (cf. test14.sm1). |
| |
%% Modify the following or copy the /cone.sample2 { ... } def |
| |
%% to your own file, |
| |
%% edit it, and execute if by " cone.sample2 ; " |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
/cone.sample2 { |
| |
cone.load.cohom |
| |
/cone.ckmFlip 1 def |
| |
% write a comment about the problem. "nl" means new line. |
| |
/cone.comment [ |
| |
(BS for y and y-(x-1)^2, t1, t2 space, in doubly homogenized Weyl algebra.) nl |
| |
(The Grobner cones are dehomogenized to get local Grobner fan.) nl |
| |
] cat def |
| |
|
| |
% List of variables |
| |
% If cone.type=1, then (H) should be added. |
| |
/cone.vlist [(t1) (t2) (x) (y) (Dt1) (Dt2) (Dx) (Dy) (h) (H)] def |
| |
|
| |
% List of variables in the form for define_ring. |
| |
/cone.vv (t1,t2,x,y) def |
| |
|
| |
% If cone.type=0, then x,Dx, |
| |
% If cone.type=1, then x,Dx,h,H (Doubly homogenized) |
| |
% If cone.type=2, then x,Dx,h |
| |
/cone.type 1 def |
| |
|
| |
% Set how to parametrize the weight space. |
| |
% In the example below, 6 means the number of variables x11,x12,x13,x21,x22,x33 |
| |
% p q parametrizeSmallFan (p >= q) : Enumerate Grobner cones in the Small |
| |
% Grobner fan. |
| |
% The weights for the last p-q variables |
| |
% are 0. |
| |
% Example. 6 2 parametrizeSmallFan weights for x12,x21,x22,x23 are 0. |
| |
% |
| |
% p q parametrizeTotalFan (p = q = number of variables in cone.vv) |
| |
% p > q has not yet been implemented. |
| |
% |
| |
/cone.parametrizeWeightSpace { |
| |
4 2 parametrizeSmallFan |
| |
} def |
| |
|
| |
% If you want to enumerate Grobner cones in local order (i.e., x^e <= 0), |
| |
% then cone.local = 1 else cone.local = 0. |
| |
/cone.local 1 def |
| |
|
| |
% Initial value of the weight in the weight space of which dimension is |
| |
% cone.m |
| |
% If it is null, then a random weight is used. |
| |
/cone.w_start |
| |
null |
| |
def |
| |
|
| |
% If cone.h0=1, then the weight for h is 0. |
| |
% It is usally set to 1. |
| |
/cone.h0 1 def |
| |
|
| |
% Set input polynomials which generate the ideal. |
| |
% Input must be homogenized. |
| |
% (see also data/test14.sm1 for double homogenization.) |
| |
/cone.input |
| |
[ |
| |
(t1-y) (t2 - (y-(x-1)^2)) |
| |
((-2 x + 2)*Dt2+Dx) |
| |
(Dt1+Dt2+Dy) |
| |
] |
| |
def |
| |
% homogenize |
| |
[cone.vv ring_of_differential_operators |
| |
[[(t1) -1 (t2) -1 (Dt1) 1 (Dt2) 1]] ecart.weight_vector |
| |
0] define_ring |
| |
dh.begin |
| |
cone.input { . homogenize toString } map /cone.input set |
| |
dh.end |
| |
|
| |
/cone.DhH 1 def |
| |
% Set a function to compute Grobner basis. |
| |
% cone.gb_Dh : For computing in Homogenized Weyl algebra h[1,1](D). |
| |
% cone.gb_DhH : For computing in doubly homogenized Weyl algebra. |
| |
% ( Computation in ^O and h[0,1](^D) need this |
| |
% as the first step. /cone.local 1 def ) |
| |
/cone.gb { |
| |
cone.gb_DhH |
| |
} def |
| |
|
| |
cone.comment message |
| |
(cone.input = ) message |
| |
cone.input message |
| |
%%%% Step 1. Enumerating the Grobner Cones in a global ring. |
| |
%%%% The result is stored in cone.fan |
| |
getGrobnerFan |
| |
|
| |
%%%% If you want to print the output, then uncomment. |
| |
printGrobnerFan |
| |
|
| |
%%%% If you want to save the data to the file sm1out.txt, then uncomment. |
| |
% /cone.withGblist 1 def saveGrobnerFan /ff set ff output |
| |
|
| |
%%%% Step 2. Dehomogenize the Grobner Cones |
| |
%%%% by the equivalence relation in a local ring (uncomment). |
| |
dhCones_h |
| |
|
| |
%%%% Generate the final data dhcone2.fan (a list of local Grobner cones.) |
| |
dhcone.rtable |
| |
|
| |
%%%% Output dhcone2.fan with explanations |
| |
dhcone.printGrobnerFan |
| |
|
| |
} def |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%% End of " How to input data? The example 2. " |
| |
%% Do not touch below. |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
|
| |
|
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
| |
|
| |
[(parse) (cgi.sm1) pushfile] extension |
| |
|
| |
% If you use local polymake, then comment out. |
| |
% If you use the cgi/polymake on the net, then uncomment out. |
| |
%/doPolymake {doPolymake.OoHG} def (Using doPolymake.OoHG ) message |
| |
%/polymake.start {polymake.start.OoHG} def (Using polymake.start.OoHG ) message |
| |
/@@@polymake.web 1 def |
| |
%% Choose it automatically. |
| |
[(which) (polymake)] oxshell tag 0 eq |
| |
@@@polymake.web 1 eq |
| |
or |
| |
{ |
| |
(Polymake is not installed in this system or @@@polymake.web is set.) message |
| |
/doPolymake {doPolymake.OoHG} def |
| |
(Using doPolymake.OoHG ) message |
| |
/polymake.start {polymake.start.OoHG} def |
| |
(Using polymake.start.OoHG ) message |
| |
} { (Local polymake will be used.) message } ifelse |
| |
|
| /cone.debug 1 def |
/cone.debug 1 def |
| |
|
| /ox.k0.loaded boundp { |
/ox.k0.loaded boundp { |
|
|
| [(parse) (ox.sm1) pushfile] extension |
[(parse) (ox.sm1) pushfile] extension |
| } ifelse |
} ifelse |
| |
|
| |
/cone.load.cohom { |
| |
/cone.loaded boundp { } |
| |
{ |
| |
[(parse) (cohom.sm1) pushfile] extension |
| |
% [(parse) (cone.sm1) pushfile] extension % BUG? cone.sm1 overrides a global |
| |
% in cohom.sm1? |
| |
[(parse) (dhecart.sm1) pushfile] extension |
| |
/cone.loaded 1 def |
| |
oxNoX |
| |
polymake.start ( ) message |
| |
} ifelse |
| |
} def |
| |
|
| |
%% Usages: cone.gb_DhH. h H (double homogenized) $BMQ$N(B GB. |
| |
%% dhecart.sm1 $B$r(B load $B$7$F$"$k$3$H(B. $BF~NO$OF1<!$G$J$$$H$$$1$J$$(B. |
| |
%% [cone.vv ring_of_differential_operators |
| |
%% [[(t1) -1 (t2) -1 (Dt1) 1 (Dt2) 1]] ecart.weight_vector |
| |
%% 0] define_ring |
| |
%% dh.begin homogenize dh.end $B$J$I$NJ}K!$GF1<!2=$G$-$k(B. |
| |
/cone.gb_DhH { |
| |
/arg2 set /arg1 set |
| |
[/ff /ww] pushVariables |
| |
[ |
| |
/ff arg1 def |
| |
/ww arg2 def |
| |
/dh.gb.verbose 1 def |
| |
/dh.autoHomogenize 0 def |
| |
[(AutoReduce) 1] system_variable |
| |
[ff { toString } map cone.vv |
| |
[ww cone.vv generateD1_1]] ff getAttributeList setAttributeList |
| |
dh.gb 0 get /arg1 set |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| % |
% |
| % cone.fan, cone.gblist $B$K(B fan $B$N%G!<%?$,$O$$$k(B. |
% cone.fan, cone.gblist $B$K(B fan $B$N%G!<%?$,$O$$$k(B. |
| % |
% |
| |
%%%%<<<< $B=i4|%G!<%?$N@_DjNc(B. $BF|K\8lHG(B data/test13 $B$h$j(B. <<<<<<<<<<<<<< |
| %%%%<<<< $B=i4|%G!<%?$N@_DjNc(B data/test13 $B$h$j(B. <<<<<<<<<<<<<< |
/cone.sample.test13.ja { |
| /cone.sample.test13 { |
|
| /cone.loaded boundp { } |
/cone.loaded boundp { } |
| { |
{ |
| [(parse) (cohom.sm1) pushfile] extension |
[(parse) (cohom.sm1) pushfile] extension |
| Line 111 cone.comment message |
|
| Line 422 cone.comment message |
|
| % cone.d (pointed cones lies in this space. cf. cone.Lp) |
% cone.d (pointed cones lies in this space. cf. cone.Lp) |
| % These are set during getting the cone.startingCone |
% These are set during getting the cone.startingCone |
| |
|
| |
%< |
| |
% global |
| |
%cone.ckmFlip. Collar-Kalkbrener-Mall $B$N(B flip $B%"%k%4%j%:%`$r;H$o$J$$(B 0. $B;H$&(B 1. |
| |
% Default $B$O(B 0. |
| |
%> |
| |
/cone.ckmFlip 0 def |
| |
|
| %< |
%< |
| |
% global |
| |
% cone.DhH dx x = x dx + h H $B$J$i(B 1. dx x = x dx + h^2 $B$J$i(B 0. Default 0. |
| |
%> |
| |
/cone.DhH 0 def |
| |
|
| |
%< |
| |
% Global |
| |
% gbCheck $B$r$9$k$+(B? $B$7$J$$$H7k2L$O$"$d$U$d(B. $B$7$+$7%a%b%j(B exhaust $B$OKI$2$k(B. |
| |
% $B;H$&$H$-$O(B /cone.epsilon, /cone.epsilon.limit $B$r==J,>.$5$/$7$F$*$/(B. |
| |
%> |
| |
/cone.do_gbCheck 1 def |
| |
|
| |
% Default $B$N(B cone.gb $B$NDj5A(B. $B3F%W%m%0%i%`$G:FEYDj5A$7$F$b$h$$(B. |
| |
/cone.gb { |
| |
cone.DhH { |
| |
cone.gb_DhH |
| |
} { |
| |
cone.gb_Dh |
| |
} ifelse |
| |
} def |
| |
|
| |
%< |
| % Usage: wv g coneEq1 |
% Usage: wv g coneEq1 |
| % in(f) $B$,(B monomial $B@lMQ(B. in_w(f) = LT(f) $B$H$J$k(B weight w $B$NK~$?$9(B |
% in(f) $B$,(B monomial $B@lMQ(B. in_w(f) = LT(f) $B$H$J$k(B weight w $B$NK~$?$9(B |
| % $BITEy<0@)Ls$r5a$a$k(B. |
% $BITEy<0@)Ls$r5a$a$k(B. |
| Line 520 cone.comment message |
|
| Line 859 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. |
| |
|
| %< |
%< |
|
|
| %> |
%> |
| /getConeInfo { |
/getConeInfo { |
| /arg1 set |
/arg1 set |
| [/ww /g /ceq /ceq2 /cdim /mmc /mmL /rr /ineq /ppt] pushVariables |
[/ww /g /ceq /ceq2 /cdim /mmc /mmL /rr /ineq /ppt /rr0 /mm0 /mm1] pushVariables |
| [ |
[ |
| /ceq arg1 def |
/ceq arg1 def |
| ceq pruneZeroVector /ceq set |
ceq pruneZeroVector /ceq set |
| |
|
| |
ceq length 0 eq { |
| |
(Monomial ideal is not accepted as an input.) cone_ir_input |
| |
} { } ifelse |
| |
|
| |
/mm1 |
| |
( Use [(keep_tmp_files) 1] oxshell to check the input to polymake2tfb. See /tmp or $TMP ) |
| |
def |
| |
|
| ceq genPo2 /ceq2 set |
ceq genPo2 /ceq2 set |
| % ceq2 $B$O(B polymake.data(polymake.INEQUALITIES(...)) $B7A<0(B |
% ceq2 $B$O(B polymake.data(polymake.INEQUALITIES(...)) $B7A<0(B |
| % polymake $B$G(B ceq2 $B$N<!85$N7W;;(B. |
% polymake $B$G(B ceq2 $B$N<!85$N7W;;(B. |
| /getConeInfo.ceq ceq def /getConeInfo.ceq2 ceq2 def |
/getConeInfo.ceq ceq def /getConeInfo.ceq2 ceq2 def |
| |
|
| cone.debug { (Calling polymake DIM.) message } { } ifelse |
cone.debug { (Calling polymake DIM.) message } { } ifelse |
| [(DIM) ceq2] doPolymake 1 get /rr set |
[(DIM) ceq2] doPolymake /rr0 set |
| |
% rr0 2 get message |
| |
rr0 2 get 1 get 0 get /mm0 set |
| |
mm0 length 0 eq { } |
| |
{ [mm0 mm1] cat error } ifelse |
| |
rr0 1 get /rr set |
| cone.debug {(Done.) message } { } ifelse |
cone.debug {(Done.) message } { } ifelse |
| % test5 $B$K$O<!$N%3%a%s%H$H$j$5$k(B. $B>e$N9T$r%3%a%s%H%"%&%H(B. |
% test5 $B$K$O<!$N%3%a%s%H$H$j$5$k(B. $B>e$N9T$r%3%a%s%H%"%&%H(B. |
| % test5.data tfbToTree /rr set |
% test5.data tfbToTree /rr set |
|
|
| % FACETS $B$r;}$C$F$$$J$$$J$i:FEY7W;;$9$k(B. |
% FACETS $B$r;}$C$F$$$J$$$J$i:FEY7W;;$9$k(B. |
| % POINTED, NOT__POINTED $B$bF@$i$l$k(B |
% POINTED, NOT__POINTED $B$bF@$i$l$k(B |
| cone.debug { (Calling polymake FACETS.) message } { } ifelse |
cone.debug { (Calling polymake FACETS.) message } { } ifelse |
| [(FACETS) ceq2] doPolymake 1 get /rr set |
[(FACETS) ceq2] doPolymake /rr0 set |
| |
|
| |
% rr0 2 get message |
| |
rr0 2 get 1 get 0 get /mm0 set |
| |
mm0 length 0 eq { } |
| |
{ [mm0 mm1] cat error } ifelse |
| |
|
| |
rr0 1 get /rr set |
| cone.debug { (Done.) message } { } ifelse |
cone.debug { (Done.) message } { } ifelse |
| } { } ifelse |
} { } ifelse |
| |
|
| rr (VERTICES) getNode tag 0 eq { |
rr (VERTICES) getNode tag 0 eq { |
| (internal error: VERTICES is not found.) error |
(internal error: VERTICES is not found.) error |
| } { } ifelse |
} { |
| |
rr (VERTICES) getNode |
| |
(UNDEF) getNode tag 0 eq { } |
| |
{ (internal error: VERTICES is UNDEF. See rr. Set /@@@polymake.web 1 def) error } ifelse |
| |
} ifelse |
| |
|
| /cone.getConeInfo.rr1 rr def |
/cone.getConeInfo.rr1 rr 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 |
| ] |
] |
|
|
| /vlist arg1 def |
/vlist arg1 def |
| /wlist arg2 def |
/wlist arg2 def |
| wlist length vlist length eq { |
wlist length vlist length eq { |
| } { (cone_wtowv: length of the argument must be the same.) error} ifelse |
} { (cone_wtowv: length of the argument must be the same. Please check the values of cone.vlist cone.vv cone.type parametrizeWeightSpace) error} ifelse |
| |
|
| wlist to_int32 /wlist set |
wlist to_int32 /wlist 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. |
|
|
| % note: 2004.9.2 |
% note: 2004.9.2 |
| cone (facetsv) getNode 2 get facet_i get /v set |
cone (facetsv) getNode 2 get facet_i get /v set |
| cone (facets) getNode 2 get facet_i get /f set |
cone (facets) getNode 2 get facet_i get /f set |
| |
|
| |
v length 0 eq { |
| |
(The codimension of the linarity space of the Grobner cone seems to be 1 or 0.) cone_ir_input |
| |
} { } ifelse |
| |
|
| /vp v 0 get def |
/vp v 0 get def |
| 1 1 v length 1 sub { |
1 1 v length 1 sub { |
| /ii set |
/ii set |
|
|
| %> |
%> |
| /cone.gb_Dh { |
/cone.gb_Dh { |
| /arg2 set /arg1 set |
/arg2 set /arg1 set |
| [/ff /ww /gg] pushVariables |
[/ff /ww /gg /gbopt] pushVariables |
| [ |
[ |
| /ff arg1 def |
/ff arg1 def |
| /ww arg2 def |
/ww arg2 def |
| [(AutoReduce) 1] system_variable |
[(AutoReduce) 1] system_variable |
| [cone.vv ring_of_differential_operators |
[cone.vv ring_of_differential_operators |
| [ww] weight_vector 0] define_ring |
[ww] weight_vector 0] define_ring |
| [ff {toString .} map] groebner 0 get /gg set |
%(---) messagen ff getAttributeList message |
| |
ff getAttributeList tag 0 eq {/gbopt [ ] def } |
| |
{ |
| |
/gbopt ff getAttributeList def |
| |
} ifelse |
| |
[ff {toString .} map gbopt] |
| |
groebner 0 get /gg set %% groenber $B$O(B attribute $B$r<u$1IU$1$J$$(B. |
| /cone.gb_Dh.g gg def |
/cone.gb_Dh.g gg def |
| /arg1 gg def |
/arg1 gg def |
| ] pop |
] pop |
|
|
| %> |
%> |
| /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. |
|
|
| } def |
} def |
| |
|
| %< |
%< |
| % usages: getNextFlip [cone, k] |
% usages: getNextFlip [cone, k, cid] |
| % cone.fan $B$r8!:w$7$F(B $B$^$@(B flip $B$7$F$J$$(B cone $B$H(B facet $B$NAH$rLa$9(B. |
% cone.fan $B$r8!:w$7$F(B $B$^$@(B flip $B$7$F$J$$(B cone $B$H(B facet $B$NAH$rLa$9(B. |
| % $B$b$&$J$$$H$-$K$O(B null $B$rLa$9(B. |
% $B$b$&$J$$$H$-$K$O(B null $B$rLa$9(B. |
| |
% cid $B$O(B cone $B$,(B cone.fan $B$N(B $B2?HVL\$G$"$k$+$N(B index. cone.gblist $B$N8!:wEy$K(B |
| |
% $BMQ$$$k(B. |
| %> |
%> |
| /getNextFlip { |
/getNextFlip { |
| [/tcone /ans /ii ] pushVariables |
[/tcone /ans /ii /cid] pushVariables |
| [ |
[ |
| /ans null def |
/ans null def /cid -1 def |
| 0 1 cone.fan length 1 sub { |
0 1 cone.fan length 1 sub { |
| /ii set |
/ii set |
| cone.fan ii get /tcone set |
cone.fan ii get /tcone set |
| |
/cid ii def |
| tcone getNextFacet /ans set |
tcone getNextFacet /ans set |
| ans tag 0 eq { } { exit } ifelse |
ans tag 0 eq { } { exit } ifelse |
| } for |
} for |
| ans tag 0 eq { /arg1 null def } |
ans tag 0 eq { /arg1 null def } |
| { /arg1 [tcone ans] def } ifelse |
{ /arg1 [tcone ans cid] def } ifelse |
| ] pop |
] pop |
| popVariables |
popVariables |
| arg1 |
arg1 |
|
|
| % flip $B$N;~$N(B epsilon |
% flip $B$N;~$N(B epsilon |
| /cone.epsilon (1).. (10).. div def |
/cone.epsilon (1).. (10).. div def |
| /cone.epsilon.limit (1).. (100).. div def |
/cone.epsilon.limit (1).. (100).. div def |
| |
% cone.epsilon.limit $B$rIi$K$9$l$PDd;_$7$J$$(B. |
| |
|
| %< |
%< |
| % Usages: result_getNextFlip getNextCone ncone |
% Usages: result_getNextFlip getNextCone ncone |
| % flip $B$7$F?7$7$$(B ncone $B$rF@$k(B. |
% flip $B$7$F?7$7$$(B ncone $B$rF@$k(B. |
| %> |
%> |
| /getNextCone { |
/getNextCone.orig { |
| /arg1 set |
/arg1 set |
| [/ncone /ccone /kk /w /next_weight_w_wv] pushVariables |
[/ncone /ccone /kk /w /next_weight_w_wv] pushVariables |
| [ |
[ |
|
|
| |
|
| %< |
%< |
| % 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) [ ] 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. |
| |
|
| |
%< |
| |
% Collart, Kalkbrener, Mall $B$N%"%k%4%j%:%`$K$h$k(B gb $B$N(B flip. |
| |
% See also Sturmfels' book, p.22, 23. |
| |
% Usages: [reducedGb, vlist, oldWeight, facetWeight, newWeight] ckmFlip rGb |
| |
% If it fails, then it returns null, else it returns the reducedGb for the |
| |
% newWeight. |
| |
% gb $B$N(B check $B$r$d$k$N$G(B, $B$=$l$K<:GT$7$?$i(B null $B$rLa$9(B. |
| |
% weight $B$O$9$Y$F(B vw $B7A<0$G(B. vw $B7A<0(B = variable weight $B$N7+$jJV$7$N7A<0(B |
| |
% reducedGb $B$OJ8;zNs$N%j%9%H$G$O$J$/B?9`<0$N7A<0$N$3$H(B. |
| |
% $BM}M3$O(B reducedGb $B$h$j(B ring $B$N9=B$$rFI$`$?$a(B. |
| |
%> |
| |
/ckmFlip { |
| |
/arg1 set |
| |
[/arg_ckmFlip /gOld /vlist /oldWeight /facetWeight /newWeight |
| |
/gNew |
| |
/ww /ww1 /ww2 % $BK\$NCf$N(B w1, w, w2 ($B8E$$(B, facet, $B?7$7$$(B) |
| |
/ch1 /ch2 % $BK\$NCf$N(B {\cal H}_1, {\cal H}_2 |
| |
/grData /rTable |
| |
/rTable2 % rTable $B$NH?BP$NJQ49(B. |
| |
/facetWeight_gr /vlist_gr % graded ring $BMQ(B. |
| |
/oldWeight_gr |
| |
/ccf % reduction $B$7$?78?t(B. |
| |
/rwork /ccf2 /gNew |
| |
] pushVariables |
| |
[ |
| |
arg1 /arg_ckmFlip set |
| |
arg_ckmFlip 0 get /gOld set |
| |
arg_ckmFlip 1 get /vlist set |
| |
arg_ckmFlip 2 get /oldWeight set |
| |
arg_ckmFlip 3 get /facetWeight set |
| |
arg_ckmFlip 4 get /newWeight set |
| |
|
| |
% facet weight vector ww $B$K$D$$$F$N(B initial $B$r<h$j=P$9(B. ch1 $B$X$$$l$k(B. |
| |
gOld getRing ring_def |
| |
facetWeight weightv /ww set |
| |
gOld { ww init } map /ch1 set % facetWeight $B$K$h$k(B initial $B$N<h$j=P$7(B. |
| |
|
| |
|
| |
% $BNc(B: [(x,y) [(x) -1 (Dx) 1 (y) -1 (Dy) 2]] getGrRing |
| |
% [$x,y,y',$ , [ $x$ , $y$ ] , [ [ $Dy$ , $y'$ ] ] ] |
| |
% $BJQ?t%j%9%H(B $BCV49I=(B |
| |
% ch1 $B$r(B gr_ww $B$N85$KJQ49(B. |
| |
[vlist facetWeight] getGrRing /grData set |
| |
[grData 0 get ring_of_differential_operators 0] define_ring /rwork set |
| |
grData 2 get { { . } map } map /rTable set |
| |
rTable { reverse } map /rTable2 set |
| |
grData 0 get /vlist_gr set |
| |
ch1 { toString . rTable replace toString } map /ch1 set |
| |
|
| |
oldWeight { dup isString { . rTable replace toString } |
| |
{ } ifelse } map /oldWeight_gr set |
| |
|
| |
% facetWeight $B$b(B $B?7$7$$4D(B gr_ww $B$N(B weight $B$KJQ49(B. |
| |
% $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2] |
| |
facetWeight { dup isString { . rTable replace toString } |
| |
{ } ifelse } map /facetWeight_gr set |
| |
|
| |
% newWeight $B$b(B $B?7$7$$4D(B gr_ww $B$N(B weight $B$KJQ49(B. |
| |
% $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2] |
| |
newWeight { dup isString { . rTable replace toString } |
| |
{ } ifelse } map /newWeight_gr set |
| |
|
| |
% Dx x = x Dx + h H or Dx x = x Dx + h^2 $B$G7W;;(B. |
| |
% $B$I$A$i$r$H$k$+$O(B cone.gb_gr $B$G6hJL$9$k$7$+$J$7(B |
| |
%% [ch1 vlist_gr oldWeight_gr] /ttt set |
| |
%% ttt cone.gb_gr /ch1 set %$B:FEY$N7W;;$OITMW(B. |
| |
[[(1)] vlist_gr oldWeight_gr] cone.gb_gr getRing ring_def % Set Ring. |
| |
ch1 {toString .} map /ch1 set |
| |
%% $B$3$3$^$G$G$H$j$"$($:%F%9%H$r$7$h$&(B. |
| |
%% ch1 /arg1 set |
| |
[ch1 { toString } map vlist_gr newWeight_gr] cone.gb_gr /ch2 set |
| |
|
| |
% Dx x = x Dx + h H or Dx x = x Dx + h^2 $B$G7W;;(B. |
| |
% $B$I$A$i$r$H$k$+$O(B cone.reduction_gr $B$G6hJL$9$k$7$+$J$7(B |
| |
ch1 getRing ring_def ; |
| |
ch2 {toString .} map {ch1 cone.reduction} map /ccf set |
| |
%ccf pmat |
| |
% $B$H$j$"$($:%F%9%H(B. |
| |
% [ch1 ch2] /arg1 set |
| |
%% ccf[i][0] $B$O(B 0 $B$G$J$$$HL7=b(B. check $B$^$@$7$F$J$$(B. |
| |
|
| |
%% ccf[i][2] (syzygy) $B$r(B gr $B$+$i(B $B$b$H$N(B ring $B$XLa$7(B, |
| |
%% $B?7$7$$(B reduced gbasis $B$r(B ccf[i][2] * gOld $B$G:n$k(B. |
| |
rwork ring_def |
| |
ccf { 2 get {toString . rTable2 replace toString} map } map /ccf2 set |
| |
%% ccf2 $B$O(B gr $B$G$J$$(B ring $B$N85(B. |
| |
gOld getRing ring_def |
| |
cone.DhH { cone.begin_DhH } { } ifelse % Hh $B$+(B h^2 $B$+(B. |
| |
ccf2 { {.} map gOld mul } map /gNew set |
| |
gNew { toString } map /gNew set |
| |
cone.DhH { cone.end_DhH } { } ifelse % Hh $B$+(B h^2 $B$+(B. |
| |
% gNew /arg1 set |
| |
%gNew $B$,(B newWeight $B$G$N(B GB $B$+(B check. Yes $B$J$i(B reduced basis $B$X(B. |
| |
%No $B$J$i(B null $B$rLa$9(B. |
| |
%%Ref: note @s/2005/06/30-note-gfan.pdf |
| |
cone.do_gbCheck not { |
| |
(Warning! gbCheck is skipped.) message |
| |
} { |
| |
(Doing gbCheck.) message |
| |
} ifelse |
| |
cone.do_gbCheck { |
| |
gNew [(gbCheck) 1] setAttributeList newWeight |
| |
cone.gb (gb) getAttribute |
| |
} { 1 } ifelse |
| |
1 eq { |
| |
gNew [(reduceOnly) 1] setAttributeList newWeight cone.gb /arg1 set |
| |
}{ /arg1 null def } ifelse |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
%< |
| |
% Usages: f gbasis cone.reduction_DhH |
| |
% dx x = x dx + h H $B$G$N(B reduction. |
| |
%> |
| |
/cone.reduction_DhH { |
| |
/arg2 set /arg1 set |
| |
[/ff /ggbasis /eenv /ans] pushVariables |
| |
[ |
| |
/ff arg1 def /ggbasis arg2 def |
| |
cone.begin_DhH |
| |
ff ggbasis reduction /ans set |
| |
cone.end_DhH |
| |
/arg1 ans def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
%< |
| |
% Usages: f gbasis cone.reduction_Dh |
| |
% dx x = x dx + h^2 $B$G$N(B reduction. |
| |
%> |
| |
/cone.reduction_Dh { |
| |
/arg2 set /arg1 set |
| |
[/ff /ggbasis /eenv /ans] pushVariables |
| |
[ |
| |
/ff arg1 def /ggbasis arg2 def |
| |
ff ggbasis reduction /ans set |
| |
/arg1 ans def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
%< |
| |
% Usages: cone.begin_DhH dx x = x dx + h H $B$r3+;O(B. |
| |
%> |
| |
/cone.begin_DhH { |
| |
[(Homogenize) (AutoReduce) (KanGBmessage)] pushEnv /cone.eenv set |
| |
[(Homogenize) 3] system_variable |
| |
} def |
| |
|
| |
%< |
| |
% Usages: cone.begin_DhH dx x = x dx + h H $B$r=*N;(B. |
| |
%> |
| |
/cone.end_DhH { |
| |
cone.eenv popEnv |
| |
} def |
| |
|
| |
%< |
| |
% Usages: ff vv ww cone.gb_gr_DhH dx x = x dx + h H $B$G7W;;(B. |
| |
% dh.gb $B$O(B dhecart.sm1 $B$GDj5A$5$l$F$*$j(B, dx x = x dx + h H $B$G$N7W;;(B. |
| |
% gr $B$r$H$C$F$b(B, -w,w $B$N>l9g$O(B $BHyJ,:nMQAG4D$N$^$^$G$"$j(B, $B$3$l$,I,MW(B. |
| |
% bug? cone.gb $B$G==J,(B? |
| |
%> |
| |
/cone.gb_gr_DhH { |
| |
/arg1 set |
| |
[/ff /ww /vv] pushVariables |
| |
[ |
| |
/ff arg1 0 get def |
| |
/vv arg1 1 get def |
| |
/ww arg1 2 get def |
| |
/dh.gb.verbose 1 def |
| |
/dh.autoHomogenize 0 def |
| |
[(AutoReduce) 1] system_variable |
| |
[ff { toString } map vv |
| |
[ww vv generateD1_1]] dh.gb 0 get /arg1 set |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
%< |
| |
% Usages: ff vv ww cone.gb_gr_Dh dx x = x dx + h^2 $B$G7W;;(B. |
| |
% gb $B$O(B dhecart.sm1 $B$GDj5A$5$l$F$*$j(B, dx x = x dx + h^2 $B$G$N7W;;(B. |
| |
% gr $B$r$H$C$F$b(B, -w,w $B$N>l9g$O(B $BHyJ,:nMQAG4D$N$^$^$G$"$j(B, $B$3$l$,I,MW(B. |
| |
% bug? cone.gb $B$G==J,(B? |
| |
%> |
| |
/cone.gb_gr_Dh { |
| |
/arg1 set |
| |
[/ff /ww /vv /gg /envtmp] pushVariables |
| |
[ |
| |
/ff arg1 0 get def |
| |
/vv arg1 1 get def |
| |
/ww arg1 2 get def |
| |
|
| |
[(AutoReduce) (KanGBmessage)] pushEnv /envtmp set |
| |
[(AutoReduce) 1] system_variable |
| |
[(KanGBmessage) 1] system_variable |
| |
[vv ring_of_differential_operators |
| |
[ww] weight_vector 0] define_ring |
| |
[ff {toString .} map] ff getAttributeList setAttributeList |
| |
groebner 0 get /gg set |
| |
envtmp popEnv |
| |
|
| |
/arg1 gg def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
|
| |
% $B$3$l$i$O(B cone.ckmFlip 1 $B$N;~$7$+;H$o$:(B. |
| |
/cone.reduction { |
| |
cone.DhH { |
| |
cone.reduction_DhH |
| |
}{ |
| |
cone.reduction_Dh |
| |
} ifelse |
| |
} def |
| |
/cone.gb_gr { |
| |
cone.DhH { |
| |
cone.gb_gr_DhH |
| |
}{ |
| |
cone.gb_gr_Dh |
| |
} ifelse |
| |
} def |
| |
|
| |
|
| |
/test1.ckmFlip { |
| |
% cf. cone.sample2 |
| |
cone.load.cohom |
| |
/cone.comment [ |
| |
(BS for y and y-(x-1)^2, t1, t2 space, in doubly homogenized Weyl algebra.) nl |
| |
(The Grobner cones are dehomogenized to get local Grobner fan.) nl |
| |
] cat def |
| |
/cone.vlist [(t1) (t2) (x) (y) (Dt1) (Dt2) (Dx) (Dy) (h) (H)] def |
| |
/cone.vv (t1,t2,x,y) def |
| |
/cone.type 1 def |
| |
/cone.parametrizeWeightSpace { |
| |
4 2 parametrizeSmallFan |
| |
} def |
| |
|
| |
/cone.DhH 1 def |
| |
/cone.ckmFlip 1 def |
| |
|
| |
/cone.local 1 def |
| |
/cone.w_start null def |
| |
/cone.h0 1 def |
| |
/cone.input |
| |
[ |
| |
(t1-y) (t2 - (y-(x-1)^2)) |
| |
((-2 x + 2)*Dt2+Dx) |
| |
(Dt1+Dt2+Dy) |
| |
] |
| |
def |
| |
% homogenize |
| |
[cone.vv ring_of_differential_operators |
| |
[[(t1) -1 (t2) -1 (Dt1) 1 (Dt2) 1]] ecart.weight_vector |
| |
0] define_ring |
| |
dh.begin |
| |
cone.input { . homogenize toString } map /cone.input set |
| |
dh.end |
| |
|
| |
|
| |
% $B%F%9%H$r3+;O$9$k(B. |
| |
% getStartingCone /cone.ncone set |
| |
% cone.ncone updateFan |
| |
% cone.gblist 0 get message |
| |
% cone.ncone /cone.ccone set |
| |
% getNextFlip /cone.nextflip set |
| |
% cone.nextflip message |
| |
|
| |
/wOld [(t1) , -29 , (t2) , -38 , (Dt1) , 29 , (Dt2) , 38 ] def |
| |
/wFacet [(t1) , -1 , (t2) , -1 , (Dt1) , 1 , (Dt2) , 1 ] def |
| |
/wNew [(t1) , -39 , (t2) , -38 , (Dt1) , 39 , (Dt2) , 38 ] def |
| |
cone.input wOld cone.gb /ff set |
| |
[ff (t1,t2,x,y) wOld wFacet wNew] ckmFlip /ff2 set |
| |
(See ff and ff2) message |
| |
|
| |
} def |
| |
|
| |
%< |
| |
% Usages: cone i getaVectorOnFacet |
| |
% cone $B$N(B i $BHVL\$N(B facet $B$N>e$N(B vector $B$r5a$a$k(B. |
| |
% cf. liftWeight |
| |
%> |
| |
/getaVectorOnFacet { |
| |
/arg2 set /arg1 set |
| |
[/cone /facet_i /ep /vp /v /v /ii] pushVariables |
| |
[ |
| |
/cone arg1 def /facet_i arg2 def |
| |
facet_i to_int32 /facet_i set |
| |
|
| |
cone (facetsv) getNode 2 get facet_i get /v set |
| |
/vp v 0 get def |
| |
1 1 v length 1 sub { |
| |
/ii set |
| |
vp v ii get add /vp set |
| |
} for |
| |
vp nnormalize_vec /vp set |
| |
/arg1 vp def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
/getNextCone { |
| |
getNextCone_ckm |
| |
} def |
| |
|
| |
%< |
| |
% Usages: result_getNextFlip getNextCone_ckm ncone |
| |
% flip $B$7$F?7$7$$(B ncone $B$rF@$k(B. Collar-Kalkbrener-Moll $B$N%"%k%4%j%:%`$r;H$&(B |
| |
% if (cone.ckmFlip == 0) $BIaDL$N7W;;(B else CKM. |
| |
%> |
| |
/getNextCone_ckm { |
| |
/arg1 set |
| |
[/ncone /ccone /kk /w /next_weight_w_wv /cid /ttt] pushVariables |
| |
[ |
| |
/ccone arg1 def |
| |
/ncone null def |
| |
/kk ccone 1 get def % kk $B$O(B cid $BHVL\$N(B cone $B$N(B kk $BHVL\$N(B facet $B$rI=$9(B. |
| |
/cid ccone 2 get def % cid $B$O(B cone $B$N(B $BHV9f(B. |
| |
ccone 0 get /ccone set |
| |
{ |
| |
ccone tag 0 eq { exit } { } ifelse |
| |
|
| |
% ccone $B$N(B kk $BHVL\$N(B facet $B$K$D$$$F(B flip $B$9$k(B. |
| |
ccone kk cone.epsilon flipWeight /w set |
| |
(Trying new weight is ) messagen w message |
| |
w liftWeight /next_weight_w_wv set |
| |
(Trying new weight [w,wv] is ) messagen next_weight_w_wv message |
| |
|
| |
cone.ckmFlip { |
| |
[ |
| |
cone.gblist cid get (grobnerBasis) getNode 2 get % reduce gb |
| |
cone.vv |
| |
cone.gblist cid get (weight) getNode [2 0 2] get % weight |
| |
ccone kk getaVectorOnFacet liftWeight 1 get % weight on facet |
| |
next_weight_w_wv 1 get % new weight |
| |
] /ttt set |
| |
ttt message |
| |
ttt ckmFlip /cone.cgb set |
| |
}{ |
| |
cone.input next_weight_w_wv 1 get cone.gb /cone.cgb set |
| |
} ifelse |
| |
|
| |
cone.cgb tag 0 eq not { |
| |
[w] next_weight_w_wv join /cone.cgb_weight 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 |
| |
pruneZeroVector /cone.gw_ineq_projectedWtLpt set |
| |
|
| |
(cone.gw_ineq_projectedWtLpt is obtained.) message |
| |
|
| |
cone.gw_ineq_projectedWtLpt getConeInfo /cone.nextConeInfo set |
| |
% $B<!85$rD4$Y$k(B. $B$@$a$J$i(B retry |
| |
cone.nextConeInfo 0 get 0 get to_int32 cone.d eq { |
| |
cone.nextConeInfo 1 get newCone /ncone set |
| |
ccone ncone getCommonFacet 0 get { |
| |
(Flip succeeded.) message |
| |
exit |
| |
} { } ifelse |
| |
} { } ifelse |
| |
% common face $B$,$J$1$l$P(B $B$d$O$j(B epsilon $B$r>.$5$/(B. |
| |
cone.nextConeInfo 0 get 0 get to_int32 cone.d eq { |
| |
(ccone and ncone do not have a common facet.) message |
| |
} { |
| |
(ncone is not maximal dimensional. ) message |
| |
} ifelse |
| |
}{ } ifelse |
| |
|
| |
(Decreasing epsilon to ) messagen |
| |
cone.epsilon (1).. (2).. div mul /cone.epsilon set |
| |
cone.epsilon cone.epsilon.limit sub numerator (0).. lt { |
| |
(Too small cone.epsilon ) error |
| |
} { } ifelse |
| |
cone.epsilon message |
| |
} loop |
| |
/arg1 ncone def |
| |
] pop |
| |
popVariables |
| |
arg1 |
| |
} def |
| |
|
| |
%%change |
| |
/cone_ir_input { |
| |
/arg1 set |
| |
[/msg ] pushVariables |
| |
[ |
| |
/msg arg1 def |
| |
(---------------) message |
| |
msg message |
| |
( ) message |
| |
(Please also refer to the value of the variables cone.getConeInfo.rr0) message |
| |
( cone.getConeInfo.rr1 cone.Lp cone.cinit) message |
| |
$ cone.cinit (FACETS) getNode :: $ message |
| |
(We are sorry that we cannot accept this input.) error |
| |
] pop |
| |
popVariables |
| |
} def |
![[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