Annotation of OpenXM/src/kan96xx/Doc/complex.sm1, Revision 1.4
1.4 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/complex.sm1,v 1.3 2000/06/08 08:35:01 takayama Exp $
1.1 maekawa 2: %% lib/complex.sm1 [ functions for complex ], 1999, 9/9
3: %% cf. yama:1999/Int/uli.sm1
4: %%%%%%%%%%%%%%%%%%% commands %%%%%%%%%%%%%%%%%%%%%%%%%
5: %%% res-div, res-solv, res-kernel-image, res-dual
6: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
7: [(complex.sm1 : 1999, 9/28, res-div, res-solv, res-kernel-image, res-dual )
1.3 takayama 8: ( 2000, 6/8, isExact_h, isExact )
1.1 maekawa 9: (In this package, complex is expressed in terms of matrices.)
1.4 ! takayama 10: ] {message-quiet} map
1.1 maekawa 11: /uli.verbose 0 def
12: /uli.weight [(x) -1 (y) -1 (Dx) 1 (Dy) 1] def
13:
14: %%% M = [M_1, ..., M_p], M_i has the length q
15: %%% D^p (row vector) --- M ---> D^q (row vector), v --> v M
16: %%% In this package (res-***), all data are expressed by matrices.
17: /res-nextShift {
18: /arg1 set
19: [/in-nextShift /f /mm /m /p /q /i /fi] pushVariables
20: [
21: /f arg1 0 get def
22: /mm arg1 1 get def
23: %% D^p[m] ---f---> D^q[mm] [f mm] nextShift m
24: /p f length def
25: [1 1 p { pop 0 } for] /m set
26: 0 1 p 1 sub {
27: /i set
28: /fi f i get def
29: m i << mm fi { uli.weight ord_w } map add maxInArray >> put
30: } for
31: /arg1 m def
32: ] pop
33: popVariables
34: arg1
35: } def
36:
37: [(res-nextShift)
38: [([f mm] nextShift m)
39: $Example: [(x,y) ring_of_differential_operators 0] define_ring$
40: $ [ [ [ (x). (x^2). (x^3). ] $
41: $ [ (Dx). (Dx^2). (Dx^3).]] [5 6 7]] res-nextShift :: $
42: ]] putUsages
43:
44:
45: %% Input must be a matrix.
46: /res-init {
47: /arg1 set
48: [/in-initv /v /n] pushVariables
49: [
50: /v arg1 def
51: /n v length def
52: [n [v] fromVectors {init} map] toVectors2
53: /arg1 set
54: ] pop
55: popVariables
56: arg1
57: } def
58:
59:
60: /res-isVadapted {
61: /arg1 set
62: [/in-res-isVstrict /f /m /mm /ans] pushVariables
63: [
64: /f arg1 0 get def
65: /m arg1 1 get def
66: /mm arg1 2 get def
67: %% D^p[m] ---f---> D^q[mm] [f m mm] res-isVadapted
68: f [ [ ] ] eq {
69: /ans 1 def
70: } {
71: [f mm] res-nextShift m eq {/ans 1 def} { /ans 0 def} ifelse
72: } ifelse
73: /arg1 ans def
74: ] pop
75: popVariables
76: arg1
77: } def
78:
79: /res-gb {
80: /arg1 set
81: [/in-res-gb /aa /gg /qq /ans] pushVariables
82: [(KanGBmessage)] pushEnv
83: [
84: /aa arg1 def %% Input is a matrix.
85: aa [ ] eq { /arg1 [ ] def /res-gb.LLL goto } { } ifelse
86: aa 0 get isArray {
87: }{ aa { [ 2 1 roll ] } map /aa} ifelse
88: /qq aa 0 get length def
89: aa { dehomogenize homogenize } map /aa set
90: uli.verbose { } { [(KanGBmessage) 0] system_variable} ifelse
91: [aa] groebner 0 get /ans set
92: ans 0 get isArray { }
93: { [qq ans] toVectors2 /ans set } ifelse
94: /arg1 ans def
95: /res-gb.LLL
96: ] pop
97: popEnv
98: popVariables
99: arg1
100: } def
101:
102: %% Utility functions res-setRing and res-toString
103: /res-toString {
104: /arg1 set
105: [/in-res-toString /s /ans] pushVariables
106: [
107: /s arg1 def
108: s isArray {
109: s {res-toString} map /ans set
110: }{
111: s isPolynomial {
112: /ans s toString def
113: } {
114: /ans s def
115: } ifelse
116: } ifelse
117: ans /arg1 set
118: ] pop
119: popVariables
120: arg1
121: } def
122:
123: %% res-setRing.v res-setRing.vlist are global variables that contain,
124: %% for example, (x,y) and [(x) (y)].
125: /res-setRing {
126: /arg1 set
127: [/in-res-setRing /R /v] pushVariables
128: [
129: /v arg1 def
130: v isArray {
131: /v v res-toString from_records def
132: }{
133: v isString {
134: }{
135: [(res-setRing: ) v toString
136: ( is not a set of variables to define a ring.)] cat
137: error
138: }ifelse
139: }ifelse
140: /res-setRing.v v def
141: /res-setRing.vlist [v to_records pop] def
142: [v ring_of_differential_operators 0] define_ring /R set
143: /arg1 R def
144: ] pop
145: popVariables
146: arg1
147: } def
148:
149:
150: %% [M N] res-div It returns ker(M/N) i.e. D^*/ [M N] res-div = M/N
151: %% First size(M) part of the syzygy of M and N.
152: /res-div {
153: /arg1 set
154: [/in-res-div /M /N /ss /m /n /ss2 /ans] pushVariables
155: [(KanGBmessage)] pushEnv
156: [
157: /M arg1 0 get def
158: /N arg1 1 get def
159: /m M length def
160: /n N length def
161: M 0 get isArray {
162: }{ M { [ 2 1 roll ] } map /M } ifelse
163: M { dehomogenize homogenize } map /M set
164:
165: n 0 eq not {
166: N 0 get isArray {
167: }{ N { [ 2 1 roll ] } map /N } ifelse
168: N { dehomogenize homogenize } map /N set
169: } { } ifelse
170:
171: uli.verbose { } { [(KanGBmessage) 0] system_variable} ifelse
172: [M N join [(needSyz)]] groebner 2 get /ss set
173: ss dehomogenize /ss set
174: ss { [ 2 1 roll aload pop 1 1 n { pop pop } for ] } map
175: /ss2 set
176: ss2 {homogenize} map /ss2 set
177: ss2 [ ] eq {
178: [ m res-newpvec ] /ans set
179: }{
180: [ss2 0 get length [ss2] groebner 0 get dehomogenize ] toVectors2
181: /ans set
182: } ifelse
183:
184: /arg1 ans def
185: ] pop
186: popEnv
187: popVariables
188: arg1
189: } def
190: [(res-div)
191: [( [M N] res-div K )
192: ( matrix M, N, K ; Each element of M and N must be an element of a ring.)
193: ( coker(K) is isomorphic to M/N. )
194: (Example: [(x,y) ring_of_differential_operators 0] define_ring )
195: ( [[[(x+x^2+y^2).] [(x y).]] [[(x+x^2+y^2).] [(x y).]]] res-div)
196: ( )
197: $res*div accepts string inputs, too. For example,$
198: $ [[[[(x+x^2+y^2)] [(x y)]] [[(x+x^2+y^2)] [(x y)]]]$
199: $ [(x) (y)]] res*div ::$
200: (See also res-toString, res-setRing.)
201: ]] putUsages
202:
203: /res*div {
204: /arg1 set
205: [/in-res*div /A] pushVariables
206: [(CurrentRingp)] pushEnv
207: [
208: /A arg1 def
209: A 1 get res-setRing pop
210: A 0 get res-toString expand res-div /arg1 set
211: ] pop
212: popEnv
213: popVariables
214: arg1
215: } def
216:
217: /res-syz {
218: /arg1 set
219: [/in-res-syz /M /m] pushVariables
220: [
221: /M arg1 def
222:
223: M 0 get isArray {
224: }{ M { [ 2 1 roll ] } map /M } ifelse
225:
226: M { dehomogenize homogenize } map /M set
227: [M [(needSyz)]] groebner 2 get dehomogenize /arg1 set
228: ] pop
229: popVariables
230: arg1
231: } def
232: [(res-syz)
233: [( M res-syz N)
234: ( matrix M, N ; each element of M and N must be an element of a ring.)
235: ( N is a set of generators of the syzygy module of M.)
236: (res*syz is also provided. It accepts string inputs.)
237: ]] putUsages
238: /res*syz {
239: /arg1 set
240: [/in-res*syz /A] pushVariables
241: [(CurrentRingp)] pushEnv
242: [
243: /A arg1 def
244: A 1 get res-setRing pop
245: A 0 get res-toString expand res-syz /arg1 set
246: ] pop
247: popEnv
248: popVariables
249: arg1
250: } def
251:
252: /res-getx {
253: /arg1 set
254: [/in-res-getx /xx /nn /ff] pushVariables
255: [
256: /ff arg1 def
257: /xx ff getvNamesCR def
258: [(N)] system_variable /nn set
259: [ xx aload pop 1 1 nn { pop pop } for pop ] rest
260: /arg1 set
261: ] pop
262: popVariables
263: arg1
264: } def
265:
266: %% Solving \sum c_i M_i = d
267: %% [M d] res-solv c'/r ; M : matrix, d, c' : vectors, r : scalar, c'/r =c
268: /res-solv {
269: /arg1 set
270: [/in-res-solv /M /d /ans /B /vv /G /rr /rng] pushVariables
271: [(CurrentRingp) (KanGBmessage)] pushEnv
272: [
273: /M arg1 0 get def
274: /d arg1 1 get def
275: M getRing /rng set
276: rng res-getx /vv set
277: uli.verbose { (res-solv : vv = ) messagen vv message } { } ifelse
278: uli.verbose { } { [(KanGBmessage) 0] system_variable } ifelse
279: M dehomogenize /M set
280: [vv from_records ring_of_differential_operators 0] define_ring
281: M 0 get isArray {
282: M { { toString . } map } map /M set
283: } {
284: M { toString . } map /M set
285: } ifelse
286: [M [(needBack)]] groebner_sugar /G set
287: G 1 get /B set
288:
289: d isArray {
290: d 0 get isArray { [d] fromVectors 0 get /d set } { } ifelse
291: [d] fromVectors 0 get /d set
292: } { } ifelse
293: d toString . dehomogenize /d set
294:
295: /res-solv.d d def
296: /res-solv.G G def
297:
298: d G 0 get reduction-noH /rr set
299: rr 0 get (0). eq {
300: [rr 2 get] B mul 0 get /ans set
301: /ans [ ans { toString rng ,, (-1) rng ,, mul} map
302: rr 1 get toString .. ] def
303: } {
304: /ans null def
305: } ifelse
306: /arg1 ans def
307: ] pop
308: popEnv
309: popVariables
310: arg1
311: } def
312: [(res-solv)
313: [$[M d] res-solv [c' r] $
314: $ M : matrix, d, c' : vectors, r : scalar(integer) $
315: $ c:=c'/r is a solutions of Sum[c_i M_i] = d where c_i is the i-th element $
316: $ of the vector c and M_i is the i-th row vector of M.$
317: $If there is no solution, then res-solv returns null. $
318: (Note that M and d are not treated as an element of the homogenized Weyl)
319: (algebra. If M or d contains the homogenization variable h, it automatically)
320: (set to 1. If you need to use h, use the command res-solv-h)
321: $Example 1: [(x,y) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0] $
322: $ define_ring $
323: $ [ [ [(x Dx + 2).] [ (Dx (x Dx + 3) - (x Dx + 2) (x Dx -4)).]] [(1).]] $
324: $ res-solv :: $
325: $Example 2: $
326: $ [ [ (x Dx + 2). (Dx (x Dx + 3) - (x Dx + 2) (x Dx -4)).] (1).] $
327: $ res-solv :: $
328: $Example 3: $
329: $ [ [[(x Dx + 2). (0).] $
330: $ [(Dx+3). (x^3).]$
331: $ [(3). (x).]$
332: $ [(Dx (x Dx + 3) - (x Dx + 2) (x Dx -4)). (0).]] [(1). (0).]] $
333: $ res-solv :: $
334: $Example 4: $
335: $ [[ (x*Dx+h^2). (Dx^2+x*h).] [(x^2+h^2). (h Dx + x^2).]] /ff set $
336: $ [[ (x^2 Dx + x h^2). (Dx^3).]] /gg set $
337: $ [ff gg ff mul 0 get ] res-solv-h :: $
338: $ $
339: $res*solv and res*solv*h accept string inputs, too. For example,$
340: $ [[ [ [(x Dx + 2)] [ (Dx (x Dx + 3) - (x Dx + 2) (x Dx -4))]] [(1)]] $
341: $ (x)] res*solv :: $
342: ]] putUsages
343: /res*solv {
344: /arg1 set
345: [/in-res*solv /A] pushVariables
346: [(CurrentRingp)] pushEnv
347: [
348: /A arg1 def
349: A 1 get res-setRing pop
350: A 0 get res-toString expand res-solv /arg1 set
351: ] pop
352: popEnv
353: popVariables
354: arg1
355: } def
356:
357: %% Solving \sum c_i M_i = d
358: %% [M d] res-solv-h c'/r ;
359: %% M : matrix, d, c' : vectors, r : scalar, c'/r =c
360: /res-solv-h {
361: /arg1 set
362: [/in-res-solv-h /M /d /ans /B /vv /G /rr /rng] pushVariables
363: [(CurrentRingp) (KanGBmessage)] pushEnv
364: [
365: /M arg1 0 get def
366: /d arg1 1 get def
367: M getRing /rng set
368: rng res-getx /vv set
369: uli.verbose { (res-solv-h : vv = ) messagen vv message } { } ifelse
370: uli.verbose { } { [(KanGBmessage) 0] system_variable } ifelse
371: [vv from_records ring_of_differential_operators 0] define_ring
372: M 0 get isArray {
373: M { { toString . } map } map /M set
374: } {
375: M { toString . } map /M set
376: } ifelse
377:
378: getOptions /options set
379: (grade) (module1v) switch_function
380: [M [(needBack)]] groebner /G set
381: options restoreOptions
382:
383: G 1 get /B set
384:
385: d isArray {
386: d 0 get isArray { [d] fromVectors 0 get /d set } { } ifelse
387: [d] fromVectors 0 get /d set
388: } { } ifelse
389: d toString . /d set
390:
391: /res-solv.d d def
392: /res-solv.G G def
393:
394: d G 0 get reduction /rr set
395: rr 0 get (0). eq {
396: [rr 2 get] B mul 0 get /ans set
397: /ans [ ans { toString rng ,, (-1) rng ,, mul} map
398: rr 1 get toString .. ] def
399: } {
400: /ans null def
401: } ifelse
402: /arg1 ans def
403: ] pop
404: popEnv
405: popVariables
406: arg1
407: } def
408: /res*solv*h {
409: /arg1 set
410: [/in-res*solv*h /A] pushVariables
411: [(CurrentRingp)] pushEnv
412: [
413: /A arg1 def
414: A 1 get res-setRing pop
415: A 0 get res-toString expand res-solv-h /arg1 set
416: ] pop
417: popEnv
418: popVariables
419: arg1
420: } def
421:
422: %% See also xm, sm1_mul, sm1_mul_d, sm1_mul_h
423: /res*mul {
424: /arg1 set
425: [/in-res*mul /A] pushVariables
426: [(CurrentRingp)] pushEnv
427: [
428: /A arg1 def
429: A 1 get res-setRing pop
430: A 0 get 0 get res-toString expand
431: A 0 get 1 get res-toString expand
432: mul dehomogenize
433: /arg1 set
434: ] pop
435: popEnv
436: popVariables
437: arg1
438: } def
439: /res*mul*h {
440: /arg1 set
441: [/in-res*mul*h /A] pushVariables
442: [(CurrentRingp)] pushEnv
443: [
444: /A arg1 def
445: A 1 get res-setRing pop
446: A 0 get 0 get res-toString expand
447: A 0 get 1 get res-toString expand
448: mul
449: /arg1 set
450: ] pop
451: popEnv
452: popVariables
453: arg1
454: } def
455:
456: %% cf. sm1_adjoint
457: /res*adjoint {
458: /arg1 set
459: [/in-res*adjoint /A /p /v /p0 /ans] pushVariables
460: [(CurrentRingp)] pushEnv
461: [
462: /A arg1 def
463: A 1 get res-setRing pop
464: A 0 get res-toString expand dehomogenize /p set
465: /v res-setRing.v def
466: p isArray {
467: p { /p0 set [p0 v] res*adjoint } map /ans set
468: }{
469: p v adjoint dehomogenize /ans set
470: }ifelse
471: /arg1 ans def
472: ] pop
473: popEnv
474: popVariables
475: arg1
476: } def
477:
478: /res-init-m {
479: /arg1 set
480: [/in-res-init-m /A /ans] pushVariables
481: [
482: /A arg1 def
483: A isArray {
484: A { res-init-m } map /ans set
485: }{
486: A init /ans set
487: }ifelse
488: /arg1 ans def
489: ] pop
490: popVariables
491: arg1
492: } def
493:
494: /res-ord_w-m {
495: /arg2 set
496: /arg1 set
497: [/in-ord_w-m /A /ans /w] pushVariables
498: [
499: /A arg1 def
500: /w arg2 def
501: A isArray {
502: A { w res-ord_w-m } map /ans set
503: }{
504: A w ord_w /ans set
505: }ifelse
506: /arg1 ans def
507: ] pop
508: popVariables
509: arg1
510: } def
511:
512: %% cf. sm1_resol1
513: /res*resol1 {
514: /arg1 set
515: [/in-res*resol1 /A /ans /w /ans1 /ans2] pushVariables
516: [
517: /A arg1 def
518: A length 3 ge {
519: /w A 2 get def %% weight vector
520: } {
521: /w null def
522: }ifelse
523: A resol1 /ans set
524: /ans1 ans res-init-m def
525: w tag 0 eq {
526: /ans [ans ans1] def
527: }{
528: ans w 0 get res-ord_w-m /ans2 set
529: /ans [ans ans1 ans2] def
530: }ifelse
531: /arg1 ans def
532: ] pop
533: popVariables
534: arg1
535: } def
536:
537: %% @@@
538:
539: %% submodule to quotient module
540: %% M res-sub2Q ==> J, where M \simeq D^m/J
541: /res-sub2Q {
542: /arg1 set
543: [/in-res-sub2Q /M /m] pushVariables
544: [
545: /M arg1 def
546: M 0 get isArray {
547: }{ M { [ 2 1 roll ] } map /M } ifelse
548: M { dehomogenize homogenize } map /M set
549: [M [(needSyz)]] groebner 2 get dehomogenize /arg1 set
550: ] pop
551: popVariables
552: arg1
553: } def
554: [(res-sub2Q)
555: [(M res-sub2Q J)
556: (matrix M, J; )
557: (The submodule generated by M is isomorphic to D^m/J.)
558: ]] putUsages
559:
560:
561: %% submodules to quotient module
562: %% [M N] res-subsub2Q ==> J, where M \simeq D^m/J
563: /res-subsub2Q {
564: /arg1 set
565: [/in-res-subsub2Q /M /N /ss /m /n /ss2] pushVariables
566: [
567: /M arg1 0 get def
568: /N arg1 1 get def
569: /m M length def
570: /n N length def
571: M 0 get isArray {
572: }{ M { [ 2 1 roll ] } map /M } ifelse
573: N 0 get isArray {
574: }{ N { [ 2 1 roll ] } map /N } ifelse
575: M { dehomogenize homogenize } map /M set
576: N { dehomogenize homogenize } map /N set
577: [M N join [(needSyz)]] groebner 2 get /ss set
578: ss dehomogenize /ss set
579: ss { [ 2 1 roll aload pop 1 1 n { pop pop } for ] } map
580: /ss2 set
581: ss2 {homogenize} map /ss2 set
582: [ss2 0 get length [ss2] groebner 0 get dehomogenize ] toVectors2
583: /arg1 set
584: ] pop
585: popVariables
586: arg1
587: } def
588:
589: /res-newpvec {
590: /arg1 set
591: [/in-res-newpvec /n ] pushVariables
592: [
593: /n arg1 def
594: [1 1 n { pop (0). } for] /arg1 set
595: ] pop
596: popVariables
597: arg1
598: } def
599:
600: %% ki.sm1 kernel/image, 1999, 2/4
601: %% ki.sm1 is now moved to gbhg3/Int.
602: %% It is included in lib/complex.sm1
603: /kernel-image.v 1 def
604: /kernel-image.p 0 def % characteristic
605: %%
606: %% D^p <-- m --- D^q <-- n -- D^r
607: %% ker(m)/im(n)
608: %%
609: /res-kernel-image {
610: /arg1 set
611: [/in-res-kernel-image /p /q /r /m /n /t
612: /vlist /s0 /s1 /ans
613: ] pushVariables
614: [
615: /m arg1 0 get def
616: /n arg1 1 get def
617: /vlist arg1 2 get def
618: vlist isArray {
619: vlist from_records /vlist
620: } { } ifelse
621: [vlist ring_of_differential_operators kernel-image.p] define_ring
622: m { {toString . dehomogenize toString} map } map /m set
623: m length /q set
624: n { {toString . dehomogenize toString} map } map /n set
625: n length /r set
626:
627: [m vlist] syz 0 get {{toString} map} map /s0 set
628: /t s0 length def
629: [ s0 n join vlist ] syz 0 get /s1 set
630: s1 { t carN } map /ans set
631:
632: /arg1 ans def
633: ] pop
634: popVariables
635: arg1
636: } def
637: [(res-kernel-image)
638: [( [m n vlist] res-kernel-image c )
639: (When, D^p <-- m --- D^q <-- n -- D^r )
640: (D^q/c is isomorhic to ker(m)/im(n).)
641: (vlist is a list of variables.)
642: ]] putUsages
643:
644:
645: /res-dual {
646: /arg1 set
647: [/in-res-dual ] pushVariables
648: [
649: arg1 0 get /input set
650: arg1 1 get /vlist set
651: /n vlist length def
652: /vv vlist from_records def
653:
654: %% preprocess to input resol0. Future version of resol1 should do them.
655: input 0 get isArray {
656: /kernel-image.unknowns input 0 get length def
657: } { /kernel-image.unknowns 1 def } ifelse
658: [vv ring_of_differential_operators
659: kernel-image.p ] define_ring
660: input 0 get isArray {
661: input { {toString . dehomogenize toString} map
662: } map /input set
663: }{ input { toString . dehomogenize toString} map /input set } ifelse
664:
665: [input vv]
666: resol0 /rr set
667:
668: %% Postprocess of resol0
669: [vv ring_of_differential_operators
670: kernel-image.p ] define_ring
671: [ [kernel-image.unknowns rr 0 get { toString . dehomogenize } map]
672: toVectors2 { {toString} map } map ]
673: rr 1 get join /rr-syz set
674: %%% end. The result is in rr-syz.
675:
676: /M rr-syz << n >> get def
677: /N rr-syz << n 1 sub >> get def
678: M [ ] eq {
679: /q N length def
680: /M [ [0 1 q 1 sub { pop (0). } for] ] def
681: } { } ifelse
682:
683: %% regard them as a map from row vector v to row vector w; v M --> w
684: uli.verbose {
685: (M = ) messagen M pmat
686: (N = ) messagen N pmat
687: } { } ifelse
688: M transpose { { toString . dehomogenize vv adjoint} map } map /M set
689: N transpose { { toString . dehomogenize vv adjoint} map } map /N set
690: uli.verbose {
691: $We are now computing ker (*N)/im (*M).$ message
692: (*N = ) messagen N pmat
693: (*M = ) messagen M pmat
694: ( *N *M = ) messagen N M mul dehomogenize message
695: ( ) message
696: }{ } ifelse
697: /M M {{toString} map } map def
698: /N N {{toString} map } map def
699: [M N vv] res-kernel-image {{toString} map}map /ans1 set
700: [ans1 vv] gb 0 get /arg1 set
701: ] pop
702: popVariables
703: arg1
704: } def
705:
706: [(res-dual)
707: [$[F V] res-dual G$
708: $G is the dual D-module of F. V is a list of variables.$
709: $Example 1: [ [( x^3-y^2 ) ( 2 x Dx + 3 y Dy + 6 ) ( 2 y Dx + 3 x^2 Dy) ] $
710: $ [(x) (y)]] res-dual $
711: $Example 2: [[1 3 4 5]] appell1 res-dual $
712: $Example 3: [ [(-x1 Dx1 + x1 + 2) (x2 Dx2 - Dx2 -3)] [(x1) (x2)]] res-dual $
713: $Example 4: [ [(x2 Dx2 - Dx2 + 4) (x1 Dx1 + x1 +3)] [(x1) (x2)]] res-dual $
714: $ 3 and 4 are res-dual each other. $
715: $Example 5: [ [[1 1 1][0 1 2]] [0 0]] gkz res-dual $
716: $Example 6: [ [[1 1 1][0 1 2]] [-2 -1]] gkz res-dual $
717: $ $
718: $Example 7: [ [(x Dx -1) (Dx^2)] [(x)]] res-dual $
719: $Example 8: [ [[(1) (0)] [(0) (Dx)]] [(x)]] res-dual $
720: $Example 9: [ [((x Dx + x +1) (Dx-1))] [(x)]] res-dual $
721: ]] putUsages
722:
723: %%% From 1999/Int/sst.sm1
724: /saturation1 {
725: /arg1 set
726: [/in-saturation1 /ff /vlist /ulist /mm /hlist /iii
727: /i /uweight /aaa
728: ] pushVariables
729: [(KanGBmessage) (CurrentRingp)] pushEnv
730: [
731: /ff arg1 def
732: /iii ff 0 get {toString} map def %% ideal
733: /hlist ff 1 get {toString} map def %% saturation polynomials
734: /vlist [ff 2 get to_records pop] def
735: /mm hlist length def
736:
737: [(KanGBmessage) 0] system_variable
738: /ulist [ 0 1 mm 1 sub { /i set [(_u) i] cat } for ] def
739: /uweight ulist { 1 } map def
740: [vlist ulist join from_records ring_of_polynomials
741: [uweight] weight_vector 0] define_ring
742: [0 1 mm 1 sub { /i set hlist i get .
743: ulist i get . mul (1). sub } for]
744: /hlist set
745: %%hlist pmat
746: [iii {.} map hlist join] groebner_sugar 0 get /aaa set
747: %%[aaa ulist] pmat
748: aaa ulist eliminatev /arg1 set
749: ] pop
750: popEnv
751: popVariables
752: arg1
753: } def
754:
755: [(saturation1)
756: [([ideal saturation-poly vlist] saturation jjj)
757: $It returns(((ideal:f_1^\infty):f_2^\infty) ...) where$
758: $saturation-poly is [f_1, f_2, ...]$
759: $Example 1: $
760: $ [[(x1 y1 + x2 y2 + x3 y3 + x4 y4) $
761: $ (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)]$
762: $ [(y1) (y2) (y3) (y4)] (x1,x2,x3,x4,y1,y2,y3,y4)] saturation1$
763: $ /ff set [ff (x1,x2,x3,x4,y1,y2,y3,y4) $
764: $ [[(y1) 1 (y2) 1 (y3) 1 (y4) 1]]] pgb $
765: $ 0 get [(y1) (y2) (y3) (y4)] eliminatev ::$
766: ]] putUsages
767:
768:
769: /intersection {
770: /arg1 set
771: [/in-intersection2 /ii /jj /rr /vlist /ii2 /jj2 ] pushVariables
772: [(CurrentRingp) (KanGBmessage)] pushEnv
773: [
774: /ii arg1 0 get def
775: /jj arg1 1 get def
776: /vlist arg1 2 get def
777:
778: [(KanGBmessage) 0] system_variable
779:
780: [vlist to_records pop] /vlist set
781: [vlist [(_t)] join from_records ring_of_differential_operators
782: [[(_t) 1]] weight_vector 0] define_ring
783: ii { toString . (_t). mul } map /ii2 set
784: jj { toString . (1-_t). mul } map /jj2 set
785: [ii2 jj2 join] groebner_sugar 0 get
786: [(_t)] eliminatev /arg1 set
787: ] pop
788: popEnv
789: popVariables
790: arg1
791: } def
792:
793: [(intersection)
794: [(Ideal intersections in the ring of differential operators.)
795: $Example 1: [[[(x1) (x2)] [(x2) (x4)] (x1,x2,x3,x4)] intersection$
796: $ [(x2) (x4^2)] (x1,x2,x3,x4)] intersection :: $
797: $Example 2: [[[(x1) (x2)] [(x2) (x4)] (x1,x2,x3,x4)] intersection$
798: $ [(x2) (x4^2)] (x1,x2,x3,x4)] intersection /ff set ff message$
799: $ [ ff [(x2^2) (x3) (x4)] (x1,x2,x3,x4)] intersection :: $
800: $Example 3: [[[(x1) (x2)] [(x2) (x4^2)] (x1,x2,x3,x4)] intersection$
801: $ [(x2^2) (x3) (x4)] (x1,x2,x3,x4)] intersection :: $
802: ]] putUsages
803:
804:
805: /saturation2 {
806: /arg1 set
807: [/in-saturation2 /ff /vlist /mm /slist /iii
808: /i /aaa
809: ] pushVariables
810: [(KanGBmessage) (CurrentRingp)] pushEnv
811: [
812: /ff arg1 def
813: /iii ff 0 get {toString} map def %% ideal
814: /slist ff 1 get {toString} map def %% saturation polynomials
815: /vlist ff 2 get def
816: /mm slist length def
817:
818: /aaa [iii [slist 0 get] vlist] saturation1 def
819: 1 1 mm 1 sub {
820: /i set
821: [[iii [slist i get] vlist] saturation1
822: aaa vlist] intersection /aaa set
823: } for
824: /arg1 aaa def
825: ] pop
826: popEnv
827: popVariables
828: arg1
829: } def
830:
831: [(saturation2)
832: [([ideal saturation-poly vlist] saturations jjj)
833: $It returns (ideal:f_1^infty) \cap (ideal:f_2^\infty) \cap ... where$
834: $saturation-poly is [f_1, f_2, ...]$
835: $Example 1: $
836: $ [[(x1 y1 + x2 y2 + x3 y3 + x4 y4) $
837: $ (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)]$
838: $ [(y1) (y2) (y3) (y4)] (x1,x2,x3,x4,y1,y2,y3,y4)] saturation2$
839: $ /ff set [ff (x1,x2,x3,x4,y1,y2,y3,y4) $
840: $ [[(y1) 1 (y2) 1 (y3) 1 (y4) 1]]] pgb $
841: $ 0 get [(y1) (y2) (y3) (y4)] eliminatev ::$
842: $Example 2: [[(x2^2) (x2 x4) (x2) (x4^2)] [(x2) (x4)] (x2,x4)] saturation2$
843: ]] putUsages
844:
845: /innerProduct {
846: { [ 2 1 roll ] } map /innerProduct.tmp2 set
847: /innerProduct.tmp1 set
848: [innerProduct.tmp1] innerProduct.tmp2 mul
849: 0 get 0 get
850: } def
851:
852: /saturation {
853: /arg1 set
854: [/in-saturation /ff /vlist /mm /slist /iii
855: /i /aaa /vlist2
856: ] pushVariables
857: [(KanGBmessage) (CurrentRingp)] pushEnv
858: [
859: /ff arg1 def
860: /iii ff 0 get {toString} map def %% ideal
861: /slist ff 1 get {toString} map def %% saturation polynomials
862: /vlist ff 2 get def
863: /mm slist length def
864:
865: [vlist to_records pop] [(_z) (_y)] join /vlist2 set
866: [vlist2 from_records ring_of_polynomials
867: [[(_z) 1 (_y) 1]] weight_vector
868: 0] define_ring
869:
870: [
871: [
872: [0 1 mm 1 sub { /i set (_y). i npower } for ]
873: slist {.} map innerProduct (_z). sub
874: ]
875: iii {.} map join
876:
877: [(_z)]
878: vlist2 from_records
879: ] saturation1 /aaa set
880:
881: [(KanGBmessage) 0] system_variable
882: aaa {toString .} map /aaa set
883: [aaa] groebner_sugar 0 get
884: [(_z) (_y)] eliminatev
885: /arg1 set
886: ] pop
887: popEnv
888: popVariables
889: arg1
890: } def
891:
892: [(saturation)
893: [([ideal J vlist] saturations jjj)
894: $It returns (ideal : J^\infty) $
895: (Saturation is computed in the ring of polynomials.)
896: $When J=[f_1, f_2, ...], it is equal to $
897: $((ideal, z-(f_1 + y f_2 + y^2 f_3 +...)) : z^\infty) \cap k[x].$
898: $Example 1: $
899: $ [[(x1 y1 + x2 y2 + x3 y3 + x4 y4) $
900: $ (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)]$
901: $ [(y1) (y2) (y3) (y4)] (x1,x2,x3,x4,y1,y2,y3,y4)] saturation$
902: $ /ff set [ff (x1,x2,x3,x4,y1,y2,y3,y4) $
903: $ [[(y1) 1 (y2) 1 (y3) 1 (y4) 1]]] pgb $
904: $ 0 get [(y1) (y2) (y3) (y4)] eliminatev ::$
905: $Example 2: [[(x2^2) (x2 x4) (x2) (x4^2)] [(x2) (x4)] (x2,x4)] saturation$
1.3 takayama 906: ]] putUsages
907:
908:
909: %% 2000, 6/8, at Fernando Colon, 319, Sevilla
910:
911:
912: /isExact.verbose 1 def %% should be changed to gb.verbose
913: /isExact_h {
914: /arg1 set
915: [/in-isExact_h /vv /comp /i /j /n /kernel.i /ans] pushVariables
916: [
917: /comp arg1 0 get def
918: /vv arg1 1 get def
919: /n comp length def
920: /ans 1 def
921: 0 1 n 2 sub {
922: /i set
923: /j i 1 add def
924: isExact.verbose { (Checking ker ) messagen i messagen ( = im of ) messagen
925: j message } { } ifelse
926: [comp i get vv] syz_h 0 get /kernel.i set
927: [ kernel.i comp j get vv] isSameIdeal_h /ans set
928: ans 0 eq {
929: (image != kernel at ) messagen i messagen ( and ) messagen j message
930: /LLL.isExact_h goto
931: } { } ifelse
932: isExact.verbose { (OK) message } { } ifelse
933: } for
934: /LLL.isExact_h
935: /arg1 ans def
936: ] pop
937: arg1
938: } def
939:
940: [(isExact_h)
941: [( complex isExact_h bool )
942: (It returns 1 when the given complex is exact. All computations are done)
943: (in D<h>, the ring of homogenized differential operators.)
944: (cf. syz_h, isSameIdeal_h )
945: $Example1: [ [[1 2 3]] [0]] gkz /ff set $
946: $ [ff 0 get (x1,x2,x3) [[(x2) -1 (Dx2) 1]]] resol1 /gg set $
947: $ [gg (x1,x2,x3)] isExact_h :: $
948: $ gg 1 get 0 get /pp set $
949: $ gg [1 1] pp put $
950: $ [gg (x1,x2,x3)] isExact_h :: $
951: ]] putUsages
952:
953: /isExact {
954: /arg1 set
955: [/in-isExact /vv /comp /i /j /n /kernel.i /ans] pushVariables
956: [
957: /comp arg1 0 get def
958: /vv arg1 1 get def
959: /n comp length def
960: /ans 1 def
961: 0 1 n 2 sub {
962: /i set
963: /j i 1 add def
964: isExact.verbose { (Checking ker ) messagen i messagen ( = im of ) messagen
965: j message } { } ifelse
966: [comp i get vv] syz 0 get /kernel.i set
967: [ kernel.i comp j get vv] isSameIdeal /ans set
968: ans 0 eq {
969: (image != kernel at ) messagen i messagen ( and ) messagen j message
970: /LLL.isExact goto
971: } { } ifelse
972: isExact.verbose { (OK) message } { } ifelse
973: } for
974: /LLL.isExact
975: /arg1 ans def
976: ] pop
977: arg1
978: } def
979:
980: [(isExact)
981: [( complex isExact bool )
982: (It returns 1 when the given complex is exact. All computations are done)
983: (in D, the ring of differentialoperators. Inputs are dehomogenized.)
984: (cf. syz, isSameIdeal )
985: $Example1: [ [[1 2 3]] [0]] gkz /ff set $
986: $ [ff 0 get (x1,x2,x3) [[(x2) -1 (Dx2) 1]]] resol1 /gg set $
987: $ [gg (x1,x2,x3)] isExact :: $
988: $ gg 1 get 0 get /pp set $
989: $ gg [1 1] pp put $
990: $ [gg (x1,x2,x3)] isExact :: $
991: $Example2: [ [[1 2 3]] [0]] gkz /ff set $
992: $ [ff 0 get (x1,x2,x3) [[(x2) -1 (Dx2) 1]]] resol1 /gg set $
993: $ gg dehomogenize /gg set $
994: $ [gg (x1,x2,x3)] isExact :: $
995: ( The syzygies of f_i^h in D<h> do not always give generators of )
996: ( the corresponding syzygy of f_i in D.)
1.1 maekawa 997: ]] putUsages
998:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to complex.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc