Annotation of OpenXM/src/kan96xx/Doc/gfan.sm1, Revision 1.11
1.11 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/gfan.sm1,v 1.10 2005/07/07 01:31:21 takayama Exp $
1.1 takayama 2: % cp cone.sm1 $OpenXM_HOME/src/kan96xx/Doc/gfan.sm1
1.11 ! takayama 3: % $Id: cone.sm1,v 1.78 2005/07/07 05:46:33 taka Exp $
1.1 takayama 4: % iso-2022-jp
1.9 takayama 5: %%Ref: @s/2004/08/21-note.pdf
1.1 takayama 6:
1.6 takayama 7: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
8: %% Two examples are given below to get a global Grobner fan and
9: %% a local Grobner fan ; cone.sample and cone.sample2
10: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
11: %%% Global Grobner Fan
12: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
13: %% How to input data? An example. (cf. test13.sm1)
14: %% Modify the following or copy the /cone.sample { ... } def
15: %% to your own file,
1.9 takayama 16: %% edit it, and execute it by " cone.sample ; "
1.6 takayama 17: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
18: /cone.sample {
19: cone.load.cohom
1.11 ! takayama 20: /cone.ckmFlip 1 def
1.6 takayama 21: % write a comment about the problem. "nl" means new line.
22: /cone.comment [
23: (Toric ideal for 1-simplex x 2-simplex, in k[x]) nl
24: ] cat def
25:
26: % List of variables
27: % If cone.type=1, then (H) should be added.
28: /cone.vlist [(x11) (x12) (x13) (x21) (x22) (x23)
29: (Dx11) (Dx12) (Dx13) (Dx21) (Dx22) (Dx23) (h)] def
30:
31: % List of variables in the form for define_ring.
32: /cone.vv (x11,x12,x13,x21,x22,x23) def
33:
34: % If cone.type=0, then x,Dx,
35: % If cone.type=1, then x,Dx,h,H (Doubly homogenized)
36: % If cone.type=2, then x,Dx,h
37: /cone.type 2 def
38:
39: % Set how to parametrize the weight space.
40: % In the example below, 6 means the number of variables x11,x12,x13,x21,x22,x33
41: % p q parametrizeSmallFan (p >= q) : Enumerate Grobner cones in the Small
42: % Grobner fan.
43: % The weights for the last p-q variables
44: % are 0.
45: % Example. 6 2 parametrizeSmallFan weights for x12,x21,x22,x23 are 0.
46: %
47: % p q parametrizeTotalFan (p = q = number of variables in cone.vv)
48: % p > q has not yet been implemented.
49: %
50: /cone.parametrizeWeightSpace {
51: 6 6 parametrizeSmallFan
52: } def
53:
54: % If you want to enumerate Grobner cones in local order (i.e., x^e <= 0),
55: % then cone.local = 1 else cone.local = 0.
56: /cone.local 0 def
57:
58: % Initial value of the weight in the weight space of which dimension is
59: % cone.m
60: % If it is null, then a random weight is used.
61: /cone.w_start
62: null
63: def
64:
65: % If cone.h0=1, then the weight for h is 0.
66: % It is usally set to 1.
67: /cone.h0 1 def
68:
69: % Set input polynomials which generate the ideal.
70: % Input must be homogenized.
71: % (see also data/test14.sm1 for double homogenization.)
72: /cone.input
73: [
74: (x11 x22 - x12 x21)
75: (x12 x23 - x13 x22)
76: (x11 x23 - x13 x21)
77: ]
78: def
79:
1.10 takayama 80: /cone.DhH 0 def
1.6 takayama 81: % Set a function to compute Grobner basis.
82: % cone.gb_Dh : For computing in Homogenized Weyl algebra h[1,1](D).
83: % cone.gb_DhH : For computing in doubly homogenized Weyl algebra.
84: % ( Computation in ^O and h[0,1](^D) need this
85: % as the first step. /cone.local 1 def )
86: /cone.gb {
87: cone.gb_Dh
88: } def
89:
90:
91: cone.comment message
92: (cone.input = ) message
93: cone.input message
94: %%%% Step 1. Enumerating the Grobner Cones in a global ring.
95: %%%% The result is stored in cone.fan
96: getGrobnerFan
97:
98: %%%% If you want to print the output, then uncomment.
99: printGrobnerFan
100:
101: %%%% If you want to save the data to the file sm1out.txt, then uncomment.
1.9 takayama 102: % /cone.withGblist 1 def saveGrobnerFan /ff set ff output
1.6 takayama 103:
104: %%%% Step 2. Dehomogenize the Grobner Cones
105: %%%% by the equivalence relation in a local ring (uncomment).
106: % dhCones_h
107:
108: %%%% Generate the final data dhcone2.fan (a list of local Grobner cones.)
109: % dhcone.rtable
110:
111: %%%% Output dhcone2.fan with explanations
112: % dhcone.printGrobnerFan
113:
114: } def
115: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
116: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
117: %% End of " How to input data? An example. "
118: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
119: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
120:
121:
122:
123: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
124: %%% Local Grobner Fan
125: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
126: %% How to input data? The example 2 (cf. test14.sm1).
127: %% Modify the following or copy the /cone.sample2 { ... } def
128: %% to your own file,
129: %% edit it, and execute if by " cone.sample2 ; "
130: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
131: /cone.sample2 {
132: cone.load.cohom
1.11 ! takayama 133: /cone.ckmFlip 1 def
1.6 takayama 134: % write a comment about the problem. "nl" means new line.
135: /cone.comment [
136: (BS for y and y-(x-1)^2, t1, t2 space, in doubly homogenized Weyl algebra.) nl
137: (The Grobner cones are dehomogenized to get local Grobner fan.) nl
138: ] cat def
139:
140: % List of variables
141: % If cone.type=1, then (H) should be added.
142: /cone.vlist [(t1) (t2) (x) (y) (Dt1) (Dt2) (Dx) (Dy) (h) (H)] def
143:
144: % List of variables in the form for define_ring.
145: /cone.vv (t1,t2,x,y) def
146:
147: % If cone.type=0, then x,Dx,
148: % If cone.type=1, then x,Dx,h,H (Doubly homogenized)
149: % If cone.type=2, then x,Dx,h
150: /cone.type 1 def
151:
152: % Set how to parametrize the weight space.
153: % In the example below, 6 means the number of variables x11,x12,x13,x21,x22,x33
154: % p q parametrizeSmallFan (p >= q) : Enumerate Grobner cones in the Small
155: % Grobner fan.
156: % The weights for the last p-q variables
157: % are 0.
158: % Example. 6 2 parametrizeSmallFan weights for x12,x21,x22,x23 are 0.
159: %
160: % p q parametrizeTotalFan (p = q = number of variables in cone.vv)
161: % p > q has not yet been implemented.
162: %
163: /cone.parametrizeWeightSpace {
164: 4 2 parametrizeSmallFan
165: } def
166:
167: % If you want to enumerate Grobner cones in local order (i.e., x^e <= 0),
168: % then cone.local = 1 else cone.local = 0.
169: /cone.local 1 def
170:
171: % Initial value of the weight in the weight space of which dimension is
172: % cone.m
173: % If it is null, then a random weight is used.
174: /cone.w_start
175: null
176: def
177:
178: % If cone.h0=1, then the weight for h is 0.
179: % It is usally set to 1.
180: /cone.h0 1 def
181:
182: % Set input polynomials which generate the ideal.
183: % Input must be homogenized.
184: % (see also data/test14.sm1 for double homogenization.)
185: /cone.input
186: [
187: (t1-y) (t2 - (y-(x-1)^2))
188: ((-2 x + 2)*Dt2+Dx)
189: (Dt1+Dt2+Dy)
190: ]
191: def
192: % homogenize
193: [cone.vv ring_of_differential_operators
194: [[(t1) -1 (t2) -1 (Dt1) 1 (Dt2) 1]] ecart.weight_vector
195: 0] define_ring
196: dh.begin
197: cone.input { . homogenize toString } map /cone.input set
198: dh.end
199:
1.10 takayama 200: /cone.DhH 1 def
1.6 takayama 201: % Set a function to compute Grobner basis.
202: % cone.gb_Dh : For computing in Homogenized Weyl algebra h[1,1](D).
203: % cone.gb_DhH : For computing in doubly homogenized Weyl algebra.
204: % ( Computation in ^O and h[0,1](^D) need this
205: % as the first step. /cone.local 1 def )
206: /cone.gb {
207: cone.gb_DhH
208: } def
209:
210: cone.comment message
211: (cone.input = ) message
212: cone.input message
213: %%%% Step 1. Enumerating the Grobner Cones in a global ring.
214: %%%% The result is stored in cone.fan
215: getGrobnerFan
216:
217: %%%% If you want to print the output, then uncomment.
218: printGrobnerFan
219:
220: %%%% If you want to save the data to the file sm1out.txt, then uncomment.
1.9 takayama 221: % /cone.withGblist 1 def saveGrobnerFan /ff set ff output
1.6 takayama 222:
223: %%%% Step 2. Dehomogenize the Grobner Cones
224: %%%% by the equivalence relation in a local ring (uncomment).
225: dhCones_h
226:
227: %%%% Generate the final data dhcone2.fan (a list of local Grobner cones.)
228: dhcone.rtable
229:
230: %%%% Output dhcone2.fan with explanations
231: dhcone.printGrobnerFan
232:
233: } def
234: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
235: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
236: %% End of " How to input data? The example 2. "
237: %% Do not touch below.
238: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
239: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
240:
241:
242: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
243: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
244: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
245: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
246:
247: [(parse) (cgi.sm1) pushfile] extension
248:
249: % If you use local polymake, then comment out.
250: % If you use the cgi/polymake on the net, then uncomment out.
1.8 takayama 251: %/doPolymake {doPolymake.OoHG} def (Using doPolymake.OoHG ) message
252: %/polymake.start {polymake.start.OoHG} def (Using polymake.start.OoHG ) message
253: %% Choose it automatically.
254: [(which) (polymake)] oxshell tag 0 eq {
255: (Polymake is not installed in this system.) message
256: /doPolymake {doPolymake.OoHG} def
257: (Using doPolymake.OoHG ) message
258: /polymake.start {polymake.start.OoHG} def
259: (Using polymake.start.OoHG ) message
260: } { (Local polymake will be used.) message } ifelse
1.6 takayama 261:
1.1 takayama 262: /cone.debug 1 def
263:
264: /ox.k0.loaded boundp {
265: } {
266: [(parse) (ox.sm1) pushfile] extension
267: } ifelse
268:
1.6 takayama 269: /cone.load.cohom {
270: /cone.loaded boundp { }
271: {
272: [(parse) (cohom.sm1) pushfile] extension
1.8 takayama 273: % [(parse) (cone.sm1) pushfile] extension % BUG? cone.sm1 overrides a global
274: % in cohom.sm1?
1.6 takayama 275: [(parse) (dhecart.sm1) pushfile] extension
276: /cone.loaded 1 def
1.8 takayama 277: oxNoX
278: polymake.start ( ) message
1.6 takayama 279: } ifelse
280: } def
281:
282: %% Usages: cone.gb_DhH. h H (double homogenized) $BMQ$N(B GB.
283: %% dhecart.sm1 $B$r(B load $B$7$F$"$k$3$H(B. $BF~NO$OF1<!$G$J$$$H$$$1$J$$(B.
284: %% [cone.vv ring_of_differential_operators
285: %% [[(t1) -1 (t2) -1 (Dt1) 1 (Dt2) 1]] ecart.weight_vector
286: %% 0] define_ring
287: %% dh.begin homogenize dh.end $B$J$I$NJ}K!$GF1<!2=$G$-$k(B.
288: /cone.gb_DhH {
289: /arg2 set /arg1 set
290: [/ff /ww] pushVariables
291: [
292: /ff arg1 def
293: /ww arg2 def
294: /dh.gb.verbose 1 def
295: /dh.autoHomogenize 0 def
296: [(AutoReduce) 1] system_variable
297: [ff { toString } map cone.vv
1.9 takayama 298: [ww cone.vv generateD1_1]] ff getAttributeList setAttributeList
299: dh.gb 0 get /arg1 set
1.6 takayama 300: ] pop
1.9 takayama 301: popVariables
1.6 takayama 302: arg1
303: } def
304:
1.3 takayama 305: %
306: % cone.fan, cone.gblist $B$K(B fan $B$N%G!<%?$,$O$$$k(B.
307: %
1.6 takayama 308: %%%%<<<< $B=i4|%G!<%?$N@_DjNc(B. $BF|K\8lHG(B data/test13 $B$h$j(B. <<<<<<<<<<<<<<
309: /cone.sample.test13.ja {
1.2 takayama 310: /cone.loaded boundp { }
311: {
312: [(parse) (cohom.sm1) pushfile] extension
313: [(parse) (cone.sm1) pushfile] extension
314: /cone.loaded 1 def
315: } ifelse
316: /cone.comment [
317: (Toric ideal for 1-simplex x 2-simplex, in k[x]) nl
318: ] cat def
319: %------------------Globals----------------------------------------
320: % Global: cone.type
321: % $B$I$N(B exponents $B$r<h$j=P$9$N$+;XDj$9$k(B.
322: % cf. exponents, gbext h $B$d(B H $B$b8+$k$+(B?
323: % 0 : x,y,Dx,Dy
324: % 1 : x,y,Dx,Dy,h,H
325: % 2 : x,y,Dx,Dy,h
326: /cone.type 2 def
327:
328: % Global: cone.local
329: % cone.local: Local $B$+(B? 1 $B$J$i(B local
330: /cone.local 0 def
331:
332:
333: % Global: cone.h0
334: % cone.h0: 1 $B$J$i(B h $B$N(B weight 0 $B$G$N(B Grobner fan $B$r7W;;$9$k(B.
335: /cone.h0 1 def
336:
337: % --------------- $BF~NO%G!<%?MQBg0hJQ?t$N@_Dj(B --------------------------
338: %
339: % cone.input : $BF~NOB?9`<07O(B
340: /cone.input
341: [
342: (x11 x22 - x12 x21) (x12 x23 - x13 x22)
343: (x11 x23 - x13 x21)
344: ]
345: def
346:
347: % cone.vlist : $BA4JQ?t$N%j%9%H(B
348: /cone.vlist [(x11) (x12) (x13) (x21) (x22) (x23)
349: (Dx11) (Dx12) (Dx13) (Dx21) (Dx22) (Dx23) (h)] def
350:
351: % cone.vv : define_ring $B7A<0$NJQ?t%j%9%H(B.
352: /cone.vv (x11,x12,x13,x21,x22,x23) def
353:
354: % cone.parametrizeWeightSpace : weight $B6u4V$r(B parametrize $B$9$k4X?t(B.
355: % $BBg0hJQ?t(B cone.W , cone.Wpos $B$b$-$^$k(B.
356: /cone.parametrizeWeightSpace {
357: 6 6 parametrizeSmallFan
358: } def
359:
360: % cone.w_start : weight$B6u4V$K$*$1$k(B weight $B$N=i4|CM(B.
361: % $B$3$NCM$G(B max dim cone $B$,F@$i$l$J$$$H(B random weight $B$K$h$k(B $B%5!<%A$,;O$^$k(B.
362: % random $B$K$d$k$H$-$O(B null $B$K$7$F$*$/(B.
363: /cone.w_start
364: [9 8 5 4 5 6]
365: def
366:
367: % cone.gb : gb $B$r7W;;$9$k4X?t(B.
368: /cone.gb {
369: cone.gb_Dh
370: } def
371:
372:
373:
374: ( ) message
375: cone.comment message
376: (cone.input = ) messagen cone.input message
377: (Type in getGrobnerFan) message
378: (Do clearGlobals if necessary) message
379: (printGrobnerFan ; saveGrobnerFan /ff set ff output ) message
380:
381: } def
382: %%%%%%>>>>> $B=i4|%G!<%?$N@_DjNc$*$o$j(B >>>>>>>>>>>>>>>>>>>>>>
383:
1.1 takayama 384: % Global: cone.type
385: % $B$I$N(B exponents $B$r<h$j=P$9$N$+;XDj$9$k(B.
386: % cf. exponents, gbext h $B$d(B H $B$b8+$k$+(B?
387: % 0 : x,y,Dx,Dy
388: % 1 : x,y,Dx,Dy,h,H
389: % 2 : x,y,Dx,Dy,h
390: /cone.type 2 def
391:
392: % Global: cone.local
393: % cone.local: Local $B$+(B? 1 $B$J$i(B local
394: /cone.local 1 def
395:
396: % Global: cone.h0
397: % cone.h0: 1 $B$J$i(B h $B$N(B weight 0 $B$G$N(B Grobner fan $B$r7W;;$9$k(B.
398: /cone.h0 1 def
399:
400: % Global: cone.n (number of variables in GB)
401: % cone.m (freedom of the weight space. cf. cone.W)
402: % cone.d (pointed cones lies in this space. cf. cone.Lp)
403: % These are set during getting the cone.startingCone
404:
1.10 takayama 405: %<
406: % global
407: %cone.ckmFlip. Collar-Kalkbrener-Mall $B$N(B flip $B%"%k%4%j%:%`$r;H$o$J$$(B 0. $B;H$&(B 1.
408: % Default $B$O(B 0.
409: %>
410: /cone.ckmFlip 0 def
411:
412: %<
413: % global
414: % 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.
415: %>
416: /cone.DhH 0 def
417:
418: % Default $B$N(B cone.gb $B$NDj5A(B. $B3F%W%m%0%i%`$G:FEYDj5A$7$F$b$h$$(B.
419: /cone.gb {
420: cone.DhH {
421: cone.gb_DhH
422: } {
423: cone.gb_Dh
424: } ifelse
425: } def
1.1 takayama 426:
427: %<
428: % Usage: wv g coneEq1
429: % in(f) $B$,(B monomial $B@lMQ(B. in_w(f) = LT(f) $B$H$J$k(B weight w $B$NK~$?$9(B
430: % $BITEy<0@)Ls$r5a$a$k(B.
431: %>
432: /coneEq1 {
433: /arg1 set
434: [/g /eqs /gsize /i /j /n /f /exps /m % Do not use "eq" as a variable
435: /expsTop
436: ] pushVariables
437: [
438: /g arg1 def % Reduced Grobner basis
439: /eqs [ ] def % $BITEy<07O$N78?t(B
440: /gsize g length def
441: 0 1 gsize 1 sub {
442: /i set
443: g i get /f set % f $B$O(B i $BHVL\$N(B reduced Grobner basis $B$N85(B
444: [(exponents) f cone.type] gbext /exps set % exps $B$O(B f $B$N(B exponent vector
445: exps length /m set
446: m 1 eq not {
447: /expsTop exps 0 get def % expsTop $B$O(B f $B$N@hF,$N(B exponent vector.
448: 1 1 exps length 1 sub {
449: /j set
450: eqs [expsTop exps j get sub] join /eqs set
451: % exps[0]-exps[j] $B$r(B eqs $B$X3JG<$7$F$$$/$@$1(B.
452: % Cone $B$N(B closure $B$r$@$9$N$G(B >= $B$G(B OK.
453: } for
454: } { } ifelse
455: } for
456: /arg1 eqs def
457: ] pop
458: popVariables
459: arg1
460: } def
461:
462: %<
463: % Usage: ww g coneEq
464: % ww $B$O(B [v1 w1 v2 w2 ... ] $B7A<0(B. (v-w $B7A<0(B) w1, w2 $B$O(B univNumber $B$G$b$$$$(B.
465: % g $B$O(B reduced Grobner basis
466: % in(f) $B$,(B monomial $B$G$J$$>l9g$b07$&(B.
467: % in_w(f) = in_ww(f) $B$H$J$k(B weight w $B$NK~$?$9(B
468: % $BITEy<0@)Ls$r5a$a$k(B.
469: % ord_w, init (weightv) $B$rMQ$$$k(B.
470: %>
471: /coneEq {
472: /arg2 set
473: /arg1 set
474: [/g /eqs /gsize /i /j /n /f /exps /m
475: /expsTop /ww /ww2 /iterms
476: ] pushVariables
477: [
478: /g arg2 def % Reduced Grobner basis
479: /ww arg1 def % weight vector. v-w $B7A<0(B
480: ww to_int32 /ww set % univNum $B$,$"$l$P(B int32 $B$KD>$7$F$*$/(B.
481: /ww2 ww weightv def % v-w $B7A<0$r(B $B?t;z$N%Y%/%H%k$K(B. (init $BMQ(B)
482:
1.3 takayama 483: /eqs null def % $BITEy<07O$N78?t(B
1.1 takayama 484: /gsize g length def
485: 0 1 gsize 1 sub {
486: /i set
487: g i get /f set % f $B$O(B i $BHVL\$N(B reduced Grobner basis $B$N85(B
488: [(exponents) f cone.type] gbext /exps set % exps $B$O(B f $B$N(B exponent vector
489: exps length /m set
490: m 1 eq not {
491: /expsTop exps 0 get def % expsTop $B$O(B f $B$N@hF,$N(B exponent vector.
492: /iterms f ww2 init length def % f $B$N(B initial term $B$N9`$N?t(B.
493: % in_ww(f) > f_j $B$H$J$k9`$N=hM}(B.
494: iterms 1 exps length 1 sub {
495: /j set
1.3 takayama 496: expsTop exps j get sub eqs cons /eqs set
1.1 takayama 497: % exps[0]-exps[j] $B$r(B eqs $B$X3JG<$7$F$$$/(B.
498: } for
499: % in_ww(f) = f_j $B$H$J$k9`$N=hM}(B.
500: [(exponents) f ww2 init cone.type] gbext /exps set % exps $B$O(B in(f)
501: 1 1 iterms 1 sub {
502: /j set
1.3 takayama 503: exps j get expsTop sub eqs cons /eqs set
504: expsTop exps j get sub eqs cons /eqs set
1.1 takayama 505: % exps[j]-exps[0], exps[0]-exps[j] $B$r3JG<(B.
506: % $B7k2LE*$K(B (exps[j]-exps[0]).w = 0 $B$H$J$k(B.
507: } for
508: } { } ifelse
509: } for
1.3 takayama 510: eqs listToArray reverse /eqs set
1.1 takayama 511: /arg1 eqs def
512: ] pop
513: popVariables
514: arg1
515: } def
516:
517: %<
518: % Usage: wv g coneEq genPo
519: % polymake $B7A<0$N(B INEQUALITIES $B$r@8@.$9$k(B. coneEq -> genPo $B$HMxMQ(B
520: %>
521: /genPo {
522: /arg1 set
523: [/outConeEq /rr /nn /ii /mm /jj /ee] pushVariables
524: [
525: /outConeEq arg1 def
526: /rr [(INEQUALITIES) nl] cat def % $BJ8;zNs(B rr $B$KB-$7$F$$$/(B.
527: outConeEq length /nn set
528: 0 1 nn 1 sub {
529: /ii set
530: outConeEq ii get /ee set
531: [ rr
532: (0 ) % $BHs$;$$$8MQ$N(B 0 $B$r2C$($k(B.
533: 0 1 ee length 1 sub {
534: /jj set
535: ee jj get toString ( )
536: } for
537: nl
538: ] cat /rr set
539: } for
540: /arg1 rr def
541: ] pop
542: popVariables
543: arg1
544: } def
545:
546: %<
547: % Usage: wv g coneEq genPo2
548: % doPolyamke $B7A<0$N(B INEQUALITIES $B$r@8@.$9$k(B. coneEq -> genPo2 $B$HMxMQ(B
549: % tfb $B7A<0J8;zNs(B.
550: %>
551: /genPo2 {
552: /arg1 set
553: [/outConeEq /rr /nn /ii /mm /jj /ee] pushVariables
554: [
555: /outConeEq arg1 def
556: /rr $polymake.data(polymake.INEQUALITIES([$ def
557: % $BJ8;zNs(B rr $B$KB-$7$F$$$/(B.
558: outConeEq length /nn set
559: 0 1 nn 1 sub {
560: /ii set
561: outConeEq ii get /ee set
562: [ rr
563: ([0,) % $BHs$;$$$8MQ$N(B 0 $B$r2C$($k(B.
564: 0 1 ee length 1 sub {
565: /jj set
566: ee jj get toString
567: jj ee length 1 sub eq { } { (,) } ifelse
568: } for
569: (])
570: ii nn 1 sub eq { } { (,) } ifelse
571: ] cat /rr set
572: } for
573: [rr $]))$ ] cat /rr set
574: /arg1 rr def
575: ] pop
576: popVariables
577: arg1
578: } def
579:
580: /test1 {
581: [(x,y) ring_of_differential_operators 0] define_ring
582: [ (x + y + Dx + Dy).
583: (x ^2 Dx^2 + y^2 Dy^2).
584: (x).
585: ] /gg set
586: gg coneEq1 /ggc set
587: gg message
588: ggc pmat
589:
590: ggc genPo message
591: } def
592:
593: /test2 {
594: [(parse) (dhecart.sm1) pushfile] extension
595: dh.test.p1 /ff set
596: ff 0 get coneEq1 /ggc set
597: ggc message
598: ggc genPo /ss set
599: ss message
600: (Data is in ss) message
601: } def
602:
603:
604: /test3 {
605: % [(parse) (cohom.sm1) pushfile] extension
606: /ww [(Dx) 1 (Dy) 1] def
607: [(x,y) ring_of_differential_operators
608: [ww] weight_vector
609: 0] define_ring
610: [ (x Dx + y Dy -1).
611: (y^2 Dy^2 + 2 + y Dy ).
612: ] /gg set
613: gg {homogenize} map /gg set
614: [gg] groebner 0 get /gg set
615: ww message
616: ww gg coneEq /ggc set
617: gg message
618: ggc pmat
619:
620: ggc genPo message
621: } def
622:
623: %<
624: % Usage: test3b
625: % Grobner cone $B$r7hDj$7$F(B, polymake $BMQ$N%G!<%?$r@8@.$9$k%F%9%H(B.
626: % weight (0,0,1,1) $B$@$H(B max dim cone $B$G$J$$(B.
627: %>
628: /test3b {
629: % [(parse) (cohom.sm1) pushfile] extension
630: /ww [(Dx) 1 (Dy) 2] def
631: [(x,y) ring_of_differential_operators
632: [ww] weight_vector
633: 0] define_ring
634: [ (x Dx + y Dy -1).
635: (y^2 Dy^2 + 2 + y Dy ).
636: ] /gg set
637: gg {homogenize} map /gg set
638: [gg] groebner 0 get /gg set
639: ww message
640: ww gg coneEq /ggc set
641: gg message
642: ggc pmat
643:
644: % ggc genPo /ggs set % INEQ $B$rJ8;zNs7A<0$G(B
645: % ggs message
646: % ggs output
647: % (mv sm1out.txt test3b.poly) system
648: % (Type in polymake-pear.sh test3b.poly FACETS) message
649:
650: ggc genPo2 /ggs set % INEQ $B$rJ8;zNs7A<0(B for doPolymake
651: ggs message
652:
653: } def
654:
655: % commit (dr.sm1): lcm, denominator, ngcd, to_univNum, numerator, reduce
656: % 8/22, changelog-ja $B$^$@(B.
657: % to do : nnormalize_vec, sort_vec --> shell $B$G(B OK.
658: % 8/27, getNode
659:
660: /test4 {
661: $polymake.data(polymake.INEQUALITIES([[0,1,0,0],[0,0,1,0]]))$ /ff set
662: [(FACETS) ff] doPolymake /rr set
663:
664: rr 1 get /rr1 set
665: rr1 getLinearitySubspace pmat
666:
667: } def
668:
669: %<
670: % Usage: vv ineq isInLinearSpace
671: % vv $B$,(B ineq[i] > 0 $B$GDj5A$5$l$kH>6u4V$N$I$l$+$K$O$$$C$F$$$k$J$i(B 0
672: % vv $B$,(B $BA4$F$N(B i $B$K$D$$$F(B ineq[i] = 0 $B$K$O$$$C$F$$$?$i(B 1.
673: %>
674: /isInLinearSpace {
675: /arg2 set
676: /arg1 set
677: [/vv /ineq /ii /rr] pushVariables
678: [
679: /vv arg1 def
680: /ineq arg2 def
681: /rr 1 def
682: {
683: 0 1 ineq length 1 sub {
684: /ii set
685: % vv . ineq[ii] != 0 $B$J$i(B vv $B$O(B linearity space $B$N85$G$J$$(B.
686: vv ineq ii get mul to_univNum isZero {
687: } { /rr 0 def exit} ifelse
688: } for
689: exit
690: } loop
691: /arg1 rr def
692: ] pop
693: popVariables
694: arg1
695: } def
696:
697: %<
698: % Usages: doPolymakeObj getLinearitySubspace
699: % INEQUALITIES $B$H(B VERTICES $B$+$i(B maximal linearity subspace
700: % $B$N@8@.%Y%/%H%k$r5a$a$k(B.
701: % $BNc(B: VERTICES [[0,1,0,0],[0,0,1,0],[0,0,0,-1],[0,0,0,1]]]
702: % $BNc(B: INEQUALITIES [[0,1,0,0],[0,0,1,0]]
703: % $BF~NO$O(B polymake $B$N(B tree (doPolymake $B$N(B 1 get)
704: %>
705: /getLinearitySubspace {
706: /arg1 set
707: [/pdata /vv /ineq /rr /ii] pushVariables
708: [
709: /pdata arg1 def
710: {
711: /rr [ ] def
712: % POINTED $B$J$i(B max lin subspace $B$O(B 0.
713: pdata (POINTED) getNode tag 0 eq { } { exit} ifelse
714:
715: pdata (INEQUALITIES) getNode 2 get 0 get /ineq set
716: pdata (VERTICES) getNode 2 get 0 get /vv set
717: 0 1 vv length 1 sub {
718: /ii set
719: % -vv[ii] $B$,(B ineq $B$rK~$?$9$+D4$Y$k(B.
720: vv ii get ineq isInLinearSpace {
721: rr [vv ii get] join /rr set
722: } { } ifelse
723: } for
724: exit
725: } loop
726: /arg1 rr def
727: ] pop
728: popVariables
729: arg1
730: } def
731:
732: %<
733: % Usages: mm asir_matrix_image
734: % $B@8@.85$h$j@~7A6u4V$N4pDl$rF@$k(B.
735: %>
736: /asir_matrix_image {
737: /arg1 set
738: [/mm /rr] pushVariables
739: [(CurrentRingp)] pushEnv
740: [
741: /mm arg1 def
742: mm to_univNum /mm set
743: oxasir.ccc [ ] eq {
744: (Starting ox_asir server.) message
745: ox_asirConnectMethod
746: } { } ifelse
747: {
748: oxasir.ccc [(matrix_image) mm] asir
749: /rr set
750: rr null_to_zero /rr set
751: exit
752:
753: (asir_matrix_image: not implemented) error exit
754: } loop
755:
756: rr numerator /rr set
757: /arg1 rr def
758: ] pop
759: popEnv
760: popVariables
761: arg1
762: } def
763: [(asir_matrix_image)
764: [(Calling the function matrix_image of asir. It gets a reduced basis of a given matrix.)
765: (Example: [[1 2 3] [2 4 6]] asir_matrix_image)
766: ]] putUsages
767:
768: %<
769: % Usages: mm asir_matrix_kernel
770: % $BD>8r$9$k6u4V$N4pDl(B.
771: %>
772: /asir_matrix_kernel {
773: /arg1 set
774: [/mm /rr] pushVariables
775: [(CurrentRingp)] pushEnv
776: [
777: /mm arg1 def
778: mm to_univNum /mm set
779: oxasir.ccc [ ] eq {
780: (Starting ox_asir server.) message
781: ox_asirConnectMethod
782: } { } ifelse
783: {
784: oxasir.ccc [(matrix_kernel) mm] asir
785: /rr set
786: rr null_to_zero /rr set
787: exit
788:
789: (asir_matrix_image: not implemented) error exit
790: } loop
791: rr 1 get numerator /rr set
792: /arg1 rr def
793: ] pop
794: popEnv
795: popVariables
796: arg1
797: } def
798: [(asir_matrix_kernel)
799: [(Calling the function matrix_kernel of asir.)
800: (It gets a reduced basis of the kernel of a given matrix.)
801: (Example: [[1 2 3] [2 4 6]] asir_matrix_kernel)
802: ]] putUsages
803:
804: %<
805: % Usages: v null_to_zero
806: %>
807: /null_to_zero {
808: /arg1 set
809: [/pp /rr] pushVariables
810: [
811: /pp arg1 def
812: {
813: /rr pp def
814: pp isArray {
815: pp {null_to_zero} map /rr set
816: exit
817: }{ } ifelse
818:
819: pp tag 0 eq {
820: /rr (0).. def
821: exit
822: }{ } ifelse
823: exit
824: } loop
825: /arg1 rr def
826: ] pop
827: popVariables
828: arg1
829: } def
830: [(null_to_zero)
831: [(obj null_to_zero rob)
832: $It translates null to (0)..$
833: ]] putUsages
834:
1.4 takayama 835: %<
836: % Usages: newVector.with-1
837: % (-1).. $B$GKd$a$?%Y%/%H%k$r:n$k(B.
838: %>
839: /newVector.with-1 {
840: newVector { pop (-1).. } map
841: } def
842:
843:
1.1 takayama 844: % [2 0] lcm $B$O(B 0 $B$r$b$I$9$,$$$$$+(B? --> OK.
845:
846: %<
847: % Usages: mm addZeroForPolymake
848: % $B0J2<$NFs$D$N4X?t$O(B, toQuotientSpace $B$K$bMxMQ(B.
849: % Polymake INEQUALITIES $BMQ$K(B 0 $B$r;O$a$KB-$9(B.
850: % $BF~NO$O(B $B%j%9%H$N%j%9%H(B
851: % [[1,2], [3,4],[5,6]] --> [[0,1,2],[0,3,4],[0,5,6]]
852: %>
853: /addZeroForPolymake {
854: /arg1 set
855: [/mm /rr] pushVariables
856: [
857: /mm arg1 def
858: mm to_univNum /mm set
859: mm { [(0)..] 2 1 roll join } map /mm set
860: /arg1 mm def
861: ] pop
862: popVariables
863: arg1
864: } def
865:
866: %<
867: % Usages: mm cone.appendZero
868: %>
869: /cone.appendZero {
870: /arg1 set
871: [/mm /rr] pushVariables
872: [
873: /mm arg1 def
874: mm to_univNum /mm set
875: mm { [(0)..] join } map /mm set
876: /arg1 mm def
877: ] pop
878: popVariables
879: arg1
880: } def
881:
882: %<
883: % Usages: mm removeFirstFromPolymake
884: % $B;O$a$N(B 0 $B$r<h$j=|$/(B.
885: % $BF~NO$O(B $B%j%9%H$N%j%9%H(B
886: % [[0,1,2],[0,3,4],[0,5,6]] ---> [[1,2], [3,4],[5,6]]
887: %>
888: /removeFirstFromPolymake {
889: /arg1 set
890: [/mm /rr] pushVariables
891: [
892: /mm arg1 def
893: mm to_univNum /mm set
894: mm {rest} map /mm set
895: /arg1 mm def
896: ] pop
897: popVariables
898: arg1
899: } def
900:
901: %<
902: % Usages: mm genUnit
903: % [1,0,0,...] $B$r2C$($k$?$a$K@8@.(B.
904: % [[0,1,2], [0,3,4],[0,5,6]]--> [1,0,0]
905: %>
906: /genUnit {
907: /arg1 set
908: [/mm /rr /i] pushVariables
909: [
910: /mm arg1 def
911: mm 0 get length newVector /rr set
912: rr null_to_zero /rr set
913: rr 0 (1).. put
914: /arg1 rr def
915: ] pop
916: popVariables
917: arg1
918: } def
919:
920: %<
921: % Usages: mm genUnitMatrix
922: % [[0,1,2], [0,3,4],[0,5,6]]--> [[1,0,0],[0,1,0],[0,0,1]]
923: %>
924: /genUnitMatrix {
925: /arg1 set
926: [/mm /rr /nn /i] pushVariables
927: [
928: /mm arg1 def
929: mm 0 get length /nn set
930: [
931: 0 1 nn 1 sub {
932: /i set
933: nn newVector null_to_zero /mm set
934: mm i (1).. put
935: mm
936: } for
937: ]
938: /arg1 set
939: ] pop
940: popVariables
941: arg1
942: } def
943:
944: %<
945: %%note: 2004, 8/29 (sun)
946: % toQuotientSpace : Linearity space $B$G3d$k(B.
947: % Usages: ineq mm toQuotientSpace
948: % $BF~NO$O(B coneEq $B$N=PNO(B ineq
949: % $B$*$h$S(B doPolymake --> getLinearitySubspace ==> L
950: % [L,[1,0,0,...]] asir_matrix_kernel removeFirstFromPolymake $B$GF@$i$l$?(B mm
951: % $B=PNO$+$i(B 0 $B%Y%/%H%k$O:o=|(B.
952: % $B=PNO$b(B coneEq $B7A<0(B. $BFC$K(B polymake $BMQ$K(B 0 $B$r2C$($k$N$,I,MW(B.
953: % ref: getUnit, removeFirstFromPolymake, addZeroForPolymake,
954: % asir_matrix_kernel, getLinearitySubspace
955: %>
956: /toQuotientSpace {
957: /arg2 set
958: /arg1 set
959: [/ineq /mm /rr] pushVariables
960: [
961: /ineq arg1 def
962: /mm arg2 def
963:
964: ineq mm transpose mul /rr set
965:
966: /arg1 rr def
967: ] pop
968: popVariables
969: arg1
970: } def
971:
972: /test5.data
973: $polymake.data(polymake.INEQUALITIES([[0,1,-1,1,-1,0],[0,0,-1,0,-1,2],[0,0,-1,0,-1,2],[0,0,-2,0,-2,4],[0,-1,0,-1,0,2],[0,-2,0,-2,0,4]]),polymake.VERTICES([[0,0,-1,0,0,0],[0,-1,-1,0,0,0],[0,1,0,-1,0,0],[0,-1,0,1,0,0],[0,0,1,0,-1,0],[0,0,-1,0,1,0],[0,-2,-2,0,0,-1],[0,2,2,0,0,1]]),polymake.FACETS([[0,1,-1,1,-1,0],[0,-1,0,-1,0,2]]),polymake.AFFINE_HULL(),polymake.FEASIBLE(),polymake.NOT__POINTED(),polymake.FAR_FACE([polymake._set([0,1,2,3,4,5,6,7])]),polymake.VERTICES_IN_INEQUALITIES([polymake._set([1,2,3,4,5,6,7]),polymake._set([2,3,4,5,6,7]),polymake._set([2,3,4,5,6,7]),polymake._set([2,3,4,5,6,7]),polymake._set([0,2,3,4,5,6,7]),polymake._set([0,2,3,4,5,6,7])]),polymake.DIM([[5]]),polymake.AMBIENT_DIM([[5]]))$
974: def
975: %<
976: % Usages: test5
977: %% getConeInfo $B$rJQ99$9$l$P(B polymake $B$r8F$P$:$K%F%9%H$G$-$k(B.
978: %>
979: /test5 {
980: % test3b $B$h$j(B
981: /ww [(Dx) 1 (Dy) 2] def
982: % /ww [(x) 1 (y) -2 (Dx) 3 (Dy) 6] def
983: [(x,y) ring_of_differential_operators
984: [ww] weight_vector
985: 0] define_ring
986: [ (x Dx + y Dy -1).
987: (y^2 Dy^2 + 2 + y Dy ).
988: ] /gg set
989: gg {homogenize} map /gg set
990: [(AutoReduce) 1] system_variable
991: [gg] groebner 0 get /gg set
992: ww message
993:
994: ww gg coneEq getConeInfo /rr set
995: (Type in rr 0 get :: ) message
996: } def
997: %[5, [[1,0,1,0,-2],[0,1,0,1,-2]], $NOT__POINTED$ ]
998: % $B$3$N>l9g$O(B 2 $B<!85$^$GMn$9$H(B pointed cone $B$K$J$k(B.
999: % coneEq mmc transpose $B$r$b$H$K(B FACETS $B$r7W;;$9$l$P$h$$(B.
1000:
1001: %<
1002: % Usage: ceq getConeInfo
1003: % vw $B$O(B [v1 w1 v2 w2 ... ] $B7A<0(B. (v-w $B7A<0(B) w1, w2 $B$O(B univNumber $B$G$b$$$$(B.
1004: % g $B$O(B reduced Grobner basis $B$H$7$F(B vw g coneEq $B$r7W;;(B. $B$3$l$r(B getConeInfo $B$X(B.
1005: % Grobner cone $B$N(B $B<!85(B cdim (DIM), $BJd6u4V(B (linearity space ) $B$X$N9TNs(B mmc
1006: % linearity space $B<+BN(B, pointed or not__pointed
1007: % $B$D$^$j(B [cdim, L', L, PointedQ]
1008: % $B$r7W;;$7$FLa$9(B. (polymake $B7A<0$NM>J,$JItJ,$J$7(B)
1009: % polymake $BI,MW(B.
1010: % ref: coneEq
1011: % Global:
1012: % cone.getConeInfo.rr0, cone.getConeInfo.rr1 $B$K(B polymake $B$h$j$NLa$jCM$,$O$$$k(B.
1013: %>
1014: /getConeInfo {
1015: /arg1 set
1016: [/ww /g /ceq /ceq2 /cdim /mmc /mmL /rr /ineq /ppt] pushVariables
1017: [
1018: /ceq arg1 def
1019: ceq pruneZeroVector /ceq set
1020: ceq genPo2 /ceq2 set
1021: % ceq2 $B$O(B polymake.data(polymake.INEQUALITIES(...)) $B7A<0(B
1022: % polymake $B$G(B ceq2 $B$N<!85$N7W;;(B.
1023: /getConeInfo.ceq ceq def /getConeInfo.ceq2 ceq2 def
1024:
1025: cone.debug { (Calling polymake DIM.) message } { } ifelse
1026: [(DIM) ceq2] doPolymake 1 get /rr set
1027: cone.debug {(Done.) message } { } ifelse
1028: % test5 $B$K$O<!$N%3%a%s%H$H$j$5$k(B. $B>e$N9T$r%3%a%s%H%"%&%H(B.
1029: % test5.data tfbToTree /rr set
1030: /cone.getConeInfo.rr0 rr def
1031:
1032: rr (DIM) getNode /cdim set
1033: cdim 2 get 0 get 0 get 0 get to_univNum /cdim set
1034: % polymake $B$N(B DIM $B$O0l$D>.$5$$$N$G(B 1 $BB-$9(B.
1035: cdim (1).. add /cdim set
1036:
1037: rr (FACETS) getNode tag 0 eq {
1038: % FACETS $B$r;}$C$F$$$J$$$J$i:FEY7W;;$9$k(B.
1039: % POINTED, NOT__POINTED $B$bF@$i$l$k(B
1040: cone.debug { (Calling polymake FACETS.) message } { } ifelse
1041: [(FACETS) ceq2] doPolymake 1 get /rr set
1042: cone.debug { (Done.) message } { } ifelse
1043: } { } ifelse
1044:
1045: rr (VERTICES) getNode tag 0 eq {
1046: (internal error: VERTICES is not found.) error
1047: } { } ifelse
1048:
1049: /cone.getConeInfo.rr1 rr def
1050:
1051: rr (NOT__POINTED) getNode tag 0 eq {
1052: % cone $B$,(B pointed $B$N;~$O(B mmc $B$OC10L9TNs(B. genUnitMatrix $B$r;H$&(B.
1053: % VERTICES $B$h$j0l$D>.$5$$%5%$%:(B.
1054: /mmc
1055: [ rr (VERTICES) getNode 2 get 0 get 0 get rest]
1056: genUnitMatrix
1057: def
1058: /mmL [ ] def
1059: /ppt (POINTED) def
1060: } {
1061: % pointed $B$G$J$$>l9g(B,
1062: % cone $B$N@~7AItJ,6u4V$r7W;;(B.
1063: rr getLinearitySubspace /mmL set
1064: [mmL genUnit] mmL join /mmc set % [1,0,0,...] $B$rB-$9(B.
1065: mmc asir_matrix_kernel /mmc set % $BJd6u4V(B
1066: mmc removeFirstFromPolymake /mmc set % $B$R$H$D>.$5$$%5%$%:$K(B.
1067:
1068: [mmL genUnit] mmL join asir_matrix_image
1069: removeFirstFromPolymake /mmL set
1070: mmL asir_matrix_image /mmL set % Linearity space $B$r5a$a$k(B. rm 0vector
1071: /ppt (NOT__POINTED) def
1072: } ifelse
1073: /arg1 [[cdim mmc mmL ppt] rr] def
1074: ] pop
1075: popVariables
1076: arg1
1077: } def
1078:
1079:
1080: /test.put {
1081: /dog [(dog) [[(legs) 4] ] [1 2 3 ]] [(class) (tree)] dc def
1082: /man [(man) [[(legs) 2] ] [1 2 3 ]] [(class) (tree)] dc def
1083: /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def
1084: /fan [ma 1 copy] def
1085: ma (dog) getNode /dd set
1086: dd 2 get /dd2 set
1087: dd2 1 0 put
1088: ma message
1089:
1090: fan message
1091: } def
1092:
1093: /test6.data
1094: $polymake.data(polymake.INEQUALITIES([[0,1,-1,1,-1,0],[0,0,-1,0,-1,2],[0,0,-1,0,-1,2],[0,0,-2,0,-2,4],[0,-1,0,-1,0,2],[0,-2,0,-2,0,4]]),polymake.VERTICES([[0,0,-1,0,0,0],[0,-1,-1,0,0,0],[0,1,0,-1,0,0],[0,-1,0,1,0,0],[0,0,1,0,-1,0],[0,0,-1,0,1,0],[0,-2,-2,0,0,-1],[0,2,2,0,0,1]]),polymake.FACETS([[0,1,-1,1,-1,0],[0,-1,0,-1,0,2]]),polymake.AFFINE_HULL(),polymake.FEASIBLE(),polymake.NOT__POINTED(),polymake.FAR_FACE([polymake._set([0,1,2,3,4,5,6,7])]),polymake.VERTICES_IN_INEQUALITIES([polymake._set([1,2,3,4,5,6,7]),polymake._set([2,3,4,5,6,7]),polymake._set([2,3,4,5,6,7]),polymake._set([2,3,4,5,6,7]),polymake._set([0,2,3,4,5,6,7]),polymake._set([0,2,3,4,5,6,7])]))$
1095: def
1096: % tfbToTree
1097:
1098: /arrayToTree { [(class) (tree)] dc } def
1099:
1100: %<
1101: % polymake $B$h$jF@$i$l$?(B TreeObject $B$+$i(B TreeObject cone $B$r@8@.$9$k(B.
1102: % Usages: test6.data tfbToTree newCone $B$GF0:n%F%9%H(B
1103: %>
1104: /test6 {
1105: test6.data tfbToTree /rr set
1106: rr newCone /rr2 set
1107: } def
1108:
1109: %<
1110: % Usages: doPolymakeObj newCone
1111: %>
1112: /newCone {
1113: /arg1 set
1114: [/polydata /cone /facets /vertices /flipped /ineq
1115: /facetsv /rr] pushVariables
1116: [
1117: /polydata arg1 def
1118: polydata (FACETS) getNode tag 0 eq {
1119: (newCone : no FACETS data.) error
1120: } { } ifelse
1121: % facets $B$OM-M}?t$N>l9g@55,2=$9$k(B. data/test11 $B$G(B $BM-M}?t$G$k(B.
1122: polydata (FACETS) getNode 2 get 0 get to_univNum
1123: { nnormalize_vec} map /facets set
1124: [[ ] ] facets join shell rest removeFirstFromPolymake /facets set
1.2 takayama 1125: facets length 0 eq
1126: {(Internal error. Facet data is not obtained. See OpenXM_tmp.) error} { } ifelse
1.1 takayama 1127: % vertices $B$O(B cone $B$N>e$K$"$k$N$G@0?tG\(B OK. $B@55,$+$9$k(B.
1128: polydata (VERTICES) getNode 2 get 0 get to_univNum
1129: { nnormalize_vec} map /vertices set
1130: [[ ] ] vertices join shell rest removeFirstFromPolymake /vertices set
1131: % inequalities $B$OM-M}?t$N>l9g@55,2=$9$k(B.
1132: polydata (INEQUALITIES) getNode 2 get 0 get to_univNum
1133: { nnormalize_vec } map /ineq set
1134: [[ ] ] ineq join shell rest removeFirstFromPolymake /ineq set
1135:
1.4 takayama 1136: % nextcid, nextfid $B$r2C$($k(B. nextcid $B$O(B nextConeId $B$NN,(B. $B$H$J$j$N(B cone $BHV9f(B.
1137: % nextfid $B$O(B nextFacetId $B$NN,(B. $B$H$J$j$N(B cone $B$N(B facet
1138: % $BHV9f(B.
1.1 takayama 1139: [(cone) [ ]
1140: [
1141: [(facets) [ ] facets] arrayToTree
1142: [(flipped) [ ] facets length newVector null_to_zero] arrayToTree
1143: [(facetsv) [ ] facets vertices newCone_facetsv] arrayToTree
1.4 takayama 1144: [(nextcid) [ ] facets length newVector.with-1 ] arrayToTree
1145: [(nextfid) [ ] facets length newVector.with-1 ] arrayToTree
1.1 takayama 1146: [(vertices) [ ] vertices] arrayToTree
1147: [(inequalities) [ ] ineq] arrayToTree
1148: ]
1149: ] arrayToTree /cone set
1150: /arg1 cone def
1151: ] pop
1152: popVariables
1153: arg1
1154: } def
1155:
1156: %<
1157: % Usages: newCone_facetv
1158: % facet vertices newCone_facetv
1159: % facet $B$K$N$C$F$$$k(B vertices $B$r$9$Y$FNs5s(B.
1160: %>
1161: /newCone_facetv {
1162: /arg2 set
1163: /arg1 set
1164: [/facet /vertices] pushVariables
1165: [
1166: /facet arg1 def /vertices arg2 def
1167: [
1168: 0 1 vertices length 1 sub {
1169: /ii set
1170: facet vertices ii get mul isZero
1171: { vertices ii get } { } ifelse
1172: } for
1173: ]
1174: /arg1 set
1175: ] pop
1176: popVariables
1177: arg1
1178: } def
1179:
1180: %<
1181: % Usages: newCone_facetsv
1182: % facets vertices newCone_facetv
1183: % facets $B$K$N$C$F$$$k(B vertices $B$r$9$Y$FNs5s(B. $B%j%9%H$r:n$k(B.
1184: %>
1185: /newCone_facetsv {
1186: /arg2 set
1187: /arg1 set
1188: [/facets /vertices] pushVariables
1189: [
1190: /facets arg1 def /vertices arg2 def
1191: facets { vertices newCone_facetv } map
1192: /arg1 set
1193: ] pop
1194: popVariables
1195: arg1
1196: } def
1197:
1198: %<
1.2 takayama 1199: % Usages: [gb weight] newConeGB
1200: % gb $B$H(B weight $B$r(B tree $B7A<0$K$7$F3JG<$9$k(B.
1201: %>
1202: /newConeGB {
1203: /arg1 set
1204: [/gbdata /gg /ww /rr] pushVariables
1205: [
1206: /gbdata arg1 def
1207: % gb
1208: gbdata 0 get /gg set
1209: % weight
1210: gbdata 1 get /ww set
1211: %
1212: [(coneGB) [ ]
1213: [
1214: [(grobnerBasis) [ ] gg] arrayToTree
1215: [(weight) [ ] [ww]] arrayToTree
1216: [(initial) [ ] gg { ww 2 get weightv init } map ] arrayToTree
1217: ]
1218: ] arrayToTree /rr set
1219: /arg1 rr def
1220: ] pop
1221: popVariables
1222: arg1
1223: } def
1224:
1225: %<
1.1 takayama 1226: % Usages: cone_random
1227: %>
1228: /cone_random.start (2).. def
1229: /cone_random {
1230: [(tdiv_qr)
1231: cone_random.start (1103515245).. mul
1232: (12345).. add
1233:
1234: (2147483646)..
1235: ] mpzext 1 get /cone_random.start set
1236: cone_random.start
1237: } def
1238:
1239: /cone_random.limit 40 def
1240: /cone_random_vec {
1241: /arg1 set
1242: [/nn /rr] pushVariables
1243: [
1244: /nn arg1 def
1245: [
1246: 0 1 nn 1 sub {
1247: pop
1248: [(tdiv_qr) cone_random cone_random.limit] mpzext 1 get
1249: } for
1250: ] /arg1 set
1251: ] pop
1252: popVariables
1253: arg1
1254: } def
1255:
1256: %<
1257: % Usages: getNewRandomWeight
1258: %% max dim $B$N(B cone $B$r@8@.$9$k$?$a$K(B, random $B$J(B weight $B$r@8@.$9$k(B.
1259: %% h, H $B$N=hM}$bI,MW(B.
1260: %% $B@)Ls>r7o(B u+v >= 2t $B$r$_$?$9(B weight $B$,I,MW(B. $B$3$l$r$I$N$h$&$K:n$k$N$+(B?
1261: %>
1262: /getNewRandomWeight {
1263: /arg1 set
1264: [/vv /vvd /rr] pushVariables
1265: [
1266: /vv arg1 def
1267: vv { (D) 2 1 roll 2 cat_n } map /vvd set
1268: ] pop
1269: popVariables
1270: arg1
1271: } def
1272:
1273: % test7 : univNum $B$N(B weight $B$,@5$7$/G'<1$5$l$k$+$N%F%9%H(B
1274: % aux-cone.sm1
1275:
1276: %<
1277: % Usages: n d coneEqForSmallFan.2 (cone.type 2 $B@lMQ(B: x,y,Dx,Dy,h)
1278: % n $BJQ?t$N?t(B, d zero $B$K$7$J$$JQ?t$N?t(B. d $B$O(B max dim cone $B$N<!85$H$J$k(B.
1279: % $B$O$8$a$+$i(B d $B8D$NJQ?t(B.
1280: % 4, 2 , s,t,x,y $B$J$i(B weight $B$O(B s,t,Ds,Dt $B$N$_(B.
1281: % u_i + v_i >= 0 , u_i = v_i = 0.
1282: % homog $BJQ?t$N>r7o(B u_i+v_i >= t, i.e, -t >= 0 $B$bF~$l$k(B.
1283: % coneEq $B$N7k2L$H(B coneEqForSmallFan.2 $B$N7k2L$r(B join $B$7$F(B
1284: % getConeInfo or newCone
1285: % note-cone.sm1 2004.8.31 $B$r8+$h(B. w_ineq $B$"$?$j(B.
1286: % cone.local $B$,@_Dj$5$l$F$$$k$H(B u_i <= 0 $B$b>r7o$KF~$k(B.
1287: %>
1288: /coneEqForSmallFan.2 {
1289: /arg2 set
1290: /arg1 set
1291: [/n /d /nn /dd /ii /tt] pushVariables
1292: [
1293: /n arg1 def
1294: /d arg2 def
1295: n to_int32 /n set
1296: d to_int32 /d set
1297: /dd n d add def
1298: /nn n n add def
1299:
1300: % 0 ~ d-1, n ~ dd-1 $B$G$O(B u_i + v_i = 0
1301: % d ~ n-1, dd ~ nn-1 $B$G$O(B u_i=v+i = 0.
1302: % -t >= 0
1303: [
1304: % d ~ n-1, dd ~ nn-1 $B$G$O(B u_i=v+i = 0.
1305: d 1 n 1 sub {
1306: /ii set
1307: % [ 0,0, ..., 0,1,0,... ; 0] $B$r@8@.(B
1308: nn 1 add newVector null_to_zero /tt set
1309: tt ii (1).. put
1310: tt
1311: % [ 0,0, ..., 0,-1,0,... ; 0] $B$r@8@.(B
1312: nn 1 add newVector null_to_zero /tt set
1313: tt ii (-1).. put
1314: tt
1315: } for
1316: dd 1 nn 1 sub {
1317: /ii set
1318: nn 1 add newVector null_to_zero /tt set
1319: tt ii (1).. put
1320: tt
1321: nn 1 add newVector null_to_zero /tt set
1322: tt ii (-1).. put
1323: tt
1324: } for
1325:
1326: % 0 ~ d-1, n ~ dd-1 $B$G$O(B u_i + v_i = 0
1327: 0 1 d 1 sub {
1328: /ii set
1329: nn 1 add newVector null_to_zero /tt set
1330: tt ii (1).. put
1331: tt ii n add (1).. put
1332: tt
1333:
1334: nn 1 add newVector null_to_zero /tt set
1335: tt ii (-1).. put
1336: tt ii n add (-1).. put
1337: tt
1338:
1339: } for
1340:
1341: % -t >= 0
1342: cone.h0 {
1343: % t = 0
1344: nn 1 add newVector null_to_zero /tt set
1345: tt nn (1).. put
1346: tt
1347: nn 1 add newVector null_to_zero /tt set
1348: tt nn (-1).. put
1349: tt
1350: }
1351: {
1352: % -t >= 0
1353: nn 1 add newVector null_to_zero /tt set
1354: tt nn (-1).. put
1355: tt
1356: } ifelse
1357:
1358: % cone.local $B$,(B 1 $B$N;~(B
1359: % 0 ~ d-1 $B$G$O(B -u_i >= 0
1360: cone.local {
1361: 0 1 d 1 sub {
1362: /ii set
1363: nn 1 add newVector null_to_zero /tt set
1364: tt ii (-1).. put
1365: tt
1366: } for
1367: } { } ifelse
1368: ] /rr set
1369: /arg1 rr to_univNum def
1370: ] pop
1371: popVariables
1372: arg1
1373: } def
1374:
1375: %<
1376: % Usages: n d coneEqForSmallFan.1 (cone.type 1 $B@lMQ(B: x,y,Dx,Dy,h,H)
1377: % cone.type 2 $B$G$O(B x,y,Dx,Dy,h
1378: % coneEqForSmallFan.2 $B$N7k2L$rMQ$$$F@8@.(B.
1379: % H $B$N>r7o$r2C$($k(B.
1380: %>
1381: /coneEqForSmallFan.1 {
1382: /arg2 set
1383: /arg1 set
1384: [/n /d /i /j /rr /tt /tt2] pushVariables
1385: [
1386: /n arg1 def /d arg2 def
1387: n d coneEqForSmallFan.2 /rr set
1388: rr cone.appendZero /rr set
1389: % H $BMQ$N(B 0 $B$r2C$($k(B.
1390: % $B$H$j$"$($:(B t' = 0 $B$G$-$a$&$A(B.
1391: cone.h0 { } { (cone.h0 = 0 has not yet been implemented.) error } ifelse
1392: n 2 mul 2 add newVector null_to_zero /tt set
1393: tt n 2 mul 2 add 1 sub (-1).. put
1394: n 2 mul 2 add newVector null_to_zero /tt2 set
1395: tt2 n 2 mul 2 add 1 sub (1).. put
1396: rr [tt tt2] join /rr set
1397: /arg1 rr to_univNum def
1398: ] pop
1399: popVariables
1400: arg1
1401: } def
1402:
1403: %<
1404: % Usages: vv ineq toQuotientCone
1405: % weight space $B$N(B $B%Q%i%a!<%?$D$1$N$?$a$K;H$&(B.
1406: % cone.V $B$r5a$a$?$$(B. vv $B$O(B doPolymakeObj (VERTICES) getNode 2 get 0 get $B$GF@$k(B.
1407: % vertices $B$N(B non-negative combination $B$,(B cone.
1408: % vertice cone.w_ineq isInLinearSubspace $B$J$i<h$j=|$/(B.
1409: % $B$D$^$j(B vertice*cone.w_ineq = 0 $B$J$i<h$j=|$/(B.
1410: %
1411: % $B$3$l$G@5$7$$(B? $B>ZL@$O(B? $B$^$@ESCf(B. cone.W $B$r5a$a$k$N$K;H$&(B. (BUG)
1412: % cone.w_cone 1 get (VERTICES) getNode :: $B$HHf3S$;$h(B.
1413: % $B$3$N4X?t$r8F$s$G(B cone.W $B$r:n$k$N$OITMW$+$b(B.
1414: %
1415: % Example: cf. parametrizeSmallFan
1416: % 4 2 coneEqForSmallFan.2 /cone.w_ineq set cone.w_ineq getConeInfo /rr set
1417: % rr 1 get (VERTICES) getNode 2 get 0 get removeFirstFromPolymake /vv set
1418: % vv cone.w_ineq toQuotientCone pmat
1419: %>
1420: /toQuotientCone {
1421: /arg2 set /arg1 set
1422: [/vv /ineq /rr] pushVariables
1423: [
1424: /vv arg1 def /ineq arg2 def
1425: vv {
1426: dup
1427: ineq isInLinearSpace 1 eq { pop }
1428: { } ifelse
1429: } map /arg1 set
1430: ] pop
1431: popVariables
1432: arg1
1433: } def
1434:
1435: %<
1436: % Usages: n d parametrizeSmallFan
1437: % n : x $BJQ?t$N?t(B.
1438: % d : 0 $B$K$7$J$$(B weight $B$N?t(B.
1439: % $B<!$NBg0hJQ?t$b@_Dj$5$l$k(B.
1440: % cone.W : weight $B$r%Q%i%a!<%?$E$1$9$k%Y%/%H%k$NAH(B.
1441: % cone.Wpos : i $B$,(B 0 ~ Wpos-1 $B$NHO0O$N$H$-(B V[i] $B$X$O(B N $B$N85$r3]$1;;$7$F$h$$(B,
1442: % i $B$,(B Wpos ~ $B$NHO0O$N$H$-(B V[i] $B$X$O(B Z $B$N85$r3]$1;;$7$F$h$$(B.
1443: % cone.w_ineq : weight space $B$NITEy<0@)Ls(B. $B0J8e$N7W;;$G>o$KIU2C$9$k(B.
1444: % cone.w_cone : w_ineq $B$r(B polymake $B$G(B getConeInfo $B$7$?7k2L(B.
1445: % Example: /cone.local 1 def ; 4 2 parametrizeSmallFan pmat
1446: % Example: /cone.local 0 def ; 4 2 parametrizeSmallFan pmat
1447: %>
1448: /parametrizeSmallFan {
1449: /arg2 set /arg1 set
1450: [/n /d /vv /coneray] pushVariables
1451: [
1452: /n arg1 def /d arg2 def
1453: {
1454: cone.type 1 eq {
1455: n d coneEqForSmallFan.1 /cone.w_ineq set
1456: exit
1457: } { } ifelse
1458: cone.type 2 eq {
1459: n d coneEqForSmallFan.2 /cone.w_ineq set
1460: exit
1461: } { } ifelse
1462: (This cone.type has not yet been implemented.) error
1463: } loop
1464: cone.w_ineq getConeInfo /cone.w_cone set
1465: cone.w_cone 1 get (VERTICES) getNode 2 get 0 get
1466: removeFirstFromPolymake /vv set
1467:
1468: vv cone.w_ineq toQuotientCone /coneray set
1469: coneray length /cone.Wpos set
1470:
1471: coneray cone.w_cone 0 get 2 get join /cone.W set
1472: /arg1 cone.W def
1473: ] pop
1474: popVariables
1475: arg1
1476: } def
1477:
1478: %<
1479: % Usages: n d coneEqForTotalFan.2 (cone.type 2 $B@lMQ(B: x,y,Dx,Dy,h)
1480: % n $BJQ?t$N?t(B,
1481: % d 0 $B$K$7$J$$JQ?t(B.
1482: % u_i + v_i >= 0 ,
1483: % homog $BJQ?t$N>r7o(B u_i+v_i >= 0, t = 0 $B$bF~$l$k(B.
1484: % coneEq $B$N7k2L$H(B coneEqForSmallFan.2 $B$N7k2L$r(B join $B$7$F(B
1485: % getConeInfo or newCone
1486: % cone.local $B$,@_Dj$5$l$F$$$k$H(B u_i <= 0 $B$b>r7o$KF~$k(B.
1487: %>
1488: /coneEqForTotalFan.2 {
1489: /arg2 set
1490: /arg1 set
1491: [/n /nn /dd /ii /tt] pushVariables
1492: [
1493: /n arg1 def
1494: /d arg2 def
1495: n to_int32 /n set
1496: d to_int32 /d set
1497: /nn n n add def
1498: /dd n d add def
1499:
1500: % 0 ~ d-1, n ~ dd-1 $B$G$O(B u_i + v_i >= 0
1501: % d ~ n-1, dd ~ nn-1 $B$G$O(B u_i=v+i = 0.
1502: % t = 0
1503: [
1504: % d ~ n-1, dd ~ nn-1 $B$G$O(B u_i=v+i = 0.
1505: d 1 n 1 sub {
1506: /ii set
1507: % [ 0,0, ..., 0,1,0,... ; 0] $B$r@8@.(B
1508: nn 1 add newVector null_to_zero /tt set
1509: tt ii (1).. put
1510: tt
1511: % [ 0,0, ..., 0,-1,0,... ; 0] $B$r@8@.(B
1512: nn 1 add newVector null_to_zero /tt set
1513: tt ii (-1).. put
1514: tt
1515: } for
1516: dd 1 nn 1 sub {
1517: /ii set
1518: nn 1 add newVector null_to_zero /tt set
1519: tt ii (1).. put
1520: tt
1521: nn 1 add newVector null_to_zero /tt set
1522: tt ii (-1).. put
1523: tt
1524: } for
1525:
1526: % 0 ~ d-1, n ~ dd-1 $B$G$O(B u_i + v_i >= 0
1527: 0 1 d 1 sub {
1528: /ii set
1529: nn 1 add newVector null_to_zero /tt set
1530: tt ii (1).. put
1531: tt ii n add (1).. put
1532: tt
1533:
1534: } for
1535:
1536: % t = 0
1537: cone.h0 {
1538: % t = 0
1539: nn 1 add newVector null_to_zero /tt set
1540: tt nn (1).. put
1541: tt
1542: nn 1 add newVector null_to_zero /tt set
1543: tt nn (-1).. put
1544: tt
1545: }
1546: {
1547: (coneForTotalFan.2. Not implemented.) error
1548: } ifelse
1549:
1550: % cone.local $B$,(B 1 $B$N;~(B
1551: % 0 ~ d-1 $B$G$O(B -u_i >= 0
1552: cone.local {
1553: 0 1 d 1 sub {
1554: /ii set
1555: nn 1 add newVector null_to_zero /tt set
1556: tt ii (-1).. put
1557: tt
1558: } for
1559: } { } ifelse
1560: ] /rr set
1561: /arg1 rr to_univNum def
1562: ] pop
1563: popVariables
1564: arg1
1565: } def
1566:
1567: %<
1568: % Usages: n d parametrizeTotalFan
1569: % n : x $BJQ?t$N?t(B.
1570: % d : 0 $B$K$7$J$$?t(B.
1571: % $B<!$NBg0hJQ?t$b@_Dj$5$l$k(B.
1572: % cone.W : weight $B$r%Q%i%a!<%?$E$1$9$k%Y%/%H%k$NAH(B.
1573: % cone.Wpos : i $B$,(B 0 ~ Wpos-1 $B$NHO0O$N$H$-(B V[i] $B$X$O(B N $B$N85$r3]$1;;$7$F$h$$(B,
1574: % i $B$,(B Wpos ~ $B$NHO0O$N$H$-(B V[i] $B$X$O(B Z $B$N85$r3]$1;;$7$F$h$$(B.
1575: % cone.w_ineq : weight space $B$NITEy<0@)Ls(B. $B0J8e$N7W;;$G>o$KIU2C$9$k(B.
1576: % cone.w_ineq $B$r(B getConeInfo $B$7$?7k2L$O(B cone.w_cone
1577: % Example: /cone.local 1 def ; 3 parametrizeSmallFan pmat
1578: % Example: /cone.local 0 def ; 3 parametrizeSmallFan pmat
1579: % local $B$,(B 1 $B$@$H(B u_i <= 0 $B$K$J$k(B.
1580: %>
1581: /parametrizeTotalFan {
1582: /arg2 set
1583: /arg1 set
1584: [/n /d /vv /coneray] pushVariables
1585: [
1586: /n arg1 def /d arg2 def
1587: {
1588: cone.type 2 eq { n d coneEqForTotalFan.2 /cone.w_ineq set exit}
1589: { } ifelse
1590: (This cone.type has not yet been implemented.) error
1591: } loop
1592: cone.w_ineq getConeInfo /cone.w_cone set
1593: cone.w_cone 1 get (VERTICES) getNode 2 get 0 get
1594: removeFirstFromPolymake /vv set
1595:
1596: vv cone.w_ineq toQuotientCone /coneray set
1597: coneray length /cone.Wpos set
1598:
1599: coneray cone.w_cone 0 get 2 get join /cone.W set
1600: /arg1 cone.W def
1601: ] pop
1602: popVariables
1603: arg1
1604: } def
1605:
1606: %<
1607: % Usages: vlist wlist cone_wtowv
1608: % [x y Dx Dy h] [-1 0 1 0 0] ==> [(x) -1 (Dx) 1] $B$r:n$k(B.
1609: %>
1610: /cone_wtowv {
1611: /arg2 set /arg1 set
1612: [/vlist /wlist /ii] pushVariables
1613: [
1614: /vlist arg1 def
1615: /wlist arg2 def
1616: wlist length vlist length eq {
1617: } { (cone_wtowv: length of the argument must be the same.) error} ifelse
1618:
1619: wlist to_int32 /wlist set
1620: [
1621: 0 1 wlist length 1 sub {
1622: /ii set
1623: wlist ii get 0 eq { }
1624: { vlist ii get wlist ii get } ifelse
1625: } for
1626: ] /arg1 set
1627: ] pop
1628: popVariables
1629: arg1
1630: } def
1631:
1632: %<
1633: % Usages: pruneZeroVector
1634: % genPo, getConeInfo $BEy$NA0$K;H$&(B. 0 $B%Y%/%H%k$O0UL#$N$J$$@)Ls$J$N$G=|$/(B.
1.2 takayama 1635: % $BF1$8@)Ls>r7o$b$N$>$/(B. polymake FACET $B$,@5$7$/F0$+$J$$>l9g$,$"$k$N$G(B.
1636: % cf. pear/OpenXM_tmp/x3y2.poly, x^3+y^2, x^2+y^3 data/test15.sm1
1.1 takayama 1637: %>
1638: /pruneZeroVector {
1639: /arg1 set
1640: [/mm /ii /jj /tt] pushVariables
1641: [
1642: /mm arg1 def
1643: mm to_univNum /mm set
1.2 takayama 1644: [ [ ] ] mm join shell rest uniq /mm set
1.1 takayama 1645: [
1646: 0 1 mm length 1 sub {
1647: /ii set
1648: mm ii get /tt set
1649: {
1650: 0 1 tt length 1 sub {
1651: /jj set
1652: tt jj get (0).. eq { }
1653: { tt exit } ifelse
1654: } for
1655: exit
1656: } loop
1657: } for
1658: ] /arg1 set
1659: ] pop
1660: arg1
1661: } def
1662:
1663: %<
1664: % Usages: a projectIneq v , dim(a) = n, dim(v) = d
1665: % a*cone.Wt*cone.Lpt
1666: %>
1667: /projectIneq {
1668: cone.Wt mul cone.Lpt mul
1669: } def
1670:
1671: %<
1672: % Usages: v liftWeight [w vw], dim(v) = d, dim(w) = n, vw : vw $B7A<0$N(B weight
1673: % v*cone.Lp*cone.W cone.vlist w cone_wtowv
1674: %>
1675: /liftWeight {
1676: /arg1 set
1677: [/v /w /vw] pushVariables
1678: [
1679: /v arg1 def
1680: v cone.Lp mul cone.W mul /w set
1681: [w cone.vlist w cone_wtowv] /arg1 set
1682: ] pop
1683: popVariables
1684: arg1
1685: } def
1686:
1687: %<
1688: % Usage: m isZero
1689: % dr.sm1 $B$X0\$9(B.
1690: %>
1691: /isZero {
1692: /arg1 set
1693: [/mm /ans /ii] pushVariables
1694: [
1695: /mm arg1 def
1696: /ans 1 def
1697: mm isArray {
1698: 0 1 mm length 1 sub {
1699: /ii set
1700: mm ii get isZero /ans set
1701: ans 0 eq { exit } { } ifelse
1702: } for
1703: } {
1704: {
1705: mm tag 1 eq {/ans mm 0 eq def exit} { } ifelse
1706: mm isPolynomial { /ans mm (0). eq def exit } { } ifelse
1707: mm isUniversalNumber { /ans mm (0).. eq def exit } { } ifelse
1708: /ans 0 def exit
1709: } loop
1710: } ifelse
1711: /arg1 ans def
1712: ] pop
1713: popVariables
1714: arg1
1715: } def
1716: [(isZero)
1717: [(m isZero bool)]] putUsages
1718:
1719: %<
1720: % Usage: m isNonNegative
1721: % dr.sm1 $B$X0\$9(B.
1722: %>
1723: /isNonNegative {
1724: /arg1 set
1725: [/mm /ans /ii] pushVariables
1726: [
1727: /mm arg1 def
1728: /ans 1 def
1729: mm isArray {
1730: 0 1 mm length 1 sub {
1731: /ii set
1732: mm ii get isNonNegative /ans set
1733: ans 0 eq { exit } { } ifelse
1734: } for
1735: } {
1736: {
1737: mm tag 1 eq {/ans mm 0 gt mm 0 eq or def exit} { } ifelse
1738: mm isUniversalNumber { /ans mm (0).. gt mm (0).. eq or def exit }
1739: { } ifelse
1740: mm isRational { mm (numerator) dc mm (denominator) dc mul /mm set
1741: /ans mm (0).. gt mm (0).. eq or def exit } { } ifelse
1742: /ans 0 def exit
1743: } loop
1744: } ifelse
1745: /arg1 ans def
1746: ] pop
1747: popVariables
1748: arg1
1749: } def
1750: [(isNonNegative)
1751: [(m isNonNegative bool)
1752: (In case of matrix, m[i,j] >= 0 must hold for all i,j.)
1753: ]] putUsages
1754:
1755: % Global variable: cone.weightBorder
1756: % /cone.weightBorder null def $BITMW$G$"$m$&(B. getStartingCone $B$G@_Dj$5$l$k(B.
1757:
1758: %<
1759: % Usages: cone i isOnWeigthBorder
1760: % cone $B$N(B i $BHVL\$N(B facet $B$,(B weight $B6u4V$N6-3&$K$"$k$+(B?
1761: % $BBg0hJQ?t(B cone.weightBorder $B$,@_Dj$5$l$F$k$3$H(B.
1762: % $B$3$NJQ?t$O(B cone $B$N(B facet $B%Y%/%H%k$N%j%9%H(B.
1763: % $B$3$NJQ?t$O(B setWeightBorder $B$G@_Dj(B
1764: % cone.weightBorder[0] or cone.weightBorder[1] or ...
1765: % /ccone cone.startingCone def ccone 0 isOnWeightBorder
1766: % ccone 1 isOnWeightBorder
1767: %>
1768: /isOnWeightBorder {
1769: /arg2 set /arg1 set
1770: [/cone /facet_i /i /j /vv /co /ans] pushVariables
1771: [
1772: /cone arg1 def /facet_i arg2 def
1773: facet_i to_int32 /facet_i set
1774: /ans 0 def
1775: cone (facetsv) getNode 2 get facet_i get /vv set % Facet $B$r(B vertex $BI=8=(B.
1776: {
1777: 0 1 cone.weightBorder length 1 sub {
1778: /i set
1779: cone.weightBorder i get /co set % co $B$K@)Ls>r7o(B
1780: vv cone.Lp mul % vv $B$r(B weight space $B$X(B lift.
1781: co mul isZero
1782: { /ans 1 def exit } { } ifelse
1783: } for
1784: exit
1785: } loop
1786: /arg1 ans def
1787: ] pop
1788: popVariables
1789: arg1
1790: } def
1791:
1792: %<
1793: % Usages: cone i markFlipped
1794: % cone $B$N(B i $BHVL\$N(B facet $B$K(B flipped $B$N0u$r$D$1$k(B. cone $B<+BN$,JQ99$5$l$k(B.
1795: % cone $B$O(B class-tree. Constructor $B$O(B newCone
1796: %>
1797: /markFlipped {
1798: /arg2 set /arg1 set
1799: [/cone /facet_i /vv] pushVariables
1800: [
1801: /cone arg1 def /facet_i arg2 def
1802: facet_i to_int32 /facet_i set
1803: cone (flipped) getNode 2 get /vv set
1804: vv facet_i (1).. put
1805: ] pop
1806: popVariables
1807: } def
1808:
1.4 takayama 1809: %<
1810: % Usages: cone i [cid fid] markNext
1811: % cone $B$N(B i $BHVL\$N(B facet $B$N$H$J$j$N(B cone id (cid) $B$H(B face id (fid) $B$r@_Dj$9$k(B.
1812: % cone $B$N(B nextcid[i] = cid; nextfid[i] = fid $B$H$J$k(B.
1813: % cone $B<+BN$,JQ99$5$l$k(B.
1814: % cone $B$O(B class-tree.
1815: %>
1816: /markNext {
1817: /arg3 set /arg2 set /arg1 set
1818: [/cone /facet_i /vv /nextid] pushVariables
1819: [
1820: /cone arg1 def /facet_i arg2 def /nextid arg3 def
1821: facet_i to_int32 /facet_i set
1822: cone (nextcid) getNode 2 get /vv set
1823: vv facet_i , nextid 0 get to_univNum , put
1824:
1825: cone (nextfid) getNode 2 get /vv set
1826: vv facet_i , nextid 1 get to_univNum , put
1827: ] pop
1828: popVariables
1829: } def
1830:
1.1 takayama 1831:
1832:
1833: %<
1834: % Usages: cone getNextFacet i
1835: % flipped $B$N(B mark $B$N$J$$(B facet $B$N(B index facet_i $B$rLa$9(B.
1836: % $B$=$l$,$J$$$H$-$O(B null
1837: %>
1838: /getNextFacet {
1839: /arg1 set
1840: [/cone /facet_i /vv /ii] pushVariables
1841: [
1842: /cone arg1 def
1843: /facet_i null def
1844: cone (flipped) getNode 2 get /vv set
1845: 0 1 vv length 1 sub {
1846: /ii set
1847: vv ii get to_int32 0 eq { /facet_i ii def exit }
1848: { } ifelse
1849: } for
1850: /arg1 facet_i def
1851: ] pop
1852: popVariables
1853: arg1
1854: } def
1855:
1856: %<
1857: % Usages: cone i epsilon flipWeight
1858: % cone $B$N(B i $BHVL\$N(B facet $B$K$+$s$7$F(B flip $B$9$k(B.
1859: % $B?7$7$$(B weight $B$r5a$a$k(B. cf. liftWeight
1860: %>
1861: /flipWeight {
1862: /arg3 set /arg2 set /arg1 set
1863: [/cone /facet_i /ep /vp /v /v /ii] pushVariables
1864: [
1865: /cone arg1 def /facet_i arg2 def
1866: facet_i to_int32 /facet_i set
1867: /ep arg3 def
1868:
1869: ep to_univNum (1).. div /ep set
1870:
1871: % note: 2004.9.2
1872: cone (facetsv) getNode 2 get facet_i get /v set
1873: cone (facets) getNode 2 get facet_i get /f set
1874: /vp v 0 get def
1875: 1 1 v length 1 sub {
1876: /ii set
1877: vp v ii get add /vp set
1878: } for
1879: vp ep f mul sub /vp set
1880: vp nnormalize_vec /vp set
1881: /arg1 vp def
1882: ] pop
1883: popVariables
1884: arg1
1885: } def
1886:
1887: %<
1888: % Usages: cone1 cone2 isSameCone bool
1889: % cone1 cone2 $B$,Ey$7$$$+(B? facet $B$GHf$Y$k(B.
1890: % cone1, cone2 $B$O(B pointed cone $B$G$J$$$H$$$1$J$$(B.
1891: %>
1892: /isSameCone {
1893: /arg2 set /arg1 set
1894: [/cone1 /cone2 /facets1 /facets2 /ans] pushVariables
1895: [
1896: /cone1 arg1 def
1897: /cone2 arg2 def
1898: /facets1 cone1 (facets) getNode 2 get def
1899: /facets2 cone2 (facets) getNode 2 get def
1900: facets1 length facets2 length eq {
1901: facets1 facets2 sub isZero /ans set
1902: } {
1903: /ans 0 def
1904: } ifelse
1905: /arg1 ans def
1906: ] pop
1907: popVariables
1908: arg1
1909: } def
1910:
1911: %<
1912: % Usages: cone1 cone2 getCommonFacet list
1913: % cone1 $B$NCf$G(B cone2 $B$K4^$^$l$k(B facet $B$N%j%9%H(B
1914: % cone2 $B$NCf$G(B cone1 $B$K4^$^$l$k(B facet $B$N%j%9%H$r$b$I$9(B.
1915: % [1 [i] [j]] $B$"$k$H$-(B. [0 [ ] [ ]] $B$J$$$H$-(B.
1916: % cone1 $B$N(B facetsv[i] $B$,(B cone2 $B$K4^$^$l$k$+D4$Y$k(B.
1917: % cone2 $B$N(B facetsv[i] $B$,(B cone1 $B$K4^$^$l$k$+D4$Y$k(B.
1918: % cone1, cone2 $B$O(B pointed cone $B$G$J$$$H$$$1$J$$(B.
1919: %>
1920: /getCommonFacet {
1921: /arg2 set /arg1 set
1922: [/cone1 /cone2 /facets /ineq /ans1 /ans2 /i /tt] pushVariables
1923: [
1924: /cone1 arg1 def
1925: /cone2 arg2 def
1926:
1927: /facets cone1 (facetsv) getNode 2 get def
1928: /ineq cone2 (inequalities) getNode 2 get def
1929: /ans1 [
1930: 0 1 facets length 1 sub {
1931: /i set
1932: facets i get /tt set % facetsv[i] $B$r(B tt $B$X(B.
1933: ineq tt transpose mul isNonNegative {
1934: i
1935: } { } ifelse
1936: } for
1937: ] def
1938:
1939: /facets cone2 (facetsv) getNode 2 get def
1940: /ineq cone1 (inequalities) getNode 2 get def
1941: /ans2 [
1942: 0 1 facets length 1 sub {
1943: /i set
1944: facets i get /tt set % facetsv[i] $B$r(B tt $B$X(B.
1945: ineq tt transpose mul isNonNegative {
1946: i
1947: } { } ifelse
1948: } for
1949: ] def
1950: ans1 length 1 gt ans2 length 1 gt or {
1951: (getCommonFacet found more than 1 common facets.) error
1952: } { } ifelse
1953: % $B6&DL(B facet $B$,$"$l$P(B 1, $B$J$1$l$P(B 0.
1954: ans1 length 1 eq ans2 length 1 eq and {
1955: /tt 1 def
1956: } {
1957: /tt 0 def
1958: } ifelse
1959: /arg1 [tt ans1 ans2] def
1960: ] pop
1961: popVariables
1962: arg1
1963: } def
1964:
1965: %
1966: % -------------------------------------------------
1967: % test8 $B$O(B aux-cone.sm1 $B$X0\F0(B.
1968: % $B0J2<$$$h$$$h0lHL$N%W%m%0%i%`$N:n@.3+;O(B.
1969: % -------------------------------------------------
1970: %
1971:
1972: %<
1973: % Usages: setWeightBorder
1974: % cone.weightBorder (weight cone $B$N(B facet $B%Y%/%H%k$N=89g(B) $B$r@_Dj$9$k(B.
1975: % $B$"$HI{;:J*$H$7$F(B cone.w_cone_projectedWt (doPolymakeObj)
1976: % cone.w_ineq_projectedWt
1977: % cone.m $B<!85$N%Y%/%H%k(B.
1978: % cone.W, cone.Wt, cone.w_ineq $B$,$9$G$K7W;;$:$_$G$J$$$H$$$1$J$$(B.
1979: %>
1980: /setWeightBorder {
1981: [
1982: (Entering setWeightBorder ) message
1983: cone.w_ineq cone.Wt mul pruneZeroVector /cone.w_ineq_projectedWt set
1984: {
1985: cone.w_ineq_projectedWt length 0 eq {
1986: % weight $B$N6u4V$K(B border $B$,$J$$>l9g(B.
1987: /cone.weightBorder [ ] def
1988: exit
1989: } { } ifelse
1990: % weight $B$N6u4V$K(B border $B$,$"$k>l9g(B.
1991: cone.w_ineq_projectedWt getConeInfo /cone.w_cone_projectedWt set
1992: cone.w_cone_projectedWt 0 get 0 get to_int32 cone.m to_int32 eq {
1993: } {
1994: (setWeightBorder : internal error.) message
1995: } ifelse
1996: cone.w_cone_projectedWt 1 get (FACETS) getNode 2 get 0 get
1997: removeFirstFromPolymake /cone.weightBorder set
1998: exit
1999: } loop
2000: (cone.weightBorder=) message
2001: cone.weightBorder pmat
2002: ] pop
2003: } def
2004:
2005: %
2006: % -------------------------------------------------
2007: % $B%W%m%0%i%`$NN.$l(B.
2008: % Global: cone.fan cone $B$rG[Ns$H$7$F3JG<$9$k(B.
2009: %
2010: % ncone (next cone) $B$,?75,$KF@$i$l$?(B cone $B$G$"$k$H$9$k(B.
2011: % $B$3$N$H$-<!$NA`:n$r$9$k(B.
2012: % 0. ncone $B$,(B cone.fan $B$K$9$G$K$J$$$+D4$Y$k(B. $B$"$l$P(B, internal error.
2013: % 1. ncone markBorder ; ncone $B$NCf$N(B border $B>e$N(B facet $B$r(B mark
2014: % 2. cone.fan $B$NCf$N(B cone $B$H6&DL(B facet $B$,$J$$$+D4$Y(B (getCommonFacet),
2015: % $B$"$l$P$=$l$i$r(B mark $B$9$k(B.
2016: % global: cone.incidence $B$K(B $B6&DL(Bfacet $B$r;}$DAH$_$N>pJs$r2C$($k(B.
2017: % 3. ncone $B$r(B cone.fan $B$N:G8e$K2C$($k(B.
2018: % $B0J>e$NA`:n$r$^$H$a$?$b$N$,(B ncone updateFan
2019: %
2020: % getNextFlip $B$O(B cone.fan $B$NCf$+$i(B flip $B$7$F$J$$(B cone $B$H(B facet $B$NAH$rLa$9(B.
2021: % $B$J$1$l$P(B null $B$rLa$9(B. null $B$,La$l$P%W%m%0%i%`=*N;(B.
2022: %
2023: % getStargingCone $B$O7W;;$r=PH/$9$Y$-?75,$N(B cone $B$r7W;;$9$k(B. $BBg0hJQ?t(B cone.Lt, cone.W
2024: % $B$J$I$b$3$NCf$G@_Dj$9$k(B.
2025: % $BJQ?t%j%9%H(B, weight space $B$r@8@.$9$k4X?t(B, $BF~NOB?9`<0(B, weight $B$N8uJd(B $BEy$OBg0hJQ?t(B
2026: % $B$H$7$FF~NO$7$F$*$/(B.
2027: %
2028: % reduced gb $B$O(B $B4X?t(B input weight cone.gb reduced_G $B$G7W;;$9$k(B.
2029: %
2030: %
2031: % [ccone i] getNextCone ncone : flip $B$K$h$j<!$N(B cone $B$rF@$k(B.
2032: %
2033: % 1. clearGlobals ; $BF~NOBg0hJQ?t$N@_Dj(B.
2034: % 2. getStartingCone /ncone set
2035: % 3. { ncone updateFan
2036: % 4. getNextFlip /cone.nextflip set
2037: % 6. cone.nextflip isNull { exit } { } ifelse
2038: % 7. cone.nextflip getNextCone /ncone set
2039: % 8. } loop
2040: %
2041: %
2042: % -------------------------------------------------
2043: %
2044:
2045: %<
2046: % Usages: input weight cone.gb_Dh reduced_G
2047: % gb in h[1,1](D)
2048: %>
2049: /cone.gb_Dh {
2050: /arg2 set /arg1 set
2051: [/ff /ww /gg] pushVariables
2052: [
2053: /ff arg1 def
2054: /ww arg2 def
2055: [(AutoReduce) 1] system_variable
2056: [cone.vv ring_of_differential_operators
2057: [ww] weight_vector 0] define_ring
1.9 takayama 2058: [ff {toString .} map] ff getAttributeList setAttributeList
2059: groebner 0 get /gg set
1.1 takayama 2060: /cone.gb_Dh.g gg def
2061: /arg1 gg def
2062: ] pop
2063: popVariables
2064: arg1
2065: } def
2066:
2067: %<
2068: % Usages: cone.boundp
2069: %
2070: /cone.boundp {
2071: dup boundp 2 1 roll tag 0 eq not and
2072: } def
2073:
2074: %<
2075: % Usages: clearGlobals
2076: % cf. cone.boundp
2077: % polymake $B$r:FEY8F$V$?$a$K(B global $BJQ?t$r%/%j%"$9$k(B.
2078: % $B$^$@ESCf(B.
2079: %>
2080: /clearGlobals {
2081: /cone.W null def
2082: /cone.Wt null def
2083:
2084: /cone.cinit null def
2085: /cone.weightBorder null def
2086:
2087: } def
2088:
2089: %<
2090: % Usages: getStartingCone ncone
2091: % getStargingCone $B$O7W;;$r=PH/$9$Y$-?75,$N(B cone $B$r7W;;$9$k(B.
2092: % $B@_Dj$9$Y$-Bg0hJQ?t$O0J2<$r8+$h(B.
2093: %>
2094:
2095: /getStartingCone.test {
2096: %------------------Globals----------------------------------------
2097: % --------------- $BF~NO%G!<%?MQBg0hJQ?t$N@_Dj(B --------------------------
2098: %
2099: % cone.input : $BF~NOB?9`<07O(B
2100: /cone.input
2101: [(t1-x-y) (h*t2-x^2-y^2) (2*x*Dt2+h*Dt1+h*Dx) (2*y*Dt2+h*Dt1+h*Dy)]
2102: def
2103:
2104: % cone.vlist : $BA4JQ?t$N%j%9%H(B
2105: /cone.vlist [(t1) (t2) (x) (y) (Dt1) (Dt2) (Dx) (Dy) (h)] def
2106:
2107: % cone.vv : define_ring $B7A<0$NJQ?t%j%9%H(B.
2108: % t1,t2, x,y : t-space $B$N(B Grobner fan (local) $B$r5a$a$k(B.
2109: /cone.vv (t1,t2,x,y) def
2110:
2111: % cone.parametrizeWeightSpace : weight $B6u4V$r(B parametrize $B$9$k4X?t(B.
2112: % $BBg0hJQ?t(B cone.W , cone.Wpos $B$b$-$^$k(B.
2113: /cone.parametrizeWeightSpace {
2114: 4 2 parametrizeSmallFan
2115: } def
2116:
2117: % cone.w_start : weight$B6u4V$K$*$1$k(B weight $B$N=i4|CM(B.
2118: % $B$3$NCM$G(B max dim cone $B$,F@$i$l$J$$$H(B random weight $B$K$h$k(B $B%5!<%A$,;O$^$k(B.
2119: /cone.w_start
2120: [ 1 4 ]
2121: def
2122:
2123: % cone.gb : gb $B$r7W;;$9$k4X?t(B.
2124: /cone.gb {
2125: cone.gb_Dh
2126: } def
2127:
2128: %
2129: % ----------------- $B$*$o$j(B ---------------------------
2130: %
2131: } def % end of getStartingCone.test
2132:
2133: /getStartingCone {
2134: [/wv_start /w_start /reduced_G] pushVariables
2135: [
2136: % cone.n $B$O<+F0E*$K$-$a$i$l$k(B.
2137: % cone.n $B$O(B GB $B$r7W;;$9$k6u4V$N<!85(B.
2138: /cone.n cone.vlist length def
2139: %[1] cone.W, cone.Wpos $B$r5a$a$k(B. cone.m $B$O(B cone.W $B$h$j<+F0E*$K$-$^$k(B.
2140: % cone.m $B$O(B weight $B6u4V$N<+M3EY(B. cone.W $B$G<M1F$5$l$k@h$N<!85(B.
2141: /cone.W cone.boundp {
2142: (Skip cone.parametrizeWeightSpace. cf. clearGlobals) message
2143: } {
2144: cone.parametrizeWeightSpace
2145: } ifelse
2146: (parametrizing weight space: cone.W = ) messagen cone.W message
2147: /cone.Wt cone.W transpose def
2148: /cone.m cone.W length def
2149: % WeightBorder $B$N>r7oH=Dj(B facet $B$r@_Dj(B.
2150: /cone.weightBorder cone.boundp {
2151: (Skip setWeightBorder cf. clearGlobals) message
2152: } {
2153: setWeightBorder
2154: } ifelse
2155:
2156: %[2] weight vector wv_start $B$r@8@.$9$k(B.
2157: % wv_start $B$r@_Dj(B.
2158: cone.w_start tag 0 eq {
2159: % cone.w_start $B$,(B null $B$J$i(B random $B$K(B weight $B$r@_Dj(B.
2160: /cone.w_start cone.m cone_random_vec def
2161: } {
2162: cone.w_start length cone.m to_int32 eq {
2163: } {
2164: (Error: cone.w_start has wrong length.) error
2165: /cone.w_start cone.m cone_random_vec def
2166: } ifelse
2167: } ifelse
2168: /w_start cone.w_start cone.W mul def
2169:
2170: {
2171: cone.vlist w_start cone_wtowv /wv_start set
2172: (Trying a starting weight vector : ) messagen
2173: wv_start pmat
2174: %[3] reduced GB $B$N7W;;(B.
2175: cone.input wv_start cone.gb /reduced_G set
1.2 takayama 2176: (Reduced GB is obtained: ) message
2177: %reduced_G pmat
2178: /cone.cgb reduced_G def
2179: [cone.w_start w_start wv_start] /cone.cgb_weight set
1.1 takayama 2180:
2181: %[4] $B<M1F$7$F$+$i(B polytope $B$N%G!<%?$r7W;;(B.
2182: wv_start reduced_G coneEq /cone.g_ineq set
2183: cone.g_ineq cone.w_ineq join /cone.gw_ineq set
2184: cone.gw_ineq cone.Wt mul /cone.gw_ineq_projectedWt set % $B<M1F(B
2185: /cone.cinit cone.boundp {
2186: (Skipping cone.gw_ineq_projectedWt getConeInfo. cf. clearGlobals) message
2187: } {
2188: cone.gw_ineq_projectedWt getConeInfo /cone.cinit set
2189: } ifelse
2190:
2191: (cone.cinit is --- the first number is the dim of cone.) messagen
2192: cone.cinit 0 get pmat
2193: % Maximal dimensional cone $B$+$I$&$+$N8!::(B. $B8!::$K%Q%9$9$l$P(B loop $B$r(B exit
2194: % $B%Q%9$7$J$$>l9g(B w_start $B$r(B cone_random_vec $B$rMQ$$$FJQ99$9$k(B.
2195: cone.cinit 0 get 0 get to_int32 cone.m eq { exit }
2196: {
2197: (Failed to get the max dim cone. Updating the weight ...) messagen
1.2 takayama 2198: cone.m cone_random_vec /cone.w_start set
2199: /w_start cone.w_start cone.W mul def
1.1 takayama 2200: % cone.cinit $B$r:FEY7W;;$9$k$?$a$K(B clear $B$9$k(B.
2201: /cone.cinit null def
2202: } ifelse
2203: } loop
2204:
2205: (cone.m = ) messagen cone.m message
2206: (Suceeded to get the maximal dimensional startingCone.) message
2207:
2208: % Linearity subspace $B$N(B orth complement $B$X$N<M1F9TNs(B.
2209: % $BBg0hJQ?t(B cone.Lp, cone.Lpt $B$r@_Dj(B
2210: cone.cinit 0 get 1 get /cone.Lp set
2211: cone.Lp transpose /cone.Lpt set
2212: % Linearity subspace $B$N9TNs$r@_Dj(B.
2213: % $BBg0hJQ?t(B cone.L $B$r@_Dj(B
2214: cone.cinit 0 get 2 get /cone.L set
2215: % cone.d $B$O(B cone.W $B$*$h$S(B Linearity space $B$G3d$C$?8e(B, cone $B$r9M$($k$H$-$N<!85(B.
2216: % $BBg0hJQ?t(B cone.d $B$N@_Dj(B.
2217: /cone.d cone.Lp length def
2218:
2219: cone.m cone.d eq {
2220: (There is no linearity space) message
2221: } {
2222: (Dim of the linearity space is ) messagen cone.m cone.d sub message
2223: (cone.Lp = ) messagen cone.Lp pmat
2224: } ifelse
2225:
2226: %[5] cone.g_ineq * cone.Wt * cone.Lpt
2227: % cone.w_ineq * cone.Wt * cone.Lpt
2228: % $B$G@)Ls$r(B d $B<!85%Y%/%H%k$KJQ49(B.
2229: % W (R^m) $B6u4V$NITEy<0@)Ls$r(B L' (R^d) $B6u4V$X<M1F(B
2230: % cone.gw_ineq_projectedWtLpt
2231: % = cone.g_ineq*cone.Wt*cone.Lpt \/ cone.w_ineq*coneWt*cone.Lpt
2232:
2233: /cone.gw_ineq_projectedWtLpt
2234: cone.gw_ineq_projectedWt cone.Lpt mul
2235: def
2236:
2237: cone.m cone.d eq {
2238: /cone.cinit.d cone.cinit def
2239: } {
2240: % cone.m > cone.d $B$J$i$P(B, $B:FEY(B cone $B$N7W;;$,I,MW(B.
2241: % R^d $B$N(B cone $B$O(B cone.cinit.d $B$XF~$l$k(B.
2242: cone.gw_ineq_projectedWtLpt getConeInfo /cone.cinit.d set
2243: } ifelse
2244:
2245: cone.cinit.d 1 get newCone /cone.startingCone set
2246:
2247: (cone.startingCone is ) message
2248: cone.startingCone message
2249: ] pop
2250: popVariables
2251: cone.startingCone
2252: } def
2253:
2254: %
2255: % data/test9.sm1 $B$N(B test9 1-simplex X 2-simplex
2256: %
2257: % data/test10.sm1 1-simplex X 3-simplex
2258: % data/test11.sm1 SST, p.59
2259: %
2260: % $B$$$h$$$h(B, cone enumeration $B$N%W%m%0%i%`=q$-3+;O(B
2261: %
2262:
2263: %<
2264: % Usages: cone markBorder
2265: % cone->facets[i] $B$,(B weight space $B$N(B border $B$K$"$k$H$-(B
2266: % cone->flipped[i] = 2 $B$H$9$k(B.
2267: % $B$3$l$r(B cone $B$N$9$Y$F$N(B facet $B$KBP$7$F7W;;(B.
2268: %>
2269: /markBorder {
2270: /arg1 set
1.4 takayama 2271: [/cone /facets_t /flipped_t /kk /nextcid_t /nextfid_t] pushVariables
1.1 takayama 2272: [
2273: /cone arg1 def
2274: cone (facets) getNode 2 get /facets_t set
2275: cone (flipped) getNode 2 get /flipped_t set
1.4 takayama 2276: cone (nextcid) getNode 2 get /nextcid_t set
2277: cone (nextfid) getNode 2 get /nextfid_t set
1.1 takayama 2278: 0 1 flipped_t length 1 sub {
2279: /kk set
2280: flipped_t kk get (0).. eq {
2281: cone kk isOnWeightBorder {
2282: % Border $B$N>e$K$"$k$N$G(B flip $B:Q$N%^!<%/$r$D$1$k(B.
2283: flipped_t kk (2).. put
1.4 takayama 2284: % $B$H$J$j$N(B cone $B$N(B id (nextcid, nextfid) $B$O(B -2 $B$H$9$k(B.
2285: nextcid_t kk (-2).. put
2286: nextfid_t kk (-2).. put
1.1 takayama 2287: } { } ifelse
2288: } { } ifelse
2289: } for
2290: ] pop
2291: popVariables
2292: } def
2293:
2294: %<
2295: % Usages: ncone updateFan
2296: % $B%0%m!<%P%kJQ?t(B cone.fan $B$r99?7$9$k(B.
2297: %>
2298: %
2299: % updateFan $B$N(B debug $B$O(B data/test8 $B$G$H$j$"$($:$d$k(B.
2300: % test8 /ncone set $B$r<B9T$7$F$+$i(B ncone updateFan
2301:
2302: % global: cone.fan
2303: /cone.fan [ ] def
2304: % global: cone.incidence
2305: /cone.incidence [ ] def
1.2 takayama 2306: % global: cone.gblist gb's standing for each cones in cone.fan.
2307: /cone.gblist [ ] def
1.1 takayama 2308:
2309: /updateFan {
2310: /arg1 set
2311: [/ncone /kk /cfacet /ii /jj /tcone /flipped_t] pushVariables
2312: [
2313: /ncone arg1 def
2314: /cone.fan.n cone.fan length def
1.2 takayama 2315: % -1. cone.cgb ($BD>A0$K7W;;$5$l$?(B gb) $B$H(B cone.cgb_weight ($BD>A0$N7W;;$N(B weight)
2316: % $B$r(B cone.gblist $B$X3JG<$9$k(B.
2317: cone.gblist [ [cone.cgb cone.cgb_weight] newConeGB ] join /cone.gblist set
1.1 takayama 2318: % 0. ncone $B$,(B cone.fan $B$K$9$G$K$"$l$P%(%i!<(B
2319: 0 1 cone.fan.n 1 sub {
2320: /kk set
2321: ncone cone.fan kk get isSameCone {
2322: (Internal error updateFan: ncone is already in cone.fan) error
2323: } { } ifelse
2324: } for
2325:
2326: % 1. ncone $B$NCf$N(B border $B>e$N(B facet $B$r$9$Y$F(B mark.
2327: ncone markBorder
2328:
2329: % 2. ncone /\ cone.fan[kk] $B$,$"$k$+D4$Y$k(B. $B$"$l$P(B Mark $B$9$k(B. incidence graph $B$K2C$($k(B
2330: 0 1 cone.fan.n 1 sub {
2331: /kk set
2332: ncone cone.fan kk get getCommonFacet /cfacet set
2333: cfacet 0 get
2334: {
2335: % $B6&DL(B facet $B$,$"$k>l9g(B. [[cone$BHV9f(B face$BHV9f(B] [cone$BHV9f(B face$BHV9f(B]] $B$N7A<0$G3JG<(B.
2336: /ii cfacet 1 get 0 get def
2337: /jj cfacet 2 get 0 get def
2338: cone.incidence [ [[cone.fan.n ii] [kk jj]] ] join /cone.incidence set
2339: % flipped $B$r(B mark $B$9$k(B.
2340: ncone ii markFlipped
2341: cone.fan kk get /tcone set
2342: tcone jj markFlipped
1.4 takayama 2343: % nextcid, nextfid $B$r@_Dj$9$k(B.
2344: ncone ii [kk jj] markNext
2345: tcone jj [cone.fan.n ii] markNext
1.1 takayama 2346: } { } ifelse
2347: } for
2348: % 3. ncone $B$r2C$($k(B.
2349: cone.fan [ncone] join /cone.fan set
2350: ] pop
2351: popVariables
2352: } def
2353:
2354: %<
1.9 takayama 2355: % usages: getNextFlip [cone, k, cid]
1.1 takayama 2356: % 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.
2357: % $B$b$&$J$$$H$-$K$O(B null $B$rLa$9(B.
1.9 takayama 2358: % 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
2359: % $BMQ$$$k(B.
1.1 takayama 2360: %>
2361: /getNextFlip {
1.9 takayama 2362: [/tcone /ans /ii /cid] pushVariables
1.1 takayama 2363: [
1.9 takayama 2364: /ans null def /cid -1 def
1.1 takayama 2365: 0 1 cone.fan length 1 sub {
2366: /ii set
2367: cone.fan ii get /tcone set
1.9 takayama 2368: /cid ii def
1.1 takayama 2369: tcone getNextFacet /ans set
2370: ans tag 0 eq { } { exit } ifelse
2371: } for
2372: ans tag 0 eq { /arg1 null def }
1.9 takayama 2373: { /arg1 [tcone ans cid] def } ifelse
1.1 takayama 2374: ] pop
2375: popVariables
2376: arg1
2377: } def
2378:
2379: % global variable : cone.epsilon , cone.epsilon.limit
2380: % flip $B$N;~$N(B epsilon
2381: /cone.epsilon (1).. (10).. div def
2382: /cone.epsilon.limit (1).. (100).. div def
1.9 takayama 2383: % cone.epsilon.limit $B$rIi$K$9$l$PDd;_$7$J$$(B.
1.1 takayama 2384:
2385: %<
2386: % Usages: result_getNextFlip getNextCone ncone
2387: % flip $B$7$F?7$7$$(B ncone $B$rF@$k(B.
2388: %>
1.11 ! takayama 2389: /getNextCone.orig {
1.1 takayama 2390: /arg1 set
2391: [/ncone /ccone /kk /w /next_weight_w_wv] pushVariables
2392: [
2393: /ccone arg1 def
2394: /ncone null def
2395: /kk ccone 1 get def
2396: ccone 0 get /ccone set
2397: {
2398: ccone tag 0 eq { exit } { } ifelse
2399:
2400: % ccone $B$N(B kk $BHVL\$N(B facet $B$K$D$$$F(B flip $B$9$k(B.
2401: ccone kk cone.epsilon flipWeight /w set
2402: (Trying new weight is ) messagen w message
2403: w liftWeight /next_weight_w_wv set
2404: (Trying new weight [w,wv] is ) messagen next_weight_w_wv message
2405:
2406: cone.input next_weight_w_wv 1 get cone.gb /cone.cgb set
1.2 takayama 2407: [w] next_weight_w_wv join /cone.cgb_weight set
1.1 takayama 2408: next_weight_w_wv 1 get cone.cgb coneEq /cone.g_ineq set
2409: cone.g_ineq cone.w_ineq join cone.Wt mul cone.Lpt mul
2410: pruneZeroVector /cone.gw_ineq_projectedWtLpt set
2411:
2412: (cone.gw_ineq_projectedWtLpt is obtained.) message
2413:
2414: cone.gw_ineq_projectedWtLpt getConeInfo /cone.nextConeInfo set
2415: % $B<!85$rD4$Y$k(B. $B$@$a$J$i(B retry
2416: cone.nextConeInfo 0 get 0 get to_int32 cone.d eq {
2417: cone.nextConeInfo 1 get newCone /ncone set
2418: ccone ncone getCommonFacet 0 get {
2419: (Flip succeeded.) message
2420: exit
2421: } { } ifelse
2422: } { } ifelse
2423: % common face $B$,$J$1$l$P(B $B$d$O$j(B epsilon $B$r>.$5$/(B.
2424: cone.nextConeInfo 0 get 0 get to_int32 cone.d eq {
2425: (ccone and ncone do not have a common facet.) message
2426: } {
2427: (ncone is not maximal dimensional. ) message
2428: } ifelse
2429: (Decreasing epsilon to ) messagen
2430: cone.epsilon (1).. (2).. div mul /cone.epsilon set
2431: cone.epsilon cone.epsilon.limit sub numerator (0).. lt {
2432: (Too small cone.epsilon ) error
2433: } { } ifelse
2434: cone.epsilon message
2435: } loop
2436: /arg1 ncone def
2437: ] pop
2438: popVariables
2439: arg1
2440: } def
2441:
2442: %<
2443: % Usages: set globals and getGrobnerFan
2444: % cf. clearGlobals
2445: % getStartingCone $B$9$k$H(B weightSpace $B$H$+$N7W;;$,$G$-$k(B. isOnWeightBorder $B$,(B
2446: % $B7h$a$i$l$k(B.
2447: %>
2448: % $B$H$j$"$($:(B (data/test8.sm1) run $B$7$F$+$i(B getGrobnerFan
2449: /getGrobnerFan {
2450: getStartingCone /cone.ncone set
2451: {
2452: cone.ncone updateFan
2453: ( ) message
2454: (----------------------------------------------------------) message
2455: (getGrobnerFan #cone.fan=) messagen cone.fan length message
2456: cone.ncone /cone.ccone set
2457: getNextFlip /cone.nextflip set
2458: cone.nextflip tag 0 eq { exit } { } ifelse
2459: cone.nextflip getNextCone /cone.ncone set
2460: } loop
1.2 takayama 2461: (Construction is completed. See cone.fan, cone.incidence and cone.gblist.)
2462: message
2463: } def
2464:
2465: %<
2466: % Usages: vlist generateD1_1
2467: % -1,1 weight $B$r@8@.$9$k(B.
2468: % vlist $B$O(B (t,x,y) $B$+(B [(t) (x) (y)]
2469: %
2470: %>
2471: /generateD1_1 {
2472: /arg1 set
2473: [/vlist /rr /rr /ii /vv] pushVariables
2474: [
2475: /vlist arg1 def
2476: vlist isString {
2477: [vlist to_records pop] /vlist set
2478: } { } ifelse
2479: [
2480: 0 1 vlist length 1 sub {
2481: /ii set
2482: vlist ii get /vv set
2483: vv -1
2484: [@@@.Dsymbol vv] cat 1
2485: } for
2486: ] /rr set
2487: /arg1 rr def
2488: ] pop
2489: popVariables
2490: arg1
2491: } def
2492:
2493: /listNodes {
2494: /arg1 set
2495: [/in-listNodes /ob /rr /rr /ii] pushVariables
2496: [
2497: /ob arg1 def
2498: /rr [ ] def
2499: {
2500: ob isClass {
2501: ob (array) dc /ob set
2502: } { exit } ifelse
2503: rr [ob 0 get] join /rr set
2504: ob 2 get /ob set
2505: 0 1 ob length 1 sub {
2506: /ii set
2507: rr ob ii get listNodes join /rr set
2508: } for
2509: exit
2510: } loop
2511: /arg1 rr def
2512: ] pop
2513: popVariables
2514: arg1
2515: } def
2516: [(listNodes)
2517: [(ob listNodes)
2518: (cf. getNode)
2519: (Example:)
2520: ( /dog [(dog) [[(legs) 4] ] [ ]] [(class) (tree)] dc def)
2521: ( /man [(man) [[(legs) 2] ] [ ]] [(class) (tree)] dc def)
2522: ( /ma [(mammal) [ ] [man dog]] [(class) (tree)] dc def)
2523: ( ma listNodes )
2524: ]] putUsages
2525:
2526: %<
2527: % Usages: obj printTree
2528: %>
2529: /printTree {
2530: /arg1 set
2531: [/ob /rr /rr /ii /keys /tt] pushVariables
2532: [
2533: /ob arg1 def
2534: /rr [ ] def
2535: /keys ob listNodes def
2536: keys 0 get /tt set
2537: keys rest /keys set
2538: keys { ob 2 1 roll getNode } map /rr set
2539: (begin ) messagen tt messagen
2540: ( ---------------------------------------) message
2541: 0 1 rr length 1 sub {
2542: /ii set
2543: keys ii get messagen (=) message
2544: rr ii get 2 get pmat
2545: } for
2546: (--------------------------------------- end ) messagen
2547: tt message
2548: /arg1 rr def
2549: ] pop
2550: popVariables
2551: arg1
2552: } def
2553:
2554: %<
2555: % Usages $B$O(B (inputForm) usages $B$r$_$h(B.
2556: %>
2557: /inputForm {
2558: /arg1 set
2559: [/ob /rr /i ] pushVariables
2560: [
2561: /ob arg1 def
2562: /rr [ ] def
2563: {
2564: ob isArray {
2565: rr [ ([) ] join /rr set
2566: 0 1 ob length 1 sub {
2567: /i set
2568: i ob length 1 sub lt {
2569: rr [ob i get inputForm $ , $] join /rr set
2570: } {
2571: rr [ob i get inputForm] join /rr set
2572: } ifelse
2573: } for
2574: rr [ (]) ] join cat /rr set
2575: exit
2576: } { } ifelse
2577: ob isClass {
2578: ob etag 263 eq { % tree
2579: /rr ob inputForm.tree def exit
2580: } { /rr [( $ this etag is not implemented $ )] cat def exit } ifelse
2581: } { } ifelse
2582: ob isUniversalNumber {
2583: [$($ ob toString $)..$] cat /rr set
2584: exit
2585: } { } ifelse
2586: ob isPolynomial {
2587: [$($ ob toString $).$] cat /rr set
2588: exit
2589: } { } ifelse
2590: ob isRational {
2591: [$ $ ob (numerator) dc inputForm $ $
2592: ob (denominator) dc inputForm $ div $ ] cat /rr set
2593: exit
2594: } { } ifelse
2595: ob isString {
2596: [$($ ob $)$ ] cat /rr set
2597: exit
2598: } { } ifelse
2599: ob toString /rr set
2600: exit
2601: } loop
2602: rr /arg1 set
2603: ] pop
2604: popVariables
2605: arg1
2606: } def
2607: [(inputForm)
2608: [(obj inputForm str)
2609: ]] putUsages
2610: % should be moved to dr.sm1
2611:
2612: /inputForm.tree {
2613: /arg1 set
2614: [/ob /key /rr /rr /ii] pushVariables
2615: [
2616: /ob arg1 def
2617: /rr [ ] def
2618: {
2619: ob (array) dc /ob set
2620: /rr [ $[$ ob 0 get inputForm $ , $
2621: ob 1 get inputForm $ , $
2622: ] def
2623: rr [ob 2 get inputForm ] join /rr set
2624: rr [$ ] $] join /rr set
2625: rr [ $ [(class) (tree)] dc $ ] join /rr set
2626: rr cat /rr set
2627: exit
2628: } loop
2629: /arg1 rr def
2630: ] pop
2631: popVariables
2632: arg1
2633: } def
2634:
2635: %<
2636: % Usages: str inputForm.value str
2637: %>
2638: /inputForm.value {
2639: /arg1 set
2640: [/key /val /valstr /rr] pushVariables
2641: [
2642: arg1 /key set
2643: key isString { } {(inputForm.value: argument must be a string) error } ifelse
2644: key boundp {
2645: [(parse) key] extension pop
2646: /val set
2647: val inputForm /valstr set
2648: [( ) valstr ( /) key ( set )] cat /rr set
2649: } {
2650: /valstr [] cat /rr set
2651: } ifelse
2652: rr /arg1 set
2653: ] pop
2654: popVariables
2655: arg1
2656: } def
2657:
2658: % global: cone.withGblist
2659: /cone.withGblist 0 def
2660: %<
2661: % Usages: saveGrobnerFan str
2662: % GrobnerFan $B$N%G!<%?$r(B inputForm $B$KJQ99$7$FJ8;zNs$KJQ$($k(B.
2663: % $B$3$N%G!<%?$r(B parse $B$9$k$H(B GrobnerFan $B$rF@$k$3$H$,2DG=(B.
2664: % BUG: $BB?9`<0$NB0$9$k4D$N%G!<%?$NJ]B8$O$^$@$7$F$J$$(B.
2665: %>
2666: /saveGrobnerFan {
2667: [/rr] pushVariables
2668: [
2669: (cone.withGblist=) messagen cone.withGblist message
2670: [
2671: % $B%f!<%6$N@_Dj$9$k%Q%i%a!<%?(B. cone.gb, cone.parametrizeWeightSpace $BEy$N4X?t$b$"$j(B.
2672: (cone.comment)
2673: (cone.type) (cone.local) (cone.h0)
2674: (cone.vlist) (cone.vv)
2675: (cone.input)
2676:
2677: % $B%W%m%0%i%`Cf$GMxMQ$9$k(B, $BBg;v$JBg0hJQ?t(B. weight vector $B$N<M1F9TNs$,=EMW(B.
2678: (cone.n) (cone.m) (cone.d)
2679: (cone.W) (cone.Wpos) (cone.Wt)
2680: (cone.L) (cone.Lp) (cone.Lpt)
2681: (cone.weightBorder)
2682: (cone.w_ineq)
2683: (cone.w_ineq_projectedWt)
2684: (cone.epsilon)
2685:
2686: % $B7k2L$NMWLs(B.
2687: (cone.fan)
2688: cone.withGblist { (cone.gblist) } { } ifelse
2689: (cone.incidence)
2690:
2691: ] { inputForm.value nl } map /rr set
1.3 takayama 2692: rr cat /rr set
2693: % ring $B$r(B save $B$7$F$J$$$N$GEv:B$NBP=h(B.
2694: [ ([) cone.vv inputForm ( ring_of_differential_operators 0 ] define_ring )
2695: nl nl rr] cat /arg1 set
1.2 takayama 2696: ] pop
2697: popVariables
2698: arg1
2699: } def
2700:
2701: /printGrobnerFan.1 {
2702: /arg1 set
2703: [/key /rr] pushVariables
2704: [
2705: /key arg1 def
2706: key boundp {
2707: [(parse) key] extension pop /rr set
2708: rr isArray {
2709: key messagen ( = ) message rr pmat
2710: } {
2711: key messagen ( = ) messagen rr message
2712: } ifelse
2713: }{
2714: key messagen ( = ) message
2715: } ifelse
2716: ] pop
2717: popVariables
2718: } def
2719:
2720: /printGrobnerFan {
2721: [/i] pushVariables
2722: [
2723: (========== Grobner Fan ====================) message
2724: [
2725: (cone.comment)
2726: (cone.vlist) (cone.vv)
2727: (cone.input)
2728: (cone.type) (cone.local) (cone.h0)
2729: (cone.n) (cone.m) (cone.d)
2730: (cone.W) (cone.Wpos) (cone.Wt)
2731: (cone.L) (cone.Lp) (cone.Lpt)
2732: (cone.weightBorder)
2733: (cone.incidence)
2734: ] { printGrobnerFan.1 } map
2735: ( ) message
2736: 0 1 cone.fan length 1 sub {
2737: /ii set
2738: ii messagen ( : ) messagen
2739: cone.fan ii get printTree
2740: } for
2741: cone.withGblist {
2742: 0 1 cone.gblist length 1 sub {
2743: /ii set
2744: ii messagen ( : ) messagen
2745: cone.gblist ii get printTree
2746: } for
2747: } { } ifelse
2748:
2749:
2750: (=========================================) message
2751: (cone.withGblist = ) messagen cone.withGblist message
2752: ( ) message
2753: ] pop
2754: popVariables
2755: } def
2756:
2757: %<
2758: % Usages: m uniq
2759: % Remove duplicated lines.
2760: %>
2761: /uniq {
2762: /arg1 set
2763: [/mm /prev /i /rr] pushVariables
2764: [
2765: /mm arg1 def
2766: {
2767: mm length 0 eq { [ ] /rr set exit } { } ifelse
2768: /prev mm 0 get def
2769: [
2770: prev
2771: 1 1 mm length 1 sub {
2772: /i set
2773: mm i get prev sub isZero { }
2774: { /prev mm i get def prev } ifelse
2775: } for
2776: ] /rr set
2777: exit
2778: } loop
2779: rr /arg1 set
2780: ] pop
2781: popVariables
2782: arg1
2783: } def
1.3 takayama 2784:
2785: %<
2786: % Usages: [vlist vw_vector] getGrRing [vlist vGlobal sublist]
2787: % example: [(x,y,z) [(x) -1 (Dx) 1 (y) 1 (Dy) 2]] getGrRing
2788: % [(x,y,z,y') [(x)] [[(Dy) (y')]]]
2789: % h[0,1](D_0) $B@lMQ$N(B getGrRing.
2790: % u_i + v_i > 0 $B$J$i(B Dx_i ==> x_i' ($B2D49$JJQ?t(B). sublist $B$X(B.
2791: % u_i < 0 $B$J$i(B x_i $B$O(B vGlobal $B$X(B.
2792: % ii [vlist vGlobal sublist] toGrRing /ii set
2793: % [ii jj vlist [(partialEcartGlobalVarX) vGlobal]] ecart.isSameIdeal $B$H;H$&(B.
2794: %>
2795: /getGrRing {
2796: /arg1 set
2797: [/vlist /vw_vector /ans /vGlobal /sublist /newvlist
2798: /dlist /tt /i /u /v /k
2799: ] pushVariables
2800: [
2801: /vlist arg1 0 get def
2802: /vw_vector arg1 1 get def
2803:
2804: vlist isString { [vlist to_records pop] /vlist set } { } ifelse
2805: vlist { toString } map /vlist set
2806: % dlist $B$O(B [(Dx) (Dy) (Dz)] $B$N%j%9%H(B.
2807: vlist { /tt set [@@@.Dsymbol tt] cat } map /dlist set
2808:
2809: /newvlist [ ] def /sublist [ ] def /vGlobal [ ] def
2810: % $B2D49$J?7$7$$JQ?t$r(B newvlist $B$X(B. $BCV49I=$r(B sublist $B$X(B.
2811: 0 1 vlist length 1 sub {
2812: /i set
2813: % (u,v) $B$O(B (x_i, Dx_i) $B$KBP$9$k(B weight vector
2814: /u vlist i get , vw_vector getGrRing.find def
2815: u -1 gt {
2816: vw_vector , u 1 add , get /u set
2817: } { /u 0 def } ifelse
2818:
2819: /v dlist i get , vw_vector getGrRing.find def
2820: v -1 gt {
2821: vw_vector , v 1 add , get /v set
2822: } { /v 0 def } ifelse
2823: u to_int32 /u set , v to_int32 /v set
2824:
2825: u v add , 0 gt {
2826: newvlist [vlist i get] join /newvlist set
2827: } { } ifelse
2828: u 0 lt {
2829: vGlobal [vlist i get] join /vGlobal set
2830: } { } ifelse
2831: } for
2832:
2833: newvlist { /tt set [ [@@@.Dsymbol tt] cat [tt (')] cat ] } map
2834: /sublist set
2835:
2836: /ans [ vlist , newvlist { /tt set [tt (')] cat } map , join from_records
2837: vGlobal sublist] def
2838: /arg1 ans def
2839: ] pop
2840: popVariables
2841: arg1
2842: } def
2843:
2844: %<
2845: % Usages: a uset getGrRing.find index
2846: %>
2847: /getGrRing.find {
2848: /arg2 set /arg1 set
2849: [/a /uset /ans /i] pushVariables
2850: [
2851: /a arg1 def /uset arg2 def
2852: /ans -1 def
2853: { /ans -1 def
2854: 0 1 , uset length 1 sub {
2855: /i set
2856: a tag , uset i get tag eq {
2857: a , uset i get eq {
2858: /ans i def exit
2859: } { } ifelse
2860: } { } ifelse
2861: } for
2862: exit
2863: } loop
2864: /arg1 ans def
2865: ] pop
2866: popVariables
2867: arg1
2868: } def
2869:
2870: %<
2871: % Usages: g1 g2 isSameGrRing bool
2872: % g1, g2 $B$O(B getGrRing $B$NLa$jCM(B.
2873: %>
2874: /isSameGrRing {
2875: /arg2 set /arg1 set
2876: [/g1 /g2 /ans] pushVariables
2877: [
2878: /g1 arg1 def /g2 arg2 def
2879: {
2880: /ans 1 def
2881: g1 0 get , g2 0 get eq { } { /ans 0 def exit } ifelse
2882: exit
2883: g1 1 get , g2 1 get eq { } { /ans 0 def exit } ifelse
2884: } loop
2885: /arg1 ans def
2886: ] pop
2887: popVariables
2888: arg1
2889: } def
2890:
2891: %<
2892: % Usages: [[ii i_vw_vector] [jj j_vw_vector] vlist] isSameInGrRing_h
1.4 takayama 2893: % It computes gb.
1.3 takayama 2894: %>
2895: /isSameInGrRing_h {
2896: /arg1 set
2897: [/ii /i_vw_vector /jj /j_vw_vector /vlist
2898: /i_gr /j_gr /rrule /ans] pushVariables
2899: [
2900: /ii arg1 [0 0] get def
2901: /i_vw_vector arg1 [0 1] get def
2902: /jj arg1 [1 0] get def
2903: /j_vw_vector arg1 [1 1] get def
2904: /vlist arg1 2 get def
2905: {
2906: [vlist i_vw_vector] getGrRing /i_gr set
2907: [vlist j_vw_vector] getGrRing /j_gr set
2908: i_gr j_gr isSameGrRing { } { /ans [0 [i_gr j_gr]] def exit} ifelse
2909:
2910: % bug: in case of module
2911: [i_gr 0 get , ring_of_differential_operators 0] define_ring
2912:
2913: % H $B$r(B 1 $B$K(B.
2914: /rrule [ [@@@.Hsymbol . (1).] ] def
2915:
2916: i_gr 2 get length 0 eq {
2917: } {
2918: rrule i_gr 2 get { { . } map } map join /rrule set
2919: } ifelse
2920: ii { toString . rrule replace toString } map /ii set
2921: jj { toString . rrule replace toString } map /jj set
2922:
2923: [ii jj i_gr 0 get , i_gr 1 get] ecartd.isSameIdeal_h /ans set
2924: [ans [i_gr] rrule ecartd.isSameIdeal_h.failed] /ans set
2925:
2926: exit
2927: } loop
2928: /arg1 ans def
2929: ] pop
2930: popVariables
2931: arg1
2932: } def
2933:
2934: /test1.isSameInGrRing_h {
2935: [(parse) (data/test8-data.sm1) pushfile] extension
2936:
2937: cone.gblist 0 get (initial) getNode 2 get /ii set
2938: cone.gblist 0 get (weight) getNode [2 0 2] get /iiw set
2939:
2940: cone.gblist 1 get (initial) getNode 2 get /jj set
2941: cone.gblist 1 get (weight) getNode [2 0 2] get /jjw set
2942:
2943: (Doing [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ff set) message
2944: [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ff set
2945:
2946: ff pmat
2947:
2948: } def
2949:
2950:
2951: %<
1.4 takayama 2952: % Usages: i j isSameCone_h.0 [bool, ...]
2953: % $B%F%9%HJ}K!(B. (data/test8.sm1) run (data/test8-data.sm1) run 0 1 isSameCone_h.0
2954: % gb $B$r:FEY7W;;$9$k(B stand alone $BHG(B. gr(Local ring) $B$GHf3S(B.
1.3 takayama 2955: %>
1.4 takayama 2956: /isSameCone_h.0 {
1.3 takayama 2957: /arg2 set /arg1 set
2958: [/i /j /ans /ii /iiw /jj /jjw] pushVariables
2959: [
2960: /i arg1 def /j arg2 def
1.4 takayama 2961: i to_int32 /i set , j to_int32 /j set
1.3 takayama 2962: cone.debug { (Comparing ) messagen [i j] message } { } ifelse
2963:
2964: cone.gblist i get (initial) getNode 2 get /ii set
2965: cone.gblist i get (weight) getNode [2 0 2] get /iiw set
2966:
2967: cone.gblist j get (initial) getNode 2 get /jj set
2968: cone.gblist j get (weight) getNode [2 0 2] get /jjw set
2969:
2970: [ [ii iiw] [jj jjw] cone.vv ] isSameInGrRing_h /ans set
2971:
2972: ans /arg1 set
2973: ] pop
2974: popVariables
2975: arg1
2976: } def
2977:
1.4 takayama 2978: %<
2979: % Usages: [ii vv i_vw_vector] getGbInGrRing_h [ii_gr i_gr]
2980: % Get Grobner Basis of ii in the graded ring.
2981: % The graded ring is obtained automatically from vv and i_vw_vector.
2982: % ii_gr is the Grobner basis. i_gr is the output of getGrRing.
2983: % cf. isSameInGrRing_h, ecart.isSameIdeal_h with [(noRecomputation) 1]
2984: %>
2985: /getGbInGrRing_h {
2986: /arg1 set
2987: [/ii /i_vw_vector /vlist /rng /vv /vvGlobal /wv /iigg
2988: /i_gr /rrule /ans] pushVariables
2989: [
2990: /ii arg1 0 get def
2991: /vlist arg1 1 get def
2992: /i_vw_vector arg1 2 get def
2993: [vlist i_vw_vector] getGrRing /i_gr set
2994:
2995: % bug: in case of module
2996: [i_gr 0 get , ring_of_differential_operators 0] define_ring
2997:
2998: % H $B$r(B 1 $B$K(B.
2999: /rrule [ [@@@.Hsymbol . (1).] ] def
3000:
3001: i_gr 2 get length 0 eq {
3002: } {
3003: rrule i_gr 2 get { { . } map } map join /rrule set
3004: } ifelse
3005: /vvGlobal i_gr 1 get def
3006: /vv i_gr 0 get def
3007:
3008: ii { toString . rrule replace toString } map /ii set
3009:
3010: [vv vvGlobal] ecart.stdBlockOrder /wv set
3011: vvGlobal length 0 eq {
3012: /rng [vv wv ] def
3013: }{
3014: /rng [vv wv [(partialEcartGlobalVarX) vvGlobal]] def
3015: } ifelse
3016: /save-cone.autoHomogenize ecart.autoHomogenize def
3017: /ecart.autoHomogenize 0 def
3018: [ii] rng join ecartd.gb /iigg set
3019: save-cone.autoHomogenize /ecart.autoHomogenize set
3020: /ans [iigg 0 get i_gr] def
3021: /arg1 ans def
3022: ] pop
3023: popVariables
3024: arg1
3025: } def
3026:
3027: /test1.getGbInGrRing_h {
3028: [(parse) (data/test8-data.sm1) pushfile] extension
3029:
3030: cone.gblist 0 get (initial) getNode 2 get /ii set
3031: cone.gblist 0 get (weight) getNode [2 0 2] get /iiw set
3032: [ii cone.vv iiw] getGbInGrRing_h /ff1 set
3033:
3034: cone.gblist 1 get (initial) getNode 2 get /jj set
3035: cone.gblist 1 get (weight) getNode [2 0 2] get /jjw set
3036: [jj cone.vv jjw] getGbInGrRing_h /ff2 set
3037:
3038: (ff1 and ff2) message
3039:
3040: } def
3041:
3042:
3043: %<
3044: % setGrGblist
3045: % cone.grGblist $B$r@_Dj$9$k(B.
3046: %>
3047: /setGrGblist {
3048: [/ii /ww /gg] pushVariables
3049: [
3050: cone.gblist {
3051: /gg set
3052: gg (initial) getNode 2 get /ii set
3053: gg (weight) getNode [2 0 2] get /ww set
3054: [ii cone.vv ww] getGbInGrRing_h
3055: } map /cone.grGblist set
3056: ] pop
3057: popVariables
3058: } def
3059:
3060: %<
3061: % Usages: i j isSameCone_h.2 [bool, ...]
3062: % gb $B$r:FEY7W;;$7$J$$(B.
3063: %>
3064: /isSameCone_h.2 {
3065: /arg2 set /arg1 set
3066: [/i /j /ans /ii /iiw /jj /jjw] pushVariables
3067: [
3068: /i arg1 def /j arg2 def
3069: i to_int32 /i set , j to_int32 /j set
3070: (cone.grGblist) boundp { } { setGrGblist } ifelse
3071: cone.debug { (Comparing ) messagen [i j] message } { } ifelse
3072:
3073: cone.grGblist i get /ii set
3074: cone.grGblist j get /jj set
3075:
3076: ii 1 get , jj 1 get isSameGrRing { }
3077: { /ans [0 [ii 1 get jj 1 get]] def exit} ifelse
3078:
3079: [ii 0 get , jj 0 get cone.vv [[(noRecomputation) 1]] ]
3080: ecartd.isSameIdeal_h /ans set
3081: [ans [ii 1 get] ii 1 get , ecartd.isSameIdeal_h.failed] /ans set
3082:
3083: ans /arg1 set
3084: ] pop
3085: popVariables
3086: arg1
3087: } def
3088:
3089: %<
3090: % test1.isSameCone_h.2 $B$O(B cone.grGblist $B$K(B initial $B$N(B gb $B$r(B graded ring
3091: % $B$G$^$:7W;;$7(B, $B$=$l$+$i(B ideal $B$NHf3S$r$*$3$J$&(B. isSameCone_h.1 $B$KHf$Y$F(B
3092: % gb $B$N:FEY$N7W;;$,$J$$$N$G7P:QE*(B.
3093: %>
3094: /test1.isSameCone_h.2 {
3095: /cone.loaded boundp { }
3096: {
3097: [(parse) (cohom.sm1) pushfile] extension
3098: [(parse) (dhecart.sm1) pushfile] extension
3099: /cone.loaded 1 def
3100: } ifelse
3101: %[(parse) (cone.sm1) pushfile] extension
3102: [(parse) (data/test8-data.sm1) pushfile] extension
3103: setGrGblist
3104: (cone.grGblist is set.) message
3105: 0 1 isSameCone_h.2 pmat
3106: } def
3107:
3108: %<
3109: % dhcone $B$O(B DeHomogenized Cone $B$NN,(B. H->1 $B$H$7$F(B cone $B$r(B merge $B$7$F$$$/4X?t(B
3110: % $B$dBg0hJQ?t$K;H$&(B.
3111: % cone.gblist, cone.fan $B$,@5$7$/@_Dj$5$l$F$$$k$3$H(B.
3112: % (setGrGblist $B$r<B9T:Q$G$"$k$3$H(B. $B<+F0<B9T$5$l$k$,(B... )
3113: %
3114: %>
3115:
3116: /isSameCone_h { isSameCone_h.2 } def
3117:
3118: %<
3119: % Usages: genDhcone.init
3120: % dhcone.checked (dehomogenized $B:Q$N(B cone$BHV9f(B), dhcone.unchecked $B$N=i4|2=(B.
3121: %>
3122: /genDhcone.init {
3123: /dhcone.checked [ ] def
3124: /dhcone.unchecked [
3125: 0 1 cone.fan length 1 sub {
3126: to_univNum
3127: } for
3128: ] def
3129: } def
3130:
3131: %<
3132: % Usages: k genDhcone dhcone
3133: % cone.fan[k] $B$r=PH/E@$H$7$F(B cone $B$r(B dehomogenize $B$9$k(B (merge $B$9$k(B).
3134: %
3135: % $B%F%9%H(B1. (data/test14.sm1) run (data/test14-data.sm1) run
3136: % genDhcone.init
3137: % 0 genDhcone /ff set
3138: %>
3139:
3140: /genDhcone {
3141: /arg1 set
3142: [/k /facets /merged /nextcid /nextfid /coneid
3143: /newfacets /newmerged /newnextcid /newnextfid /newconeid /vv
3144: /i /j /p /q /rr /cones /differentC
3145: ] pushVariables
3146: [
3147: /k arg1 def
3148: /facets [ ] def /merged [ ] def /nextcid [ ] def
3149: /nextfid [ ] def /coneid [ ] def
3150: /cones [ ] def
3151: /differentC [ ] def
3152:
3153: k to_univNum /k set
3154:
3155: {
3156: % Step1. cone.fan[k] $B$r(B $B2C$($k(B. new... $B$X=i4|%G!<%?$r=q$-9~$`(B.
3157: cone.debug {(Step 1. Adding ) messagen k messagen (-th cone.) message} { } ifelse
3158: cones [k to_univNum] join /cones set
3159: cone.fan k get , (facets) getNode 2 get /vv set
3160: /newfacets [ ] vv join def
3161:
3162: cone.fan k get , (nextcid) getNode 2 get /vv set
3163: /newnextcid [ ] vv join def
3164:
3165: cone.fan k get , (nextfid) getNode 2 get /vv set
3166: /newnextfid [ ] vv join def
3167:
3168: % newmerged $B$O$^$:(B 0 $B$G$&$a$k(B. 0 : $B$^$@D4$Y$F$J$$(B.
3169: % 1 : merged $B$G>C$($?(B. 2 : boundary. 3 : $B$H$J$j$O0[$J$k(B.
3170: % [ ] join $B$r$d$C$F(B $B%Y%/%H%k$N(B clone $B$r:n$k(B.
3171: cone.fan k get , (flipped) getNode 2 get /vv set
3172: /newmerged [ ] vv join def
3173: 0 1 , newmerged length 1 sub {
3174: /i set
3175: newmerged i get , (2).. eq { }
3176: { newmerged i (0).. put } ifelse
3177: } for
3178: % newconeid $B$O(B k $B$G$&$a$k(B.
3179: /newconeid newfacets length newVector { pop k to_univNum } map def
3180:
3181: % merged $B$H(B newmerged $B$r(B cone $B$NNY@\4X78$N$_$G99?7$9$k(B.
3182: % $BF1$8(B init $B$r;}$D$3$H$O$o$+$C$F$$$k$N$G(B facet vector $B$N$_$N(B check $B$G==J,(B.
3183: % merged $B$N(B i $BHVL\(B $B$H(B newmerged $B$N(B j $BHVL\$GHf3S(B.
3184: 0 1 , merged length 1 sub {
3185: /i set
3186: 0 1 , newmerged length 1 sub {
3187: /j set
3188: merged i get , (0).. eq ,
3189: newmerged j get , (0).. eq , and
3190: nextcid i get , k to_univNum eq , and
3191: {
3192: facets i get , newfacets j get , add isZero {
3193: % merged[i], newmerged[j] $B$K(B 1 $B$rF~$l$F>C$9(B.
3194: % $B>e$NH=Dj$O(B nextfid, newnextfid $B$rMQ$$$F$b$h$$$N$G$O(B?
3195: merged i (1).. put
3196: newmerged j (1).. put
3197: } { } ifelse
3198: } { } ifelse
3199: } for
3200: } for
3201:
3202: % Step2. $B7k9g$7$F$+$i(B, $B$^$@D4$Y$F$J$$(B facet $B$rC5$9(B.
3203: cone.debug { (Step 2. Joining *** and new***) message } { } ifelse
3204: /facets facets newfacets join def
3205: /merged merged newmerged join def
3206: /nextcid nextcid newnextcid join def
3207: /nextfid nextfid newnextfid join
3208: /coneid coneid newconeid join def
3209:
3210: cone.debug{ ( Checking facets.) message } { } ifelse
3211: /k null def
3212: 0 1 , merged length 1 sub {
3213: /i set
3214: % i message
3215: merged i get (0).. eq {
3216: % i $BHVL\$r$^$@D4$Y$F$$$J$$(B.
3217: coneid i get , /p set
3218: nextcid i get , /q set
3219: cone.debug { [p q] message } { } ifelse
3220: q (0).. ge {
3221: % cone.fan [p] $B$H(B cone.fan [q] $B$N(B initial $B$rHf3S$9$k(B.
3222: % $BF1$8$J$i(B k $B$r@_Dj(B. exit for. $B0c$($P(B merged[i] = 3 ($B0c$&(B) $B$rBeF~(B.
3223: % differentC $B$O$9$G$K(B $B8=:_$N(B dhcone $B$H0c$&$H(B check $B$5$l$?(B cone $BHV9f(B.
3224: % dhcone.checked $B$O(B dhcone $B$,$9$G$K@8@.$5$l$F$$$k(B cone $BHV9f$N%j%9%H(B.
3225: % $B$3$l$K$O$$$C$F$$$F$b0c$&(B.
3226: q differentC memberQ , q dhcone.checked memberQ , or
3227: { /rr [0 ] def }
3228: { p q isSameCone_h /rr set } ifelse
3229:
3230: rr 0 get 1 eq {
3231: cone.debug { (Found next cone. ) message } { } ifelse
3232: /k q to_univNum def exit
3233: } {
3234: cone.debug { ( It is a different cone. ) message } { } ifelse
3235: differentC [ q ] join /differentC set
3236: merged i (3).. put
3237: } ifelse
3238: } { } ifelse
3239: } { } ifelse
3240: } for
3241:
3242: k tag 0 eq { exit } { } ifelse
3243: } loop
3244:
3245: [(-1)..] cones join shell rest /cones set
3246: % dhcone.checked, dhcone.unchecked $B$r99?7(B.
3247: dhcone.checked cones join /dhcone.checked set
3248: dhcone.unchecked cones setMinus /dhcone.unchecked set
3249:
3250: [(dhcone) [ ]
3251: [
3252: [(cones) [ ] cones] arrayToTree
3253: [(facets) [ ] facets] arrayToTree
3254: [(merged) [ ] merged] arrayToTree
1.5 takayama 3255: [(nextcid) [ ] nextcid] arrayToTree
3256: [(nextfid) [ ] nextfid] arrayToTree
3257: [(coneid) [ ] coneid] arrayToTree
1.4 takayama 3258: ]
3259: ] arrayToTree /arg1 set
3260: ] pop
3261: popVariables
3262: arg1
3263: } def
3264:
3265:
3266: %<
3267: % Usages: dhCones_h
3268: % cone.fan $B$O(B doubly homogenized (local) $B$G@8@.$5$l$?(B Grobner fan.
3269: % cone.fan $B$r(B dehomogenize (H->1) $B$7$F(B init $B$rHf$Y$F(B dhcone.fan $B$r@8@.$9$k(B.
3270: %
3271: % $B%F%9%H(B1. (data/test14.sm1) run (data/test14-data.sm1) run
3272: % dhCones_h
3273: % test22
3274: %>
3275: /dhCones_h {
3276: (cone.grGblist) boundp { } {setGrGblist} ifelse
3277: genDhcone.init
3278: /dhcone.fan [ ] def
3279: {
3280: (-----------------------------------------) message
3281: (#dhcone.unchecked = ) messagen dhcone.unchecked length message
3282: dhcone.unchecked length 0 eq { exit } { } ifelse
3283: dhcone.fan
3284: [ dhcone.unchecked 0 get , genDhcone ] join /dhcone.fan set
3285: (#dhcone.fan = ) messagen dhcone.fan length message
3286: } loop
3287: dhcone.fan
3288: } def
3289:
1.5 takayama 3290: %<
3291: % Usages: dhcone.rtable
3292: % dhcone $B$NHV9f$H(B cone $B$NHV9f$N(B $BCV49I=$r@8@.$7(B dhcone2.fan (merge $B$7$?(B cone $B$N>pJs(B)
3293: % $B$r(B dhcone.fan $B$+$i:n$k(B. dhcone2.gblist $B$b:n$kJd=u4X?t(B.
3294: % dhCones_h $B$7$F$+$i(B dhcone.rable $B$9$k(B.
3295: %>
3296: /dhcone.rtable {
3297: [/i /j /vv /cones /facets /facets2 /merged /nextcid /nextcid2 /ii /ww] pushVariables
3298: [
3299: % $BCV49I=(B dhcone.h2dh $B$r:n$k(B.
3300: /dhcone.h2dh cone.fan length newVector.with-1 def
3301: 0 1 , dhcone.fan length 1 sub {
3302: /i set
3303: dhcone.fan i get , (cones) getNode 2 get /vv set
3304: 0 1 vv length 1 sub {
3305: /j set
3306: dhcone.h2dh , vv j get , i to_univNum , put
3307: } for
3308: } for
3309: % merge $B$7$?(B dhcone $B$r@0M}$7$?$b$N(B, dhcone2.fan $B$r:n$k(B.
3310: /dhcone2.fan dhcone.fan length newVector def
3311: 0 1 , dhcone.fan length 1 sub {
3312: /i set
3313: dhcone.fan i get (facets) getNode 2 get /facets set
3314: dhcone.fan i get (merged) getNode 2 get /merged set
3315: dhcone.fan i get (nextcid) getNode 2 get /nextcid set
3316: dhcone.fan i get (cones) getNode 2 get /cones set
3317: /facets2 [ ] def
3318: /nextcid2 [ ] def
3319: 0 1 , facets length 1 sub {
3320: /j set
3321: merged j get , (3).. eq {
3322: facets2 [ facets j get ] join /facets2 set
3323: % $B$H$J$j$N(B cone $B$,$"$k$H$-(B $BJQ49I=$K$7$?$,$$(B, cone $BHV9f$rJQ49(B
3324: nextcid2 [ dhcone.h2dh , nextcid j get , get ] join /nextcid2 set
3325: } { } ifelse
3326: merged j get , (2).. eq {
3327: facets2 [ facets j get ] join /facets2 set
3328: % $B6-3&$N$H$-(B -2 $B$rF~$l$k(B.
3329: nextcid2 [ (-2).. ] join /nextcid2 set
3330: } { } ifelse
3331: } for
3332:
3333: dhcone2.fan i ,
3334: [(dhcone) [ ]
3335: [
3336: [(facets) [ ] facets2] arrayToTree
3337: [(nextcid) [ ] nextcid2] arrayToTree
3338: [(cones) [ ] cones] arrayToTree
3339: ]
3340: ] arrayToTree , put
3341:
3342: } for
3343:
3344: % $B:G8e$K(B dhcone2.gblist $B$r:n$k(B.
3345: /dhcone2.gblist , dhcone2.fan length newVector , def
3346: 0 1 , dhcone2.fan length 1 sub {
3347: /i set
3348: dhcone2.fan i get (cones) getNode 2 get /cones set
3349: cone.grGblist , cones 0 get , get , /ii set % GB of initial (H->1).
3350: cone.gblist i get , (weight) getNode , [ 2 0 2 ] get /ww set
3351:
3352: dhcone2.gblist i,
3353: [(gbasis) [ ]
3354: [
3355: [(initial) [ ] ii] arrayToTree
3356: [(weight) [ ] ww] arrayToTree
3357: ]
3358: ] arrayToTree , put
3359:
3360: } for
3361: (dhcone2.fan, dhcone2.gblist, dhcone.h2dh are set.) message
3362:
3363: ] pop
3364: popVariables
3365: } def
3366:
3367: %<
3368: % $BI=$N8+J}$N2r@b$r0u:~$9$k4X?t(B.
3369: % Usages: dhcone.explain
3370: %>
3371: /dhcone.explain {
3372: [
3373: ( ) nl
3374: (Data format in << dhcone2.fan >>, which is a dehomogenized Grobner fan.) nl nl
3375: (<< cone.vlist >> is the list of the variables.) nl
3376: @@@.Hsymbol ( is the homogenization variable to be dehomogenized.) nl nl
3377: (<< cone.input >> is generators of a given ideal.) nl nl
3378: (<< cone.d >> is the dimension of parametrization space of the weights P_w) nl
3379: ( P_w is a cone in R^m where the number m is stored in << cone.m >>) nl
3380: ( P_w --- W ---> R^n [weight space]. ) nl
3381: ( W is stored in << cone.W >> ) nl
3382: ( << u cone.W mul >> gives the weight vector standing for u) nl nl
3383: (All cones in the data lie in the weight parametrization space P_w.) nl
3384: ( "facets" are the inner normal vector of the cone. ) nl
3385: ( "nextcid" is a list of the cone id's of the adjacent cones.) nl
3386: ( -2 in "nextcid" means that this facet lies on the border of the weight space.) nl
3387: ( "cones" is a list of the cone id's of the NON-dehomonized Grobner fan) nl
3388: ( stored in << cone.fan >>) nl
3389: ] cat
3390: } def
3391:
3392: %<
3393: % dhcone.printGrobnerFan
3394: % dhcone $B$N0u:~4X?t(B
3395: %>
3396: /dhcone.printGrobnerFan {
3397: [/i] pushVariables
3398: [
3399: (========== Grobner Fan (for dehomogenized cones) ============) message
3400: [
3401: (cone.comment)
3402: (cone.vlist) (cone.vv)
3403: (cone.input)
3404: (cone.type) (cone.local) (cone.h0)
3405: (cone.n) (cone.m) (cone.d)
3406: (cone.W) (cone.Wpos) (cone.Wt)
3407: (cone.L) (cone.Lp) (cone.Lpt)
3408: (cone.weightBorder)
3409: (cone.incidence)
3410: ] { printGrobnerFan.1 } map
3411: ( ) message
3412: (The number of cones = ) messagen dhcone.fan length message
3413: ( ) message
3414: 0 1 dhcone2.fan length 1 sub {
3415: /ii set
3416: ii messagen ( : ) messagen
3417: dhcone2.fan ii get printTree
3418: } for
3419: 1 {
3420: 0 1 dhcone2.gblist length 1 sub {
3421: /ii set
3422: ii messagen ( : ) messagen
3423: dhcone2.gblist ii get printTree
3424: } for
3425: } { } ifelse
3426:
3427:
3428: (=========================================) message
3429: %(cone.withGblist = ) messagen cone.withGblist message
3430: dhcone.explain message
3431: ( ) message
3432: ] pop
3433: popVariables
3434: } def
3435:
3436: %
3437: % $B;n$7J}(B test14, 22, 25
3438: %
3439: % (data/test14.sm1) run (data/test14-data.sm1) run
3440: % printGrobnerFan ; % H $BIU$-$G0u:~(B.
3441: % dhCones_h ; % dehomogenize Cones.
3442: % dhcone.rtable ; % dhcone2.fan $BEy$r@8@.(B.
3443: % dhcone.printGrobnerFan ; % $B0u:~(B.
3444: % $B0u:~$7$?$b$N$O(B test*-print.txt $B$X3JG<$7$F$"$k(B.
3445: %
3446:
3447: % Todo: save functions.
1.9 takayama 3448:
3449: %<
3450: % Collart, Kalkbrener, Mall $B$N%"%k%4%j%:%`$K$h$k(B gb $B$N(B flip.
3451: % See also Sturmfels' book, p.22, 23.
3452: % Usages: [reducedGb, vlist, oldWeight, facetWeight, newWeight] ckmFlip rGb
3453: % If it fails, then it returns null, else it returns the reducedGb for the
3454: % newWeight.
3455: % gb $B$N(B check $B$r$d$k$N$G(B, $B$=$l$K<:GT$7$?$i(B null $B$rLa$9(B.
3456: % 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
3457: % reducedGb $B$OJ8;zNs$N%j%9%H$G$O$J$/B?9`<0$N7A<0$N$3$H(B.
1.11 ! takayama 3458: % $BM}M3$O(B reducedGb $B$h$j(B ring $B$N9=B$$rFI$`$?$a(B.
1.9 takayama 3459: %>
3460: /ckmFlip {
3461: /arg1 set
3462: [/arg_ckmFlip /gOld /vlist /oldWeight /facetWeight /newWeight
3463: /gNew
3464: /ww /ww1 /ww2 % $BK\$NCf$N(B w1, w, w2 ($B8E$$(B, facet, $B?7$7$$(B)
3465: /ch1 /ch2 % $BK\$NCf$N(B {\cal H}_1, {\cal H}_2
3466: /grData /rTable
3467: /rTable2 % rTable $B$NH?BP$NJQ49(B.
3468: /facetWeight_gr /vlist_gr % graded ring $BMQ(B.
3469: /oldWeight_gr
3470: /ccf % reduction $B$7$?78?t(B.
3471: /rwork /ccf2 /gNew
3472: ] pushVariables
3473: [
3474: arg1 /arg_ckmFlip set
3475: arg_ckmFlip 0 get /gOld set
3476: arg_ckmFlip 1 get /vlist set
3477: arg_ckmFlip 2 get /oldWeight set
3478: arg_ckmFlip 3 get /facetWeight set
3479: arg_ckmFlip 4 get /newWeight set
3480:
3481: % facet weight vector ww $B$K$D$$$F$N(B initial $B$r<h$j=P$9(B. ch1 $B$X$$$l$k(B.
3482: gOld getRing ring_def
3483: facetWeight weightv /ww set
3484: gOld { ww init } map /ch1 set % facetWeight $B$K$h$k(B initial $B$N<h$j=P$7(B.
3485:
3486:
3487: % $BNc(B: [(x,y) [(x) -1 (Dx) 1 (y) -1 (Dy) 2]] getGrRing
3488: % [$x,y,y',$ , [ $x$ , $y$ ] , [ [ $Dy$ , $y'$ ] ] ]
3489: % $BJQ?t%j%9%H(B $BCV49I=(B
3490: % ch1 $B$r(B gr_ww $B$N85$KJQ49(B.
3491: [vlist facetWeight] getGrRing /grData set
3492: [grData 0 get ring_of_differential_operators 0] define_ring /rwork set
3493: grData 2 get { { . } map } map /rTable set
3494: rTable { reverse } map /rTable2 set
3495: grData 0 get /vlist_gr set
3496: ch1 { toString . rTable replace toString } map /ch1 set
3497:
3498: oldWeight { dup isString { . rTable replace toString }
3499: { } ifelse } map /oldWeight_gr set
3500:
3501: % facetWeight $B$b(B $B?7$7$$4D(B gr_ww $B$N(B weight $B$KJQ49(B.
3502: % $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2]
3503: facetWeight { dup isString { . rTable replace toString }
3504: { } ifelse } map /facetWeight_gr set
1.11 ! takayama 3505:
! 3506: % newWeight $B$b(B $B?7$7$$4D(B gr_ww $B$N(B weight $B$KJQ49(B.
! 3507: % $BNc(B. [(x) -1 (Dx) 1 (y) -1 (Dy) 2] ==> [(x) -1 (Dx) 1 (y) -1 (y') 2]
! 3508: newWeight { dup isString { . rTable replace toString }
! 3509: { } ifelse } map /newWeight_gr set
! 3510:
1.9 takayama 3511: % Dx x = x Dx + h H or Dx x = x Dx + h^2 $B$G7W;;(B.
3512: % $B$I$A$i$r$H$k$+$O(B cone.gb_gr $B$G6hJL$9$k$7$+$J$7(B
3513: %% [ch1 vlist_gr oldWeight_gr] /ttt set
3514: %% ttt cone.gb_gr /ch1 set %$B:FEY$N7W;;$OITMW(B.
3515: [[(1)] vlist_gr oldWeight_gr] cone.gb_gr getRing ring_def % Set Ring.
3516: ch1 {toString .} map /ch1 set
3517: %% $B$3$3$^$G$G$H$j$"$($:%F%9%H$r$7$h$&(B.
3518: %% ch1 /arg1 set
3519: [ch1 { toString } map vlist_gr newWeight_gr] cone.gb_gr /ch2 set
3520:
3521: % Dx x = x Dx + h H or Dx x = x Dx + h^2 $B$G7W;;(B.
3522: % $B$I$A$i$r$H$k$+$O(B cone.reduction_gr $B$G6hJL$9$k$7$+$J$7(B
3523: ch1 getRing ring_def ;
3524: ch2 {toString .} map {ch1 cone.reduction} map /ccf set
3525: %ccf pmat
3526: % $B$H$j$"$($:%F%9%H(B.
3527: % [ch1 ch2] /arg1 set
3528: %% ccf[i][0] $B$O(B 0 $B$G$J$$$HL7=b(B. check $B$^$@$7$F$J$$(B.
3529:
3530: %% ccf[i][2] (syzygy) $B$r(B gr $B$+$i(B $B$b$H$N(B ring $B$XLa$7(B,
3531: %% $B?7$7$$(B reduced gbasis $B$r(B ccf[i][2] * gOld $B$G:n$k(B.
3532: rwork ring_def
3533: ccf { 2 get {toString . rTable2 replace toString} map } map /ccf2 set
3534: %% ccf2 $B$O(B gr $B$G$J$$(B ring $B$N85(B.
3535: gOld getRing ring_def
1.10 takayama 3536: cone.DhH { cone.begin_DhH } { } ifelse % Hh $B$+(B h^2 $B$+(B.
1.9 takayama 3537: ccf2 { {.} map gOld mul } map /gNew set
3538: gNew { toString } map /gNew set
1.10 takayama 3539: cone.DhH { cone.end_DhH } { } ifelse % Hh $B$+(B h^2 $B$+(B.
1.9 takayama 3540: % gNew /arg1 set
3541: %gNew $B$,(B newWeight $B$G$N(B GB $B$+(B check. Yes $B$J$i(B reduced basis $B$X(B.
3542: %No $B$J$i(B null $B$rLa$9(B.
1.10 takayama 3543: %%Ref: note @s/2005/06/30-note-gfan.pdf
1.9 takayama 3544: gNew [(gbCheck) 1] setAttributeList newWeight
3545: cone.gb (gb) getAttribute
3546: 1 eq {
3547: gNew [(reduceOnly) 1] setAttributeList newWeight cone.gb /arg1 set
3548: }{ /arg1 null def } ifelse
3549: ] pop
3550: popVariables
3551: arg1
3552: } def
3553:
3554: %<
3555: % Usages: f gbasis cone.reduction_DhH
1.10 takayama 3556: % dx x = x dx + h H $B$G$N(B reduction.
1.9 takayama 3557: %>
3558: /cone.reduction_DhH {
3559: /arg2 set /arg1 set
3560: [/ff /ggbasis /eenv /ans] pushVariables
3561: [
3562: /ff arg1 def /ggbasis arg2 def
1.10 takayama 3563: cone.begin_DhH
3564: ff ggbasis reduction /ans set
3565: cone.end_DhH
3566: /arg1 ans def
3567: ] pop
3568: popVariables
3569: arg1
3570: } def
3571:
3572: %<
3573: % Usages: f gbasis cone.reduction_Dh
3574: % dx x = x dx + h^2 $B$G$N(B reduction.
3575: %>
3576: /cone.reduction_Dh {
3577: /arg2 set /arg1 set
3578: [/ff /ggbasis /eenv /ans] pushVariables
3579: [
3580: /ff arg1 def /ggbasis arg2 def
1.9 takayama 3581: ff ggbasis reduction /ans set
3582: /arg1 ans def
3583: ] pop
3584: popVariables
3585: arg1
3586: } def
3587:
1.10 takayama 3588: %<
3589: % Usages: cone.begin_DhH dx x = x dx + h H $B$r3+;O(B.
3590: %>
1.9 takayama 3591: /cone.begin_DhH {
3592: [(Homogenize) (AutoReduce) (KanGBmessage)] pushEnv /cone.eenv set
3593: [(Homogenize) 3] system_variable
3594: } def
3595:
1.10 takayama 3596: %<
3597: % Usages: cone.begin_DhH dx x = x dx + h H $B$r=*N;(B.
3598: %>
1.9 takayama 3599: /cone.end_DhH {
3600: cone.eenv popEnv
3601: } def
3602:
1.10 takayama 3603: %<
3604: % Usages: ff vv ww cone.gb_gr_DhH dx x = x dx + h H $B$G7W;;(B.
3605: % dh.gb $B$O(B dhecart.sm1 $B$GDj5A$5$l$F$*$j(B, dx x = x dx + h H $B$G$N7W;;(B.
3606: % 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.
3607: % bug? cone.gb $B$G==J,(B?
3608: %>
3609: /cone.gb_gr_DhH {
3610: /arg1 set
3611: [/ff /ww /vv] pushVariables
3612: [
3613: /ff arg1 0 get def
3614: /vv arg1 1 get def
3615: /ww arg1 2 get def
3616: /dh.gb.verbose 1 def
3617: /dh.autoHomogenize 0 def
3618: [(AutoReduce) 1] system_variable
3619: [ff { toString } map vv
3620: [ww vv generateD1_1]] dh.gb 0 get /arg1 set
3621: ] pop
3622: popVariables
3623: arg1
3624: } def
3625: %<
3626: % Usages: ff vv ww cone.gb_gr_Dh dx x = x dx + h^2 $B$G7W;;(B.
3627: % gb $B$O(B dhecart.sm1 $B$GDj5A$5$l$F$*$j(B, dx x = x dx + h^2 $B$G$N7W;;(B.
3628: % 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.
3629: % bug? cone.gb $B$G==J,(B?
3630: %>
3631: /cone.gb_gr_Dh {
3632: /arg1 set
1.11 ! takayama 3633: [/ff /ww /vv /gg /envtmp] pushVariables
1.10 takayama 3634: [
3635: /ff arg1 0 get def
3636: /vv arg1 1 get def
3637: /ww arg1 2 get def
1.11 ! takayama 3638:
! 3639: [(AutoReduce) (KanGBmessage)] pushEnv /envtmp set
1.10 takayama 3640: [(AutoReduce) 1] system_variable
1.11 ! takayama 3641: [(KanGBmessage) 1] system_variable
! 3642: [vv ring_of_differential_operators
! 3643: [ww] weight_vector 0] define_ring
! 3644: [ff {toString .} map] ff getAttributeList setAttributeList
! 3645: groebner 0 get /gg set
! 3646: envtmp popEnv
! 3647:
! 3648: /arg1 gg def
1.10 takayama 3649: ] pop
3650: popVariables
3651: arg1
3652: } def
3653:
3654:
3655: % $B$3$l$i$O(B cone.ckmFlip 1 $B$N;~$7$+;H$o$:(B.
3656: /cone.reduction {
3657: cone.DhH {
3658: cone.reduction_DhH
3659: }{
3660: cone.reduction_Dh
3661: } ifelse
3662: } def
3663: /cone.gb_gr {
3664: cone.DhH {
3665: cone.gb_gr_DhH
3666: }{
3667: cone.gb_gr_Dh
3668: } ifelse
3669: } def
3670:
3671:
1.9 takayama 3672: /test1.ckmFlip {
3673: % cf. cone.sample2
3674: cone.load.cohom
3675: /cone.comment [
3676: (BS for y and y-(x-1)^2, t1, t2 space, in doubly homogenized Weyl algebra.) nl
3677: (The Grobner cones are dehomogenized to get local Grobner fan.) nl
3678: ] cat def
3679: /cone.vlist [(t1) (t2) (x) (y) (Dt1) (Dt2) (Dx) (Dy) (h) (H)] def
3680: /cone.vv (t1,t2,x,y) def
3681: /cone.type 1 def
3682: /cone.parametrizeWeightSpace {
3683: 4 2 parametrizeSmallFan
3684: } def
1.10 takayama 3685:
3686: /cone.DhH 1 def
3687: /cone.ckmFlip 1 def
3688:
1.9 takayama 3689: /cone.local 1 def
3690: /cone.w_start null def
3691: /cone.h0 1 def
3692: /cone.input
3693: [
3694: (t1-y) (t2 - (y-(x-1)^2))
3695: ((-2 x + 2)*Dt2+Dx)
3696: (Dt1+Dt2+Dy)
3697: ]
3698: def
3699: % homogenize
3700: [cone.vv ring_of_differential_operators
3701: [[(t1) -1 (t2) -1 (Dt1) 1 (Dt2) 1]] ecart.weight_vector
3702: 0] define_ring
3703: dh.begin
3704: cone.input { . homogenize toString } map /cone.input set
3705: dh.end
3706:
3707:
3708: % $B%F%9%H$r3+;O$9$k(B.
3709: % getStartingCone /cone.ncone set
3710: % cone.ncone updateFan
3711: % cone.gblist 0 get message
3712: % cone.ncone /cone.ccone set
3713: % getNextFlip /cone.nextflip set
3714: % cone.nextflip message
3715:
3716: /wOld [(t1) , -29 , (t2) , -38 , (Dt1) , 29 , (Dt2) , 38 ] def
3717: /wFacet [(t1) , -1 , (t2) , -1 , (Dt1) , 1 , (Dt2) , 1 ] def
3718: /wNew [(t1) , -39 , (t2) , -38 , (Dt1) , 39 , (Dt2) , 38 ] def
3719: cone.input wOld cone.gb /ff set
3720: [ff (t1,t2,x,y) wOld wFacet wNew] ckmFlip /ff2 set
3721: (See ff and ff2) message
3722:
1.11 ! takayama 3723: } def
! 3724:
! 3725: %<
! 3726: % Usages: cone i getaVectorOnFacet
! 3727: % cone $B$N(B i $BHVL\$N(B facet $B$N>e$N(B vector $B$r5a$a$k(B.
! 3728: % cf. liftWeight
! 3729: %>
! 3730: /getaVectorOnFacet {
! 3731: /arg2 set /arg1 set
! 3732: [/cone /facet_i /ep /vp /v /v /ii] pushVariables
! 3733: [
! 3734: /cone arg1 def /facet_i arg2 def
! 3735: facet_i to_int32 /facet_i set
! 3736:
! 3737: cone (facetsv) getNode 2 get facet_i get /v set
! 3738: /vp v 0 get def
! 3739: 1 1 v length 1 sub {
! 3740: /ii set
! 3741: vp v ii get add /vp set
! 3742: } for
! 3743: vp nnormalize_vec /vp set
! 3744: /arg1 vp def
! 3745: ] pop
! 3746: popVariables
! 3747: arg1
! 3748: } def
! 3749:
! 3750: /getNextCone {
! 3751: getNextCone_ckm
! 3752: } def
! 3753:
! 3754: %<
! 3755: % Usages: result_getNextFlip getNextCone_ckm ncone
! 3756: % flip $B$7$F?7$7$$(B ncone $B$rF@$k(B. Collar-Kalkbrener-Moll $B$N%"%k%4%j%:%`$r;H$&(B
! 3757: % if (cone.ckmFlip == 0) $BIaDL$N7W;;(B else CKM.
! 3758: %>
! 3759: /getNextCone_ckm {
! 3760: /arg1 set
! 3761: [/ncone /ccone /kk /w /next_weight_w_wv /cid /ttt] pushVariables
! 3762: [
! 3763: /ccone arg1 def
! 3764: /ncone null def
! 3765: /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.
! 3766: /cid ccone 2 get def % cid $B$O(B cone $B$N(B $BHV9f(B.
! 3767: ccone 0 get /ccone set
! 3768: {
! 3769: ccone tag 0 eq { exit } { } ifelse
! 3770:
! 3771: % ccone $B$N(B kk $BHVL\$N(B facet $B$K$D$$$F(B flip $B$9$k(B.
! 3772: ccone kk cone.epsilon flipWeight /w set
! 3773: (Trying new weight is ) messagen w message
! 3774: w liftWeight /next_weight_w_wv set
! 3775: (Trying new weight [w,wv] is ) messagen next_weight_w_wv message
! 3776:
! 3777: cone.ckmFlip {
! 3778: [
! 3779: cone.gblist cid get (grobnerBasis) getNode 2 get % reduce gb
! 3780: cone.vv
! 3781: cone.gblist cid get (weight) getNode [2 0 2] get % weight
! 3782: ccone kk getaVectorOnFacet liftWeight 1 get % weight on facet
! 3783: next_weight_w_wv 1 get % new weight
! 3784: ] /ttt set
! 3785: ttt message
! 3786: ttt ckmFlip /cone.cgb set
! 3787: }{
! 3788: cone.input next_weight_w_wv 1 get cone.gb /cone.cgb set
! 3789: } ifelse
! 3790:
! 3791: cone.cgb tag 0 eq not {
! 3792: [w] next_weight_w_wv join /cone.cgb_weight set
! 3793: next_weight_w_wv 1 get cone.cgb coneEq /cone.g_ineq set
! 3794: cone.g_ineq cone.w_ineq join cone.Wt mul cone.Lpt mul
! 3795: pruneZeroVector /cone.gw_ineq_projectedWtLpt set
! 3796:
! 3797: (cone.gw_ineq_projectedWtLpt is obtained.) message
! 3798:
! 3799: cone.gw_ineq_projectedWtLpt getConeInfo /cone.nextConeInfo set
! 3800: % $B<!85$rD4$Y$k(B. $B$@$a$J$i(B retry
! 3801: cone.nextConeInfo 0 get 0 get to_int32 cone.d eq {
! 3802: cone.nextConeInfo 1 get newCone /ncone set
! 3803: ccone ncone getCommonFacet 0 get {
! 3804: (Flip succeeded.) message
! 3805: exit
! 3806: } { } ifelse
! 3807: } { } ifelse
! 3808: % common face $B$,$J$1$l$P(B $B$d$O$j(B epsilon $B$r>.$5$/(B.
! 3809: cone.nextConeInfo 0 get 0 get to_int32 cone.d eq {
! 3810: (ccone and ncone do not have a common facet.) message
! 3811: } {
! 3812: (ncone is not maximal dimensional. ) message
! 3813: } ifelse
! 3814: }{ } ifelse
! 3815:
! 3816: (Decreasing epsilon to ) messagen
! 3817: cone.epsilon (1).. (2).. div mul /cone.epsilon set
! 3818: cone.epsilon cone.epsilon.limit sub numerator (0).. lt {
! 3819: (Too small cone.epsilon ) error
! 3820: } { } ifelse
! 3821: cone.epsilon message
! 3822: } loop
! 3823: /arg1 ncone def
! 3824: ] pop
! 3825: popVariables
! 3826: arg1
1.9 takayama 3827: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to gfan.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc