Annotation of OpenXM/src/kan96xx/Doc/resol0.sm1, Revision 1.1.1.1
1.1 maekawa 1: %% lib/resol0.sm1, 1998, 11/8, 11/14, 1999, 05/18
2: %% cf. r-interface.sm1, tower.sm1, tower-sugar.sm1
3: %%
4: %% It must contain one-line command for resolution.
5: /resol0.verbose 0 def
6: /resol0.parse 0 def %% If 1,
7: %%Output of resol1 will be in a regular (non-schreyer) ring.
8: %% tower or tower-sugar will be chosen by the global variable
9: %% resol0.cp --- resol0 context pointer.
10: /resol0.version (2.981114) def
11: resol0.version [(Version)] system_variable gt
12: { (This package requires the latest version of kan/sm1) message
13: (Please get it from http://www.math.kobe-u.ac.jp/KAN) message
14: error
15: } { } ifelse
16:
17: $resol0.sm1, package to construct schreyer resolutions -- not minimal $ message-quiet
18: $ (C) N.Takayama, 1999, 5/18. resol0, resol1 $
19: message-quiet
20:
21: resol0.verbose {
22: (Loading tower.sm1 in the context Tower and) message
23: (loading tower-sugar.sm1 in the context Tower-sugar.) message
24: } { } ifelse
25:
26: (Tower) StandardContextp newcontext /cp.Tower set
27: cp.Tower setcontext
28: [(parse) (tower.sm1) pushfile] extension pop
29: StandardContextp setcontext
30:
31: (Tower-sugar) StandardContextp newcontext /cp.Tower-sugar set
32: cp.Tower-sugar setcontext
33: [(parse) (tower-sugar.sm1) pushfile] extension pop
34: StandardContextp setcontext
35:
36: /resol0.cp cp.Tower def
37: /resol0.v [(x) (y) (z)] def
38: /resol0 {
39: /arg1 set
40: [/in-resol0 /aa /typev /setarg /f /v
41: /gg /wv /vec /ans /depth
42: ] pushVariables
43: [(CurrentRingp) (KanGBmessage)] pushEnv
44: [
45: /aa arg1 def
46: aa isArray { } { (array gb) message (resol0) usage error } ifelse
47: aa length 0 { (resol0) usage error } { } ifelse
48: aa 0 get isInteger {
49: aa 0 get /depth set
50: aa rest /aa set
51: }
52: { /depth [ ] def } ifelse
53:
54: /setarg 0 def
55: /wv [ ] def
56: aa { tag } map /typev set
57: typev [ ArrayP ] eq
58: { /f aa 0 get def
59: /v resol0.v def
60: /setarg 1 def
61: } { } ifelse
62: typev [ArrayP StringP] eq
63: { /f aa 0 get def
64: /v aa 1 get def
65: /setarg 1 def
66: } { } ifelse
67: typev [ArrayP ArrayP] eq
68: { /f aa 0 get def
69: /v aa 1 get from_records def
70: /setarg 1 def
71: } { } ifelse
72: typev [ArrayP StringP ArrayP] eq
73: { /f aa 0 get def
74: /v aa 1 get def
75: /wv aa 2 get def
76: /setarg 1 def
77: } { } ifelse
78: typev [ArrayP ArrayP ArrayP] eq
79: { /f aa 0 get def
80: /v aa 1 get from_records def
81: /wv aa 2 get def
82: /setarg 1 def
83: } { } ifelse
84:
85: setarg { } { (resol0 : Argument mismatch) message error } ifelse
86:
87: [(KanGBmessage) resol0.verbose ] system_variable
88: f 0 get isArray {
89: [v ring_of_differential_operators 0] define_ring
90: f { {toString .} map } map /f set
91: }{
92: f {toString} map /f set
93: } ifelse
94:
95: [resol0.cp v wv ] {tower.define_sring} sendmsg
96: [resol0.cp f ] {tower.tparse-vec} sendmsg /gg set
97: [resol0.cp depth gg] {tower.sResolution} sendmsg /ans set
98: /arg1 ans def
99: ] pop
100: popEnv
101: popVariables
102: arg1
103: } def
104: [(resol0)
105: [( [ ii v] resol0 r )
106: (array of poly ii; string v;)
107: (<< vv >> is a string of variables separated by ,)
108: ( )
109: ( [ ii v] resol0 r )
110: (array of poly ii; array of strings v;)
111: (<< vv >> is an array of variable names. )
112: ( )
113: ( [ ii v w] resol0 r )
114: (array of poly ii; string v; array w;)
115: (<< w >> is a weight vector.)
116: ( )
117: (You can also give a parameter << d >> to specify the truncation depth)
118: (of the resolution: [ d ii v] resol0, [d ii v w] resol0)
119: ( )
120: (resol0 constructs a resolution which is adapted (strict))
121: (to a filtration. So, it is not minimal.)
122: ( r = [starting Groebner basis g, [ s1, s2 , s3, ...], order-def].)
123: (g is the reduced Groebner basis for f, )
124: ( s1 is the syzygy of g,)
125: ( s2 is the syzygy of s1,)
126: ( s3 is the syzygy of s2 and so on.)
127: (For details, see math.AG/9805006)
128: (cf. sResolution, tparse, s_ring_..., resol0.cp)
129: (Example: [ [( x^3-y^2 ) ( 2 x Dx + 3 y Dy + 6 ) ( 2 y Dx + 3 x^2 Dy) ] )
130: ( (x,y) ] resol0 :: )
131: ]] putUsages
132:
133: /resol1 {
134: /arg1 set
135: [/in-resol1 /aa /typev /setarg /f /v
136: /gg /wv /vec /ans /depth /vectorInput
137: /vsize /eVector /ii /syzlist /syzlist1 /syz0 /i
138: ] pushVariables
139: [(CurrentRingp) (KanGBmessage)] pushEnv
140: [
141: /aa arg1 def
142: aa isArray { } { (array gb) message (resol1) usage error } ifelse
143: aa length 0 { (resol1) usage error } { } ifelse
144: aa 0 get isInteger {
145: aa 0 get /depth set
146: aa rest /aa set
147: }
148: { /depth [ ] def } ifelse
149:
150: /setarg 0 def
151: /wv [ ] def
152: aa { tag } map /typev set
153: typev [ ArrayP ] eq
154: { /f aa 0 get def
155: /v resol0.v def
156: /setarg 1 def
157: } { } ifelse
158: typev [ArrayP StringP] eq
159: { /f aa 0 get def
160: /v aa 1 get def
161: /setarg 1 def
162: } { } ifelse
163: typev [ArrayP ArrayP] eq
164: { /f aa 0 get def
165: /v aa 1 get from_records def
166: /setarg 1 def
167: } { } ifelse
168: typev [ArrayP StringP ArrayP] eq
169: { /f aa 0 get def
170: /v aa 1 get def
171: /wv aa 2 get def
172: /setarg 1 def
173: } { } ifelse
174: typev [ArrayP ArrayP ArrayP] eq
175: { /f aa 0 get def
176: /v aa 1 get from_records def
177: /wv aa 2 get def
178: /setarg 1 def
179: } { } ifelse
180:
181: setarg { } { (resol1 : Argument mismatch) message error } ifelse
182:
183: [(KanGBmessage) resol0.verbose ] system_variable
184: f 0 get isArray {
185: /vectorInput 1 def
186: /vsize f 0 get length def
187: } {
188: /vsize 1 def
189: /vectorInput 0 def
190: }ifelse
191:
192: vectorInput {
193: [v ring_of_differential_operators 0] define_ring
194: %% /eVector [0 1 vsize 1 sub { /ii set @@@.esymbol . ii npower } for ] def
195: %% f { {toString .} map eVector mul toString } map /f set
196: %%Now, sResolution in tower.sm1 accept vector input, 1999, 5/18.
197: f { {toString .} map } map /f set
198: }{
199: f {toString} map /f set
200: } ifelse
201:
202: [resol0.cp v wv ] {tower.define_sring} sendmsg
203: [resol0.cp f ] {tower.tparse-vec} sendmsg /gg set
204: resol0.verbose { gg message } { } ifelse
205: [resol0.cp depth gg] {tower.sResolution} sendmsg /syzlist set
206:
207: /resol1.syzlist syzlist def %% save in the global variable.
208: %% From restall_s.sm1
209: %% Reformatting the free resolution:
210: %% [[f1,f2,..],[syz1,...]] --> [[[f1],[f2],...],[syz,...]]
211: %% (to be modified for the case with more than one unknowns.)
212: [v ring_of_differential_operators 0] define_ring
213: /degmax syzlist 1 get length def
214: /syzlist1 [
215: syzlist 0 get /syz0 set
216: %% start N.T.
217: resol0.parse {
218: [vsize syz0 { toString . } map]
219: } { [vsize syz0 ] } ifelse
220: toVectors2
221: %% end N.T.
222: 1 1 degmax {/i set
223: resol0.parse {
224: syzlist 1 get i 1 sub get {{toString .} map } map
225: }{ syzlist 1 get i 1 sub get } ifelse
226: } for
227: ] def
228: syzlist1
229: /syzlist set
230:
231: /arg1 syzlist def
232: ] pop
233: popEnv
234: popVariables
235: arg1
236: } def
237: [(resol1)
238: [( [ ii v] resol1 r )
239: (array of poly ii; string v;)
240: (<< vv >> is a string of variables separated by ,)
241: ( )
242: ( [ ii v] resol1 r )
243: (array of poly ii; array of strings v;)
244: (<< vv >> is an array of variable names. )
245: ( )
246: ( [ ii v w] resol1 r )
247: (array of poly ii; string v; array w;)
248: (<< w >> is a weight vector.)
249: ( )
250: ( ii may be array of array of poly.)
251: (You can also give a parameter << d >> to specify the truncation depth)
252: (of the resolution: [ d ii v] resol1, [d ii v w] resol1)
253: ( )
254: (resol1 constructs a resolution which is adapted (strict))
255: (to a filtration. So, it is not minimal in general.)
256: ( r = [s0, s1, s2 , s3, ...].)
257: ( s0 is the groebner basis of ii,)
258: ( s1 is the syzygy of s0,)
259: ( s2 is the syzygy of s1,)
260: ( s3 is the syzygy of s2 and so on.)
261: ( s1 s0 mul ==> 0, s2 s1 mul ==>0, ...)
262: (For details, see math.AG/9805006)
263: (cf. sResolution, tparse, s_ring_..., resol0.cp)
264: (resol1.withZeroMap returns a resolution with zero maps of the both sides)
265: ( of the resolution.)
266: (cf. resol1.zeroMapL, resol1.zeroMapR, resol1.withZeroMap.aux)
267: (resol1.syzlist : global variable to keep the raw output of sResolution.)
268: ( )
269: (Example 1: [ [( x^3-y^2 ) ( 2 x Dx + 3 y Dy + 6 ) ( 2 y Dx + 3 x^2 Dy) ] )
270: ( (x,y) ] resol1 pmat ; )
271: (Example 2: [ [( x^3-y^2 ) ( 2 x Dx + 3 y Dy + 6 ) ( 2 y Dx + 3 x^2 Dy) ] )
272: ( (x,y) [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1 pmat ; )
273: (Example 3: [ [[(2 x Dx + 3 y Dy +6) (0)] )
274: ( [(3 x^2 Dy + 2 y Dx) (0)] )
275: ( [(0) (x^2+y^2)] )
276: ( [(0) (x y )] ] )
277: ( (x,y) [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1 pmat ; )
278: (Example 4: /resol0.verbose 1 def)
279: $ [ [[(x^2+y^2+ x y) (x+y)] [(x y ) ( x^2 + x y^3)] ] (x,y) $
280: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1 pmat ; $
281: ]] putUsages
282:
283: /resol1.withZeroMap {
284: resol1 resol1.withZeroMap.aux
285: } def
286: /resol1.withZeroMap.aux {
287: /arg1 set
288: [/in-resol1.withZeroMap.aux /ss /nn /mm] pushVariables
289: [
290: /ss arg1 def
291: ss 0 get length /mm set
292: ss 0 get 0 get isArray {
293: /nn ss 0 get 0 get length def
294: } { /nn 1 def } ifelse
295: [ [nn mm] resol1.zeroMapR]
296: ss join
297: /ss set
298:
299: ss ss length 1 sub get [ ] eq {
300: ss << ss length 1 sub >>
301: << ss << ss length 2 sub >> get >> length resol1.zeroMapL put
302: } { } ifelse
303: /arg1 ss def
304: ] pop
305: popVariables
306: arg1
307: } def
308:
309: /resol1.zeroMapR {
310: %% [[0,0],
311: %% [0,0],
312: %% [0,0]]
313: /arg1 set
314: [/in-resol1.zeroMapR /mm /nn] pushVariables
315: [
316: /mm arg1 0 get def
317: /nn arg1 1 get def
318: [ 1 1 mm { pop [1 1 nn { pop (0).} for] } for ]
319: /arg1 set
320: ] pop
321: popVariables
322: arg1
323: } def
324: /resol1.zeroMapL {
325: %% [[0,0,0]]
326: /arg1 set
327: [/in-resol1.zeroMapL /mm ] pushVariables
328: [
329: /mm arg1 def
330: [ [1 1 mm { pop (0). } for ]]
331: /arg1 set
332: ] pop
333: popVariables
334: arg1
335: } def
336:
337: /pres1 {
338: /arg1 set
339: [/in-pres1 /rr /i /nn] pushVariables
340: [
341: /rr arg1 def
342: /nn rr length 1 sub def
343: 0 1 nn {
344: /i set
345: rr i get [ ] eq { /pres1.LLL goto } { } ifelse
346: (k^) messagen rr i get 0 get length message
347: (^) message
348: (|) message
349: rr i get pmat
350: (|) message
351: } for
352: /pres1.LLL
353: ] pop
354: popVariables
355: arg1
356: } def
357: [(pres1)
358: [(rr pres1)
359: (print resolution rr.)
360: $Example $
361: $ [ [[(x^2+y^2+ x y) (x+y)] [(x y ) ( x^2 + x y^3)] ] (x,y) $
362: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1.withZeroMap pres1 ; $
363: ]] putUsages
364:
365:
366:
367: %% It is included to work on the older version. It may removed.
368: %% toVectors2 is already in dr.sm1
369: (2.990500) [(Version)] system_variable gt
370: {
371: /toVectors2 {
372: /arg1 set
373: [/in-toVectors2 /gg /ans /n /tmp] pushVariables
374: [
375: /gg arg1 def
376: /ans gg 1 get toVectors def
377: /n gg 0 get def
378: ans {
379: /tmp set
380: tmp length n lt {
381: tmp
382: [1 1 n tmp length sub { pop (0). } for ]
383: join /tmp set
384: } { } ifelse
385: tmp
386: } map
387: /ans set
388: /arg1 ans def
389: ] pop
390: popVariables
391: arg1
392: } def
393: } { } ifelse
394:
395: resol0.cp setcontext
396: /tower.define_sring {
397: /arg1 set
398: [/in-tower.define_sring /vv /ww /r] pushVariables
399: [
400: /vv arg1 1 get def
401: /ww arg1 2 get def
402: ww [ ] eq {
403: [vv s_ring_of_differential_operators 0 [(schreyer) 1]] define_ring
404: } {
405: [vv s_ring_of_differential_operators ww s_weight_vector
406: 0 [(schreyer) 1]] define_ring
407: } ifelse
408: /r set
409: /arg1 r def
410: ] pop
411: popVariables
412: arg1
413: } def
414:
415: /tower.tparse-vec {
416: /arg1 set
417: [/in-tower.tparse-vec /ff ] pushVariables
418: [
419: arg1 1 get /ff set
420: ff 0 get isArray {
421: ff {{tparse} map} map /ff set
422: } {
423: ff {tparse} map /ff set
424: } ifelse
425: /arg1 ff def
426: ] pop
427: popVariables
428: arg1
429: } def
430:
431: /tower.sResolution {
432: resol0.verbose {
433: /tower.verbose 1 def
434: } { } ifelse
435: rest aload pop sResolution
436: } def
437: StandardContextp setcontext
438:
439: /test00 {
440: /resol0.verbose 1 def
441: [ [[(x^2+y^2+ x y) (x+y)] [(x y ) ( x^2 + x y^3)] ] (x,y) [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] resol1 /ff set
442: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>