version 1.7, 2004/09/30 07:45:04 |
version 1.9, 2005/06/30 08:39:39 |
|
|
% $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.6 2004/09/30 07:39:42 takayama Exp $ |
% $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.8 2004/10/13 23:36:52 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 |
|
|
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
%% Two examples are given below to get a global Grobner fan and |
%% Two examples are given below to get a global Grobner fan and |
|
|
%% How to input data? An example. (cf. test13.sm1) |
%% How to input data? An example. (cf. test13.sm1) |
%% Modify the following or copy the /cone.sample { ... } def |
%% Modify the following or copy the /cone.sample { ... } def |
%% to your own file, |
%% to your own file, |
%% edit it, and execute if by " cone.sample ; " |
%% edit it, and execute it by " cone.sample ; " |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
/cone.sample { |
/cone.sample { |
cone.load.cohom |
cone.load.cohom |
|
|
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.wightGblist 1 def saveGrobnerFan /ff set ff output |
% /cone.withGblist 1 def 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). |
|
|
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.wightGblist 1 def saveGrobnerFan /ff set ff output |
% /cone.withGblist 1 def 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). |
Line 243 dhcone.printGrobnerFan |
|
Line 244 dhcone.printGrobnerFan |
|
|
|
% If you use local polymake, then comment out. |
% If you use local polymake, then comment out. |
% 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 |
%/doPolymake {doPolymake.OoHG} def (Using doPolymake.OoHG ) message |
|
%/polymake.start {polymake.start.OoHG} def (Using polymake.start.OoHG ) message |
|
%% Choose it automatically. |
|
[(which) (polymake)] oxshell tag 0 eq { |
|
(Polymake is not installed in this system.) 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 |
|
|
% My setting. |
|
[(getenv) (HOST)] extension /cone.hostname set |
|
cone.hostname tag 0 eq { /cone.hostname (?) def } { } ifelse |
|
cone.hostname (orange2.math.sci.kobe-u.ac.jp) eq |
|
cone.hostname (orange2-clone.math.sci.kobe-u.ac.jp) eq |
|
or |
|
{ |
|
(Using doPolymake.OoHG ) message |
|
/doPolymake {doPolymake.OoHG} def |
|
} { } ifelse |
|
|
|
/cone.debug 1 def |
/cone.debug 1 def |
|
|
/ox.k0.loaded boundp { |
/ox.k0.loaded boundp { |
|
|
/cone.loaded boundp { } |
/cone.loaded boundp { } |
{ |
{ |
[(parse) (cohom.sm1) pushfile] extension |
[(parse) (cohom.sm1) pushfile] extension |
% [(parse) (cone.sm1) pushfile] extension |
% [(parse) (cone.sm1) pushfile] extension % BUG? cone.sm1 overrides a global |
|
% in cohom.sm1? |
[(parse) (dhecart.sm1) pushfile] extension |
[(parse) (dhecart.sm1) pushfile] extension |
/cone.loaded 1 def |
/cone.loaded 1 def |
oxNoX polymake.start ( ) message |
oxNoX |
|
polymake.start ( ) message |
} ifelse |
} ifelse |
} def |
} def |
|
|
|
|
/dh.autoHomogenize 0 def |
/dh.autoHomogenize 0 def |
[(AutoReduce) 1] system_variable |
[(AutoReduce) 1] system_variable |
[ff { toString } map cone.vv |
[ff { toString } map cone.vv |
[ww cone.vv generateD1_1]] dh.gb 0 get /arg1 set |
[ww cone.vv generateD1_1]] ff getAttributeList setAttributeList |
|
dh.gb 0 get /arg1 set |
] pop |
] pop |
|
popVariables |
arg1 |
arg1 |
} def |
} 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 |
[ff {toString .} map] ff getAttributeList setAttributeList |
|
groebner 0 get /gg set |
/cone.gb_Dh.g gg def |
/cone.gb_Dh.g gg def |
/arg1 gg def |
/arg1 gg def |
] pop |
] pop |
|
|
} 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 |
|
|
% |
% |
|
|
% Todo: save functions. |
% 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. |
|
%> |
|
/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 |
|
% 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 |
|
% 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 |
|
|
|
% 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.beginH % Hh $B$+(B h^2 $B$+(B. |
|
ccf2 { {.} map gOld mul } map /gNew set |
|
gNew { toString } map /gNew set |
|
cone.endH |
|
% 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. |
|
gNew [(gbCheck) 1] setAttributeList newWeight |
|
cone.gb (gb) getAttribute |
|
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 |
|
%> |
|
/cone.reduction_DhH { |
|
/arg2 set /arg1 set |
|
[/ff /ggbasis /eenv /ans] pushVariables |
|
[ |
|
/ff arg1 def /ggbasis arg2 def |
|
cone.beginH |
|
ff ggbasis reduction /ans set |
|
cone.endH |
|
/arg1 ans def |
|
] pop |
|
popVariables |
|
arg1 |
|
} def |
|
|
|
/cone.begin_DhH { |
|
[(Homogenize) (AutoReduce) (KanGBmessage)] pushEnv /cone.eenv set |
|
[(Homogenize) 3] system_variable |
|
} def |
|
|
|
/cone.end_DhH { |
|
cone.eenv popEnv |
|
} 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.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 |
|
|
|
/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. |
|
/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 |
|
% 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 |