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