version 1.9, 2005/06/30 08:39:39 |
version 1.20, 2018/05/02 02:28:13 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.8 2004/10/13 23:36:52 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.19 2013/10/11 01:08:35 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 |
%%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 the source code gfan.sm1, there are sample inputs cone.sample and cone.sample2.) |
|
( ) |
|
(gfan.sm1 works only with polymake 2.0. We provide 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.sample ; is an example. See the source code. The state polytope is the hexagon.) |
|
( ) |
|
(*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.) |
|
(*cone.Lp gives a basis of the pointed cone. cone.Lpt is the transpose of cone.Lp.) |
|
$*When v is a row vector in an ouput cone, (v cone.Lp cone.W) gives $ |
|
( the corresponding weight vector in the full variable space in D) |
|
(*cone.incidence is a list of [[cone num1,facet num1], [cone num2,facet num2]]) |
|
( which means that cone num1 and cone num2 are adjacent and shares ) |
|
( the facet num1 and the facet num2) |
|
(*/cone.withGblist 1 def saves the Grobner basis standing for each cone.) |
|
( ) |
|
(*Cone descriptions: cone.fan) |
|
(**A facet is given by its normal vector n of a cone. It gives facet num of the cone.) |
|
(**A cone is defined by facet normal vectors n1, n2, ... as n1.x>=0 and n2.x >=0 and ...) |
|
(**facetsv is a list of facets expressed by generators.) |
|
(**nextcid is a list of the adjacent cone numbers.) |
|
(**nextfid is a list of the shared facet numbers.) |
|
(**vertices is the generators of a cone.) |
|
(**inequalities are not necessarily unique.) |
|
] |
|
] putUsages |
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
%% Two examples are given below to get a global Grobner fan and |
%% Two examples are given below to get a global Grobner fan and |
%% a local Grobner fan ; cone.sample and cone.sample2 |
%% a local Grobner fan ; cone.sample and cone.sample2 |
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
/cone.sample { |
/cone.sample { |
cone.load.cohom |
cone.load.cohom |
|
/cone.ckmFlip 1 def |
% write a comment about the problem. "nl" means new line. |
% write a comment about the problem. "nl" means new line. |
/cone.comment [ |
/cone.comment [ |
(Toric ideal for 1-simplex x 2-simplex, in k[x]) nl |
(Toric ideal for 1-simplex x 2-simplex, in k[x]) nl |
|
|
] |
] |
def |
def |
|
|
|
/cone.DhH 0 def |
% Set a function to compute Grobner basis. |
% Set a function to compute Grobner basis. |
% cone.gb_Dh : For computing in Homogenized Weyl algebra h[1,1](D). |
% cone.gb_Dh : For computing in Homogenized Weyl algebra h[1,1](D). |
% cone.gb_DhH : For computing in doubly homogenized Weyl algebra. |
% cone.gb_DhH : For computing in doubly homogenized Weyl algebra. |
|
|
cone.comment message |
cone.comment message |
(cone.input = ) message |
(cone.input = ) message |
cone.input message |
cone.input message |
|
%%% Step 0. If you want to output Grobner basis standing for each cone, then uncomment |
|
% /cone.withGblist 1 def |
|
|
%%%% Step 1. Enumerating the Grobner Cones in a global ring. |
%%%% Step 1. Enumerating the Grobner Cones in a global ring. |
%%%% The result is stored in cone.fan |
%%%% The result is stored in cone.fan |
getGrobnerFan |
getGrobnerFan |
|
|
printGrobnerFan |
printGrobnerFan |
|
|
%%%% If you want to save the data to the file sm1out.txt, then uncomment. |
%%%% If you want to save the data to the file sm1out.txt, then uncomment. |
% /cone.withGblist 1 def saveGrobnerFan /ff set ff output |
%saveGrobnerFan /ff set ff output |
|
|
%%%% Step 2. Dehomogenize the Grobner Cones |
%%%% Step 2. Dehomogenize the Grobner Cones |
%%%% by the equivalence relation in a local ring (uncomment). |
%%%% by the equivalence relation in a local ring (uncomment). |
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
/cone.sample2 { |
/cone.sample2 { |
cone.load.cohom |
cone.load.cohom |
|
/cone.ckmFlip 1 def |
% write a comment about the problem. "nl" means new line. |
% write a comment about the problem. "nl" means new line. |
/cone.comment [ |
/cone.comment [ |
(BS for y and y-(x-1)^2, t1, t2 space, in doubly homogenized Weyl algebra.) nl |
(BS for y and y-(x-1)^2, t1, t2 space, in doubly homogenized Weyl algebra.) nl |
|
|
cone.input { . homogenize toString } map /cone.input set |
cone.input { . homogenize toString } map /cone.input set |
dh.end |
dh.end |
|
|
|
/cone.DhH 1 def |
% Set a function to compute Grobner basis. |
% Set a function to compute Grobner basis. |
% cone.gb_Dh : For computing in Homogenized Weyl algebra h[1,1](D). |
% cone.gb_Dh : For computing in Homogenized Weyl algebra h[1,1](D). |
% cone.gb_DhH : For computing in doubly homogenized Weyl algebra. |
% cone.gb_DhH : For computing in doubly homogenized Weyl algebra. |
Line 246 dhcone.printGrobnerFan |
|
Line 287 dhcone.printGrobnerFan |
|
% If you use the cgi/polymake on the net, then uncomment out. |
% If you use the cgi/polymake on the net, then uncomment out. |
%/doPolymake {doPolymake.OoHG} def (Using doPolymake.OoHG ) message |
%/doPolymake {doPolymake.OoHG} def (Using doPolymake.OoHG ) message |
%/polymake.start {polymake.start.OoHG} def (Using polymake.start.OoHG ) message |
%/polymake.start {polymake.start.OoHG} def (Using polymake.start.OoHG ) message |
|
/@@@polymake.web 1 def |
%% Choose it automatically. |
%% Choose it automatically. |
[(which) (polymake)] oxshell tag 0 eq { |
[(which) (polymake)] oxshell tag 0 eq |
(Polymake is not installed in this system.) message |
@@@polymake.web 1 eq |
/doPolymake {doPolymake.OoHG} def |
or |
(Using doPolymake.OoHG ) message |
{ |
/polymake.start {polymake.start.OoHG} def |
(Polymake is not installed in this system or @@@polymake.web is set.) message |
(Using polymake.start.OoHG ) message |
usePolymake.OoHG.curl |
} { (Local polymake will be used.) message } ifelse |
(Using doPolymake.OoHG.curl ) message |
|
} { usePolymake.local (Local polymake will be used.) message } ifelse |
|
|
/cone.debug 1 def |
/cone.debug 1 def |
|
|
Line 398 cone.comment message |
|
Line 441 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. |
|
|
%> |
%> |
/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 |
|
|
|
|
/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 |
[ |
[ |
|
|
% 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] ff getAttributeList setAttributeList |
%(---) messagen ff getAttributeList message |
groebner 0 get /gg set |
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 |
|
|
% 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 |
[ |
[ |
|
|
/printGrobnerFan { |
/printGrobnerFan { |
[/i] pushVariables |
[/i] pushVariables |
[ |
[ |
|
$(gfan) usage to find explanations on variables.$ message |
(========== Grobner Fan ====================) message |
(========== Grobner Fan ====================) message |
[ |
[ |
(cone.comment) |
(cone.comment) |
|
|
% gb $B$N(B check $B$r$d$k$N$G(B, $B$=$l$K<:GT$7$?$i(B null $B$rLa$9(B. |
% 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 |
% 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. |
% 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 { |
/ckmFlip { |
/arg1 set |
/arg1 set |
|
|
% $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2] |
% $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2] |
facetWeight { dup isString { . rTable replace toString } |
facetWeight { dup isString { . rTable replace toString } |
{ } ifelse } map /facetWeight_gr set |
{ } 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. |
% 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 |
% $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 |
%% [ch1 vlist_gr oldWeight_gr] /ttt set |
|
|
ch1 {toString .} map /ch1 set |
ch1 {toString .} map /ch1 set |
%% $B$3$3$^$G$G$H$j$"$($:%F%9%H$r$7$h$&(B. |
%% $B$3$3$^$G$G$H$j$"$($:%F%9%H$r$7$h$&(B. |
%% ch1 /arg1 set |
%% ch1 /arg1 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 |
|
[ch1 { toString } map vlist_gr newWeight_gr] cone.gb_gr /ch2 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. |
% Dx x = x Dx + h H or Dx x = x Dx + h^2 $B$G7W;;(B. |
|
|
ccf { 2 get {toString . rTable2 replace toString} map } map /ccf2 set |
ccf { 2 get {toString . rTable2 replace toString} map } map /ccf2 set |
%% ccf2 $B$O(B gr $B$G$J$$(B ring $B$N85(B. |
%% ccf2 $B$O(B gr $B$G$J$$(B ring $B$N85(B. |
gOld getRing ring_def |
gOld getRing ring_def |
cone.beginH % Hh $B$+(B h^2 $B$+(B. |
cone.DhH { cone.begin_DhH } { } ifelse % Hh $B$+(B h^2 $B$+(B. |
ccf2 { {.} map gOld mul } map /gNew set |
ccf2 { {.} map gOld mul } map /gNew set |
gNew { toString } map /gNew set |
gNew { toString } map /gNew set |
cone.endH |
cone.DhH { cone.end_DhH } { } ifelse % Hh $B$+(B h^2 $B$+(B. |
% gNew /arg1 set |
% 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. |
%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. |
%No $B$J$i(B null $B$rLa$9(B. |
gNew [(gbCheck) 1] setAttributeList newWeight |
%%Ref: note @s/2005/06/30-note-gfan.pdf |
cone.gb (gb) getAttribute |
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 { |
1 eq { |
gNew [(reduceOnly) 1] setAttributeList newWeight cone.gb /arg1 set |
gNew [(reduceOnly) 1] setAttributeList newWeight cone.gb /arg1 set |
}{ /arg1 null def } ifelse |
}{ /arg1 null def } ifelse |
|
|
|
|
%< |
%< |
% Usages: f gbasis cone.reduction_DhH |
% Usages: f gbasis cone.reduction_DhH |
|
% dx x = x dx + h H $B$G$N(B reduction. |
%> |
%> |
/cone.reduction_DhH { |
/cone.reduction_DhH { |
/arg2 set /arg1 set |
/arg2 set /arg1 set |
[/ff /ggbasis /eenv /ans] pushVariables |
[/ff /ggbasis /eenv /ans] pushVariables |
[ |
[ |
/ff arg1 def /ggbasis arg2 def |
/ff arg1 def /ggbasis arg2 def |
cone.beginH |
cone.begin_DhH |
ff ggbasis reduction /ans set |
ff ggbasis reduction /ans set |
cone.endH |
cone.end_DhH |
/arg1 ans def |
/arg1 ans def |
] pop |
] pop |
popVariables |
popVariables |
arg1 |
arg1 |
} def |
} 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 { |
/cone.begin_DhH { |
[(Homogenize) (AutoReduce) (KanGBmessage)] pushEnv /cone.eenv set |
[(Homogenize) (AutoReduce) (KanGBmessage)] pushEnv /cone.eenv set |
[(Homogenize) 3] system_variable |
[(Homogenize) 3] system_variable |
} def |
} def |
|
|
|
%< |
|
% Usages: cone.begin_DhH dx x = x dx + h H $B$r=*N;(B. |
|
%> |
/cone.end_DhH { |
/cone.end_DhH { |
cone.eenv popEnv |
cone.eenv popEnv |
} def |
} 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 { |
/test1.ckmFlip { |
% cf. cone.sample2 |
% cf. cone.sample2 |
cone.load.cohom |
cone.load.cohom |
|
|
/cone.parametrizeWeightSpace { |
/cone.parametrizeWeightSpace { |
4 2 parametrizeSmallFan |
4 2 parametrizeSmallFan |
} def |
} def |
|
|
|
/cone.DhH 1 def |
|
/cone.ckmFlip 1 def |
|
|
/cone.local 1 def |
/cone.local 1 def |
/cone.w_start null def |
/cone.w_start null def |
/cone.h0 1 def |
/cone.h0 1 def |
|
|
cone.input { . homogenize toString } map /cone.input set |
cone.input { . homogenize toString } map /cone.input set |
dh.end |
dh.end |
|
|
/cone.gb { |
|
cone.gb_DhH |
|
} def |
|
|
|
/cone.reduction { |
|
cone.reduction_DhH |
|
} def |
|
|
|
/cone.beginH { |
|
cone.begin_DhH |
|
} def |
|
/cone.endH { |
|
cone.end_DhH |
|
} def |
|
% $B%F%9%H$r3+;O$9$k(B. |
% $B%F%9%H$r3+;O$9$k(B. |
/cone.gb_gr { |
|
/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 |
|
|
|
% getStartingCone /cone.ncone set |
% getStartingCone /cone.ncone set |
% cone.ncone updateFan |
% cone.ncone updateFan |
% cone.gblist 0 get message |
% cone.gblist 0 get message |
|
|
[ff (t1,t2,x,y) wOld wFacet wNew] ckmFlip /ff2 set |
[ff (t1,t2,x,y) wOld wFacet wNew] ckmFlip /ff2 set |
(See ff and ff2) message |
(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 |
} def |