Annotation of OpenXM/src/kan96xx/Doc/dhecart.sm1, Revision 1.3
1.3 ! takayama 1: % $OpenXM: OpenXM/src/kan96xx/Doc/dhecart.sm1,v 1.2 2004/07/31 02:23:02 takayama Exp $
1.1 takayama 2: % Stdbasis via the double homogenization: dx x = x dx + h H
3: % Homogenize=3
4: (ecart_loaded) boundp { }
5: { [(parse) (ecart.sm1) pushfile] extension } ifelse
6:
7: /dh.begin {
1.2 takayama 8: [(Homogenize) (AutoReduce) (KanGBmessage)] pushEnv /dh.saved.env set
1.1 takayama 9: [(Homogenize) 3] system_variable
1.2 takayama 10: dh.autoReduce { [(AutoReduce) 1] system_variable } { } ifelse
1.1 takayama 11: } def
12:
13: /dh.end {
1.2 takayama 14: dh.saved.env popEnv
1.1 takayama 15: [(Homogenize) 1] system_variable
16: } def
17:
18: /dh.dehomogenize {
19: dehomogenize
20: } def
21:
22: % Global environmental variables
23: /dh.gb.verbose 1 def
24: /dh.autoHomogenize 1 def
1.2 takayama 25: /dh.autoReduce 1 def
1.1 takayama 26: /dh.needSyz 0 def
27:
28: /dh.message {
29: (dh.ecart: ) messagen message
30: } def
31: /dh.messagen {
32: (dh.ecart: ) messagen messagen
33: } def
34:
35: %%test
36: % [(x,y) ring_of_differential_operators [[(Dx) 1]] ecart.weight_vector 0] define_ring ; dh.begin ;
37: % [[(x Dx + 1). homogenize]] groebner ::
38:
39: %%test
40: % [ [(x Dx + y Dy + 1) (x Dx y Dy -1)] (x,y) [[(x) -1 (y) -1]]] dh.gb pmat
41: % --> It is not an admissible order.
42: % [ [(x Dx + y Dy + 1) (x Dx y Dy -1)] (x,y) [[(Dx) 1 (Dy) 1 (x) -1 (y) -1] [(Dx) 1 (Dy) 1] [(x) -1 (y) -1]]] dh.gb pmat
43:
44: /dh.gb {
45: /arg1 set
46: [/in-dh.gb /aa /typev /setarg /f /v
47: /gg /wv /vec /ans /rr /mm
48: /env2 /ans.gb
49: ] pushVariables
50: [(CurrentRingp) (KanGBmessage)] pushEnv
51: [
52: /aa arg1 def
53: aa isArray { } { ( << array >> dh.gb) error } ifelse
54: /setarg 0 def
55: /wv 0 def
56:
57: aa { tag } map /typev set
58: typev [ ArrayP ] eq
59: { /f aa 0 get def
60: /v gb.v def
61: /setarg 1 def
62: } { } ifelse
63: typev [ArrayP StringP] eq
64: { /f aa 0 get def
65: /v aa 1 get def
66: /setarg 1 def
67: } { } ifelse
68: typev [ArrayP RingP] eq
69: { /f aa 0 get def
70: /v aa 1 get def
71: /setarg 1 def
72: } { } ifelse
73: typev [ArrayP ArrayP] eq
74: { /f aa 0 get def
75: /v aa 1 get from_records def
76: /setarg 1 def
77: } { } ifelse
78: typev [ArrayP StringP ArrayP] eq
79: { /f aa 0 get def
80: /v aa 1 get def
81: /wv aa 2 get def
82: /setarg 1 def
83: } { } ifelse
84: typev [ArrayP ArrayP ArrayP] eq
85: { /f aa 0 get def
86: /v aa 1 get from_records def
87: /wv aa 2 get def
88: /setarg 1 def
89: } { } ifelse
90:
91: /env1 getOptions def
92:
93: setarg { } { (dh.gb : Argument mismatch) error } ifelse
94:
95: [(KanGBmessage) dh.gb.verbose ] system_variable
96:
97: %%% Start of the preprocess
98: v tag RingP eq {
99: /rr v def
100: }{
101: f getRing /rr set
102: } ifelse
103: %% To the normal form : matrix expression.
104: f gb.toMatrixOfString /f set
105: /mm gb.itWasMatrix def
106:
107: rr tag 0 eq {
108: %% Define the ring.
109: v isInteger {
110: (Error in dh.gb: Specify variables) error
111: } { } ifelse
112: %% wv is set when parsing the arguments.
113: wv isInteger {
114: (Give a weight vector) error
115: }{
116: [v ring_of_differential_operators
117: wv ecart.weight_vector
118: gb.characteristic
119: ] define_ring
120: } ifelse
121: } {
122: %% Use the ring structre given by the input.
123: v isInteger not {
124: gb.warning {
125: (Warning : the given ring definition is not used.) message
126: } { } ifelse
127: } { } ifelse
128: rr ring_def
129: /wv rr gb.getWeight def
130: } ifelse
131: %%% Enf of the preprocess
132:
133: dh.begin
134:
1.3 ! takayama 135: [v] ecart.checkOrder
1.1 takayama 136:
137: dh.gb.verbose { (gb.options = ) dh.messagen gb.options dh.message } { } ifelse
138:
139: dh.autoHomogenize not {
140: % No automatic hH-homogenization.
141: f { {. } map} map /f set
142: } {
143: % Automatic hH-homogenization
144: (dh.gb : Input polynomial or vectors are automatically homogenized) dh.message
145: f { {. } map} map /f set
146: f { { [[@@@.Hsymbol . (1).] [@@@.hsymbol . (1).] ] replace } map } map /f set
147: f { { homogenize } map } map /f set
148: f dh.message
149: } ifelse
150:
151: dh.needSyz {
152: [f [(needSyz)] gb.options join ] groebner /gg set
153: } {
154: [f gb.options] groebner 0 get /gg set
155: } ifelse
156:
157:
158: dh.needSyz {
159: mm {
160: gg 0 get { /tmp set [mm tmp] toVectors } map /ans.gb set
161: } { /ans.gb gg 0 get def } ifelse
162: /ans [gg 2 get , ans.gb , gg 1 get , f ] def
163: % ans pmat ;
164: } {
165: wv isInteger {
166: /ans [gg gg {init} map] def
167: }{
168: %% Get the initial ideal
169: /ans [gg gg {wv 0 get weightv init} map] def
170: }ifelse
171:
172: %% Postprocess : recover the matrix expression.
173: mm {
174: ans { /tmp set [mm tmp] toVectors } map
175: /ans set
176: }{ }
177: ifelse
178: } ifelse
179:
180: dh.end
181:
182: ans getRing (oxRingStructure) dc /dh.gb.oxRingStructure set
183: %%
184: env1 restoreOptions %% degreeShift changes "grade"
185:
186: /arg1 ans def
187: ] pop
188: popEnv
189: popVariables
190: arg1
191: } def
192:
193: [(dh.gb)
194: [(a dh.gb b)
195: (array a; array b;)
196: $b : [g ii]; array g; array in; g is a standard (Grobner) basis of f$
197: ( in the ring of differential operators.)
198: (The computation is done in the doubly homogenized Weyl algebra.)
199: (Dx x = x Dx + h H)
200: $ ii is the initial ideal in case of w is given or <<a>> belongs$
201: $ to a ring. In the other cases, it returns the initial monominal.$
202: (a : [f ]; array f; f is a set of generators of an ideal in a ring.)
203: (a : [f v]; array f; string v; v is the variables. )
204: (a : [f v w]; array f; string v; array of array w; w is the weight matirx.)
205: ( )
206: (Globals: dh.autoHomogenize dh.gb.verbose dh.needSyz dh.gb.oxRingStructure)
207: (cf. dh.begin dh.end dh.message dh.messagen)
208: ( )
209: $Example 1: [ [( (x Dx)^2 + (y Dy)^2 -1) ( x y Dx Dy -1)] (x,y) $
210: $ [ [ (Dx) 1 ] [(x) -1 (y) -1 (Dx) 1 (Dy) 1]] ] dh.gb pmat ; $
211: (Example 2: )
212: $ [ [(2 x Dx + 3 y Dy+6) (2 y Dx + 3 x^2 Dy)] (x,y) $
213: $ [[(x) -1 (Dx) 1 (y) -1 (Dy) 1]]] dh.gb /ff set ff pmat ;$
214: (To set the current ring to the ring in which ff belongs )
215: ( ff getRing ring_def )
1.2 takayama 216: ( )
217: (Data: dh.p1, dh.p2, dh.p3 )
218: (In order to get a standard basis of the test data, type in dh.test.p1, ...)
1.1 takayama 219: ( )
220: ]] putUsages
1.2 takayama 221:
222: %Test input.
223: %misc-2003/09/oaku/b.sm1, Granger-Oaku-Takayama, Tangent cone algorithm ...
224: /dh.p1 {
225: [
226: [(t-(x^3 - y^2 z^2 - w^2))
227: (Dx + (3 x^2 ) Dt)
228: (Dy - (2 y z^2) Dt)
229: (Dz - (2 y^2 z) Dt)
230: (Dw - (2 w ) Dt)
231: ]
232: [ [(t) -1 (Dt) 1]
233: [(Dt) 1 (Dx) 1 (Dy) 1 (Dz) 1 (Dw) 1]
234: [(t) -1 (x) -1 (y) -1 (z) -1 (w) -1]]
235: ]
236: } def
237: /dh.test.p1 {
238: [(KanGBmessage) 1] system_variable
239: { [dh.p1 0 get (x,y,z,t,w) dh.p1 1 get] dh.gb } timer
240: } def
241:
242: %misc-2003/09/oaku/ob.sm1,
243: % fw2 [(x) (y) (z) (w)] fw_delta
244: % > 30min, degree 25.
245: /dh.p2 {
246: [
247: [ (-w^8-z^4-y^3*w-x^3+t) (3*x^2*Dt+Dx) (3*y^2*w*Dt+Dy) (4*z^3*Dt+Dz)
248: (8*w^7*Dt+y^3*Dt+Dw) ]
249: [ [(t) -1 (Dt) 1]
250: [(Dt) 1 (Dx) 1 (Dy) 1 (Dz) 1 (Dw) 1]
251: [(t) -1 (x) -1 (y) -1 (z) -1 (w) -1]]
252: ]
253: } def
254: /dh.test.p2 {
255: [(KanGBmessage) 1] system_variable
256: { [dh.p2 0 get (x,y,z,t,w) dh.p2 1 get] dh.gb } timer
257: } def
258:
259: %misc-2003/09/oaku/
260: % x^3 + (x+1)*y*z, x^3+x*y*z is easy, but it is difficult in ecart.
261: /dh.p3 {
262: [
263: [ $-x^3-x*y*z-y*z+t$ , $3*x^2*Dt+y*z*Dt+Dx$ , $x*z*Dt+z*Dt+Dy$ ,
264: $x*y*Dt+y*Dt+Dz$ ]
265: [ [(t) -1 (Dt) 1]
266: [(Dt) 1 (Dx) 1 (Dy) 1 (Dz) 1]
267: [(t) -1 (x) -1 (y) -1 (z) -1]]
268: ]
269: } def
270: /dh.test.p3 {
271: [(KanGBmessage) 1] system_variable
272: { [dh.p3 0 get (x,y,z,t) dh.p3 1 get] dh.gb } timer
273: } def
274:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>