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