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