Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.6
1.6 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.5 2003/08/04 11:42:42 takayama Exp $
1.1 takayama 2: %[(parse) (hol.sm1) pushfile] extension
3: %[(parse) (appell.sm1) pushfile] extension
4:
5: (ecart.sm1 : ecart division for D, 2003/07/25 ) message-quiet
6: /ecart.begin { beginEcart } def
7: /ecart.end { endEcart } def
8: /ecart.autoHomogenize 1 def
9: /ecart.needSyz 0 def
10:
11: /ecart.dehomogenize {
12: /arg1 set
13: [/in.ecart.dehomogenize /ll /rr] pushVariables
14: [
15: /ll arg1 def
16: ll tag 6 eq {
17: ll { ecart.dehomogenize } map /ll set
18: } {
19: ll (0). eq {
20: } {
21: ll getRing /rr set
22: ll [ [ (H) rr ,, (1) rr ,, ]
23: [ (h) rr ,, (1) rr ,, ]] replace
24: /ll set
25: } ifelse
26: } ifelse
27: /arg1 ll def
28: ] pop
29: popVariables
30: arg1
31: } def
32: [(ecart.dehomogenize)
33: [(obj ecart.dehomogenize r)
34: (h->1, H->1)
35: ]] putUsages
36:
37: /ecart.dehomogenizeH {
38: /arg1 set
39: [/in.ecart.dehomogenize /ll /rr] pushVariables
40: [
41: /ll arg1 def
42: ll tag 6 eq {
43: ll { ecart.dehomogenize } map /ll set
44: } {
45: ll (0). eq {
46: } {
47: ll getRing /rr set
48: ll [ [ (H) rr ,, (1) rr ,, ] ] replace
49: /ll set
50: } ifelse
51: } ifelse
52: /arg1 ll def
53: ] pop
54: popVariables
55: arg1
56: } def
57: [(ecart.dehomogenizeH)
58: [(obj ecart.dehomogenizeH r)
59: (H->1, h is not changed.)
60: ]] putUsages
61:
62: /ecart.homogenize01 {
63: /arg1 set
64: [/in.ecart.homogenize01 /ll ] pushVariables
65: [
66: /ll arg1 def
67: [(degreeShift) [ ] ll ] homogenize
68: /arg1 set
69: ] pop
70: popVariables
71: arg1
72: } def
73: [(ecart.homogenize01)
74: [(obj ecart.homogenize01 r)
75: (Example: )
76: ( [(x1,x2) ring_of_differential_operators )
77: ( [[(H) 1 (h) 1 (x1) 1 (x2) 1] )
78: ( [(h) 1 (Dx1) 1 (Dx2) 1] )
79: ( [(Dx1) 1 (Dx2) 1] )
80: ( [(x1) -1 (x2) -1])
81: ( ] weight_vector )
82: ( 0 )
83: ( [(degreeShift) [[0 0 0]]])
84: ( ] define_ring)
85: ( ecart.begin)
86: ( [[1 -4 -2 5]] appell4 0 get /eqs set)
87: ( eqs { . [[(x1). (x1+2).] [(x2). (x2+4).]] replace} map )
88: ( ecart.homogenize01 /eqs2 set)
89: ( [eqs2] groebner )
90: ]] putUsages
91:
92: /ecart.homogenize01_with_shiftVector {
93: /arg2.set
94: /arg1 set
95: [/in.ecart.homogenize01 /ll /sv] pushVariables
96: [
97: /sv arg2 def
98: /ll arg1 def
99: [(degreeShift) sv ll ] homogenize
100: /arg1 set
101: ] pop
102: popVariables
103: arg1
104: } def
105: [(ecart.dehomogenize01_with_degreeShift)
106: [(obj shift-vector ecart.dehomogenize01_with_degreeShift r)
107: ]] putUsages
108:
109: %% Aux functions to return the default weight vectors.
110: /ecart.wv1 {
111: /arg1 set
112: [/in.ecart.wv1 /v] pushVariables
113: [
114: /v arg1 def
115: [(H) (h) v to_records pop] /v set
116: v { 1 } map /v set
117: /arg1 v def
118: ] pop
119: popVariables
120: arg1
121: } def
122: /ecart.wv2 {
123: /arg1 set
124: [/in.ecart.wv2 /v] pushVariables
125: [
126: /v arg1 def
127: [v to_records pop] /v set
128: v { [ @@@.Dsymbol 3 -1 roll ] cat 1 } map /v set
129: [(h) 1 ] v join /v set
130: /arg1 v def
131: ] pop
132: popVariables
133: arg1
134: } def
135:
136: /ecart.gb.verbose 1 def
137: /ecart.gb {
138: /arg1 set
139: [/in-ecart.gb /aa /typev /setarg /f /v
140: /gg /wv /vec /ans /rr /mm
141: /degreeShift /env2 /opt /ans.gb
142: ] pushVariables
143: [(CurrentRingp) (KanGBmessage)] pushEnv
144: [
145: /aa arg1 def
146: aa isArray { } { ( << array >> gb) error } ifelse
147: /setarg 0 def
148: /wv 0 def
149: /degreeShift 0 def
150: /opt [(weightedHomogenization) 1] def
151: aa { tag } map /typev set
152: typev [ ArrayP ] eq
153: { /f aa 0 get def
154: /v gb.v def
155: /setarg 1 def
156: } { } ifelse
157: typev [ArrayP StringP] eq
158: { /f aa 0 get def
159: /v aa 1 get def
160: /setarg 1 def
161: } { } ifelse
162: typev [ArrayP RingP] eq
163: { /f aa 0 get def
164: /v aa 1 get def
165: /setarg 1 def
166: } { } ifelse
167: typev [ArrayP ArrayP] eq
168: { /f aa 0 get def
169: /v aa 1 get from_records def
170: /setarg 1 def
171: } { } ifelse
172: typev [ArrayP StringP ArrayP] eq
173: { /f aa 0 get def
174: /v aa 1 get def
175: /wv aa 2 get def
176: /setarg 1 def
177: } { } ifelse
178: typev [ArrayP ArrayP ArrayP] eq
179: { /f aa 0 get def
180: /v aa 1 get from_records def
181: /wv aa 2 get def
182: /setarg 1 def
183: } { } ifelse
184: typev [ArrayP StringP ArrayP ArrayP] eq
185: { /f aa 0 get def
186: /v aa 1 get def
187: /wv aa 2 get def
188: /degreeShift aa 3 get def
189: /setarg 1 def
190: } { } ifelse
191: typev [ArrayP ArrayP ArrayP ArrayP] eq
192: { /f aa 0 get def
193: /v aa 1 get from_records def
194: /wv aa 2 get def
195: /degreeShift aa 3 get def
196: /setarg 1 def
197: } { } ifelse
198:
199: /env1 getOptions def
200:
201: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
202:
203: [(KanGBmessage) ecart.gb.verbose ] system_variable
204:
205: %%% Start of the preprocess
206: v tag RingP eq {
207: /rr v def
208: }{
209: f getRing /rr set
210: } ifelse
211: %% To the normal form : matrix expression.
212: f gb.toMatrixOfString /f set
213: /mm gb.itWasMatrix def
214:
215: rr tag 0 eq {
216: %% Define our own ring
217: v isInteger {
218: (Error in gb: Specify variables) error
219: } { } ifelse
220: wv isInteger {
221: [v ring_of_differential_operators
1.6 ! takayama 222: % [ v ecart.wv1 v ecart.wv2 ] weight_vector
1.3 takayama 223: gb.characteristic
1.1 takayama 224: opt
225: ] define_ring
226: }{
227: degreeShift isInteger {
228: [v ring_of_differential_operators
1.6 ! takayama 229: % [v ecart.wv1 v ecart.wv2] wv join weight_vector
! 230: wv weight_vector
1.3 takayama 231: gb.characteristic
1.1 takayama 232: opt
233: ] define_ring
234:
235: }{
236: [v ring_of_differential_operators
1.6 ! takayama 237: % [v ecart.wv1 v ecart.wv2] wv join weight_vector
! 238: wv weight_vector
1.3 takayama 239: gb.characteristic
1.1 takayama 240: [(degreeShift) degreeShift] opt join
241: ] define_ring
242:
243: } ifelse
244: } ifelse
245: } {
246: %% Use the ring structre given by the input.
247: v isInteger not {
248: gb.warning {
249: (Warning : the given ring definition is not used.) message
250: } { } ifelse
251: } { } ifelse
252: rr ring_def
253: /wv rr gb.getWeight def
254:
255: } ifelse
256: %%% Enf of the preprocess
257:
258: ecart.gb.verbose {
1.6 ! takayama 259: (The first and the second weight vectors for automatic homogenization: )
1.1 takayama 260: message
261: v ecart.wv1 message
262: v ecart.wv2 message
263: degreeShift isInteger { }
264: {
265: (The degree shift is ) messagen
266: degreeShift message
267: } ifelse
268: } { } ifelse
269:
1.5 takayama 270: %%BUG: case of v is integer
271: v ecart.checkOrder
272:
1.1 takayama 273: ecart.begin
274:
275: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
276: ecart.autoHomogenize {
277: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
278: message
279: } { } ifelse
280: ecart.autoHomogenize {
281: f { {. ecart.dehomogenize} map} map /f set
282: f ecart.homogenize01 /f set
283: }{
284: f { {. } map } map /f set
285: } ifelse
286: ecart.needSyz {
287: [f [(needSyz)] gb.options join ] groebner /gg set
288: } {
289: [f gb.options] groebner 0 get /gg set
290: } ifelse
291:
292: ecart.needSyz {
293: mm {
294: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
295: } { /ans.gb gg 0 get def } ifelse
296: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
297: ans pmat ;
298: } {
299: wv isInteger {
300: /ans [gg gg {init} map] def
301: }{
302: /ans [gg gg {wv 0 get weightv init} map] def
303: }ifelse
304:
305: %% Postprocess : recover the matrix expression.
306: mm {
307: ans { /tmp set [mm tmp] toVectors } map
308: /ans set
309: }{ }
310: ifelse
311: } ifelse
312:
313: ecart.end
314:
315: %%
316: env1 restoreOptions %% degreeShift changes "grade"
317:
318: /arg1 ans def
319: ] pop
320: popEnv
321: popVariables
322: arg1
323: } def
324: (ecart.gb ) messagen-quiet
325:
326: [(ecart.gb)
327: [(a ecart.gb b)
328: (array a; array b;)
329: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
330: ( in the ring of differential operators.)
331: (The computation is done by using Ecart division algorithm and )
332: (the double homogenization.)
333: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
334: $ ii is the initial ideal in case of w is given or <<a>> belongs$
335: $ to a ring. In the other cases, it returns the initial monominal.$
336: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
337: (a : [f v]; array f; string v; v is the variables. )
338: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
339: (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
340: ( array ds; ds is the degree shift )
341: ( )
342: (/ecart.autoHomogenize 0 def )
343: ( not to dehomogenize and homogenize)
344: ( )
345: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
1.6 ! takayama 346: $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
1.1 takayama 347: (Example 2: )
348: (To put H and h=1, type in, e.g., )
349: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
350: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /gg set gg ecart.dehomogenize pmat ;$
351: ( )
352: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
353: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
354: ( )
355: $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.6 ! takayama 356: $ [ [ (x) -1 (y) -1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] ecart.gb pmat ; $
1.1 takayama 357: ( )
358: $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
1.6 ! takayama 359: $ [ [(Dx) 1 (Dy) 1] [(x) -1 (y) -1 (Dx) 1 (Dy) 1] ] [[0 1] [-3 1] ] ] ecart.gb pmat ; (buggy infinite loop)$
1.1 takayama 360: ( )
361: (cf. gb, groebner, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
362: ( ecart.dehomogenize, ecart.dehomogenizeH)
363: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
364: ( define_ring )
365: ]] putUsages
366:
367: %% BUG: " f weight init " works well in case of vectors with degree shift ?
368:
369: /ecart.syz {
370: /arg1 set
371: [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
372: [
373: /ff arg1 def
374: /ecart.save.needSyz ecart.needSyz def
375: /ecart.needSyz 1 def
376: ff ecart.gb /ff.ans set
377: /ecart.needSyz ecart.save.needSyz def
378: /arg1 ff.ans def
379: ] pop
380: popVariables
381: arg1
382: } def
383: (ecart.syz ) messagen-quiet
384:
385: [(ecart.syz)
386: [(a ecart.syz b)
387: (array a; array b;)
388: $b : [syzygy gb tmat input]; gb = tmat * input $
389: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
390: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.syz /ff set $
391: $ ff 0 get ff 3 get mul pmat $
392: $ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $
393: ( )
394: $Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
395: $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
396: ( )
397: (cf. ecart.gb)
398: ( /ecart.autoHomogenize 0 def )
399: ]] putUsages
1.2 takayama 400:
1.3 takayama 401:
402: /ecartn.begin {
403: (red@) (standard) switch_function
404: %% (red@) (ecart) switch_function
405: [(Ecart) 1] system_variable
406: [(CheckHomogenization) 0] system_variable
407: [(ReduceLowerTerms) 0] system_variable
408: [(AutoReduce) 0] system_variable
409: [(EcartAutomaticHomogenization) 0] system_variable
410: } def
411: /ecartn.gb {
412: /arg1 set
413: [/in-ecartn.gb /aa /typev /setarg /f /v
414: /gg /wv /vec /ans /rr /mm
415: /degreeShift /env2 /opt /ans.gb
416: ] pushVariables
417: [(CurrentRingp) (KanGBmessage)] pushEnv
418: [
419: /aa arg1 def
420: aa isArray { } { ( << array >> gb) error } ifelse
421: /setarg 0 def
422: /wv 0 def
423: /degreeShift 0 def
424: /opt [(weightedHomogenization) 1] def
425: aa { tag } map /typev set
426: typev [ ArrayP ] eq
427: { /f aa 0 get def
428: /v gb.v def
429: /setarg 1 def
430: } { } ifelse
431: typev [ArrayP StringP] eq
432: { /f aa 0 get def
433: /v aa 1 get def
434: /setarg 1 def
435: } { } ifelse
436: typev [ArrayP RingP] eq
437: { /f aa 0 get def
438: /v aa 1 get def
439: /setarg 1 def
440: } { } ifelse
441: typev [ArrayP ArrayP] eq
442: { /f aa 0 get def
443: /v aa 1 get from_records def
444: /setarg 1 def
445: } { } ifelse
446: typev [ArrayP StringP ArrayP] eq
447: { /f aa 0 get def
448: /v aa 1 get def
449: /wv aa 2 get def
450: /setarg 1 def
451: } { } ifelse
452: typev [ArrayP ArrayP ArrayP] eq
453: { /f aa 0 get def
454: /v aa 1 get from_records def
455: /wv aa 2 get def
456: /setarg 1 def
457: } { } ifelse
458: typev [ArrayP StringP ArrayP ArrayP] eq
459: { /f aa 0 get def
460: /v aa 1 get def
461: /wv aa 2 get def
462: /degreeShift aa 3 get def
463: /setarg 1 def
464: } { } ifelse
465: typev [ArrayP ArrayP ArrayP ArrayP] eq
466: { /f aa 0 get def
467: /v aa 1 get from_records def
468: /wv aa 2 get def
469: /degreeShift aa 3 get def
470: /setarg 1 def
471: } { } ifelse
472:
473: /env1 getOptions def
474:
475: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
476:
477: [(KanGBmessage) ecart.gb.verbose ] system_variable
478:
479: %%% Start of the preprocess
480: v tag RingP eq {
481: /rr v def
482: }{
483: f getRing /rr set
484: } ifelse
485: %% To the normal form : matrix expression.
486: f gb.toMatrixOfString /f set
487: /mm gb.itWasMatrix def
488:
489: rr tag 0 eq {
490: %% Define our own ring
491: v isInteger {
492: (Error in gb: Specify variables) error
493: } { } ifelse
494: wv isInteger {
495: [v ring_of_differential_operators
496: [ v ecart.wv1 v ecart.wv2 ] weight_vector
497: gb.characteristic
498: opt
499: ] define_ring
500: }{
501: degreeShift isInteger {
502: [v ring_of_differential_operators
503: [v ecart.wv1 v ecart.wv2] wv join weight_vector
504: gb.characteristic
505: opt
506: ] define_ring
507:
508: }{
509: [v ring_of_differential_operators
510: [v ecart.wv1 v ecart.wv2] wv join weight_vector
511: gb.characteristic
512: [(degreeShift) degreeShift] opt join
513: ] define_ring
514:
515: } ifelse
516: } ifelse
517: } {
518: %% Use the ring structre given by the input.
519: v isInteger not {
520: gb.warning {
521: (Warning : the given ring definition is not used.) message
522: } { } ifelse
523: } { } ifelse
524: rr ring_def
525: /wv rr gb.getWeight def
526:
527: } ifelse
528: %%% Enf of the preprocess
529:
530: ecart.gb.verbose {
531: (The first and the second weight vectors are automatically set as follows)
532: message
533: v ecart.wv1 message
534: v ecart.wv2 message
535: degreeShift isInteger { }
536: {
537: (The degree shift is ) messagen
538: degreeShift message
539: } ifelse
540: } { } ifelse
541:
1.5 takayama 542: %%BUG: case of v is integer
543: v ecart.checkOrder
544:
1.3 takayama 545: ecartn.begin
546:
547: ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
548: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
549: ecart.autoHomogenize {
550: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
551: message
552: } { } ifelse
553: ecart.autoHomogenize {
554: f { {. ecart.dehomogenize} map} map /f set
555: f ecart.homogenize01 /f set
556: }{
557: f { {. } map } map /f set
558: } ifelse
559: ecart.needSyz {
560: [f [(needSyz)] gb.options join ] groebner /gg set
561: } {
562: [f gb.options] groebner 0 get /gg set
563: } ifelse
564:
565: ecart.needSyz {
566: mm {
567: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
568: } { /ans.gb gg 0 get def } ifelse
569: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
570: ans pmat ;
571: } {
572: wv isInteger {
573: /ans [gg gg {init} map] def
574: }{
575: /ans [gg gg {wv 0 get weightv init} map] def
576: }ifelse
577:
578: %% Postprocess : recover the matrix expression.
579: mm {
580: ans { /tmp set [mm tmp] toVectors } map
581: /ans set
582: }{ }
583: ifelse
584: } ifelse
585:
586: ecart.end
587:
588: %%
589: env1 restoreOptions %% degreeShift changes "grade"
590:
591: /arg1 ans def
592: ] pop
593: popEnv
594: popVariables
595: arg1
596: } def
597: (ecartn.gb[gb by non-ecart division] ) messagen-quiet
1.4 takayama 598:
599: /ecartd.gb {
600: /arg1 set
601: [/in-ecart.gb /aa /typev /setarg /f /v
602: /gg /wv /vec /ans /rr /mm
603: /degreeShift /env2 /opt /ans.gb
604: ] pushVariables
605: [(CurrentRingp) (KanGBmessage)] pushEnv
606: [
607: /aa arg1 def
608: aa isArray { } { ( << array >> gb) error } ifelse
609: /setarg 0 def
610: /wv 0 def
611: /degreeShift 0 def
612: /opt [(weightedHomogenization) 1] def
613: aa { tag } map /typev set
614: typev [ ArrayP ] eq
615: { /f aa 0 get def
616: /v gb.v def
617: /setarg 1 def
618: } { } ifelse
619: typev [ArrayP StringP] eq
620: { /f aa 0 get def
621: /v aa 1 get def
622: /setarg 1 def
623: } { } ifelse
624: typev [ArrayP RingP] eq
625: { /f aa 0 get def
626: /v aa 1 get def
627: /setarg 1 def
628: } { } ifelse
629: typev [ArrayP ArrayP] eq
630: { /f aa 0 get def
631: /v aa 1 get from_records def
632: /setarg 1 def
633: } { } ifelse
634: typev [ArrayP StringP ArrayP] eq
635: { /f aa 0 get def
636: /v aa 1 get def
637: /wv aa 2 get def
638: /setarg 1 def
639: } { } ifelse
640: typev [ArrayP ArrayP ArrayP] eq
641: { /f aa 0 get def
642: /v aa 1 get from_records def
643: /wv aa 2 get def
644: /setarg 1 def
645: } { } ifelse
646: typev [ArrayP StringP ArrayP ArrayP] eq
647: { /f aa 0 get def
648: /v aa 1 get def
649: /wv aa 2 get def
650: /degreeShift aa 3 get def
651: /setarg 1 def
652: } { } ifelse
653: typev [ArrayP ArrayP ArrayP ArrayP] eq
654: { /f aa 0 get def
655: /v aa 1 get from_records def
656: /wv aa 2 get def
657: /degreeShift aa 3 get def
658: /setarg 1 def
659: } { } ifelse
660:
661: /env1 getOptions def
662:
663: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
664:
665: [(KanGBmessage) ecart.gb.verbose ] system_variable
666: $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message
667:
668: %%% Start of the preprocess
669: v tag RingP eq {
670: /rr v def
671: }{
672: f getRing /rr set
673: } ifelse
674: %% To the normal form : matrix expression.
675: f gb.toMatrixOfString /f set
676: /mm gb.itWasMatrix def
677:
678: rr tag 0 eq {
679: %% Define our own ring
680: v isInteger {
681: (Error in gb: Specify variables) error
682: } { } ifelse
683: wv isInteger {
684: (Give an weight vector such that x < 1) error
685: }{
686: degreeShift isInteger {
687: [v ring_of_differential_operators
688: wv weight_vector
689: gb.characteristic
690: opt
691: ] define_ring
692:
693: }{
694: [v ring_of_differential_operators
695: wv weight_vector
696: gb.characteristic
697: [(degreeShift) degreeShift] opt join
698: ] define_ring
699:
700: } ifelse
701: } ifelse
702: } {
703: %% Use the ring structre given by the input.
704: v isInteger not {
705: gb.warning {
706: (Warning : the given ring definition is not used.) message
707: } { } ifelse
708: } { } ifelse
709: rr ring_def
710: /wv rr gb.getWeight def
711:
712: } ifelse
713: %%% Enf of the preprocess
714:
715: ecart.gb.verbose {
716: degreeShift isInteger { }
717: {
718: (The degree shift is ) messagen
719: degreeShift message
720: } ifelse
721: } { } ifelse
722:
1.5 takayama 723: %%BUG: case of v is integer
724: v ecart.checkOrder
725:
1.4 takayama 726: ecart.begin
727: [(EcartAutomaticHomogenization) 1] system_variable
728:
729: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
730:
731: f { {. ecart.dehomogenize} map} map /f set
732: f ecart.homogenize01 /f set
733: f { { [[(H). (1).]] replace } map } map /f set
734:
735: ecart.needSyz {
736: [f [(needSyz)] gb.options join ] groebner /gg set
737: } {
738: [f gb.options] groebner 0 get /gg set
739: } ifelse
740:
741: ecart.needSyz {
742: mm {
743: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
744: } { /ans.gb gg 0 get def } ifelse
745: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
746: ans pmat ;
747: } {
748: wv isInteger {
749: /ans [gg gg {init} map] def
750: }{
751: /ans [gg gg {wv 0 get weightv init} map] def
752: }ifelse
753:
754: %% Postprocess : recover the matrix expression.
755: mm {
756: ans { /tmp set [mm tmp] toVectors } map
757: /ans set
758: }{ }
759: ifelse
760: } ifelse
761:
762: ecart.end
763: [(EcartAutomaticHomogenization) 0] system_variable
764:
765: %%
766: env1 restoreOptions %% degreeShift changes "grade"
767:
768: /arg1 ans def
769: ] pop
770: popEnv
771: popVariables
772: arg1
773: } def
774: (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
1.2 takayama 775:
1.5 takayama 776: /ecart.checkOrder {
777: /arg1 set
778: [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables
779: [
780: /vv arg1 def
781: vv isArray
782: { } { [vv to_records pop] /vv set } ifelse
783: vv {toString} map /vv set
784: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
785: % Starting the checks.
786: 0 1 vv length 1 sub {
787: /i set
788: vv i get . dd i get . mul /tt set
789: tt @@@.hsymbol . add init tt eq { }
790: { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
791: } for
792:
793: 0 1 vv length 1 sub {
794: /i set
795: vv i get . /tt set
796: tt (1). add init (1). eq { }
1.6 ! takayama 797: { [vv i get ( is larger than 1 ) ] cat error} ifelse
1.5 takayama 798: } for
799: /arg1 1 def
800: ] pop
801: popVariables
802: arg1
803: } def
804: [(ecart.checkOrder)
805: [(v ecart.checkOrder bool checks if the given order is relevant)
806: (for the ecart division.)
807: (cf. ecartd.gb, ecart.gb, ecartn.gb)
808: ]
809: ] putUsages
810:
811: /ecart.wv_last {
812: /arg1 set
813: [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables
814: [
815: /vv arg1 def
816: vv isArray
817: { } { [vv to_records pop] /vv set } ifelse
818: vv {toString} map /vv set
819: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
820: vv { -1 } map
821: dd { 1 } map join /arg1 set
822: ] pop
823: popVariables
824: arg1
825: } def
826: [(ecart.wv_last)
827: [(v ecart.wv_last wt )
828: (It returns the weight vector -1,-1,...-1; 1,1, ..., 1)
829: (Use this weight vector as the last weight vector for ecart division)
830: (if ecart.checkOrder complains about the order given.)
831: ]
832: ] putUsages
833:
1.2 takayama 834: ( ) message-quiet
1.5 takayama 835:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to ecart.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc