=================================================================== RCS file: /home/cvs/OpenXM/src/kan96xx/Doc/gfan.sm1,v retrieving revision 1.3 retrieving revision 1.9 diff -u -p -r1.3 -r1.9 --- OpenXM/src/kan96xx/Doc/gfan.sm1 2004/09/14 08:30:47 1.3 +++ OpenXM/src/kan96xx/Doc/gfan.sm1 2005/06/30 08:39:39 1.9 @@ -1,8 +1,260 @@ -% $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.8 2004/10/13 23:36:52 takayama Exp $ % cp cone.sm1 $OpenXM_HOME/src/kan96xx/Doc/gfan.sm1 -% $Id: gfan.sm1,v 1.3 2004/09/14 08:30:47 takayama Exp $ +% $Id: gfan.sm1,v 1.9 2005/06/30 08:39:39 takayama Exp $ % iso-2022-jp +%%Ref: @s/2004/08/21-note.pdf +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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 +% 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.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 +% 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.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 +%% 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 + /cone.debug 1 def /ox.k0.loaded boundp { @@ -10,12 +262,47 @@ [(parse) (ox.sm1) pushfile] extension } 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) 用の 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]] ff getAttributeList setAttributeList + dh.gb 0 get /arg1 set + ] pop + popVariables + arg1 +} def + % % cone.fan, cone.gblist に fan のデータがはいる. % - -%%%%<<<< 初期データの設定例 data/test13 より. <<<<<<<<<<<<<< -/cone.sample.test13 { +%%%%<<<< 初期データの設定例. 日本語版 data/test13 より. <<<<<<<<<<<<<< +/cone.sample.test13.ja { /cone.loaded boundp { } { [(parse) (cohom.sm1) pushfile] extension @@ -520,6 +807,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. %< @@ -812,11 +1108,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 ] @@ -1480,8 +1781,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 を戻す. @@ -1707,7 +2030,8 @@ def [(AutoReduce) 1] system_variable [cone.vv ring_of_differential_operators [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 /arg1 gg def ] pop @@ -1919,17 +2243,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 @@ -1986,6 +2315,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 を加える. @@ -1995,22 +2327,25 @@ def } def %< -% usages: getNextFlip [cone, k] +% usages: getNextFlip [cone, k, cid] % cone.fan を検索して まだ flip してない cone と facet の組を戻す. % もうないときには null を戻す. +% cid は cone が cone.fan の 何番目であるかの index. cone.gblist の検索等に +% 用いる. %> /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 { /ii set cone.fan ii get /tcone set + /cid ii def tcone getNextFacet /ans set ans tag 0 eq { } { exit } ifelse } for ans tag 0 eq { /arg1 null def } - { /arg1 [tcone ans] def } ifelse + { /arg1 [tcone ans cid] def } ifelse ] pop popVariables arg1 @@ -2020,6 +2355,7 @@ def % flip の時の epsilon /cone.epsilon (1).. (10).. div def /cone.epsilon.limit (1).. (100).. div def +% cone.epsilon.limit を負にすれば停止しない. %< % Usages: result_getNextFlip getNextCone ncone @@ -2529,6 +2865,7 @@ def %< % Usages: [[ii i_vw_vector] [jj j_vw_vector] vlist] isSameInGrRing_h +% It computes gb. %> /isSameInGrRing_h { /arg1 set @@ -2587,14 +2924,16 @@ def %< -% Usages: i j IsSameCone_h [bool, ...] -% テスト方法. (data/test8.sm1) run (data/test8-data.sm1) run 0 1 IsSameCone_h +% 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 { +/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 @@ -2611,3 +2950,679 @@ def 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. + +%< +% Collart, Kalkbrener, Mall のアルゴリズムによる gb の 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 の check をやるので, それに失敗したら null を戻す. +% weight はすべて vw 形式で. vw 形式 = variable weight の繰り返しの形式 +% reducedGb は文字列のリストではなく多項式の形式のこと. +%> +/ckmFlip { + /arg1 set + [/arg_ckmFlip /gOld /vlist /oldWeight /facetWeight /newWeight + /gNew + /ww /ww1 /ww2 % 本の中の w1, w, w2 (古い, facet, 新しい) + /ch1 /ch2 % 本の中の {\cal H}_1, {\cal H}_2 + /grData /rTable + /rTable2 % rTable の反対の変換. + /facetWeight_gr /vlist_gr % graded ring 用. + /oldWeight_gr + /ccf % reduction した係数. + /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 についての initial を取り出す. ch1 へいれる. + gOld getRing ring_def + facetWeight weightv /ww set + gOld { ww init } map /ch1 set % facetWeight による initial の取り出し. + + +% 例: [(x,y) [(x) -1 (Dx) 1 (y) -1 (Dy) 2]] getGrRing +% [$x,y,y',$ , [ $x$ , $y$ ] , [ [ $Dy$ , $y'$ ] ] ] +% 変数リスト 置換表 +% ch1 を gr_ww の元に変換. + [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 も 新しい環 gr_ww の weight に変換. +% 例. [(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 で計算. +% どちらをとるかは cone.gb_gr で区別するしかなし + %% [ch1 vlist_gr oldWeight_gr] /ttt set + %% ttt cone.gb_gr /ch1 set %再度の計算は不要. + [[(1)] vlist_gr oldWeight_gr] cone.gb_gr getRing ring_def % Set Ring. + ch1 {toString .} map /ch1 set +%% ここまででとりあえずテストをしよう. +%% ch1 /arg1 set +% newWeight も 新しい環 gr_ww の weight に変換. +% 例. [(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 で計算. +% どちらをとるかは cone.reduction_gr で区別するしかなし + ch1 getRing ring_def ; + ch2 {toString .} map {ch1 cone.reduction} map /ccf set + %ccf pmat + % とりあえずテスト. + % [ch1 ch2] /arg1 set + %% ccf[i][0] は 0 でないと矛盾. check まだしてない. + + %% ccf[i][2] (syzygy) を gr から もとの ring へ戻し, + %% 新しい reduced gbasis を ccf[i][2] * gOld で作る. + rwork ring_def + ccf { 2 get {toString . rTable2 replace toString} map } map /ccf2 set + %% ccf2 は gr でない ring の元. + gOld getRing ring_def + cone.beginH % Hh か h^2 か. + ccf2 { {.} map gOld mul } map /gNew set + gNew { toString } map /gNew set + cone.endH + % gNew /arg1 set + %gNew が newWeight での GB か check. Yes なら reduced basis へ. + %No なら null を戻す. + 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 +% テストを開始する. + /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