Annotation of OpenXM/src/kan96xx/Doc/complex.sm1, Revision 1.8
1.8 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/complex.sm1,v 1.7 2001/11/26 01:25:44 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
1.6 takayama 270: [/in-res-solv /M /d /ans /B /vv /G /rr /rng /nn] pushVariables
1.1 maekawa 271: [(CurrentRingp) (KanGBmessage)] pushEnv
272: [
1.6 takayama 273: /nn arg1 length def
1.1 maekawa 274: /M arg1 0 get def
275: /d arg1 1 get def
1.6 takayama 276: nn 3 eq {
277: /rng arg1 2 get def
278: }{
279: M getRing /rng set
280: rng tag RingP eq { }
281: { d getRing /rng set } ifelse
282: }ifelse
1.1 maekawa 283: rng res-getx /vv set
284: uli.verbose { (res-solv : vv = ) messagen vv message } { } ifelse
285: uli.verbose { } { [(KanGBmessage) 0] system_variable } ifelse
286: M dehomogenize /M set
287: [vv from_records ring_of_differential_operators 0] define_ring
288: M 0 get isArray {
289: M { { toString . } map } map /M set
290: } {
291: M { toString . } map /M set
292: } ifelse
293: [M [(needBack)]] groebner_sugar /G set
294: G 1 get /B set
295:
296: d isArray {
297: d 0 get isArray { [d] fromVectors 0 get /d set } { } ifelse
298: [d] fromVectors 0 get /d set
299: } { } ifelse
300: d toString . dehomogenize /d set
301:
302: /res-solv.d d def
303: /res-solv.G G def
304:
305: d G 0 get reduction-noH /rr set
306: rr 0 get (0). eq {
307: [rr 2 get] B mul 0 get /ans set
308: /ans [ ans { toString rng ,, (-1) rng ,, mul} map
309: rr 1 get toString .. ] def
310: } {
311: /ans null def
312: } ifelse
313: /arg1 ans def
314: ] pop
315: popEnv
316: popVariables
317: arg1
318: } def
319: [(res-solv)
320: [$[M d] res-solv [c' r] $
321: $ M : matrix, d, c' : vectors, r : scalar(integer) $
322: $ c:=c'/r is a solutions of Sum[c_i M_i] = d where c_i is the i-th element $
323: $ of the vector c and M_i is the i-th row vector of M.$
324: $If there is no solution, then res-solv returns null. $
325: (Note that M and d are not treated as an element of the homogenized Weyl)
326: (algebra. If M or d contains the homogenization variable h, it automatically)
327: (set to 1. If you need to use h, use the command res-solv-h)
1.6 takayama 328: $[M d rng] res-solv [c' r] $
329: $ rng is a ring object. $
330: $ res-solv extracts variables names from rng, but defines a new ring. $
1.1 maekawa 331: $Example 1: [(x,y) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0] $
332: $ define_ring $
333: $ [ [ [(x Dx + 2).] [ (Dx (x Dx + 3) - (x Dx + 2) (x Dx -4)).]] [(1).]] $
334: $ res-solv :: $
335: $Example 2: $
336: $ [ [ (x Dx + 2). (Dx (x Dx + 3) - (x Dx + 2) (x Dx -4)).] (1).] $
337: $ res-solv :: $
338: $Example 3: $
339: $ [ [[(x Dx + 2). (0).] $
340: $ [(Dx+3). (x^3).]$
341: $ [(3). (x).]$
342: $ [(Dx (x Dx + 3) - (x Dx + 2) (x Dx -4)). (0).]] [(1). (0).]] $
343: $ res-solv :: $
344: $Example 4: $
345: $ [[ (x*Dx+h^2). (Dx^2+x*h).] [(x^2+h^2). (h Dx + x^2).]] /ff set $
346: $ [[ (x^2 Dx + x h^2). (Dx^3).]] /gg set $
347: $ [ff gg ff mul 0 get ] res-solv-h :: $
348: $ $
349: $res*solv and res*solv*h accept string inputs, too. For example,$
350: $ [[ [ [(x Dx + 2)] [ (Dx (x Dx + 3) - (x Dx + 2) (x Dx -4))]] [(1)]] $
351: $ (x)] res*solv :: $
352: ]] putUsages
353: /res*solv {
354: /arg1 set
355: [/in-res*solv /A] pushVariables
356: [(CurrentRingp)] pushEnv
357: [
358: /A arg1 def
359: A 1 get res-setRing pop
360: A 0 get res-toString expand res-solv /arg1 set
361: ] pop
362: popEnv
363: popVariables
364: arg1
365: } def
366:
367: %% Solving \sum c_i M_i = d
368: %% [M d] res-solv-h c'/r ;
369: %% M : matrix, d, c' : vectors, r : scalar, c'/r =c
370: /res-solv-h {
371: /arg1 set
1.6 takayama 372: [/in-res-solv-h /M /d /ans /B /vv /G /rr /rng /nn] pushVariables
1.1 maekawa 373: [(CurrentRingp) (KanGBmessage)] pushEnv
374: [
1.6 takayama 375: /nn arg1 length def
1.1 maekawa 376: /M arg1 0 get def
377: /d arg1 1 get def
1.6 takayama 378: nn 3 eq {
379: /rng arg1 2 get def
380: }{
381: M getRing /rng set
382: rng tag RingP eq { }
383: { d getRing /rng set } ifelse
384: }ifelse
1.1 maekawa 385: rng res-getx /vv set
386: uli.verbose { (res-solv-h : vv = ) messagen vv message } { } ifelse
387: uli.verbose { } { [(KanGBmessage) 0] system_variable } ifelse
388: [vv from_records ring_of_differential_operators 0] define_ring
389: M 0 get isArray {
390: M { { toString . } map } map /M set
391: } {
392: M { toString . } map /M set
393: } ifelse
394:
395: getOptions /options set
396: (grade) (module1v) switch_function
397: [M [(needBack)]] groebner /G set
398: options restoreOptions
399:
400: G 1 get /B set
401:
402: d isArray {
403: d 0 get isArray { [d] fromVectors 0 get /d set } { } ifelse
404: [d] fromVectors 0 get /d set
405: } { } ifelse
406: d toString . /d set
407:
408: /res-solv.d d def
409: /res-solv.G G def
410:
411: d G 0 get reduction /rr set
412: rr 0 get (0). eq {
413: [rr 2 get] B mul 0 get /ans set
414: /ans [ ans { toString rng ,, (-1) rng ,, mul} map
415: rr 1 get toString .. ] def
416: } {
417: /ans null def
418: } ifelse
419: /arg1 ans def
420: ] pop
421: popEnv
422: popVariables
423: arg1
424: } def
425: /res*solv*h {
426: /arg1 set
427: [/in-res*solv*h /A] pushVariables
428: [(CurrentRingp)] pushEnv
429: [
430: /A arg1 def
431: A 1 get res-setRing pop
432: A 0 get res-toString expand res-solv-h /arg1 set
433: ] pop
434: popEnv
435: popVariables
436: arg1
437: } def
438:
439: %% See also xm, sm1_mul, sm1_mul_d, sm1_mul_h
440: /res*mul {
441: /arg1 set
442: [/in-res*mul /A] pushVariables
443: [(CurrentRingp)] pushEnv
444: [
445: /A arg1 def
446: A 1 get res-setRing pop
447: A 0 get 0 get res-toString expand
448: A 0 get 1 get res-toString expand
449: mul dehomogenize
450: /arg1 set
451: ] pop
452: popEnv
453: popVariables
454: arg1
455: } def
456: /res*mul*h {
457: /arg1 set
458: [/in-res*mul*h /A] pushVariables
459: [(CurrentRingp)] pushEnv
460: [
461: /A arg1 def
462: A 1 get res-setRing pop
463: A 0 get 0 get res-toString expand
464: A 0 get 1 get res-toString expand
465: mul
466: /arg1 set
467: ] pop
468: popEnv
469: popVariables
470: arg1
471: } def
472:
473: %% cf. sm1_adjoint
474: /res*adjoint {
475: /arg1 set
476: [/in-res*adjoint /A /p /v /p0 /ans] pushVariables
477: [(CurrentRingp)] pushEnv
478: [
479: /A arg1 def
480: A 1 get res-setRing pop
481: A 0 get res-toString expand dehomogenize /p set
482: /v res-setRing.v def
483: p isArray {
484: p { /p0 set [p0 v] res*adjoint } map /ans set
485: }{
486: p v adjoint dehomogenize /ans set
487: }ifelse
488: /arg1 ans def
489: ] pop
490: popEnv
491: popVariables
492: arg1
493: } def
494:
495: /res-init-m {
496: /arg1 set
497: [/in-res-init-m /A /ans] pushVariables
498: [
499: /A arg1 def
500: A isArray {
501: A { res-init-m } map /ans set
502: }{
503: A init /ans set
504: }ifelse
505: /arg1 ans def
506: ] pop
507: popVariables
508: arg1
509: } def
510:
511: /res-ord_w-m {
512: /arg2 set
513: /arg1 set
514: [/in-ord_w-m /A /ans /w] pushVariables
515: [
516: /A arg1 def
517: /w arg2 def
518: A isArray {
519: A { w res-ord_w-m } map /ans set
520: }{
521: A w ord_w /ans set
522: }ifelse
523: /arg1 ans def
524: ] pop
525: popVariables
526: arg1
527: } def
528:
529: %% cf. sm1_resol1
530: /res*resol1 {
531: /arg1 set
532: [/in-res*resol1 /A /ans /w /ans1 /ans2] pushVariables
533: [
534: /A arg1 def
535: A length 3 ge {
536: /w A 2 get def %% weight vector
537: } {
538: /w null def
539: }ifelse
540: A resol1 /ans set
541: /ans1 ans res-init-m def
542: w tag 0 eq {
543: /ans [ans ans1] def
544: }{
545: ans w 0 get res-ord_w-m /ans2 set
546: /ans [ans ans1 ans2] def
547: }ifelse
548: /arg1 ans def
549: ] pop
550: popVariables
551: arg1
552: } def
553:
554: %% @@@
555:
556: %% submodule to quotient module
557: %% M res-sub2Q ==> J, where M \simeq D^m/J
558: /res-sub2Q {
559: /arg1 set
560: [/in-res-sub2Q /M /m] pushVariables
561: [
562: /M arg1 def
563: M 0 get isArray {
564: }{ M { [ 2 1 roll ] } map /M } ifelse
565: M { dehomogenize homogenize } map /M set
566: [M [(needSyz)]] groebner 2 get dehomogenize /arg1 set
567: ] pop
568: popVariables
569: arg1
570: } def
571: [(res-sub2Q)
572: [(M res-sub2Q J)
573: (matrix M, J; )
574: (The submodule generated by M is isomorphic to D^m/J.)
575: ]] putUsages
576:
577:
578: %% submodules to quotient module
579: %% [M N] res-subsub2Q ==> J, where M \simeq D^m/J
580: /res-subsub2Q {
581: /arg1 set
582: [/in-res-subsub2Q /M /N /ss /m /n /ss2] pushVariables
583: [
584: /M arg1 0 get def
585: /N arg1 1 get def
586: /m M length def
587: /n N length def
588: M 0 get isArray {
589: }{ M { [ 2 1 roll ] } map /M } ifelse
590: N 0 get isArray {
591: }{ N { [ 2 1 roll ] } map /N } ifelse
592: M { dehomogenize homogenize } map /M set
593: N { dehomogenize homogenize } map /N set
594: [M N join [(needSyz)]] groebner 2 get /ss set
595: ss dehomogenize /ss set
596: ss { [ 2 1 roll aload pop 1 1 n { pop pop } for ] } map
597: /ss2 set
598: ss2 {homogenize} map /ss2 set
599: [ss2 0 get length [ss2] groebner 0 get dehomogenize ] toVectors2
600: /arg1 set
601: ] pop
602: popVariables
603: arg1
604: } def
605:
606: /res-newpvec {
607: /arg1 set
608: [/in-res-newpvec /n ] pushVariables
609: [
610: /n arg1 def
611: [1 1 n { pop (0). } for] /arg1 set
612: ] pop
613: popVariables
614: arg1
615: } def
616:
617: %% ki.sm1 kernel/image, 1999, 2/4
618: %% ki.sm1 is now moved to gbhg3/Int.
619: %% It is included in lib/complex.sm1
620: /kernel-image.v 1 def
621: /kernel-image.p 0 def % characteristic
622: %%
623: %% D^p <-- m --- D^q <-- n -- D^r
624: %% ker(m)/im(n)
625: %%
626: /res-kernel-image {
627: /arg1 set
628: [/in-res-kernel-image /p /q /r /m /n /t
629: /vlist /s0 /s1 /ans
630: ] pushVariables
631: [
632: /m arg1 0 get def
633: /n arg1 1 get def
634: /vlist arg1 2 get def
635: vlist isArray {
636: vlist from_records /vlist
637: } { } ifelse
638: [vlist ring_of_differential_operators kernel-image.p] define_ring
639: m { {toString . dehomogenize toString} map } map /m set
640: m length /q set
641: n { {toString . dehomogenize toString} map } map /n set
642: n length /r set
643:
644: [m vlist] syz 0 get {{toString} map} map /s0 set
645: /t s0 length def
646: [ s0 n join vlist ] syz 0 get /s1 set
647: s1 { t carN } map /ans set
648:
649: /arg1 ans def
650: ] pop
651: popVariables
652: arg1
653: } def
654: [(res-kernel-image)
655: [( [m n vlist] res-kernel-image c )
656: (When, D^p <-- m --- D^q <-- n -- D^r )
657: (D^q/c is isomorhic to ker(m)/im(n).)
658: (vlist is a list of variables.)
659: ]] putUsages
660:
661:
662: /res-dual {
663: /arg1 set
664: [/in-res-dual ] pushVariables
665: [
666: arg1 0 get /input set
667: arg1 1 get /vlist set
668: /n vlist length def
669: /vv vlist from_records def
670:
671: %% preprocess to input resol0. Future version of resol1 should do them.
672: input 0 get isArray {
673: /kernel-image.unknowns input 0 get length def
674: } { /kernel-image.unknowns 1 def } ifelse
675: [vv ring_of_differential_operators
676: kernel-image.p ] define_ring
677: input 0 get isArray {
678: input { {toString . dehomogenize toString} map
679: } map /input set
680: }{ input { toString . dehomogenize toString} map /input set } ifelse
681:
682: [input vv]
683: resol0 /rr set
684:
685: %% Postprocess of resol0
686: [vv ring_of_differential_operators
687: kernel-image.p ] define_ring
688: [ [kernel-image.unknowns rr 0 get { toString . dehomogenize } map]
689: toVectors2 { {toString} map } map ]
690: rr 1 get join /rr-syz set
691: %%% end. The result is in rr-syz.
692:
693: /M rr-syz << n >> get def
694: /N rr-syz << n 1 sub >> get def
695: M [ ] eq {
696: /q N length def
697: /M [ [0 1 q 1 sub { pop (0). } for] ] def
698: } { } ifelse
699:
700: %% regard them as a map from row vector v to row vector w; v M --> w
701: uli.verbose {
702: (M = ) messagen M pmat
703: (N = ) messagen N pmat
704: } { } ifelse
705: M transpose { { toString . dehomogenize vv adjoint} map } map /M set
706: N transpose { { toString . dehomogenize vv adjoint} map } map /N set
707: uli.verbose {
708: $We are now computing ker (*N)/im (*M).$ message
709: (*N = ) messagen N pmat
710: (*M = ) messagen M pmat
711: ( *N *M = ) messagen N M mul dehomogenize message
712: ( ) message
713: }{ } ifelse
714: /M M {{toString} map } map def
715: /N N {{toString} map } map def
716: [M N vv] res-kernel-image {{toString} map}map /ans1 set
717: [ans1 vv] gb 0 get /arg1 set
718: ] pop
719: popVariables
720: arg1
721: } def
722:
723: [(res-dual)
724: [$[F V] res-dual G$
725: $G is the dual D-module of F. V is a list of variables.$
726: $Example 1: [ [( x^3-y^2 ) ( 2 x Dx + 3 y Dy + 6 ) ( 2 y Dx + 3 x^2 Dy) ] $
727: $ [(x) (y)]] res-dual $
728: $Example 2: [[1 3 4 5]] appell1 res-dual $
729: $Example 3: [ [(-x1 Dx1 + x1 + 2) (x2 Dx2 - Dx2 -3)] [(x1) (x2)]] res-dual $
730: $Example 4: [ [(x2 Dx2 - Dx2 + 4) (x1 Dx1 + x1 +3)] [(x1) (x2)]] res-dual $
731: $ 3 and 4 are res-dual each other. $
732: $Example 5: [ [[1 1 1][0 1 2]] [0 0]] gkz res-dual $
733: $Example 6: [ [[1 1 1][0 1 2]] [-2 -1]] gkz res-dual $
734: $ $
735: $Example 7: [ [(x Dx -1) (Dx^2)] [(x)]] res-dual $
736: $Example 8: [ [[(1) (0)] [(0) (Dx)]] [(x)]] res-dual $
737: $Example 9: [ [((x Dx + x +1) (Dx-1))] [(x)]] res-dual $
738: ]] putUsages
739:
740: %%% From 1999/Int/sst.sm1
741: /saturation1 {
742: /arg1 set
743: [/in-saturation1 /ff /vlist /ulist /mm /hlist /iii
744: /i /uweight /aaa
745: ] pushVariables
746: [(KanGBmessage) (CurrentRingp)] pushEnv
747: [
748: /ff arg1 def
749: /iii ff 0 get {toString} map def %% ideal
750: /hlist ff 1 get {toString} map def %% saturation polynomials
751: /vlist [ff 2 get to_records pop] def
752: /mm hlist length def
753:
754: [(KanGBmessage) 0] system_variable
755: /ulist [ 0 1 mm 1 sub { /i set [(_u) i] cat } for ] def
756: /uweight ulist { 1 } map def
757: [vlist ulist join from_records ring_of_polynomials
758: [uweight] weight_vector 0] define_ring
759: [0 1 mm 1 sub { /i set hlist i get .
760: ulist i get . mul (1). sub } for]
761: /hlist set
762: %%hlist pmat
763: [iii {.} map hlist join] groebner_sugar 0 get /aaa set
764: %%[aaa ulist] pmat
765: aaa ulist eliminatev /arg1 set
766: ] pop
767: popEnv
768: popVariables
769: arg1
770: } def
771:
772: [(saturation1)
773: [([ideal saturation-poly vlist] saturation jjj)
774: $It returns(((ideal:f_1^\infty):f_2^\infty) ...) where$
775: $saturation-poly is [f_1, f_2, ...]$
776: $Example 1: $
777: $ [[(x1 y1 + x2 y2 + x3 y3 + x4 y4) $
778: $ (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)]$
779: $ [(y1) (y2) (y3) (y4)] (x1,x2,x3,x4,y1,y2,y3,y4)] saturation1$
780: $ /ff set [ff (x1,x2,x3,x4,y1,y2,y3,y4) $
781: $ [[(y1) 1 (y2) 1 (y3) 1 (y4) 1]]] pgb $
782: $ 0 get [(y1) (y2) (y3) (y4)] eliminatev ::$
783: ]] putUsages
784:
785:
786: /intersection {
787: /arg1 set
788: [/in-intersection2 /ii /jj /rr /vlist /ii2 /jj2 ] pushVariables
789: [(CurrentRingp) (KanGBmessage)] pushEnv
790: [
791: /ii arg1 0 get def
792: /jj arg1 1 get def
793: /vlist arg1 2 get def
794:
795: [(KanGBmessage) 0] system_variable
796:
797: [vlist to_records pop] /vlist set
798: [vlist [(_t)] join from_records ring_of_differential_operators
799: [[(_t) 1]] weight_vector 0] define_ring
800: ii { toString . (_t). mul } map /ii2 set
801: jj { toString . (1-_t). mul } map /jj2 set
802: [ii2 jj2 join] groebner_sugar 0 get
803: [(_t)] eliminatev /arg1 set
804: ] pop
805: popEnv
806: popVariables
807: arg1
808: } def
809:
810: [(intersection)
811: [(Ideal intersections in the ring of differential operators.)
1.7 takayama 812: ([ I1 I2 V-list ] intersection : I1 and I2 are ideals, and V-list)
813: (is a list of variables. It returns the ideal intersection of I1 and I2.)
814: (Intersection is computed in the ring of differential operators.)
1.1 maekawa 815: $Example 1: [[[(x1) (x2)] [(x2) (x4)] (x1,x2,x3,x4)] intersection$
816: $ [(x2) (x4^2)] (x1,x2,x3,x4)] intersection :: $
817: $Example 2: [[[(x1) (x2)] [(x2) (x4)] (x1,x2,x3,x4)] intersection$
818: $ [(x2) (x4^2)] (x1,x2,x3,x4)] intersection /ff set ff message$
819: $ [ ff [(x2^2) (x3) (x4)] (x1,x2,x3,x4)] intersection :: $
820: $Example 3: [[[(x1) (x2)] [(x2) (x4^2)] (x1,x2,x3,x4)] intersection$
821: $ [(x2^2) (x3) (x4)] (x1,x2,x3,x4)] intersection :: $
822: ]] putUsages
823:
824:
825: /saturation2 {
826: /arg1 set
827: [/in-saturation2 /ff /vlist /mm /slist /iii
828: /i /aaa
829: ] pushVariables
830: [(KanGBmessage) (CurrentRingp)] pushEnv
831: [
832: /ff arg1 def
833: /iii ff 0 get {toString} map def %% ideal
834: /slist ff 1 get {toString} map def %% saturation polynomials
835: /vlist ff 2 get def
836: /mm slist length def
837:
838: /aaa [iii [slist 0 get] vlist] saturation1 def
839: 1 1 mm 1 sub {
840: /i set
841: [[iii [slist i get] vlist] saturation1
842: aaa vlist] intersection /aaa set
843: } for
844: /arg1 aaa def
845: ] pop
846: popEnv
847: popVariables
848: arg1
849: } def
850:
851: [(saturation2)
852: [([ideal saturation-poly vlist] saturations jjj)
853: $It returns (ideal:f_1^infty) \cap (ideal:f_2^\infty) \cap ... where$
854: $saturation-poly is [f_1, f_2, ...]$
855: $Example 1: $
856: $ [[(x1 y1 + x2 y2 + x3 y3 + x4 y4) $
857: $ (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)]$
858: $ [(y1) (y2) (y3) (y4)] (x1,x2,x3,x4,y1,y2,y3,y4)] saturation2$
859: $ /ff set [ff (x1,x2,x3,x4,y1,y2,y3,y4) $
860: $ [[(y1) 1 (y2) 1 (y3) 1 (y4) 1]]] pgb $
861: $ 0 get [(y1) (y2) (y3) (y4)] eliminatev ::$
862: $Example 2: [[(x2^2) (x2 x4) (x2) (x4^2)] [(x2) (x4)] (x2,x4)] saturation2$
863: ]] putUsages
864:
865: /innerProduct {
866: { [ 2 1 roll ] } map /innerProduct.tmp2 set
867: /innerProduct.tmp1 set
868: [innerProduct.tmp1] innerProduct.tmp2 mul
869: 0 get 0 get
870: } def
871:
872: /saturation {
873: /arg1 set
874: [/in-saturation /ff /vlist /mm /slist /iii
875: /i /aaa /vlist2
876: ] pushVariables
877: [(KanGBmessage) (CurrentRingp)] pushEnv
878: [
879: /ff arg1 def
880: /iii ff 0 get {toString} map def %% ideal
881: /slist ff 1 get {toString} map def %% saturation polynomials
882: /vlist ff 2 get def
883: /mm slist length def
884:
1.8 ! takayama 885: vlist tag ArrayP eq {
! 886: vlist { toString } map from_records /vlist set
! 887: } { } ifelse
1.1 maekawa 888: [vlist to_records pop] [(_z) (_y)] join /vlist2 set
889: [vlist2 from_records ring_of_polynomials
890: [[(_z) 1 (_y) 1]] weight_vector
891: 0] define_ring
892:
893: [
894: [
895: [0 1 mm 1 sub { /i set (_y). i npower } for ]
896: slist {.} map innerProduct (_z). sub
897: ]
898: iii {.} map join
899:
900: [(_z)]
901: vlist2 from_records
902: ] saturation1 /aaa set
903:
904: [(KanGBmessage) 0] system_variable
905: aaa {toString .} map /aaa set
906: [aaa] groebner_sugar 0 get
907: [(_z) (_y)] eliminatev
908: /arg1 set
909: ] pop
910: popEnv
911: popVariables
912: arg1
913: } def
914:
915: [(saturation)
916: [([ideal J vlist] saturations jjj)
917: $It returns (ideal : J^\infty) $
918: (Saturation is computed in the ring of polynomials.)
919: $When J=[f_1, f_2, ...], it is equal to $
920: $((ideal, z-(f_1 + y f_2 + y^2 f_3 +...)) : z^\infty) \cap k[x].$
921: $Example 1: $
922: $ [[(x1 y1 + x2 y2 + x3 y3 + x4 y4) $
923: $ (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)]$
924: $ [(y1) (y2) (y3) (y4)] (x1,x2,x3,x4,y1,y2,y3,y4)] saturation$
925: $ /ff set [ff (x1,x2,x3,x4,y1,y2,y3,y4) $
926: $ [[(y1) 1 (y2) 1 (y3) 1 (y4) 1]]] pgb $
927: $ 0 get [(y1) (y2) (y3) (y4)] eliminatev ::$
928: $Example 2: [[(x2^2) (x2 x4) (x2) (x4^2)] [(x2) (x4)] (x2,x4)] saturation$
1.3 takayama 929: ]] putUsages
930:
931:
932: %% 2000, 6/8, at Fernando Colon, 319, Sevilla
933:
934:
935: /isExact.verbose 1 def %% should be changed to gb.verbose
936: /isExact_h {
937: /arg1 set
938: [/in-isExact_h /vv /comp /i /j /n /kernel.i /ans] pushVariables
939: [
940: /comp arg1 0 get def
941: /vv arg1 1 get def
942: /n comp length def
943: /ans 1 def
944: 0 1 n 2 sub {
945: /i set
946: /j i 1 add def
947: isExact.verbose { (Checking ker ) messagen i messagen ( = im of ) messagen
948: j message } { } ifelse
949: [comp i get vv] syz_h 0 get /kernel.i set
950: [ kernel.i comp j get vv] isSameIdeal_h /ans set
951: ans 0 eq {
952: (image != kernel at ) messagen i messagen ( and ) messagen j message
953: /LLL.isExact_h goto
954: } { } ifelse
955: isExact.verbose { (OK) message } { } ifelse
956: } for
957: /LLL.isExact_h
958: /arg1 ans def
959: ] pop
1.5 takayama 960: popVariables
1.3 takayama 961: arg1
962: } def
963:
964: [(isExact_h)
965: [( complex isExact_h bool )
966: (It returns 1 when the given complex is exact. All computations are done)
967: (in D<h>, the ring of homogenized differential operators.)
968: (cf. syz_h, isSameIdeal_h )
969: $Example1: [ [[1 2 3]] [0]] gkz /ff set $
970: $ [ff 0 get (x1,x2,x3) [[(x2) -1 (Dx2) 1]]] resol1 /gg set $
971: $ [gg (x1,x2,x3)] isExact_h :: $
972: $ gg 1 get 0 get /pp set $
973: $ gg [1 1] pp put $
974: $ [gg (x1,x2,x3)] isExact_h :: $
975: ]] putUsages
976:
977: /isExact {
978: /arg1 set
979: [/in-isExact /vv /comp /i /j /n /kernel.i /ans] pushVariables
980: [
981: /comp arg1 0 get def
982: /vv arg1 1 get def
983: /n comp length def
984: /ans 1 def
985: 0 1 n 2 sub {
986: /i set
987: /j i 1 add def
988: isExact.verbose { (Checking ker ) messagen i messagen ( = im of ) messagen
989: j message } { } ifelse
990: [comp i get vv] syz 0 get /kernel.i set
991: [ kernel.i comp j get vv] isSameIdeal /ans set
992: ans 0 eq {
993: (image != kernel at ) messagen i messagen ( and ) messagen j message
994: /LLL.isExact goto
995: } { } ifelse
996: isExact.verbose { (OK) message } { } ifelse
997: } for
998: /LLL.isExact
999: /arg1 ans def
1000: ] pop
1.5 takayama 1001: popVariables
1.3 takayama 1002: arg1
1003: } def
1004:
1005: [(isExact)
1006: [( complex isExact bool )
1007: (It returns 1 when the given complex is exact. All computations are done)
1008: (in D, the ring of differentialoperators. Inputs are dehomogenized.)
1009: (cf. syz, isSameIdeal )
1010: $Example1: [ [[1 2 3]] [0]] gkz /ff set $
1011: $ [ff 0 get (x1,x2,x3) [[(x2) -1 (Dx2) 1]]] resol1 /gg set $
1012: $ [gg (x1,x2,x3)] isExact :: $
1013: $ gg 1 get 0 get /pp set $
1014: $ gg [1 1] pp put $
1015: $ [gg (x1,x2,x3)] isExact :: $
1016: $Example2: [ [[1 2 3]] [0]] gkz /ff set $
1017: $ [ff 0 get (x1,x2,x3) [[(x2) -1 (Dx2) 1]]] resol1 /gg set $
1018: $ gg dehomogenize /gg set $
1019: $ [gg (x1,x2,x3)] isExact :: $
1020: ( The syzygies of f_i^h in D<h> do not always give generators of )
1021: ( the corresponding syzygy of f_i in D.)
1.1 maekawa 1022: ]] putUsages
1023:
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