Annotation of OpenXM/src/kan96xx/Doc/ecart.sm1, Revision 1.5
1.5 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/ecart.sm1,v 1.4 2003/07/30 09:00:51 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
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
229: [v ecart.wv1 v ecart.wv2] wv join weight_vector
1.3 takayama 230: gb.characteristic
1.1 takayama 231: opt
232: ] define_ring
233:
234: }{
235: [v ring_of_differential_operators
236: [v ecart.wv1 v ecart.wv2] wv join weight_vector
1.3 takayama 237: gb.characteristic
1.1 takayama 238: [(degreeShift) degreeShift] opt join
239: ] define_ring
240:
241: } ifelse
242: } ifelse
243: } {
244: %% Use the ring structre given by the input.
245: v isInteger not {
246: gb.warning {
247: (Warning : the given ring definition is not used.) message
248: } { } ifelse
249: } { } ifelse
250: rr ring_def
251: /wv rr gb.getWeight def
252:
253: } ifelse
254: %%% Enf of the preprocess
255:
256: ecart.gb.verbose {
257: (The first and the second weight vectors are automatically set as follows)
258: message
259: v ecart.wv1 message
260: v ecart.wv2 message
261: degreeShift isInteger { }
262: {
263: (The degree shift is ) messagen
264: degreeShift message
265: } ifelse
266: } { } ifelse
267:
1.5 ! takayama 268: %%BUG: case of v is integer
! 269: v ecart.checkOrder
! 270:
1.1 takayama 271: ecart.begin
272:
273: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
274: ecart.autoHomogenize {
275: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
276: message
277: } { } ifelse
278: ecart.autoHomogenize {
279: f { {. ecart.dehomogenize} map} map /f set
280: f ecart.homogenize01 /f set
281: }{
282: f { {. } map } map /f set
283: } ifelse
284: ecart.needSyz {
285: [f [(needSyz)] gb.options join ] groebner /gg set
286: } {
287: [f gb.options] groebner 0 get /gg set
288: } ifelse
289:
290: ecart.needSyz {
291: mm {
292: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
293: } { /ans.gb gg 0 get def } ifelse
294: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
295: ans pmat ;
296: } {
297: wv isInteger {
298: /ans [gg gg {init} map] def
299: }{
300: /ans [gg gg {wv 0 get weightv init} map] def
301: }ifelse
302:
303: %% Postprocess : recover the matrix expression.
304: mm {
305: ans { /tmp set [mm tmp] toVectors } map
306: /ans set
307: }{ }
308: ifelse
309: } ifelse
310:
311: ecart.end
312:
313: %%
314: env1 restoreOptions %% degreeShift changes "grade"
315:
316: /arg1 ans def
317: ] pop
318: popEnv
319: popVariables
320: arg1
321: } def
322: (ecart.gb ) messagen-quiet
323:
324: [(ecart.gb)
325: [(a ecart.gb b)
326: (array a; array b;)
327: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
328: ( in the ring of differential operators.)
329: (The computation is done by using Ecart division algorithm and )
330: (the double homogenization.)
331: (cf. M.Granger and T.Oaku: Minimal filtered free resolutions ... 2003)
332: $ ii is the initial ideal in case of w is given or <<a>> belongs$
333: $ to a ring. In the other cases, it returns the initial monominal.$
334: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
335: (a : [f v]; array f; string v; v is the variables. )
336: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
337: (a : [f v w ds]; array f; string v; array of array w; w is the weight matirx.)
338: ( array ds; ds is the degree shift )
339: ( )
340: (/ecart.autoHomogenize 0 def )
341: ( not to dehomogenize and homogenize)
342: ( )
343: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
344: $ [ [ (Dx) 1 ] ] ] ecart.gb pmat ; $
345: (Example 2: )
346: (To put H and h=1, type in, e.g., )
347: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
348: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] ecart.gb /gg set gg ecart.dehomogenize pmat ;$
349: ( )
350: $Example 3: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
351: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.gb pmat ; $
352: ( )
353: $Example 4: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
354: $ [ [ (x) -1 (y) -1] ] ] ecart.gb pmat ; $
355: ( )
356: $Example 5: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
357: $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.gb pmat ; $
358: ( )
359: (cf. gb, groebner, ecart.syz, ecart.begin, ecart.end, ecart.homogenize01, )
360: ( ecart.dehomogenize, ecart.dehomogenizeH)
361: ( [(weightedHomogenization) 1 (degreeShift) [[1 2 1]]] : options for )
362: ( define_ring )
363: ]] putUsages
364:
365: %% BUG: " f weight init " works well in case of vectors with degree shift ?
366:
367: /ecart.syz {
368: /arg1 set
369: [/in-ecart.syz /ecart.save.needSyz /ff /ff.ans] pushVariables
370: [
371: /ff arg1 def
372: /ecart.save.needSyz ecart.needSyz def
373: /ecart.needSyz 1 def
374: ff ecart.gb /ff.ans set
375: /ecart.needSyz ecart.save.needSyz def
376: /arg1 ff.ans def
377: ] pop
378: popVariables
379: arg1
380: } def
381: (ecart.syz ) messagen-quiet
382:
383: [(ecart.syz)
384: [(a ecart.syz b)
385: (array a; array b;)
386: $b : [syzygy gb tmat input]; gb = tmat * input $
387: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
388: $ [ [ (Dx) 1 (Dy) 1] ] ] ecart.syz /ff set $
389: $ ff 0 get ff 3 get mul pmat $
390: $ ff 2 get ff 3 get mul [ff 1 get ] transpose sub pmat ; $
391: ( )
392: $Example 2: [[ [(x^2) (y+x)] [(x+y) (y^3)] [(2 x^2+x y) (y+x+x y^3)]] (x,y) $
393: $ [ [ (x) -1 (y) -1] ] [[0 1] [-3 1] ] ] ecart.syz pmat ; $
394: ( )
395: (cf. ecart.gb)
396: ( /ecart.autoHomogenize 0 def )
397: ]] putUsages
1.2 takayama 398:
1.3 takayama 399:
400: /ecartn.begin {
401: (red@) (standard) switch_function
402: %% (red@) (ecart) switch_function
403: [(Ecart) 1] system_variable
404: [(CheckHomogenization) 0] system_variable
405: [(ReduceLowerTerms) 0] system_variable
406: [(AutoReduce) 0] system_variable
407: [(EcartAutomaticHomogenization) 0] system_variable
408: } def
409: /ecartn.gb {
410: /arg1 set
411: [/in-ecartn.gb /aa /typev /setarg /f /v
412: /gg /wv /vec /ans /rr /mm
413: /degreeShift /env2 /opt /ans.gb
414: ] pushVariables
415: [(CurrentRingp) (KanGBmessage)] pushEnv
416: [
417: /aa arg1 def
418: aa isArray { } { ( << array >> gb) error } ifelse
419: /setarg 0 def
420: /wv 0 def
421: /degreeShift 0 def
422: /opt [(weightedHomogenization) 1] def
423: aa { tag } map /typev set
424: typev [ ArrayP ] eq
425: { /f aa 0 get def
426: /v gb.v def
427: /setarg 1 def
428: } { } ifelse
429: typev [ArrayP StringP] eq
430: { /f aa 0 get def
431: /v aa 1 get def
432: /setarg 1 def
433: } { } ifelse
434: typev [ArrayP RingP] eq
435: { /f aa 0 get def
436: /v aa 1 get def
437: /setarg 1 def
438: } { } ifelse
439: typev [ArrayP ArrayP] eq
440: { /f aa 0 get def
441: /v aa 1 get from_records def
442: /setarg 1 def
443: } { } ifelse
444: typev [ArrayP StringP ArrayP] eq
445: { /f aa 0 get def
446: /v aa 1 get def
447: /wv aa 2 get def
448: /setarg 1 def
449: } { } ifelse
450: typev [ArrayP ArrayP ArrayP] eq
451: { /f aa 0 get def
452: /v aa 1 get from_records def
453: /wv aa 2 get def
454: /setarg 1 def
455: } { } ifelse
456: typev [ArrayP StringP ArrayP ArrayP] eq
457: { /f aa 0 get def
458: /v aa 1 get def
459: /wv aa 2 get def
460: /degreeShift aa 3 get def
461: /setarg 1 def
462: } { } ifelse
463: typev [ArrayP ArrayP ArrayP ArrayP] eq
464: { /f aa 0 get def
465: /v aa 1 get from_records def
466: /wv aa 2 get def
467: /degreeShift aa 3 get def
468: /setarg 1 def
469: } { } ifelse
470:
471: /env1 getOptions def
472:
473: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
474:
475: [(KanGBmessage) ecart.gb.verbose ] system_variable
476:
477: %%% Start of the preprocess
478: v tag RingP eq {
479: /rr v def
480: }{
481: f getRing /rr set
482: } ifelse
483: %% To the normal form : matrix expression.
484: f gb.toMatrixOfString /f set
485: /mm gb.itWasMatrix def
486:
487: rr tag 0 eq {
488: %% Define our own ring
489: v isInteger {
490: (Error in gb: Specify variables) error
491: } { } ifelse
492: wv isInteger {
493: [v ring_of_differential_operators
494: [ v ecart.wv1 v ecart.wv2 ] weight_vector
495: gb.characteristic
496: opt
497: ] define_ring
498: }{
499: degreeShift isInteger {
500: [v ring_of_differential_operators
501: [v ecart.wv1 v ecart.wv2] wv join weight_vector
502: gb.characteristic
503: opt
504: ] define_ring
505:
506: }{
507: [v ring_of_differential_operators
508: [v ecart.wv1 v ecart.wv2] wv join weight_vector
509: gb.characteristic
510: [(degreeShift) degreeShift] opt join
511: ] define_ring
512:
513: } ifelse
514: } ifelse
515: } {
516: %% Use the ring structre given by the input.
517: v isInteger not {
518: gb.warning {
519: (Warning : the given ring definition is not used.) message
520: } { } ifelse
521: } { } ifelse
522: rr ring_def
523: /wv rr gb.getWeight def
524:
525: } ifelse
526: %%% Enf of the preprocess
527:
528: ecart.gb.verbose {
529: (The first and the second weight vectors are automatically set as follows)
530: message
531: v ecart.wv1 message
532: v ecart.wv2 message
533: degreeShift isInteger { }
534: {
535: (The degree shift is ) messagen
536: degreeShift message
537: } ifelse
538: } { } ifelse
539:
1.5 ! takayama 540: %%BUG: case of v is integer
! 541: v ecart.checkOrder
! 542:
1.3 takayama 543: ecartn.begin
544:
545: ecart.gb.verbose { (ecartn.gb : ecart.gb without ecart division.) message } { } ifelse
546: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
547: ecart.autoHomogenize {
548: (ecart.gb: Input polynomial or vectors are automatically h-H-homogenized.)
549: message
550: } { } ifelse
551: ecart.autoHomogenize {
552: f { {. ecart.dehomogenize} map} map /f set
553: f ecart.homogenize01 /f set
554: }{
555: f { {. } map } map /f set
556: } ifelse
557: ecart.needSyz {
558: [f [(needSyz)] gb.options join ] groebner /gg set
559: } {
560: [f gb.options] groebner 0 get /gg set
561: } ifelse
562:
563: ecart.needSyz {
564: mm {
565: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
566: } { /ans.gb gg 0 get def } ifelse
567: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
568: ans pmat ;
569: } {
570: wv isInteger {
571: /ans [gg gg {init} map] def
572: }{
573: /ans [gg gg {wv 0 get weightv init} map] def
574: }ifelse
575:
576: %% Postprocess : recover the matrix expression.
577: mm {
578: ans { /tmp set [mm tmp] toVectors } map
579: /ans set
580: }{ }
581: ifelse
582: } ifelse
583:
584: ecart.end
585:
586: %%
587: env1 restoreOptions %% degreeShift changes "grade"
588:
589: /arg1 ans def
590: ] pop
591: popEnv
592: popVariables
593: arg1
594: } def
595: (ecartn.gb[gb by non-ecart division] ) messagen-quiet
1.4 takayama 596:
597: /ecartd.gb {
598: /arg1 set
599: [/in-ecart.gb /aa /typev /setarg /f /v
600: /gg /wv /vec /ans /rr /mm
601: /degreeShift /env2 /opt /ans.gb
602: ] pushVariables
603: [(CurrentRingp) (KanGBmessage)] pushEnv
604: [
605: /aa arg1 def
606: aa isArray { } { ( << array >> gb) error } ifelse
607: /setarg 0 def
608: /wv 0 def
609: /degreeShift 0 def
610: /opt [(weightedHomogenization) 1] def
611: aa { tag } map /typev set
612: typev [ ArrayP ] eq
613: { /f aa 0 get def
614: /v gb.v def
615: /setarg 1 def
616: } { } ifelse
617: typev [ArrayP StringP] eq
618: { /f aa 0 get def
619: /v aa 1 get def
620: /setarg 1 def
621: } { } ifelse
622: typev [ArrayP RingP] eq
623: { /f aa 0 get def
624: /v aa 1 get def
625: /setarg 1 def
626: } { } ifelse
627: typev [ArrayP ArrayP] eq
628: { /f aa 0 get def
629: /v aa 1 get from_records def
630: /setarg 1 def
631: } { } ifelse
632: typev [ArrayP StringP ArrayP] eq
633: { /f aa 0 get def
634: /v aa 1 get def
635: /wv aa 2 get def
636: /setarg 1 def
637: } { } ifelse
638: typev [ArrayP ArrayP ArrayP] eq
639: { /f aa 0 get def
640: /v aa 1 get from_records def
641: /wv aa 2 get def
642: /setarg 1 def
643: } { } ifelse
644: typev [ArrayP StringP ArrayP ArrayP] eq
645: { /f aa 0 get def
646: /v aa 1 get def
647: /wv aa 2 get def
648: /degreeShift aa 3 get def
649: /setarg 1 def
650: } { } ifelse
651: typev [ArrayP ArrayP ArrayP ArrayP] eq
652: { /f aa 0 get def
653: /v aa 1 get from_records def
654: /wv aa 2 get def
655: /degreeShift aa 3 get def
656: /setarg 1 def
657: } { } ifelse
658:
659: /env1 getOptions def
660:
661: setarg { } { (ecart.gb : Argument mismatch) error } ifelse
662:
663: [(KanGBmessage) ecart.gb.verbose ] system_variable
664: $ecartd.gb dehomogenizes at each reduction step w.r.t. s (H).$ message
665:
666: %%% Start of the preprocess
667: v tag RingP eq {
668: /rr v def
669: }{
670: f getRing /rr set
671: } ifelse
672: %% To the normal form : matrix expression.
673: f gb.toMatrixOfString /f set
674: /mm gb.itWasMatrix def
675:
676: rr tag 0 eq {
677: %% Define our own ring
678: v isInteger {
679: (Error in gb: Specify variables) error
680: } { } ifelse
681: wv isInteger {
682: (Give an weight vector such that x < 1) error
683: }{
684: degreeShift isInteger {
685: [v ring_of_differential_operators
686: wv weight_vector
687: gb.characteristic
688: opt
689: ] define_ring
690:
691: }{
692: [v ring_of_differential_operators
693: wv weight_vector
694: gb.characteristic
695: [(degreeShift) degreeShift] opt join
696: ] define_ring
697:
698: } ifelse
699: } ifelse
700: } {
701: %% Use the ring structre given by the input.
702: v isInteger not {
703: gb.warning {
704: (Warning : the given ring definition is not used.) message
705: } { } ifelse
706: } { } ifelse
707: rr ring_def
708: /wv rr gb.getWeight def
709:
710: } ifelse
711: %%% Enf of the preprocess
712:
713: ecart.gb.verbose {
714: degreeShift isInteger { }
715: {
716: (The degree shift is ) messagen
717: degreeShift message
718: } ifelse
719: } { } ifelse
720:
1.5 ! takayama 721: %%BUG: case of v is integer
! 722: v ecart.checkOrder
! 723:
1.4 takayama 724: ecart.begin
725: [(EcartAutomaticHomogenization) 1] system_variable
726:
727: ecart.gb.verbose { (gb.options = ) messagen gb.options message } { } ifelse
728:
729: f { {. ecart.dehomogenize} map} map /f set
730: f ecart.homogenize01 /f set
731: f { { [[(H). (1).]] replace } map } map /f set
732:
733: ecart.needSyz {
734: [f [(needSyz)] gb.options join ] groebner /gg set
735: } {
736: [f gb.options] groebner 0 get /gg set
737: } ifelse
738:
739: ecart.needSyz {
740: mm {
741: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
742: } { /ans.gb gg 0 get def } ifelse
743: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
744: ans pmat ;
745: } {
746: wv isInteger {
747: /ans [gg gg {init} map] def
748: }{
749: /ans [gg gg {wv 0 get weightv init} map] def
750: }ifelse
751:
752: %% Postprocess : recover the matrix expression.
753: mm {
754: ans { /tmp set [mm tmp] toVectors } map
755: /ans set
756: }{ }
757: ifelse
758: } ifelse
759:
760: ecart.end
761: [(EcartAutomaticHomogenization) 0] system_variable
762:
763: %%
764: env1 restoreOptions %% degreeShift changes "grade"
765:
766: /arg1 ans def
767: ] pop
768: popEnv
769: popVariables
770: arg1
771: } def
772: (ecartd.gb[results are dehomogenized at each reduction step] ) messagen-quiet
1.2 takayama 773:
1.5 ! takayama 774: /ecart.checkOrder {
! 775: /arg1 set
! 776: [/in-ecart.checkOrder /vv /tt /dd /n /i] pushVariables
! 777: [
! 778: /vv arg1 def
! 779: vv isArray
! 780: { } { [vv to_records pop] /vv set } ifelse
! 781: vv {toString} map /vv set
! 782: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
! 783: % Starting the checks.
! 784: 0 1 vv length 1 sub {
! 785: /i set
! 786: vv i get . dd i get . mul /tt set
! 787: tt @@@.hsymbol . add init tt eq { }
! 788: { [@@@.hsymbol ( is larger than ) vv i get ( ) dd i get] cat error} ifelse
! 789: } for
! 790:
! 791: 0 1 vv length 1 sub {
! 792: /i set
! 793: vv i get . /tt set
! 794: tt (1). add init (1). eq { }
! 795: { [vv i get ( is larger than 1) vv i get] cat error} ifelse
! 796: } for
! 797: /arg1 1 def
! 798: ] pop
! 799: popVariables
! 800: arg1
! 801: } def
! 802: [(ecart.checkOrder)
! 803: [(v ecart.checkOrder bool checks if the given order is relevant)
! 804: (for the ecart division.)
! 805: (cf. ecartd.gb, ecart.gb, ecartn.gb)
! 806: ]
! 807: ] putUsages
! 808:
! 809: /ecart.wv_last {
! 810: /arg1 set
! 811: [/in-ecart.wv_last /vv /tt /dd /n /i] pushVariables
! 812: [
! 813: /vv arg1 def
! 814: vv isArray
! 815: { } { [vv to_records pop] /vv set } ifelse
! 816: vv {toString} map /vv set
! 817: vv { /tt set [@@@.Dsymbol tt] cat } map /dd set
! 818: vv { -1 } map
! 819: dd { 1 } map join /arg1 set
! 820: ] pop
! 821: popVariables
! 822: arg1
! 823: } def
! 824: [(ecart.wv_last)
! 825: [(v ecart.wv_last wt )
! 826: (It returns the weight vector -1,-1,...-1; 1,1, ..., 1)
! 827: (Use this weight vector as the last weight vector for ecart division)
! 828: (if ecart.checkOrder complains about the order given.)
! 829: ]
! 830: ] putUsages
! 831:
1.2 takayama 832: ( ) message-quiet
1.5 ! takayama 833:
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