=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/gfan.sm1,v retrieving revision 1.2 retrieving revision 1.6 diff -u -p -r1.2 -r1.6 --- OpenXM/src/kan96xx/Doc/gfan.sm1 2004/09/09 08:50:12 1.2 +++ OpenXM/src/kan96xx/Doc/gfan.sm1 2004/09/30 07:39:42 1.6 @@ -1,8 +1,261 @@ -% $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.1 2004/09/05 10:19:29 takayama Exp $ +% $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.5 2004/09/16 06:16:44 takayama Exp $ % cp cone.sm1 $OpenXM_HOME/src/kan96xx/Doc/gfan.sm1 -% $Id: gfan.sm1,v 1.2 2004/09/09 08:50:12 takayama Exp $ +% $Id: gfan.sm1,v 1.6 2004/09/30 07:39:42 takayama Exp $ % iso-2022-jp +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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 if by " cone.sample ; " +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +/cone.sample { + cone.load.cohom +% 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 + +% 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.wightGblist 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 +% 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 + +% 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.wightGblist 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 + +% 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 /ox.k0.loaded boundp { @@ -10,14 +263,49 @@ [(parse) (ox.sm1) pushfile] extension } ifelse -%%%%<<<< 初期データの設定例 data/test13 より. <<<<<<<<<<<<<< -/cone.sample.test13 { +/cone.load.cohom { /cone.loaded boundp { } { [(parse) (cohom.sm1) pushfile] extension [(parse) (cone.sm1) pushfile] extension + [(parse) (dhecart.sm1) pushfile] extension /cone.loaded 1 def + oxNoX polymake.start ( ) message } ifelse +} def + +%% Usages: cone.gb_DhH. h H (double homogenized) 用の GB. +%% dhecart.sm1 を load してあること. 入力は同次でないといけない. +%% [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 などの方法で同次化できる. +/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]] dh.gb 0 get /arg1 set + ] pop + arg1 +} def + +% +% cone.fan, cone.gblist に fan のデータがはいる. +% +%%%%<<<< 初期データの設定例. 日本語版 data/test13 より. <<<<<<<<<<<<<< +/cone.sample.test13.ja { + /cone.loaded boundp { } + { + [(parse) (cohom.sm1) pushfile] extension + [(parse) (cone.sm1) pushfile] extension + /cone.loaded 1 def + } ifelse /cone.comment [ (Toric ideal for 1-simplex x 2-simplex, in k[x]) nl ] cat def @@ -164,7 +452,7 @@ cone.comment message ww to_int32 /ww set % univNum があれば int32 に直しておく. /ww2 ww weightv def % v-w 形式を 数字のベクトルに. (init 用) - /eqs [ ] def % 不等式系の係数 + /eqs null def % 不等式系の係数 /gsize g length def 0 1 gsize 1 sub { /i set @@ -177,20 +465,21 @@ cone.comment message % in_ww(f) > f_j となる項の処理. iterms 1 exps length 1 sub { /j set - eqs [expsTop exps j get sub] join /eqs set + expsTop exps j get sub eqs cons /eqs set % exps[0]-exps[j] を eqs へ格納していく. } for % in_ww(f) = f_j となる項の処理. [(exponents) f ww2 init cone.type] gbext /exps set % exps は in(f) 1 1 iterms 1 sub { /j set - eqs [exps j get expsTop sub] join /eqs set - eqs [expsTop exps j get sub] join /eqs set + exps j get expsTop sub eqs cons /eqs set + expsTop exps j get sub eqs cons /eqs set % exps[j]-exps[0], exps[0]-exps[j] を格納. % 結果的に (exps[j]-exps[0]).w = 0 となる. } for } { } ifelse } for + eqs listToArray reverse /eqs set /arg1 eqs def ] pop popVariables @@ -515,6 +804,15 @@ cone.comment message $It translates null to (0)..$ ]] putUsages +%< +% Usages: newVector.with-1 +% (-1).. で埋めたベクトルを作る. +%> +/newVector.with-1 { + newVector { pop (-1).. } map +} def + + % [2 0] lcm は 0 をもどすがいいか? --> OK. %< @@ -807,11 +1105,16 @@ def { nnormalize_vec } map /ineq set [[ ] ] ineq join shell rest removeFirstFromPolymake /ineq set +% nextcid, nextfid を加える. nextcid は nextConeId の略. となりの cone 番号. +% nextfid は nextFacetId の略. となりの cone の facet +% 番号. [(cone) [ ] [ [(facets) [ ] facets] arrayToTree [(flipped) [ ] facets length newVector null_to_zero] arrayToTree [(facetsv) [ ] facets vertices newCone_facetsv] arrayToTree + [(nextcid) [ ] facets length newVector.with-1 ] arrayToTree + [(nextfid) [ ] facets length newVector.with-1 ] arrayToTree [(vertices) [ ] vertices] arrayToTree [(inequalities) [ ] ineq] arrayToTree ] @@ -1475,8 +1778,30 @@ def popVariables } def +%< +% Usages: cone i [cid fid] markNext +% cone の i 番目の facet のとなりの cone id (cid) と face id (fid) を設定する. +% cone の nextcid[i] = cid; nextfid[i] = fid となる. +% cone 自体が変更される. +% cone は 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 % flipped の mark のない facet の index facet_i を戻す. @@ -1914,17 +2239,22 @@ def %> /markBorder { /arg1 set - [/cone /facets_t /flipped_t /kk] pushVariables + [/cone /facets_t /flipped_t /kk /nextcid_t /nextfid_t] pushVariables [ /cone arg1 def cone (facets) getNode 2 get /facets_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 { /kk set flipped_t kk get (0).. eq { cone kk isOnWeightBorder { % Border の上にあるので flip 済のマークをつける. flipped_t kk (2).. put +% となりの cone の id (nextcid, nextfid) は -2 とする. + nextcid_t kk (-2).. put + nextfid_t kk (-2).. put } { } ifelse } { } ifelse } for @@ -1981,6 +2311,9 @@ def ncone ii markFlipped cone.fan kk get /tcone set tcone jj markFlipped +% nextcid, nextfid を設定する. + ncone ii [kk jj] markNext + tcone jj [cone.fan.n ii] markNext } { } ifelse } for % 3. ncone を加える. @@ -2323,7 +2656,10 @@ def (cone.incidence) ] { inputForm.value nl } map /rr set - rr cat /arg1 set + rr cat /rr set +% ring を save してないので当座の対処. + [ ([) cone.vv inputForm ( ring_of_differential_operators 0 ] define_ring ) + nl nl rr] cat /arg1 set ] pop popVariables arg1 @@ -2412,3 +2748,667 @@ def popVariables arg1 } def + +%< +% Usages: [vlist vw_vector] getGrRing [vlist vGlobal sublist] +% example: [(x,y,z) [(x) -1 (Dx) 1 (y) 1 (Dy) 2]] getGrRing +% [(x,y,z,y') [(x)] [[(Dy) (y')]]] +% h[0,1](D_0) 専用の getGrRing. +% u_i + v_i > 0 なら Dx_i ==> x_i' (可換な変数). sublist へ. +% u_i < 0 なら x_i は vGlobal へ. +% ii [vlist vGlobal sublist] toGrRing /ii set +% [ii jj vlist [(partialEcartGlobalVarX) vGlobal]] ecart.isSameIdeal と使う. +%> +/getGrRing { + /arg1 set + [/vlist /vw_vector /ans /vGlobal /sublist /newvlist + /dlist /tt /i /u /v /k + ] pushVariables + [ + /vlist arg1 0 get def + /vw_vector arg1 1 get def + + vlist isString { [vlist to_records pop] /vlist set } { } ifelse + vlist { toString } map /vlist set +% dlist は [(Dx) (Dy) (Dz)] のリスト. + vlist { /tt set [@@@.Dsymbol tt] cat } map /dlist set + + /newvlist [ ] def /sublist [ ] def /vGlobal [ ] def +% 可換な新しい変数を newvlist へ. 置換表を sublist へ. + 0 1 vlist length 1 sub { + /i set +% (u,v) は (x_i, Dx_i) に対する weight vector + /u vlist i get , vw_vector getGrRing.find def + u -1 gt { + vw_vector , u 1 add , get /u set + } { /u 0 def } ifelse + + /v dlist i get , vw_vector getGrRing.find def + v -1 gt { + vw_vector , v 1 add , get /v set + } { /v 0 def } ifelse + u to_int32 /u set , v to_int32 /v set + + u v add , 0 gt { + newvlist [vlist i get] join /newvlist set + } { } ifelse + u 0 lt { + vGlobal [vlist i get] join /vGlobal set + } { } ifelse + } for + + newvlist { /tt set [ [@@@.Dsymbol tt] cat [tt (')] cat ] } map + /sublist set + + /ans [ vlist , newvlist { /tt set [tt (')] cat } map , join from_records + vGlobal sublist] def + /arg1 ans def + ] pop + popVariables + arg1 +} def + +%< +% Usages: a uset getGrRing.find index +%> +/getGrRing.find { + /arg2 set /arg1 set + [/a /uset /ans /i] pushVariables + [ + /a arg1 def /uset arg2 def + /ans -1 def + { /ans -1 def + 0 1 , uset length 1 sub { + /i set + a tag , uset i get tag eq { + a , uset i get eq { + /ans i def exit + } { } ifelse + } { } ifelse + } for + exit + } loop + /arg1 ans def + ] pop + popVariables + arg1 +} def + +%< +% Usages: g1 g2 isSameGrRing bool +% g1, g2 は getGrRing の戻り値. +%> +/isSameGrRing { + /arg2 set /arg1 set + [/g1 /g2 /ans] pushVariables + [ + /g1 arg1 def /g2 arg2 def + { + /ans 1 def + g1 0 get , g2 0 get eq { } { /ans 0 def exit } ifelse + exit + g1 1 get , g2 1 get eq { } { /ans 0 def exit } ifelse + } loop + /arg1 ans def + ] pop + popVariables + arg1 +} def + +%< +% Usages: [[ii i_vw_vector] [jj j_vw_vector] vlist] isSameInGrRing_h +% It computes gb. +%> +/isSameInGrRing_h { + /arg1 set + [/ii /i_vw_vector /jj /j_vw_vector /vlist + /i_gr /j_gr /rrule /ans] pushVariables + [ + /ii arg1 [0 0] get def + /i_vw_vector arg1 [0 1] get def + /jj arg1 [1 0] get def + /j_vw_vector arg1 [1 1] get def + /vlist arg1 2 get def + { + [vlist i_vw_vector] getGrRing /i_gr set + [vlist j_vw_vector] getGrRing /j_gr set + i_gr j_gr isSameGrRing { } { /ans [0 [i_gr j_gr]] def exit} ifelse + +% bug: in case of module + [i_gr 0 get , ring_of_differential_operators 0] define_ring + +% H を 1 に. + /rrule [ [@@@.Hsymbol . (1).] ] def + + i_gr 2 get length 0 eq { + } { + rrule i_gr 2 get { { . } map } map join /rrule set + } ifelse + ii { toString . rrule replace toString } map /ii set + jj { toString . rrule replace toString } map /jj set + + [ii jj i_gr 0 get , i_gr 1 get] ecartd.isSameIdeal_h /ans set + [ans [i_gr] rrule ecartd.isSameIdeal_h.failed] /ans set + + exit + } loop + /arg1 ans def + ] pop + popVariables + arg1 +} def + +/test1.isSameInGrRing_h { + [(parse) (data/test8-data.sm1) pushfile] extension + + cone.gblist 0 get (initial) getNode 2 get /ii set + cone.gblist 0 get (weight) getNode [2 0 2] get /iiw set + + cone.gblist 1 get (initial) getNode 2 get /jj set + cone.gblist 1 get (weight) getNode [2 0 2] get /jjw set + + (Doing [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ff set) message + [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ff set + + ff pmat + +} def + + +%< +% Usages: i j isSameCone_h.0 [bool, ...] +% テスト方法. (data/test8.sm1) run (data/test8-data.sm1) run 0 1 isSameCone_h.0 +% gb を再度計算する stand alone 版. gr(Local ring) で比較. +%> +/isSameCone_h.0 { + /arg2 set /arg1 set + [/i /j /ans /ii /iiw /jj /jjw] pushVariables + [ + /i arg1 def /j arg2 def + i to_int32 /i set , j to_int32 /j set + cone.debug { (Comparing ) messagen [i j] message } { } ifelse + + cone.gblist i get (initial) getNode 2 get /ii set + cone.gblist i get (weight) getNode [2 0 2] get /iiw set + + cone.gblist j get (initial) getNode 2 get /jj set + cone.gblist j get (weight) getNode [2 0 2] get /jjw set + + [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ans set + + ans /arg1 set + ] pop + popVariables + arg1 +} def + +%< +% Usages: [ii vv i_vw_vector] getGbInGrRing_h [ii_gr i_gr] +% Get Grobner Basis of ii in the graded ring. +% The graded ring is obtained automatically from vv and i_vw_vector. +% ii_gr is the Grobner basis. i_gr is the output of getGrRing. +% cf. isSameInGrRing_h, ecart.isSameIdeal_h with [(noRecomputation) 1] +%> +/getGbInGrRing_h { + /arg1 set + [/ii /i_vw_vector /vlist /rng /vv /vvGlobal /wv /iigg + /i_gr /rrule /ans] pushVariables + [ + /ii arg1 0 get def + /vlist arg1 1 get def + /i_vw_vector arg1 2 get def + [vlist i_vw_vector] getGrRing /i_gr set + +% bug: in case of module + [i_gr 0 get , ring_of_differential_operators 0] define_ring + +% H を 1 に. + /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 を設定する. +%> +/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 を再度計算しない. +%> +/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 は cone.grGblist に initial の gb を graded ring +% でまず計算し, それから ideal の比較をおこなう. isSameCone_h.1 に比べて +% gb の再度の計算がないので経済的. +%> +/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 は DeHomogenized Cone の略. H->1 として cone を merge していく関数 +% や大域変数に使う. +% cone.gblist, cone.fan が正しく設定されていること. +% (setGrGblist を実行済であること. 自動実行されるが... ) +% +%> + +/isSameCone_h { isSameCone_h.2 } def + +%< +% Usages: genDhcone.init +% dhcone.checked (dehomogenized 済の cone番号), dhcone.unchecked の初期化. +%> +/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] を出発点として cone を dehomogenize する (merge する). +% +% テスト1. (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] を 加える. new... へ初期データを書き込む. + 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 はまず 0 でうめる. 0 : まだ調べてない. +% 1 : merged で消えた. 2 : boundary. 3 : となりは異なる. +% [ ] join をやって ベクトルの clone を作る. + 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 は k でうめる. + /newconeid newfacets length newVector { pop k to_univNum } map def + +% merged と newmerged を cone の隣接関係のみで更新する. +% 同じ init を持つことはわかっているので facet vector のみの check で十分. +% merged の i 番目 と newmerged の j 番目で比較. + 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] に 1 を入れて消す. +% 上の判定は nextfid, newnextfid を用いてもよいのでは? + merged i (1).. put + newmerged j (1).. put + } { } ifelse + } { } ifelse + } for + } for + +% Step2. 結合してから, まだ調べてない facet を探す. + 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 番目をまだ調べていない. + coneid i get , /p set + nextcid i get , /q set + cone.debug { [p q] message } { } ifelse + q (0).. ge { +% cone.fan [p] と cone.fan [q] の initial を比較する. +% 同じなら k を設定. exit for. 違えば merged[i] = 3 (違う) を代入. +% differentC はすでに 現在の dhcone と違うと check された cone 番号. +% dhcone.checked は dhcone がすでに生成されている cone 番号のリスト. +% これにはいっていても違う. + 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 を更新. + 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 は doubly homogenized (local) で生成された Grobner fan. +% cone.fan を dehomogenize (H->1) して init を比べて dhcone.fan を生成する. +% +% テスト1. (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 の番号と cone の番号の 置換表を生成し dhcone2.fan (merge した cone の情報) +% を dhcone.fan から作る. dhcone2.gblist も作る補助関数. +% dhCones_h してから dhcone.rable する. +%> +/dhcone.rtable { + [/i /j /vv /cones /facets /facets2 /merged /nextcid /nextcid2 /ii /ww] pushVariables + [ +% 置換表 dhcone.h2dh を作る. + /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 した dhcone を整理したもの, dhcone2.fan を作る. + /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 +% となりの cone があるとき 変換表にしたがい, cone 番号を変換 + nextcid2 [ dhcone.h2dh , nextcid j get , get ] join /nextcid2 set + } { } ifelse + merged j get , (2).. eq { + facets2 [ facets j get ] join /facets2 set +% 境界のとき -2 を入れる. + nextcid2 [ (-2).. ] join /nextcid2 set + } { } ifelse + } for + + dhcone2.fan i , + [(dhcone) [ ] + [ + [(facets) [ ] facets2] arrayToTree + [(nextcid) [ ] nextcid2] arrayToTree + [(cones) [ ] cones] arrayToTree + ] + ] arrayToTree , put + + } for + +% 最後に dhcone2.gblist を作る. + /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 + +%< +% 表の見方の解説を印刷する関数. +% 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 の印刷関数 +%> +/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 + +% +% 試し方 test14, 22, 25 +% +% (data/test14.sm1) run (data/test14-data.sm1) run +% printGrobnerFan ; % H 付きで印刷. +% dhCones_h ; % dehomogenize Cones. +% dhcone.rtable ; % dhcone2.fan 等を生成. +% dhcone.printGrobnerFan ; % 印刷. +% 印刷したものは test*-print.txt へ格納してある. +% + +% Todo: save functions.