Annotation of OpenXM/src/asir-contrib/packages/doc/sm1.oxweave, Revision 1.5
1.5 ! takayama 1: /*$OpenXM: OpenXM/src/asir-contrib/packages/doc/sm1.oxweave,v 1.4 2002/07/14 13:14:37 takayama Exp $ */
1.1 takayama 2:
3: /*&C-texi
4: @c DO NOT EDIT THIS FILE oxphc.texi
5: */
6: /*&jp-texi
7: @node SM1 $BH!?t(B,,, Top
8: @chapter SM1 $BH!?t(B
9:
10: $B$3$N@a$G$O(B sm1 $B$N(B ox $B%5!<%P(B @code{ox_sm1_forAsir}
11: $B$H$N%$%s%?%U%'!<%94X?t$r2r@b$9$k(B.
12: $B$3$l$i$N4X?t$O%U%!%$%k(B @file{sm1} $B$GDj5A$5$l$F$$$k(B.
13: @file{sm1} $B$O(B @file{$(OpenXM_HOME)/lib/asir-contrib} $B$K$"$k(B.
14: $B%7%9%F%`(B @code{sm1} $B$OHyJ,:nMQAG4D$G7W;;$9$k$?$a$N%7%9%F%`$G$"$k(B.
15: $B7W;;Be?t4v2?$N$$$m$$$m$JITJQNL$N7W;;$,HyJ,:nMQAG$N7W;;$K5"Ce$9$k(B.
16: @code{sm1} $B$K$D$$$F$NJ8=q$O(B @code{OpenXM/doc/kan96xx} $B$K$"$k(B.
17:
18: $B$H$3$KCG$j$,$J$$$+$.$j$3$N@a$N$9$Y$F$N4X?t$O(B,
19: $BM-M}?t78?t$N<0$rF~NO$H$7$F$&$1$D$1$J$$(B.
20: $B$9$Y$F$NB?9`<0$N78?t$O@0?t$G$J$$$H$$$1$J$$(B.
21:
22: @tex
23: $B6u4V(B
24: $X:={\bf C} \setminus \{ 0, 1 \} = {\bf C} \setminus V(x(x-1))$
25: $B$N%I%i!<%`%3%[%b%m%872C#$N<!85$r7W;;$7$F$_$h$&(B.
26: $X$ $B$OJ?LL$KFs$D$N7j$r$"$1$?6u4V$G$"$k$N$G(B, $BE@(B $x=0$, $x=1$ $B$N$^$o$j$r(B
27: $B$^$o$kFs$D$N%k!<%W$,(B1$B<!85$N%[%b%m%8!<72$N6u4V$r$O$k(B.
28: $B$7$?$,$C$F(B, 1$B<!85%I%i!<%`%3%[%b%m%872$N<!85$O(B $2$ $B$G$"$k(B.
29: @code{sm1} $B$O(B $0$ $B<!85$N%3%[%b%m%872$N<!85$*$h$S(B $1$ $B<!85$N%3%[%b%m%872$N(B
30: $B<!85$rEz$($k(B.
31: @end tex
32: */
33: /*&eg-texi
34: @node SM1 Functions,,, Top
35: @chapter SM1 Functions
36:
37: This chapter describes interface functions for
38: sm1 ox server @code{ox_sm1_forAsir}.
39: These interface functions are defined in the file @file{sm1}.
40: The file @file{sm1} is @*
41: at @file{$(OpenXM_HOME)/lib/asir/contrib-packages}.
42: The system @code{sm1} is a system to compute in the ring of differential
43: operators.
44: Many constructions of invariants
45: in the computational algebraic geometry reduce
46: to constructions in the ring of differential operators.
47: Documents on @code{sm1} are in
48: the directory @code{OpenXM/doc/kan96xx}.
49:
50: All the coefficients of input polynomials should be
51: integers for most functions in this section.
52: Other functions accept rational numbers as inputs
53: and it will be explicitely noted in each explanation
54: of these functions.
55:
56:
57:
58: @tex
59: Let us evaluate the dimensions of the de Rham cohomology groups
60: of
61: $X:={\bf C} \setminus \{ 0, 1 \} = {\bf C} \setminus V(x(x-1))$.
62: The space $X$ is a two punctured plane, so two loops that encircles the
63: points $x=0$ and $x=1$ respectively spans the first homology group.
64: Hence, the dimension of the first de Rham cohomology group is $2$.
65: @code{sm1} answers the dimensions of the 0th and the first
66: cohomology groups.
67: @end tex
68: */
69: /*&C-texi
70: @example
71:
1.5 ! takayama 72: @include opening.texi
1.1 takayama 73:
74: [283] sm1_deRham([x*(x-1),[x]]);
75: [1,2]
76: @end example
77: */
78: /*&C-texi
79: @noindent
80: The author of @code{sm1} : Nobuki Takayama, @code{takayama@@math.sci.kobe-u.ac.jp} @*
81: The author of sm1 packages : Toshinori Oaku, @code{oaku@@twcu.ac.jp} @*
82: Reference: [SST] Saito, M., Sturmfels, B., Takayama, N.,
83: Grobner Deformations of Hypergeometric Differential Equations,
84: 1999, Springer.
85: See the appendix.
86: */
87: /*&jp-texi
88: @section @code{ox_sm1_forAsir} $B%5!<%P(B
89: */
90: /*&eg-texi
91: @section @code{ox_sm1_forAsir} Server
92: */
93:
94: /*&eg-texi
95: @menu
96: * ox_sm1_forAsir::
97: @end menu
98: @node ox_sm1_forAsir,,, Top
99: @subsection @code{ox_sm1_forAsir}
100: @findex ox_sm1_forAsir
101: @table @t
102: @item ox_sm1_forAsir
103: :: @code{sm1} server for @code{asir}.
104: @end table
105: @itemize @bullet
106: @item
107: @code{ox_sm1_forAsir} is the @code{sm1} server started from asir
108: by the command @code{sm1_start}.
109: In the standard setting, @*
110: @code{ox_sm1_forAsir} =
111: @file{$(OpenXM_HOME)/lib/sm1/bin/ox_sm1}
112: +
113: @file{$(OpenXM_HOME)/lib/sm1/callsm1.sm1} (macro file) @*
114: +
115: @file{$(OpenXM_HOME)/lib/sm1/callsm1b.sm1} (macro file) @*
116: The macro files @file{callsm1.sm1} and @file{callsm1b.sm1}
117: are searched from
118: current directory, @code{$(LOAD_SM1_PATH)},
119: @code{$(OpenXM_HOME)/lib/sm1},
120: @code{/usr/local/lib/sm1}
121: in this order.
122: @item Note for programmers: See the files
123: @file{$(OpenXM_HOME)/src/kxx/oxserver00.c},
124: @file{$(OpenXM_HOME)/src/kxx/sm1stackmachine.c}
125: to build your own server by reading @code{sm1} macros.
126: @end itemize
127: */
128: /*&jp-texi
129: @menu
130: * ox_sm1_forAsir::
131: @end menu
132: @node ox_sm1_forAsir,,, Top
133: @subsection @code{ox_sm1_forAsir}
134: @findex ox_sm1_forAsir
135: @table @t
136: @item ox_sm1_forAsir
137: :: @code{asir} $B$N$?$a$N(B @code{sm1} $B%5!<%P(B.
138: @end table
139: @itemize @bullet
140: @item
141: $B%5!<%P(B @code{ox_sm1_forAsir} $B$O(B @code{asir} $B$h$j%3%^%s%I(B
142: @code{sm1_start} $B$G5/F0$5$l$k(B @code{sm1} $B%5!<%P$G$"$k(B.
143:
144: $BI8=`E*@_Dj$G$O(B, @*
145: @code{ox_sm1_forAsir} =
146: @file{$(OpenXM_HOME)/lib/sm1/bin/ox_sm1}
147: +
148: @file{$(OpenXM_HOME)/lib/sm1/callsm1.sm1} (macro file) @*
149: +
150: @file{$(OpenXM_HOME)/lib/sm1/callsm1b.sm1} (macro file) @*
151: $B$G$"$j(B, $B$3$l$i$N%^%/%m%U%!%$%k$O(B, $B0lHL$K$O(B
152: current directory, @code{$(LOAD_SM1_PATH)},
153: @code{$(OpenXM_HOME)/lib/sm1},
154: @code{/usr/local/lib/sm1}
155: $B$N=gHV$G$5$,$5$l$k(B.
156: @item $B%W%m%0%i%^!<$N$?$a$N%N!<%H(B:
157: @code{sm1} $B%^%/%m$rFI$_9~$s$G<+J,FH<+$N%5!<%P$r:n$k$K$O(B
158: $B<!$N%U%!%$%k$b8+$h(B
159: @file{$(OpenXM_HOME)/src/kxx/oxserver00.c},
160: @file{$(OpenXM_HOME)/src/kxx/sm1stackmachine.c}
161: @end itemize
162: */
163:
164: def sm1_check_server(P) {
165: M=ox_get_serverinfo(P);
166: if (M == []) {
167: return(sm1_start());
168: }
169: if (M[0][1] != "Ox_system=ox_sm1_ox_sm1_forAsir") {
170: print("Warning: the server number ",0)$
171: print(P,0)$
172: print(" is not ox_sm1_forAsir server.")$
173: print("Starting ox_sm1_forAsir server on the localhost.")$
174: return(sm1_start());
175: }
176: return(P);
177: }
178:
179: /*&jp-texi
180: @section $BH!?t0lMw(B
181: */
182: /*&eg-texi
183: @section Functions
184: */
185:
186: /*&eg-texi
187: @c sort-sm1_start
188: @menu
189: * sm1_start::
190: @end menu
191: @node sm1_start,,, SM1 Functions
192: @subsection @code{sm1_start}
193: @findex sm1_start
194: @table @t
195: @item sm1_start()
196: :: Start @code{ox_sm1_forAsir} on the localhost.
197: @end table
198:
199: @table @var
200: @item return
201: Integer
202: @end table
203:
204: @itemize @bullet
205: @item Start @code{ox_sm1_forAsir} on the localhost.
206: It returns the descriptor of @code{ox_sm1_forAsir}.
207: @item Set @code{Xm_noX = 1} to start @code{ox_sm1_forAsir}
208: without a debug window.
209: @item You might have to set suitable orders of variable by the command
210: @code{ord}. For example,
211: when you are working in the
212: ring of differential operators on the variable @code{x} and @code{dx}
213: (@code{dx} stands for
214: @tex $\partial/\partial x$
215: @end tex
216: ),
217: @code{sm1} server assumes that
218: the variable @code{dx} is collected to the right and the variable
219: @code{x} is collected to the left in the printed expression.
220: In the example below, you must not use the variable @code{cc}
221: for computation in @code{sm1}.
222: @item The variables from @code{a} to @code{z} except @code{d} and @code{o}
223: and @code{x0}, ..., @code{x20}, @code{y0}, ..., @code{y20},
224: @code{z0}, ..., @code{z20} can be used as variables for ring of
225: differential operators in default. (cf. @code{Sm1_ord_list} in @code{sm1}).
226: @item The descriptor is stored in @code{Sm1_proc}.
227: @end itemize
228: */
229: /*&jp-texi
230: @c sort-sm1_start
231: @menu
232: * sm1_start::
233: @end menu
234: @node sm1_start,,, SM1 $BH!?t(B
235: @subsection @code{sm1_start}
236: @findex sm1_start
237: @table @t
238: @item sm1_start()
239: :: localhost $B$G(B @code{ox_sm1_forAsir} $B$r%9%?!<%H$9$k(B.
240: @end table
241:
242: @table @var
243: @item return
244: $B@0?t(B
245: @end table
246:
247: @itemize @bullet
248: @item localhost $B$G(B @code{ox_sm1_forAsir} $B$r%9%?!<%H$9$k(B.
249: $B%5!<%P(B @code{ox_sm1_forAsir} $B$N<1JLHV9f$rLa$9(B.
250: @item @code{Xm_noX = 1} $B$H$*$/$H%5!<%P(B @code{ox_sm1_forAsir} $B$r%G%P%C%0MQ$N(B
251: $B%&%#%s%I%&$J$7$K5/F0$G$-$k(B.
252: @item $B%3%^%s%I(B @code{ord} $B$rMQ$$$FJQ?t=g=x$r@5$7$/@_Dj$7$F$*$/I,MW$,(B
253: $B$"$k(B.
254: $B$?$H$($P(B,
255: $BJQ?t(B @code{x} $B$H(B @code{dx} $B>e$NHyJ,:nMQAG4D(B
256: (@code{dx} $B$O(B
257: @tex $\partial/\partial x$
258: @end tex
259: $B$KBP1~(B)
260: $B$G7W;;$7$F$$$k$H$-(B,
261: @code{sm1} $B%5!<%P$O<0$r0u:~$7$?$H$-(B,
262: $BJQ?t(B @code{dx} $B$O1&B&$K=8$a$lJQ?t(B
263: @code{x} $B$O:8B&$K$"$D$a$i$l$F$$$k$H2>Dj$7$F$$$k(B.
264: $B<!$NNc$G$O(B, $BJQ?t(B @code{cc} $B$r(B @code{sm1} $B$G$N7W;;$N$?$a$KMQ$$$F$O$$$1$J$$(B.
265: @item @code{a} $B$h$j(B @code{z} $B$N$J$+$G(B, @code{d} $B$H(B @code{o} $B$r=|$$$?$b$N(B,
266: $B$=$l$+$i(B, @code{x0}, ..., @code{x20}, @code{y0}, ..., @code{y20},
267: @code{z0}, ..., @code{z20} $B$O(B, $B%G%U%)!<%k%H$GHyJ,:nMQAG4D$NJQ?t$H$7$F(B
268: $B;H$($k(B (cf. @code{Sm1_ord_list} in @code{sm1}).
269: @item $B<1JLHV9f$O(B @code{Sm1_proc} $B$K3JG<$5$l$k(B.
270: @end itemize
271: */
272: /*&C-texi
273: @example
274: [260] ord([da,a,db,b]);
275: [da,a,db,b,dx,dy,dz,x,y,z,dt,ds,t,s,u,v,w,
276: ......... omit ..................
277: ]
278: [261] a*da;
279: a*da
280: [262] cc*dcc;
281: dcc*cc
282: [263] sm1_mul(da,a,[a]);
283: a*da+1
284: [264] sm1_mul(a,da,[a]);
285: a*da
286: @end example
287: */
288: /*&eg-texi
289: @table @t
290: @item Reference
291: @code{ox_launch}, @code{sm1_push_int0}, @code{sm1_push_poly0},
292: @code{ord}
293: @end table
294: */
295: /*&jp-texi
296: @table @t
297: @item $B;2>H(B
298: @code{ox_launch}, @code{sm1_push_int0}, @code{sm1_push_poly0},
299: @code{ord}
300: @end table
301: */
302:
303:
304: def sm1_start() {
305: extern Sm1_lib;
306: extern Xm_noX;
307: extern Sm1_proc;
308: if (Xm_noX) {
309: P = ox_launch_nox(0,Sm1_lib+"/bin/ox_sm1_forAsir");
310: }else{
311: P = ox_launch(0,Sm1_lib+"/bin/ox_sm1_forAsir");
312: }
313: if (Xm_noX) {
314: sm1(P," oxNoX ");
315: }
316: ox_check_errors(P);
317: Sm1_proc = P;
318: return(P);
319: }
320:
321:
322: /* ox_sm1 */
323: /* P is the process number */
324: def sm1flush(P) {
325: ox_execute_string(P,"[(flush)] extension pop");
326: }
327:
328: def sm1push(P,F) {
329: G = ox_ptod(F);
330: ox_push_cmo(P,G);
331: }
332:
333: /*&eg-texi
334: @c sort-sm1
335: @menu
336: * sm1::
337: @end menu
338: @node sm1,,, SM1 Functions
339: @subsection @code{sm1}
340: @findex sm1
341: @table @t
342: @item sm1(@var{p},@var{s})
343: :: ask the @code{sm1} server to execute the command string @var{s}.
344: @end table
345:
346: @table @var
347: @item return
348: Void
349: @item p
350: Number
351: @item s
352: String
353: @end table
354:
355: @itemize @bullet
356: @item It asks the @code{sm1} server of the descriptor number @var{p}
357: to execute the command string @var{s}.
358: @end itemize
359: */
360: /*&jp-texi
361: @menu
362: * sm1::
363: @end menu
364: @node sm1,,, SM1 $BH!?t(B
365: @subsection @code{sm1}
366: @findex sm1
367: @table @t
368: @item sm1(@var{p},@var{s})
369: :: $B%5!<%P(B @code{sm1} $B$K%3%^%s%INs(B @var{s} $B$r<B9T$7$F$/$l$k$h$&$K$?$N$`(B.
370: @end table
371:
372: @table @var
373: @item return
374: $B$J$7(B
375: @item p
376: $B?t(B
377: @item s
378: $BJ8;zNs(B
379: @end table
380:
381: @itemize @bullet
382: @item $B<1JLHV9f(B @var{p} $B$N(B @code{sm1} $B%5!<%P$K(B
383: $B%3%^%s%INs(B @var{s} $B$r<B9T$7$F$/$l$k$h$&$KMj$`(B.
384: @end itemize
385: */
386: /*&C-texi
387: @example
388: [261] sm1(0," ( (x-1)^2 ) . ");
389: 0
390: [262] ox_pop_string(0);
391: x^2-2*x+1
392: [263] sm1(0," [(x*(x-1)) [(x)]] deRham ");
393: 0
394: [264] ox_pop_string(0);
395: [1 , 2]
396: @end example
397: */
398: def sm1(P,F) {
399: ox_execute_string(P,F);
400: sm1flush(P);
401: }
402: /*&jp-texi
403: @table @t
404: @item $B;2>H(B
1.5 ! takayama 405: @code{sm1_start}, @code{ox_push_int0}, @code{sm1_push_poly0}, @code{Sm1_proc}.
1.1 takayama 406: @end table
407: */
408: /*&eg-texi
409: @table @t
410: @item Reference
1.5 ! takayama 411: @code{sm1_start}, @code{ox_push_int0}, @code{sm1_push_poly0}, @code{Sm1_proc}.
1.1 takayama 412: @end table
413: */
414:
415: def sm1pop(P) {
416: return(ox_pop_cmo(P));
417: }
418:
419: def sm1_to_asir_form(V) { return(toAsirForm(V)); }
420: def toAsirForm(V) {
421: extern ToAsirForm_V; /* for debug */
422: if (type(V) == 4) { /* list */
423: if((length(V) == 3) && (V[0] == "sm1_dp")) {
424: /* For debugging. */
425: if (ToAsir_Debug != 0) {
426: ToAsirForm_V = V;
427: print(map(type,V[1]));
428: print(V);
429: }
430: /* */
431: Vlist = map(strtov,V[1]);
432: return(dp_dtop(V[2],Vlist));
433: } else {
434: return(map(toAsirForm,V));
435: }
436: }else{
437: return(V);
438: }
439: }
440:
441: def sm1_toOrdered(V) {
442: if (type(V) == 4) { /* list */
443: if((length(V) == 3) && (V[0] == "sm1_dp")) {
444: Vlist = map(strtov,V[1]);
445: Ans = "";
446: F = V[2];
447: while (F != 0) {
448: G = dp_hm(F);
449: F = dp_rest(F);
450: if (dp_hc(G)>0) {
451: Ans += "+";
452: }
453: Ans += rtostr(dp_dtop(G,Vlist));
454: }
455: return Ans;
456: } else {
457: return(map(sm1_toOrdered,V));
458: }
459: }else{
460: return(V);
461: }
462: }
463:
464:
465: def sm1_push_poly0_R(A,P,Vlist) {
466: return(sm1_push_poly0(P,A,Vlist));
467: }
468: def sm1_push_poly0(P,A,Vlist) {
469: if (type(Vlist[0]) == 4) {
470: Vlist = Vlist[2];
471: }
472: /* if Vlist=[[e,x,y,H,E,Dx,Dy,h],[e,x,y,hH,eE,dx,dy,h],[e,x,y,hH,eE,dx,dy,h]]
473: list of str (sm1) list of str (asir) list of var (asir)
474: then we execute the code above.
475: */
476: if (type(A) == 2 || type(A) == 1) { /* recursive poly or number*/
477: A = dp_ptod(A,Vlist);
478: ox_push_cmo(P,A);
479: return;
480: }
481: if (type(A) == 0) { /* zero */
482: sm1(P," (0). ");
483: return;
484: }
485: if (type(A) == 4) { /* list */
486: ox_execute_string(P," [ ");
487: map(sm1_push_poly0_R,A,P,Vlist);
488: ox_execute_string(P," ] ");
489: return;
490: }
491: ox_push_cmo(P,A);
492: ox_check_errors2(P);
493: return;
494: }
495: /* sm1_push_poly0(0,[0,1,x+y,["Hello",y^3]],[x,y]); */
496:
497: def sm1_pop_poly0(P,Vlist) {
498: if (type(Vlist[0]) == 4) {
499: Vlist = Vlist[2];
500: }
501: A = ox_pop_cmo(P);
502: return(sm1_pop_poly0_0(P,A,Vlist));
503: }
504: def sm1_pop_poly0_0_R(A,P,Vlist) {
505: return(sm1_pop_poly0_0(P,A,Vlist));
506: }
507: def sm1_pop_poly0_0(P,A,Vlist) {
508: if (type(A) == 4) {
509: return(map(sm1_pop_poly0_0_R,A,P,Vlist));
510: }
511: if (type(A)== 9) {return(dp_dtop(A,Vlist));}
512: return(A);
513: }
514:
515: def sm1_push_int0_R(A,P) {
516: return(sm1_push_int0(P,A));
517: }
518:
519: /*&eg-texi
520: @c sort-sm1_push_int0
521: @menu
522: * sm1_push_int0::
523: @end menu
524: @node sm1_push_int0,,, SM1 Functions
525: @subsection @code{sm1_push_int0}
526: @findex sm1_push_int0
527: @table @t
528: @item sm1_push_int0(@var{p},@var{f})
529: :: push the object @var{f} to the server with the descriptor number @var{p}.
530: @end table
531:
532: @table @var
533: @item return
534: Void
535: @item p
536: Number
537: @item f
538: Object
539: @end table
540:
541: @itemize @bullet
542: @item When @code{type(@var{f})} is 2 (recursive polynomial),
543: @var{f} is converted to a string (type == 7)
544: and is sent to the server by @code{ox_push_cmo}.
545: @item When @code{type(@var{f})} is 0 (zero),
546: it is translated to the 32 bit integer zero
547: on the server.
548: Note that @code{ox_push_cmo(@var{p},0)} sends @code{CMO_NULL} to the server.
549: In other words, the server does not get the 32 bit integer 0 nor
550: the bignum 0.
551: @item @code{sm1} integers are classfied into the 32 bit integer and
552: the bignum.
553: When @code{type(@var{f})} is 1 (number), it is translated to the
554: 32 bit integer on the server.
555: Note that @code{ox_push_cmo(@var{p},1234)} send the bignum 1234 to the
556: @code{sm1} server.
557: @item In other cases, @code{ox_push_cmo} is called without data conversion.
558: @end itemize
559: */
560: /*&jp-texi
561: @c sort-sm1_push_int0
562: @menu
563: * sm1_push_int0::
564: @end menu
565: @node sm1_push_int0,,, SM1 $BH!?t(B
566: @subsection @code{sm1_push_int0}
567: @findex sm1_push_int0
568: @table @t
569: @item sm1_push_int0(@var{p},@var{f})
570: :: $B%*%V%8%'%/%H(B @var{f} $B$r<1JL;R(B @var{p} $B$N%5!<%P$XAw$k(B.
571: @end table
572:
573: @table @var
574: @item return
575: $B$J$7(B
576: @item p
577: $B?t(B
578: @item f
579: $B%*%V%8%'%/%H(B
580: @end table
581:
582: @itemize @bullet
583: @item @code{type(@var{f})} $B$,(B 2 ($B:F5"B?9`<0(B) $B$N$H$-(B,
584: @var{f} $B$OJ8;zNs(B (type == 7) $B$KJQ49$5$l$F(B,
585: @code{ox_push_cmo} $B$rMQ$$$F%5!<%P$XAw$i$l$k(B.
586: @item @code{type(@var{f})} $B$,(B 0 (zero) $B$N$H$-$O(B,
587: $B%5!<%P>e$G$O(B, 32 bit $B@0?t$H2r<a$5$l$k(B.
588: $B$J$*(B @code{ox_push_cmo(P,0)} $B$O%5!<%P$KBP$7$F(B @code{CMO_NULL}
589: $B$r$*$/$k$N$G(B, $B%5!<%PB&$G$O(B, 32 bit $B@0?t$r<u$1<h$k$o$1$G$O$J$$(B.
590: @item @code{sm1} $B$N@0?t$O(B, 32 bit $B@0?t$H(B bignum $B$K$o$1$k$3$H$,$G$-$k(B.
591: @code{type(@var{f})} $B$,(B 1 ($B?t(B)$B$N$H$-(B, $B$3$N4X?t$O(B 32 bit integer $B$r%5!<%P$K(B
592: $B$*$/$k(B.
593: @code{ox_push_cmo(@var{p},1234)} $B$O(B bignum $B$N(B 1234 $B$r(B
594: @code{sm1} $B%5!<%P$K$*$/$k$3$H$KCm0U$7$h$&(B.
595: @item $B$=$NB>$N>l9g$K$O(B @code{ox_push_cmo} $B$r%G!<%?7?$NJQ49$J$7$K8F$S=P$9(B.
596: @end itemize
597: */
598: /*&C
599: @example
600: [219] P=sm1_start();
601: 0
602: [220] sm1_push_int0(P,x*dx+1);
603: 0
604: [221] A=ox_pop_cmo(P);
605: x*dx+1
606: [223] type(A);
607: 7 (string)
608: @end example
609:
610: @example
611: [271] sm1_push_int0(0,[x*(x-1),[x]]);
612: 0
613: [272] ox_execute_string(0," deRham ");
614: 0
615: [273] ox_pop_cmo(0);
616: [1,2]
617: @end example
618: */
619: /*&eg-texi
620: @table @t
621: @item Reference
622: @code{ox_push_cmo}
623: @end table
624: */
625: /*&jp-texi
626: @table @t
627: @item Reference
628: @code{ox_push_cmo}
629: @end table
630: */
631:
632:
633: def sm1_push_int0(P,A) {
634: if (type(A) == 1 || type(A) == 0) {
635: /* recursive poly or number or 0*/
636: A = rtostr(A);
637: ox_push_cmo(P,A);
638: sm1(P," . (integer) dc ");
639: return;
640: }
641: if (type(A) == 2) {
642: A = rtostr(A); ox_push_cmo(P,A);
643: return;
644: }
645: if (type(A) == 4) { /* list */
646: ox_execute_string(P," [ ");
647: map(sm1_push_int0_R,A,P);
648: ox_execute_string(P," ] ");
649: return;
650: }
651: ox_push_cmo(P,A);
652: return;
653: }
654:
655: def sm1_push_0_R(A,P) {
656: return(sm1_push_0(P,A));
657: }
658: def sm1_push_0(P,A) {
659: if (type(A) == 0) {
660: /* 0 */
661: A = rtostr(A);
662: ox_push_cmo(P,A);
663: sm1(P," .. ");
664: return;
665: }
666: if (type(A) == 2) {
667: /* Vlist = vars(A); One should check Vlist is a subset of Vlist3. */
668: Vlist2 = sm1_vlist(P);
669: Vlist3 = map(strtov,Vlist2[1]);
670: B = dp_ptod(A,Vlist3);
671: ox_push_cmo(P,B);
672: return;
673: }
674: if (type(A) == 4) { /* list */
675: ox_execute_string(P," [ ");
676: map(sm1_push_0_R,A,P);
677: ox_execute_string(P," ] ");
678: return;
679: }
680: ox_push_cmo(P,A);
681: return;
682: }
683:
684: def sm1_push(P,A) {
685: sm1_push_0(P,A);
686: }
687:
688:
689: def sm1_pop(P) {
690: extern V_sm1_pop;
691: sm1(P," toAsirForm ");
692: V_sm1_pop = ox_pop_cmo(P);
693: return(toAsirForm(V_sm1_pop));
694: }
695:
696: def sm1_pop2(P) {
697: extern V_sm1_pop;
698: sm1(P," toAsirForm ");
699: V_sm1_pop = ox_pop_cmo(P);
700: return([toAsirForm(V_sm1_pop),V_sm1_pop]);
701: }
702:
703: def sm1_check_arg_gb(A,Fname) {
704: /* A = [[x^2+y^2-1,x*y],[x,y],[[x,-1,y,-1]]] */
705: if (type(A) != 4) {
706: error(Fname+" : argument should be a list.");
707: }
708: if (length(A) < 2) {
709: error(Fname+" : argument should be a list of 2 or 3 elements.");
710: }
711: if (type(A[0]) != 4) {
712: error(Fname+" : example: [[dx^2+dy^2-4,dx*dy-1]<== it should be a list,[x,y]]");
713: }
714: if (!sm1_isListOfPoly(A[0])) {
715: error(Fname+" : example: [[dx^2+dy^2-4,dx*dy-1]<== it should be a list of polynomials or strings,[x,y]]");
716: }
717: if (!sm1_isListOfVar(A[1])) {
718: error(Fname+" : example: [[dx^2+dy^2-4,dx*dy-1],[x,y]<== list of variables or \"x,y\"]");
719: }
720: if (length(A) >= 3) {
721: if (type(A[2]) != 4) {
722: error(Fname+" : example:[[dx^2+dy^2-4,dx*dy-1],[x,y],[[x,-1,dx,1]]<== a list of weights]");
723: }
724: if (type(A[2][0]) != 4) {
725: error(Fname+" : example:[[dx^2+dy^2-4,dx*dy-1],[x,y],[[x,-1,dx,1],[dy,1]]<== a list of lists of weight]");
726: }
727: }
728: return(1);
729: }
730:
731: def sm1_isListOfPoly(A) {
732: if (type(A) !=4 ) return(0);
733: N = length(A);
734: for (I=0; I<N; I++) {
735: if (!(type(A[I]) == 0 || type(A[I]) == 1 || type(A[I]) == 2 ||
736: type(A[I]) == 7 || type(A[I]) == 9)) {
737: return(0);
738: }
739: }
740: return(1);
741: }
742:
743: def sm1_isListOfVar(A) {
744: if (type(A) == 7) return(1); /* "x,y" */
745: if (type(A) != 4) return(0);
746: N = length(A);
747: for (I=0; I<N; I++) {
748: if (!(type(A[I]) == 2 || type(A[I]) == 7 )) {
749: return(0);
750: }
751: }
752: return(1);
753: }
754:
755: /*&eg-texi
756: @c sort-sm1_gb
757: @menu
758: * sm1_gb::
759: @end menu
760: @node sm1_gb,,, SM1 Functions
761: @node sm1_gb_d,,, SM1 Functions
762: @subsection @code{sm1_gb}
763: @findex sm1_gb
764: @findex sm1_gb_d
765: @table @t
1.3 takayama 766: @item sm1_gb([@var{f},@var{v},@var{w}]|proc=@var{p},sorted=@var{q},dehomogenize=@var{r})
1.1 takayama 767: :: computes the Grobner basis of @var{f} in the ring of differential
768: operators with the variable @var{v}.
769: @item sm1_gb_d([@var{f},@var{v},@var{w}]|proc=@var{p})
770: :: computes the Grobner basis of @var{f} in the ring of differential
771: operators with the variable @var{v}.
772: The result will be returned as a list of distributed polynomials.
773: @end table
774:
775: @table @var
776: @item return
777: List
1.3 takayama 778: @item p, q, r
1.1 takayama 779: Number
780: @item f, v, w
781: List
782: @end table
783:
784: @itemize @bullet
785: @item
786: It returns the Grobner basis of the set of polynomials @var{f}
787: in the ring of deferential operators with the variables @var{v}.
788: @item
789: The weight vectors are given by @var{w}, which can be omitted.
790: If @var{w} is not given,
791: the graded reverse lexicographic order will be used to compute Grobner basis.
792: @item
793: The return value of @code{sm1_gb}
794: is the list of the Grobner basis of @var{f} and the initial
795: terms (when @var{w} is not given) or initial ideal (when @var{w} is given).
796: @item
797: @code{sm1_gb_d} returns the results by a list of distributed polynomials.
798: Monomials in each distributed polynomial are ordered in the given order.
799: The return value consists of
800: [variable names, order matrix, grobner basis in districuted polynomials,
801: initial monomials or initial polynomials].
802: @item
803: When a non-term order is given, the Grobner basis is computed in
804: the homogenized Weyl algebra (See Section 1.2 of the book of SST).
805: The homogenization variable h is automatically added.
1.2 takayama 806: @item
807: When the optional variable @var{q} is set, @code{sm1_gb} returns,
808: as the third return value, a list of
809: the Grobner basis and the initial ideal
810: with sums of monomials sorted by the given order.
811: Each polynomial is expressed as a string temporally for now.
1.3 takayama 812: When the optional variable @var{r} is set to one,
813: the polynomials are dehomogenized (,i.e., h is set to 1).
1.1 takayama 814: @end itemize
815: */
816: /*&jp-texi
817: @c sort-sm1_gb
818: @menu
819: * sm1_gb::
820: @end menu
821: @node sm1_gb,,, SM1 $BH!?t(B
822: @node sm1_gb_d,,, SM1 $BH!?t(B
823: @subsection @code{sm1_gb}
824: @findex sm1_gb
825: @findex sm1_gb_d
826: @table @t
1.3 takayama 827: @item sm1_gb([@var{f},@var{v},@var{w}]|proc=@var{p},sorted=@var{q},dehomogenize=@var{r})
1.1 takayama 828: :: @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N%0%l%V%J4pDl$r7W;;$9$k(B.
829: @item sm1_gb_d([@var{f},@var{v},@var{w}]|proc=@var{p})
830: :: @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N%0%l%V%J4pDl$r7W;;$9$k(B. $B7k2L$rJ,;6B?9`<0$N%j%9%H$GLa$9(B.
831: @end table
832:
833: @table @var
834: @item return
835: $B%j%9%H(B
1.3 takayama 836: @item p, q, r
1.1 takayama 837: $B?t(B
838: @item f, v, w
839: $B%j%9%H(B
840: @end table
841:
842: @itemize @bullet
843: @item
844: @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N%0%l%V%J4pDl$r7W;;$9$k(B.
845: @item
846: Weight $B%Y%/%H%k(B @var{w} $B$O>JN,$7$F$h$$(B.
847: $B>JN,$7$?>l9g(B, graded reverse lexicographic order $B$r$D$+$C$F(B
848: $B%V%l%V%J4pDl$r7W;;$9$k(B.
849: @item
850: @code{sm1_gb} $B$NLa$jCM$O(B @var{f} $B$N%0%l%V%J4pDl$*$h$S%$%K%7%c%k%b%N%_%"%k(B
851: ( @var{w} $B$,$J$$$H$-(B ) $B$^$?$O(B $B%$%K%7%!%kB?9`<0(B ( @var{w} $B$,M?$($i$?$H$-(B)
852: $B$N%j%9%H$G$"$k(B.
853: @item
854: @code{sm1_gb_d} $B$O7k2L$rJ,;6B?9`<0$N%j%9%H$GLa$9(B.
855: $BB?9`<0$NCf$K8=$l$k%b%N%_%"%k$O%0%l%V%J4pDl$r7W;;$9$k$H$-$KM?$($i$?=g=x$G%=!<%H$5$l$F$$$k(B.
856: $BLa$jCM$O(B
857: [$BJQ?tL>$N%j%9%H(B, $B=g=x$r$-$a$k9TNs(B, $B%0%l%V%J4pDl(B, $B%$%K%7%c%k%b%N%_%"%k$^$?$O%$%K%7%!%kB?9`<0(B]
858: $B$G$"$k(B.
859: @item
860: Term order $B$G$J$$=g=x$,M?$($i$l$?>l9g$O(B, $BF1<!2=%o%$%kBe?t$G%0%l%V%J4pDl$,7W;;$5$l$k(B (SST $B$NK\$N(B Section 1.2 $B$r8+$h(B).
861: $BF1<!2=JQ?t(B @code{h} $B$,7k2L$K2C$o$k(B.
1.2 takayama 862: @item $B%*%W%7%g%J%kJQ?t(B @var{q} $B$,%;%C%H$5$l$F$$$k$H$-$O(B,
863: 3 $BHVL\$NLa$jCM$H$7$F(B, $B%0%l%V%J4pDl$*$h$S%$%K%7%!%k$N%j%9%H$,(B
864: $BM?$($i$l$?=g=x$G%=!<%H$5$l$?%b%N%_%"%k$NOB$H$7$FLa$5$l$k(B.
865: $B$$$^$N$H$3$m$3$NB?9`<0$O(B, $BJ8;zNs$GI=8=$5$l$k(B.
1.3 takayama 866: $B%*%W%7%g%J%kJQ?t(B @var{r} $B$,%;%C%H$5$l$F$$$k$H$-$O(B,
867: $BLa$jB?9`<0$O(B dehomogenize $B$5$l$k(B ($B$9$J$o$A(B h $B$K(B 1 $B$,BeF~$5$l$k(B).
1.1 takayama 868: @end itemize
869: */
870: /*&C-texi
871: @example
872: [293] sm1_gb([[x*dx+y*dy-1,x*y*dx*dy-2],[x,y]]);
873: [[x*dx+y*dy-1,y^2*dy^2+2],[x*dx,y^2*dy^2]]
874: @end example
875: */
876: /*&eg-texi
877: In the example above,
878: @tex the set $\{ x \partial_x + y \partial_y -1,
879: y^2 \partial_y^2+2\}$
880: is the Gr\"obner basis of the input with respect to the
881: graded reverse lexicographic order such that
882: $ 1 \leq \partial_y \leq \partial_x \leq y \leq x \leq \cdots$.
883: The set $\{x \partial_x, y^2 \partial_y\}$ is the leading monomials
884: (the initial monominals) of the Gr\"obner basis.
885: @end tex
886: */
887: /*&jp-texi
888: $B>e$NNc$K$*$$$F(B,
889: @tex $B=89g(B $\{ x \partial_x + y \partial_y -1,
890: y^2 \partial_y^2+2\}$
891: $B$O(B
892: $ 1 \leq \partial_y \leq \partial_x \leq y \leq x \leq \cdots$
893: $B$G$"$k$h$&$J(B
894: graded reverse lexicographic order $B$K4X$9$k%0%l%V%J4pDl$G$"$k(B.
895: $B=89g(B $\{x \partial_x, y^2 \partial_y\}$ $B$O%0%l%V%J4pDl$N3F85$K(B
896: $BBP$9$k(B leading monomial (initial monomial) $B$G$"$k(B.
897: @end tex
898: */
899: /*&C-texi
900: @example
901: [294] sm1_gb([[dx^2+dy^2-4,dx*dy-1],[x,y],[[dx,50,dy,2,x,1]]]);
902: [[dx+dy^3-4*dy,-dy^4+4*dy^2-1],[dx,-dy^4]]
903: @end example
904: */
905: /*&eg-texi
906: In the example above, two monomials
907: @tex
908: $m = x^a y^b \partial_x^c \partial_y^d$ and
909: $m' = x^{a'} y^{b'} \partial_x^{c'} \partial_y^{d'}$
910: are firstly compared by the weight vector
911: {\tt (dx,dy,x,y) = (50,2,1,0)}
912: (i.e., $m$ is larger than $m'$ if $50c+2d+a > 50c'+2d'+a'$)
913: and when the comparison is tie, then these are
914: compared by the reverse lexicographic order
915: (i.e., if $50c+2d+a = 50c'+2d'+a'$, then use the reverse lexicogrpahic order).
916: @end tex
917: */
918: /*&jp-texi
919: $B>e$NNc$K$*$$$FFs$D$N%b%N%_%"%k(B
920: @tex
921: $m = x^a y^b \partial_x^c \partial_y^d$ $B$*$h$S(B
922: $m' = x^{a'} y^{b'} \partial_x^{c'} \partial_y^{d'}$
923: $B$O:G=i$K(B weight vector
924: {\tt (dx,dy,x,y) = (50,2,1,0)} $B$rMQ$$$FHf3S$5$l$k(B
925: ($B$D$^$j(B $m$ $B$O(B $50c+2d+a > 50c'+2d'+a'$ $B$N$H$-(B
926: $m'$ $B$h$jBg$-$$(B )
927: $B<!$K$3$NHf3S$G>!Ii$,$D$+$J$$$H$-$O(B reverse lexicographic order $B$GHf3S$5$l$k(B
928: ($B$D$^$j(B $50c+2d+a = 50c'+2d'+a'$ $B$N$H$-(B reverse lexicographic order $B$GHf3S(B
929: $B$5$l$k(B).
930: @end tex
1.2 takayama 931: */
932: /*&C-texi
933: @example
934: [294] F=sm1_gb([[dx^2+dy^2-4,dx*dy-1],[x,y],[[dx,50,dy,2,x,1]]]|sorted=1);
935: map(print,F[2][0])$
936: map(print,F[2][1])$
937: @end example
1.1 takayama 938: */
939: /*&C-texi
940: @example
941: [595]
942: sm1_gb([["dx*(x*dx +y*dy-2)-1","dy*(x*dx + y*dy -2)-1"],
943: [x,y],[[dx,1,x,-1],[dy,1]]]);
944:
945: [[x*dx^2+(y*dy-h^2)*dx-h^3,x*dy*dx+y*dy^2-h^2*dy-h^3,h^3*dx-h^3*dy],
946: [x*dx^2+(y*dy-h^2)*dx,x*dy*dx+y*dy^2-h^2*dy-h^3,h^3*dx]]
947:
948: [596]
949: sm1_gb_d([["dx (x dx +y dy-2)-1","dy (x dx + y dy -2)-1"],
950: "x,y",[[dx,1,x,-1],[dy,1]]]);
951: [[[e0,x,y,H,E,dx,dy,h],
952: [[0,-1,0,0,0,1,0,0],[0,0,0,0,0,0,1,0],[1,0,0,0,0,0,0,0],
953: [0,1,1,1,1,1,1,0],[0,0,0,0,0,0,-1,0],[0,0,0,0,0,-1,0,0],
954: [0,0,0,0,-1,0,0,0],[0,0,0,-1,0,0,0,0],[0,0,-1,0,0,0,0,0],
955: [0,0,0,0,0,0,0,1]]],
956: [[(1)*<<0,0,1,0,0,1,1,0>>+(1)*<<0,1,0,0,0,2,0,0>>+(-1)*<<0,0,0,0,0,1,0,2>>+(-1)*
957: <<0,0,0,0,0,0,0,3>>,(1)*<<0,0,1,0,0,0,2,0>>+(1)*<<0,1,0,0,0,1,1,0>>+(-1)*<<0,0,0
958: ,0,0,0,1,2>>+(-1)*<<0,0,0,0,0,0,0,3>>,(1)*<<0,0,0,0,0,1,0,3>>+(-1)*<<0,0,0,0,0,0
959: ,1,3>>],
960: [(1)*<<0,0,1,0,0,1,1,0>>+(1)*<<0,1,0,0,0,2,0,0>>+(-1)*<<0,0,0,0,0,1,0,2>>,(1)*<
961: <0,0,1,0,0,0,2,0>>+(1)*<<0,1,0,0,0,1,1,0>>+(-1)*<<0,0,0,0,0,0,1,2>>+(-1)*<<0,0,0
962: ,0,0,0,0,3>>,(1)*<<0,0,0,0,0,1,0,3>>]]]
963: @end example
964: */
965:
966: /*&eg-texi
967: @table @t
968: @item Reference
969: @code{sm1_reduction}, @code{sm1_rat_to_p}
970: @end table
971: */
972: /*&jp-texi
973: @table @t
974: @item $B;2>H(B
975: @code{sm1_reduction}, @code{sm1_rat_to_p}
976: @end table
977: */
978:
979:
980: def sm1_gb(A) {
981: SM1_FIND_PROC(P);
982: P = sm1_check_server(P);
983: sm1_check_arg_gb(A,"Error in sm1_gb");
984: sm1_push_int0(P,A);
985: sm1(P," gb ");
986: T = sm1_pop2(P);
987: return(append(T[0],[sm1_toOrdered(T[1])]));
988: }
989: def sm1_gb_d(A) {
990: SM1_FIND_PROC(P);
991: P = sm1_check_server(P);
992: sm1_check_arg_gb(A,"Error in sm1_gb_d");
993: sm1_push_int0(P,A);
994: sm1(P," gb /gb.tmp1 set ");
995: sm1(P," gb.tmp1 getOrderMatrix {{(universalNumber) dc} map } map /gb.tmp2 set ");
996: sm1(P," gb.tmp1 0 get 0 get getvNamesCR { [(class) (indeterminate)] dc } map /gb.tmp3 set ");
997: sm1(P," gb.tmp1 getRing ring_def "); /* Change the current ring! */
998: sm1(P,"[[ gb.tmp3 gb.tmp2] gb.tmp1] ");
999: return(ox_pop_cmo(P));
1000: }
1001:
1002: def sm1_pgb(A) {
1003: SM1_FIND_PROC(P);
1004: P = sm1_check_server(P);
1005: sm1_check_arg_gb(A,"Error in sm1_pgb");
1006: sm1(P," set_timer ");
1007: sm1_push_int0(P,A);
1008: sm1(P," pgb ");
1009: B = sm1_pop(P);
1010: sm1(P," set_timer ");
1011: return(B);
1012: }
1013:
1014: /*&eg-texi
1015: @c sort-sm1_deRham
1016: @menu
1017: * sm1_deRham::
1018: @end menu
1019: @node sm1_deRham,,, SM1 Functions
1020: @subsection @code{sm1_deRham}
1021: @findex sm1_deRham
1022: @table @t
1023: @item sm1_deRham([@var{f},@var{v}]|proc=@var{p})
1024: :: ask the server to evaluate the dimensions of the de Rham cohomology groups
1025: of C^n - (the zero set of @var{f}=0).
1026: @end table
1027:
1028: @table @var
1029: @item return
1030: List
1031: @item p
1032: Number
1033: @item f
1034: String or polynomial
1035: @item v
1036: List
1037: @end table
1038:
1039: @itemize @bullet
1040: @item It returns the dimensions of the de Rham cohomology groups
1041: of X = C^n \ V(@var{f}).
1042: In other words, it returns
1043: [dim H^0(X,C), dim H^1(X,C), dim H^2(X,C), ..., dim H^n(X,C)].
1044: @item @var{v} is a list of variables. n = @code{length(@var{v})}.
1045: @item
1046: @code{sm1_deRham} requires huge computer resources.
1047: For example, @code{sm1_deRham(0,[x*y*z*(x+y+z-1)*(x-y),[x,y,z]])}
1048: is already very hard.
1049: @item
1050: To efficiently analyze the roots of b-function, @code{ox_asir} should be used
1051: from @code{ox_sm1_forAsir}.
1052: It is recommended to load the communication module for @code{ox_asir}
1053: by the command @*
1054: @code{sm1(0,"[(parse) (oxasir.sm1) pushfile] extension");}
1055: This command is automatically executed when @code{ox_sm1_forAsir} is started.
1056: @item If you make an interruption to the function @code{sm1_deRham}
1057: by @code{ox_reset(Sm1_proc);}, the server might get out of the standard
1058: mode. So, it is strongly recommended to execute the command
1059: @code{ox_shutdown(Sm1_proc);} to interrupt and restart the server.
1060: @end itemize
1061: */
1062: /*&jp-texi
1063: @c sort-sm1_deRham
1064: @menu
1065: * sm1_deRham::
1066: @end menu
1067: @node sm1_deRham,,, SM1 $BH!?t(B
1068: @subsection @code{sm1_deRham}
1069: @findex sm1_deRham
1070: @table @t
1071: @item sm1_deRham([@var{f},@var{v}]|proc=@var{p})
1072: :: $B6u4V(B C^n - (the zero set of @var{f}=0) $B$N%I%i!<%`%3%[%b%m%872$N<!85$r7W;;$7$F$/$l$k$h$&$K%5!<%P$KMj$`(B.
1073: @end table
1074:
1075: @table @var
1076: @item return
1077: $B%j%9%H(B
1078: @item p
1079: $B?t(B
1080: @item f
1081: $BJ8;zNs(B $B$^$?$O(B $BB?9`<0(B
1082: @item v
1083: $B%j%9%H(B
1084: @end table
1085:
1086: @itemize @bullet
1087: @item $B$3$NH!?t$O6u4V(B X = C^n \ V(@var{f}) $B$N%I%i!<%`%3%[%b%m%872$N<!85$r7W;;$9$k(B.
1088: $B$9$J$o$A(B,
1089: [dim H^0(X,C), dim H^1(X,C), dim H^2(X,C), ..., dim H^n(X,C)]
1090: $B$rLa$9(B.
1091: @item @var{v} $B$OJQ?t$N%j%9%H(B. n = @code{length(@var{v})} $B$G$"$k(B.
1092: @item
1093: @code{sm1_deRham} $B$O7W;;5!$N;q8;$rBgNL$K;HMQ$9$k(B.
1094: $B$?$H$($P(B @code{sm1_deRham(0,[x*y*z*(x+y+z-1)*(x-y),[x,y,z]])}
1095: $B$N7W;;$9$i$9$G$KHs>o$KBgJQ$G$"$k(B.
1096: @item
1097: b-$B4X?t$N:,$r8zN($h$/2r@O$9$k$K$O(B, @code{ox_asir} $B$,(B @code{ox_sm1_forAsir}
1098: $B$h$j;HMQ$5$l$k$Y$-$G$"$k(B. $B%3%^%s%I(B @*
1099: @code{sm1(0,"[(parse) (oxasir.sm1) pushfile] extension");}
1100: $B$rMQ$$$F(B, @code{ox_asir} $B$H$NDL?.%b%8%e!<%k$r$"$i$+$8$a%m!<%I$7$F$*$/$H$h$$(B.
1101: $B$3$N%3%^%s%I$O(B @code{ox_asir_forAsir} $B$N%9%?!<%H;~$K<+F0E*$K<B9T$5$l$F$$$k(B.
1102: @item
1103: @code{sm1_deRham} $B$r(B @code{ox_reset(Sm1_proc);} $B$GCfCG$9$k$H(B,
1104: $B0J8e(B sm1 $B%5!<%P$,HsI8=`%b!<%I$KF~$jM=4|$7$J$$F0:n$r$9$k>l9g(B
1105: $B$,$"$k$N$G(B, $B%3%^%s%I(B @code{ox_shutdown(Sm1_proc);} $B$G(B, @code{ox_sm1_forAsir}
1106: $B$r0l;~(B shutdown $B$7$F%j%9%?!<%H$7$?J}$,0BA4$G$"$k(B.
1107: @end itemize
1108: */
1109: /*&C-texi
1110: @example
1111: [332] sm1_deRham([x^3-y^2,[x,y]]);
1112: [1,1,0]
1113: [333] sm1_deRham([x*(x-1),[x]]);
1114: [1,2]
1115: @end example
1116: */
1117: /*&eg-texi
1118: @table @t
1119: @item Reference
1120: @code{sm1_start}, @code{deRham} (sm1 command)
1.5 ! takayama 1121: @item Algorithm:
1.1 takayama 1122: Oaku, Takayama, An algorithm for de Rham cohomology groups of the
1123: complement of an affine variety via D-module computation,
1124: Journal of pure and applied algebra 139 (1999), 201--233.
1125: @end table
1126: */
1127: /*&jp-texi
1128: @table @t
1129: @item $B;2>H(B
1130: @code{sm1_start}, @code{deRham} (sm1 command)
1.5 ! takayama 1131: @item Algorithm:
1.1 takayama 1132: Oaku, Takayama, An algorithm for de Rham cohomology groups of the
1133: complement of an affine variety via D-module computation,
1134: Journal of pure and applied algebra 139 (1999), 201--233.
1135: @end table
1136: */
1137:
1138:
1139: def sm1_deRham(A) {
1140: SM1_FIND_PROC(P);
1141: P = sm1_check_server(P);
1142: sm1(P," set_timer ");
1143: sm1_push_int0(P,A);
1144: sm1(P," deRham ");
1145: B = sm1_pop(P);
1146: sm1(P," set_timer ");
1147: ox_check_errors2(P);
1148: return(B);
1149: }
1150:
1151: def sm1_vlist(P) {
1152: sm1(P," getvNamesC ");
1153: B=ox_pop_cmo(P);
1154: sm1(P," getvNamesC toAsirVar ");
1155: C=ox_pop_cmo(P);
1156: return([B,C,map(strtov,C)]);
1157: }
1158: /* [ sm1 names(string), asir names(string), asir names(var)] */
1159: /* Vlist = sm1_vlist(P);
1160: sm1_push_poly0( x + 20*x, Vlist[2]);
1161: sm1_pop_poly0(Vlist[2]);
1162: */
1163:
1164: /* ring of Differential operators */
1165: def sm1_ringD(V,W) {
1166: SM1_FIND_PROC(P);
1167: sm1(P," [ ");
1168: if (type(V) == 7) { /* string */
1169: ox_push_cmo(P,V);
1170: }else if (type(V) == 4) {/* list */
1171: V = map(rtostr,V);
1172: ox_push_cmo(P,V);
1173: sm1(P," from_records ");
1174: }else { printf("Error: sm1_ringD"); return(-1); }
1175: sm1(P," ring_of_differential_operators ");
1176: if (type(W) != 0) {
1177: sm1_push_int0(P,W); sm1(P," weight_vector ");
1178: }
1179: sm1(P," pstack ");
1180: sm1(P," 0 ] define_ring getOrderMatrix {{(universalNumber) dc}map}map ");
1181: ox_check_errors2(P);
1182: M = ox_pop_cmo(P);
1183: return([sm1_vlist(P)[2],M]);
1184: }
1185:
1186: def sm1_expand_d(F) {
1187: SM1_FIND_PROC(P);
1188: ox_push_cmo(P,F);
1189: sm1(P, " expand ");
1190: return(ox_pop_cmo(P));
1191: }
1192:
1193: def sm1_mul_d(A,B) {
1194: SM1_FIND_PROC(P);
1195: ox_push_cmo(P,A);
1196: ox_push_cmo(P,B);
1197: sm1(P," mul ");
1198: return(ox_pop_cmo(P));
1199: }
1200:
1201: def sm1_dehomogenize_d(A) {
1202: SM1_FIND_PROC(P);
1203: ox_push_cmo(P,A);
1204: sm1(P," dehomogenize ");
1205: return(ox_pop_cmo(P));
1206: }
1207:
1208: def sm1_homogenize_d(A) {
1209: SM1_FIND_PROC(P);
1210: ox_push_cmo(P,A);
1211: sm1(P," homogenize ");
1212: return(ox_pop_cmo(P));
1213: }
1214:
1215: def sm1_groebner_d(A) {
1216: SM1_FIND_PROC(P);
1217: ox_push_cmo(P,A);
1218: sm1(P," groebner ");
1219: return(ox_pop_cmo(P));
1220: }
1221:
1222: def sm1_reduction_d(F,G) {
1223: SM1_FIND_PROC(P);
1224: ox_push_cmo(P,F);
1225: ox_push_cmo(P,G);
1226: sm1(P," reduction ");
1227: return(ox_pop_cmo(P));
1228: }
1229:
1230: def sm1_reduction_noH_d(F,G) {
1231: SM1_FIND_PROC(P);
1232: ox_push_cmo(P,F);
1233: ox_push_cmo(P,G);
1234: sm1(P," reduction-noH ");
1235: return(ox_pop_cmo(P));
1236: }
1237:
1238:
1239: /*&eg-texi
1240: @c sort-sm1_hilbert
1241: @menu
1242: * sm1_hilbert::
1243: * hilbert_polynomial::
1244: @end menu
1245: @node sm1_hilbert,,, SM1 Functions
1246: @subsection @code{sm1_hilbert}
1247: @findex sm1_hilbert
1248: @findex hilbert_polynomial
1249: @table @t
1250: @item sm1_hilbert([@var{f},@var{v}]|proc=@var{p})
1251: :: ask the server to compute the Hilbert polynomial for the set of polynomials @var{f}.
1252: @item hilbert_polynomial(@var{f},@var{v})
1253: :: ask the server to compute the Hilbert polynomial for the set of polynomials @var{f}.
1254: @end table
1255:
1256: @table @var
1257: @item return
1258: Polynomial
1259: @item p
1260: Number
1261: @item f, v
1262: List
1263: @end table
1264:
1265: @itemize @bullet
1266: @item It returns the Hilbert polynomial h(k) of the set of polynomials
1267: @var{f}
1268: with respect to the set of variables @var{v}.
1269: @item
1270: h(k) = dim_Q F_k/I \cap F_k where F_k the set of polynomials of which
1271: degree is less than or equal to k and I is the ideal generated by the
1272: set of polynomials @var{f}.
1273: @item
1274: Note for sm1_hilbert:
1275: For an efficient computation, it is preferable that
1276: the set of polynomials @var{f} is a set of monomials.
1277: In fact, this function firstly compute a Grobner basis of @var{f}, and then
1278: compute the Hilbert polynomial of the initial monomials of the basis.
1279: If the input @var{f} is already a Grobner
1280: basis, a Grobner basis is recomputed in this function,
1281: which is a waste of time and Grobner basis computation in the ring of
1282: polynomials in @code{sm1} is slower than in @code{asir}.
1283: @end itemize
1284: */
1285: /*&jp-texi
1286: @c sort-sm1_hilbert
1287: @menu
1288: * sm1_hilbert::
1289: * hilbert_polynomial::
1290: @end menu
1291: @node sm1_hilbert,,, SM1 $BH!?t(B
1292: @subsection @code{sm1_hilbert}
1293: @findex sm1_hilbert
1294: @findex hilbert_polynomial
1295: @table @t
1296: @item sm1_hilbert([@var{f},@var{v}]|proc=@var{p})
1297: :: $BB?9`<0$N=89g(B @var{f} $B$N%R%k%Y%k%HB?9`<0$r7W;;$9$k(B.
1298: @item hilbert_polynomial(@var{f},@var{v})
1299: :: $BB?9`<0$N=89g(B @var{f} $B$N%R%k%Y%k%HB?9`<0$r7W;;$9$k(B.
1300: @end table
1301:
1302: @table @var
1303: @item return
1304: $BB?9`<0(B
1305: @item p
1306: $B?t(B
1307: @item f, v
1308: $B%j%9%H(B
1309: @end table
1310:
1311: @itemize @bullet
1312: @item $BB?9`<0$N=89g(B @var{f} $B$NJQ?t(B @var{v} $B$K$+$s$9$k%R%k%Y%k%HB?9`<0(B h(k)
1313: $B$r7W;;$9$k(B.
1314: @item
1315: h(k) = dim_Q F_k/I \cap F_k $B$3$3$G(B F_k $B$O<!?t$,(B k $B0J2<$G$"$k$h$&$J(B
1316: $BB?9`<0$N=89g$G$"$k(B. I $B$OB?9`<0$N=89g(B @var{f} $B$G@8@.$5$l$k%$%G%"%k$G$"$k(B.
1317: @item
1318: sm1_hilbert $B$K$+$s$9$k%N!<%H(B:
1319: $B8zN($h$/7W;;$9$k$K$O(B @var{f} $B$O%b%N%_%"%k$N=89g$K$7$?J}$,$$$$(B.
1320: $B<B:](B, $B$3$NH!?t$O$^$:(B @var{f} $B$N%0%l%V%J4pDl$r7W;;$7(B, $B$=$l$+$i$=$N(B initial
1321: monomial $BC#$N%R%k%Y%k%HB?9`<0$r7W;;$9$k(B.
1322: $B$7$?$,$C$F(B, $BF~NO(B @var{f} $B$,$9$G$K%0%l%V%J4pDl$@$H$3$NH!?t$N$J$+$G$b$&0lEY(B
1323: $B%0%l%V%J4pDl$N7W;;$,$*$3$J$o$l$k(B. $B$3$l$O;~4V$NL5BL$G$"$k$7(B, @code{sm1} $B$N(B
1324: $BB?9`<0%0%l%V%J4pDl7W;;$O(B @code{asir} $B$h$jCY$$(B.
1325: @end itemize
1326: */
1327:
1328: /*&C-texi
1329: @example
1330:
1331: [346] load("katsura")$
1332: [351] A=hilbert_polynomial(katsura(5),[u0,u1,u2,u3,u4,u5]);
1333: 32
1334:
1335: @end example
1336:
1337: @example
1338: [279] load("katsura")$
1339: [280] A=gr(katsura(5),[u0,u1,u2,u3,u4,u5],0)$
1340: [281] dp_ord();
1341: 0
1342: [282] B=map(dp_ht,map(dp_ptod,A,[u0,u1,u2,u3,u4,u5]));
1343: [(1)*<<1,0,0,0,0,0>>,(1)*<<0,0,0,2,0,0>>,(1)*<<0,0,1,1,0,0>>,(1)*<<0,0,2,0,0,0>>,
1344: (1)*<<0,1,1,0,0,0>>,(1)*<<0,2,0,0,0,0>>,(1)*<<0,0,0,1,1,1>>,(1)*<<0,0,0,1,2,0>>,
1345: (1)*<<0,0,1,0,2,0>>,(1)*<<0,1,0,0,2,0>>,(1)*<<0,1,0,1,1,0>>,(1)*<<0,0,0,0,2,2>>,
1346: (1)*<<0,0,1,0,1,2>>,(1)*<<0,1,0,0,1,2>>,(1)*<<0,1,0,1,0,2>>,(1)*<<0,0,0,0,3,1>>,
1347: (1)*<<0,0,0,0,4,0>>,(1)*<<0,0,0,0,1,4>>,(1)*<<0,0,0,1,0,4>>,(1)*<<0,0,1,0,0,4>>,
1348: (1)*<<0,1,0,0,0,4>>,(1)*<<0,0,0,0,0,6>>]
1349: [283] C=map(dp_dtop,B,[u0,u1,u2,u3,u4,u5]);
1350: [u0,u3^2,u3*u2,u2^2,u2*u1,u1^2,u5*u4*u3,u4^2*u3,u4^2*u2,u4^2*u1,u4*u3*u1,
1351: u5^2*u4^2,u5^2*u4*u2,u5^2*u4*u1,u5^2*u3*u1,u5*u4^3,u4^4,u5^4*u4,u5^4*u3,
1352: u5^4*u2,u5^4*u1,u5^6]
1353: [284] sm1_hilbert([C,[u0,u1,u2,u3,u4,u5]]);
1354: 32
1355: @end example
1356: */
1357:
1358: /*&eg-texi
1359: @table @t
1360: @item Reference
1361: @code{sm1_start}, @code{sm1_gb}, @code{longname}
1362: @end table
1363: */
1364: /*&jp-texi
1365: @table @t
1366: @item $B;2>H(B
1367: @code{sm1_start}, @code{sm1_gb}, @code{longname}
1368: @end table
1369: */
1370:
1371: def sm1_hilbert(A) {
1372: SM1_FIND_PROC(P);
1373: P = sm1_check_server(P);
1374: sm1(P,"[ ");
1375: sm1_push_int0(P,A[0]);
1376: sm1_push_int0(P,A[1]);
1377: sm1(P," ] pgb /sm1_hilbert.gb set ");
1378: sm1(P," sm1_hilbert.gb 0 get { init toString } map ");
1379: sm1_push_int0(P,A[1]);
1380: sm1(P, " hilbert ");
1381: B = sm1_pop(P);
1382: return(B[1]/fac(B[0]));
1383: }
1384:
1385: /*&eg-texi
1386: @c sort-sm1_genericAnn
1387: @menu
1388: * sm1_genericAnn::
1389: @end menu
1390: @node sm1_genericAnn,,, SM1 Functions
1391: @subsection @code{sm1_genericAnn}
1392: @findex sm1_genericAnn
1393: @table @t
1394: @item sm1_genericAnn([@var{f},@var{v}]|proc=@var{p})
1395: :: It computes the annihilating ideal for @var{f}^s.
1396: @var{v} is the list of variables. Here, s is @var{v}[0] and
1397: @var{f} is a polynomial in the variables @code{rest}(@var{v}).
1398: @end table
1399:
1400: @table @var
1401: @item return
1402: List
1403: @item p
1404: Number
1405: @item f
1406: Polynomial
1407: @item v
1408: List
1409: @end table
1410:
1411: @itemize @bullet
1412: @item This function computes the annihilating ideal for @var{f}^s.
1413: @var{v} is the list of variables. Here, s is @var{v}[0] and
1414: @var{f} is a polynomial in the variables @code{rest}(@var{v}).
1415: @end itemize
1416: */
1417: /*&jp-texi
1418: @c sort-sm1_genericAnn
1419: @menu
1420: * sm1_genericAnn::
1421: @end menu
1422: @node sm1_genericAnn,,, SM1 $BH!?t(B
1423: @subsection @code{sm1_genericAnn}
1424: @findex sm1_genericAnn
1425: @table @t
1426: @item sm1_genericAnn([@var{f},@var{v}]|proc=@var{p})
1427: :: @var{f}^s $B$N$_$?$9HyJ,J}Dx<0A4BN$r$b$H$a$k(B.
1428: @var{v} $B$OJQ?t$N%j%9%H$G$"$k(B. $B$3$3$G(B, s $B$O(B @var{v}[0] $B$G$"$j(B,
1429: @var{f} $B$OJQ?t(B @code{rest}(@var{v}) $B>e$NB?9`<0$G$"$k(B.
1430: @end table
1431:
1432: @table @var
1433: @item return
1434: $B%j%9%H(B
1435: @item p
1436: $B?t(B
1437: @item f
1438: $BB?9`<0(B
1439: @item v
1440: $B%j%9%H(B
1441: @end table
1442:
1443: @itemize @bullet
1444: @item $B$3$NH!?t$O(B,
1445: @var{f}^s $B$N$_$?$9HyJ,J}Dx<0A4BN$r$b$H$a$k(B.
1446: @var{v} $B$OJQ?t$N%j%9%H$G$"$k(B. $B$3$3$G(B, s $B$O(B @var{v}[0] $B$G$"$j(B,
1447: @var{f} $B$OJQ?t(B @code{rest}(@var{v}) $B>e$NB?9`<0$G$"$k(B.
1448: @end itemize
1449: */
1450: /*&C-texi
1451: @example
1452: [595] sm1_genericAnn([x^3+y^3+z^3,[s,x,y,z]]);
1453: [-x*dx-y*dy-z*dz+3*s,z^2*dy-y^2*dz,z^2*dx-x^2*dz,y^2*dx-x^2*dy]
1454: @end example
1455: */
1456: /*&eg-texi
1457: @table @t
1458: @item Reference
1459: @code{sm1_start}
1460: @end table
1461: */
1462: /*&jp-texi
1463: @table @t
1464: @item $B;2>H(B
1465: @code{sm1_start}
1466: @end table
1467: */
1468:
1469:
1470: def sm1_genericAnn(F) {
1471: SM1_FIND_PROC(P);
1472: sm1_push_int0(P,F[0]);
1473: sm1_push_int0(P,F[1]);
1474: sm1(P, " genericAnn ");
1475: B = sm1_pop(P);
1476: return(B);
1477: }
1478:
1479: def sm1_tensor0(F) {
1480: SM1_FIND_PROC(P);
1481: sm1_push_int0(P,F);
1482: sm1(P, " tensor0 ");
1483: B = sm1_pop(P);
1484: return(B);
1485: }
1486:
1487: /*&eg-texi
1488: @c sort-sm1_wTensor0
1489: @menu
1490: * sm1_wTensor0::
1491: @end menu
1492: @node sm1_wTensor0,,, SM1 Functions
1493: @subsection @code{sm1_wTensor0}
1494: @findex sm1_wTensor0
1495: @table @t
1496: @item sm1_wTensor0([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
1497: :: It computes the D-module theoretic 0-th tensor product
1498: of @var{f} and @var{g}.
1499: @end table
1500:
1501: @table @var
1502: @item return
1503: List
1504: @item p
1505: Number
1506: @item f, g, v, w
1507: List
1508: @end table
1509:
1510: @itemize @bullet
1511: @item
1512: It returns the D-module theoretic 0-th tensor product
1513: of @var{f} and @var{g}.
1514: @item
1515: @var{v} is a list of variables.
1516: @var{w} is a list of weights. The integer @var{w}[i] is
1517: the weight of the variable @var{v}[i].
1518: @item
1519: @code{sm1_wTensor0} calls @code{wRestriction0} of @code{ox_sm1},
1520: which requires a generic weight
1521: vector @var{w} to compute the restriction.
1522: If @var{w} is not generic, the computation fails.
1523: @item Let F and G be solutions of @var{f} and @var{g} respectively.
1524: Intuitively speaking, the 0-th tensor product is a system of
1525: differential equations which annihilates the function FG.
1526: @item The answer is a submodule of a free module D^r in general even if
1527: the inputs @var{f} and @var{g} are left ideals of D.
1528: @end itemize
1529: */
1530:
1531: /*&jp-texi
1532: @c sort-sm1_wTensor0
1533: @menu
1534: * sm1_wTensor0::
1535: @end menu
1536: @node sm1_wTensor0,,, SM1 $BH!?t(B
1537: @subsection @code{sm1_wTensor0}
1538: @findex sm1_wTensor0
1539: @table @t
1540: @item sm1_wTensor0([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
1541: :: @var{f} $B$H(B @var{g} $B$N(B D-module $B$H$7$F$N(B 0 $B<!%F%s%=%k@Q$r(B
1542: $B7W;;$9$k(B.
1543: @end table
1544:
1545: @table @var
1546: @item return
1547: $B%j%9%H(B
1548: @item p
1549: $B?t(B
1550: @item f, g, v, w
1551: $B%j%9%H(B
1552: @end table
1553:
1554: @itemize @bullet
1555: @item
1556: @var{f} $B$H(B @var{g} $B$N(B
1557: D-$B2C72$H$7$F$N(B 0 $B<!%F%s%=%k@Q$r7W;;$9$k(B.
1558: @item
1559: @var{v} $B$OJQ?t$N%j%9%H$G$"$k(B.
1560: @var{w} $B$O(B weight $B$N%j%9%H$G$"$k(B.
1561: $B@0?t(B @var{w}[i] $B$OJQ?t(B @var{v}[i] $B$N(B weight $B$G$"$k(B.
1562: @item
1563: @code{sm1_wTensor0} $B$O(B @code{ox_sm1} $B$N(B @code{wRestriction0}
1564: $B$r$h$s$G$$$k(B.
1565: @code{wRestriction0} $B$O(B, generic $B$J(B weight $B%Y%/%H%k(B @var{w}
1566: $B$r$b$H$K$7$F@)8B$r7W;;$7$F$$$k(B.
1567: Weight $B%Y%/%H%k(B @var{w} $B$,(B generic $B$G$J$$$H7W;;$,%(%i!<$GDd;_$9$k(B.
1568: @item F $B$*$h$S(B G $B$r(B @var{f} $B$H(B @var{g} $B$=$l$>$l$N2r$H$9$k(B.
1569: $BD>4QE*$K$$$($P(B, 0 $B<!$N%F%s%=%k@Q$O(B $B4X?t(B FG $B$N$_$?$9HyJ,J}Dx<07O$G$"$k(B.
1570: @item $BF~NO(B @var{f}, @var{g} $B$,(B D $B$N:8%$%G%"%k$G$"$C$F$b(B,
1571: $B0lHL$K(B, $B=PNO$O<+M32C72(B D^r $B$NItJ,2C72$G$"$k(B.
1572: @end itemize
1573: */
1574: /*&C-texi
1575: @example
1576: [258] sm1_wTensor0([[x*dx -1, y*dy -4],[dx+dy,dx-dy^2],[x,y],[1,2]]);
1577: [[-y*x*dx-y*x*dy+4*x+y],[5*x*dx^2+5*x*dx+2*y*dy^2+(-2*y-6)*dy+3],
1578: [-25*x*dx+(-5*y*x-2*y^2)*dy^2+((5*y+15)*x+2*y^2+16*y)*dy-20*x-8*y-15],
1579: [y^2*dy^2+(-y^2-8*y)*dy+4*y+20]]
1580: @end example
1581: */
1582:
1583:
1584: def sm1_wTensor0(F) {
1585: SM1_FIND_PROC(P);
1586: sm1_push_int0(P,F);
1587: sm1(P, " wTensor0 ");
1588: B = sm1_pop(P);
1589: return(B);
1590: }
1591:
1592:
1593: /*&eg-texi
1594: @c sort-sm1_reduction
1595: @menu
1596: * sm1_reduction::
1597: @end menu
1598: @node sm1_reduction,,, SM1 Functions
1599: @subsection @code{sm1_reduction}
1600: @findex sm1_reduction
1601: @table @t
1602: @item sm1_reduction([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
1603: ::
1604: @end table
1605:
1606: @table @var
1607: @item return
1608: List
1609: @item f
1610: Polynomial
1611: @item g, v, w
1612: List
1613: @item p
1614: Number (the process number of ox_sm1)
1615: @end table
1616:
1617: @itemize @bullet
1618: @item It reduces @var{f} by the set of polynomial @var{g}
1619: in the homogenized Weyl algebra; it applies the
1620: division algorithm to @var{f}. The set of variables is @var{v} and
1621: @var{w} is weight vectors to determine the order, which can be ommited.
1622: @code{sm1_reduction_noH} is for the Weyl algebra.
1623: @item The return value is of the form
1624: [r,c0,[c1,...,cm],[g1,...gm]] where @var{g}=[g1, ..., gm] and
1625: r/c0 + c1 g1 + ... + cm gm = 0.
1626: r/c0 is the normal form.
1627: @item The function reduction reduces reducible terms that appear
1628: in lower order terms.
1629: @item The functions
1630: sm1_reduction_d(P,F,G) and sm1_reduction_noH_d(P,F,G)
1631: are for distributed polynomials.
1632: @end itemize
1633: */
1634: /*&jp-texi
1635: @menu
1636: * sm1_reduction::
1637: @end menu
1638: @node sm1_reduction,,, SM1 $BH!?t(B
1639: @subsection @code{sm1_reduction}
1640: @findex sm1_reduction
1641: @table @t
1642: @item sm1_reduction([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
1643: ::
1644: @end table
1645:
1646: @table @var
1647: @item return
1648: $B%j%9%H(B
1649: @item f
1650: $BB?9`<0(B
1651: @item g, v, w
1652: $B%j%9%H(B
1653: @item p
1654: $B?t(B (ox_sm1 $B$N%W%m%;%9HV9f(B)
1655: @end table
1656:
1657: @itemize @bullet
1658: @item $B$3$NH!?t$O(B @var{f} $B$r(B homogenized $B%o%$%kBe?t$K$*$$$F(B,
1659: $BB?9`<0=89g(B @var{g} $B$G4JC12=(B (reduce) $B$9$k(B; $B$D$^$j(B,
1660: $B$3$NH!?t$O(B, @var{f} $B$K3d;;%"%k%4%j%:%`$rE,MQ$9$k(B.
1661: $BJQ?t=89g$O(B @var{v} $B$G;XDj$9$k(B.
1662: @var{w} $B$O=g=x$r;XDj$9$k$?$a$N(B $B%&%(%$%H%Y%/%H%k$G$"$j(B,
1663: $B>JN,$7$F$b$h$$(B.
1664: @code{sm1_reduction_noH} $B$O(B, Weyl algebra $BMQ(B.
1665: @item $BLa$jCM$O<!$N7A$r$7$F$$$k(B:
1666: [r,c0,[c1,...,cm],[g1,...gm]] $B$3$3$G(B @var{g}=[g1, ..., gm] $B$G$"$j(B,
1667: r/c0 + c1 g1 + ... + cm gm = 0
1668: $B$,$J$j$?$D(B.
1669: r/c0 $B$,(B normal form $B$G$"$k(B.
1670: @item $B$3$NH!?t$O(B, $BDc<!9`$K$"$i$o$l$k(B reducible $B$J9`$b4JC12=$9$k(B.
1671: @item $BH!?t(B
1672: sm1_reduction_d(P,F,G) $B$*$h$S(B sm1_reduction_noH_d(P,F,G)
1673: $B$O(B, $BJ,;6B?9`<0MQ$G$"$k(B.
1674: @end itemize
1675: */
1676: /*&C-texi
1677: @example
1678: [259] sm1_reduction([x^2+y^2-4,[y^4-4*y^2+1,x+y^3-4*y],[x,y]]);
1679: [x^2+y^2-4,1,[0,0],[x+y^3-4*y,y^4-4*y^2+1]]
1680: [260] sm1_reduction([x^2+y^2-4,[y^4-4*y^2+1,x+y^3-4*y],[x,y],[[x,1]]]);
1681: [0,1,[-y^2+4,-x+y^3-4*y],[x+y^3-4*y,y^4-4*y^2+1]]
1682: @end example
1683: */
1684: /*&eg-texi
1685: @table @t
1686: @item Reference
1687: @code{sm1_start}, @code{sm1_find_proc}, @code{d_true_nf}
1688: @end table
1689: */
1690: /*&jp-texi
1691: @table @t
1692: @item $B;2>H(B
1693: @code{sm1_start}, @code{sm1_find_proc}, @code{d_true_nf}
1694: @end table
1695: */
1696:
1697: def sm1_reduction(A) {
1698: /* Example: sm1_reduction(A|proc=10) */
1699: SM1_FIND_PROC(P);
1700: /* check the arguments */
1701: if (type(A) != 4) {
1702: error("sm1_reduction(A|proc=p): A must be a list.");
1703: }
1704: AA = [rtostr(A[0])];
1705: AA = append(AA,[ map(rtostr,A[1]) ]);
1706: AA = append(AA, cdr(cdr(A)));
1707: sm1(P," /reduction*.noH 0 def ");
1708: sm1_push_int0(P,AA);
1709: sm1(P," reduction* ");
1710: ox_check_errors2(P);
1711: return(sm1_pop(P));
1712: }
1713:
1714: def sm1_reduction_noH(A) {
1715: /* Example: sm1_reduction(A|proc=10) */
1716: SM1_FIND_PROC(P);
1717: /* check the arguments */
1718: if (type(A) != 4) {
1719: error("sm1_reduction_noH(A|proc=p): A must be a list.");
1720: }
1721: AA = [rtostr(A[0])];
1722: AA = append(AA,[ map(rtostr,A[1]) ]);
1723: AA = append(AA, cdr(cdr(A)));
1724: sm1(P," /reduction*.noH 1 def ");
1725: sm1_push_int0(P,AA);
1726: sm1(P," reduction* ");
1727: ox_check_errors2(P);
1728: return(sm1_pop(P));
1729: }
1730:
1731: /*&eg-texi
1732: @menu
1733: * sm1_xml_tree_to_prefix_string::
1734: @end menu
1735: @node sm1_xml_tree_to_prefix_string,,, SM1 Functions
1736: @subsection @code{sm1_xml_tree_to_prefix_string}
1737: @findex sm1_xml_tree_to_prefix_string
1738: @table @t
1739: @item sm1_xml_tree_to_prefix_string(@var{s}|proc=@var{p})
1740: :: Translate OpenMath Tree Expression @var{s} in XML to a prefix notation.
1741: @end table
1742:
1743: @table @var
1744: @item return
1745: String
1746: @item p
1747: Number
1748: @item s
1749: String
1750: @end table
1751:
1752: @itemize @bullet
1753: @item It translate OpenMath Tree Expression @var{s} in XML to a prefix notation.
1754: @item This function should be moved to om_* in a future.
1755: @item @code{om_xml_to_cmo(OpenMath Tree Expression)} returns CMO_TREE.
1756: asir has not yet understood this CMO.
1757: @item @code{java} execution environment is required.
1758: (For example, @code{/usr/local/jdk1.1.8/bin} should be in the
1759: command search path.)
1760: @end itemize
1761: */
1762: /*&jp-texi
1763: @menu
1764: * sm1_xml_tree_to_prefix_string::
1765: @end menu
1766: @node sm1_xml_tree_to_prefix_string,,, SM1 $BH!?t(B
1767: @subsection @code{sm1_xml_tree_to_prefix_string}
1768: @findex sm1_xml_tree_to_prefix_string
1769: @table @t
1770: @item sm1_xml_tree_to_prefix_string(@var{s}|proc=@var{p})
1771: :: XML $B$G=q$+$l$?(B OpenMath $B$NLZI=8=(B @var{s} $B$rA0CV5-K!$K$J$*$9(B.
1772: @end table
1773:
1774: @table @var
1775: @item return
1776: String
1777: @item p
1778: Number
1779: @item s
1780: String
1781: @end table
1782:
1783: @itemize @bullet
1784: @item XML $B$G=q$+$l$?(B OpenMath $B$NLZI=8=(B @var{s} $B$rA0CV5-K!$K$J$*$9(B.
1785: @item $B$3$NH!?t$O(B om_* $B$K>-Mh0\$9$Y$-$G$"$k(B.
1786: @item @code{om_xml_to_cmo(OpenMath Tree Expression)} $B$O(B CMO_TREE
1787: $B$rLa$9(B. @code{asir} $B$O$3$N(B CMO $B$r$^$@%5%]!<%H$7$F$$$J$$(B.
1788: @item @code{java} $B$N<B9T4D6-$,I,MW(B.
1789: ($B$?$H$($P(B, /usr/local/jdk1.1.8/bin $B$r%3%^%s%I%5!<%A%Q%9$KF~$l$k$J$I(B.)
1790: @end itemize
1791: */
1792: /*&C-texi
1793: @example
1794: [263] load("om");
1795: 1
1796: [270] F=om_xml(x^4-1);
1797: control: wait OX
1798: Trying to connect to the server... Done.
1799: <OMOBJ><OMA><OMS name="plus" cd="basic"/><OMA>
1800: <OMS name="times" cd="basic"/><OMA>
1801: <OMS name="power" cd="basic"/><OMV name="x"/><OMI>4</OMI></OMA>
1802: <OMI>1</OMI></OMA><OMA><OMS name="times" cd="basic"/><OMA>
1803: <OMS name="power" cd="basic"/><OMV name="x"/><OMI>0</OMI></OMA>
1804: <OMI>-1</OMI></OMA></OMA></OMOBJ>
1805: [271] sm1_xml_tree_to_prefix_string(F);
1806: basic_plus(basic_times(basic_power(x,4),1),basic_times(basic_power(x,0),-1))
1807: @end example
1808: */
1809: /*&eg-texi
1810: @table @t
1811: @item Reference
1812: @code{om_*}, @code{OpenXM/src/OpenMath}, @code{eval_str}
1813: @end table
1814: */
1815: /*&jp-texi
1816: @table @t
1817: @item $B;2>H(B
1818: @code{om_*}, @code{OpenXM/src/OpenMath}, @code{eval_str}
1819: @end table
1820: */
1821:
1822:
1823: def sm1_xml_tree_to_prefix_string(A) {
1824: SM1_FIND_PROC(P);
1825: /* check the arguments */
1826: if (type(A) != 7) {
1827: error("sm1_xml_tree_to_prefix_string(A|proc=p): A must be a string.");
1828: }
1829: ox_push_cmo(P,A);
1830: sm1(P," xml_tree_to_prefix_string ");
1831: ox_check_errors2(P);
1832: return(ox_pop_cmo(P));
1833: }
1834:
1835:
1836: def sm1_wbf(A) {
1837: SM1_FIND_PROC(P);
1838: /* check the arguments */
1839: if (type(A) != 4) {
1840: error("sm1_wbf(A): A must be a list.");
1841: }
1842: if (length(A) != 3) {
1843: error("sm1_wbf(A): A must be a list of the length 3.");
1844: }
1845: if (type(A[0]) != 4 || type(A[1]) != 4 || type(A[2]) != 4) {
1846: error("sm1_wbf([A,B,C]): A, B, C must be a list.");
1847: }
1848: if (! (type(A[2][0]) == 7 || type(A[2][0]) == 2)) {
1849: error("sm1_wbf([A,B,C]): C must be of a form [v-name, v-weight, ...]");
1850: }
1851: sm1_push_int0(P,A);
1852: sm1(P," wbf ");
1853: ox_check_errors2(P);
1854: return(sm1_pop(P));
1855: }
1856: def sm1_wbfRoots(A) {
1857: SM1_FIND_PROC(P);
1858: /* check the arguments */
1859: if (type(A) != 4) {
1860: error("sm1_wbfRoots(A): A must be a list.");
1861: }
1862: if (length(A) != 3) {
1863: error("sm1_wbfRoots(A): A must be a list of the length 3.");
1864: }
1865: if (type(A[0]) != 4 || type(A[1]) != 4 || type(A[2]) != 4) {
1866: error("sm1_wbfRoots([A,B,C]): A, B, C must be a list.");
1867: }
1868: if (! (type(A[2][0]) == 7 || type(A[2][0]) == 2)) {
1869: error("sm1_wbfRoots([A,B,C]): C must be of a form [v-name, v-weight, ...]");
1870: }
1871: sm1_push_int0(P,A);
1872: sm1(P," wbfRoots ");
1873: ox_check_errors2(P);
1874: return(sm1_pop(P));
1875: }
1876:
1877:
1878: def sm1_res_div(A) {
1879: SM1_FIND_PROC(P);
1880: sm1_push_int0(P,[[A[0],A[1]],A[2]]);
1881: sm1(P," res*div ");
1882: ox_check_errors2(P);
1883: return(sm1_pop(P));
1884: }
1885:
1886:
1887: /*&eg-texi
1888: @c sort-sm1_syz
1889: @menu
1890: * sm1_syz::
1891: @end menu
1892: @node sm1_syz,,, SM1 Functions
1893: @node sm1_syz_d,,, SM1 Functions
1894: @subsection @code{sm1_syz}
1895: @findex sm1_syz
1896: @findex sm1_syz_d
1897: @table @t
1898: @item sm1_syz([@var{f},@var{v},@var{w}]|proc=@var{p})
1899: :: computes the syzygy of @var{f} in the ring of differential
1900: operators with the variable @var{v}.
1901: @end table
1902:
1903: @table @var
1904: @item return
1905: List
1906: @item p
1907: Number
1908: @item f, v, w
1909: List
1910: @end table
1911:
1912: @itemize @bullet
1913: @item
1914: The return values is of the form
1915: [@var{s},[@var{g}, @var{m}, @var{t}]].
1916: Here @var{s} is the syzygy of @var{f} in the ring of differential
1917: operators with the variable @var{v}.
1918: @var{g} is a Groebner basis of @var{f} with the weight vector @var{w},
1919: and @var{m} is a matrix that translates the input matrix @var{f} to the Gr\"obner
1920: basis @var {g}.
1921: @var{t} is the syzygy of the Gr\"obner basis @var{g}.
1922: In summary, @var{g} = @var{m} @var{f} and
1923: @var{s} @var{f} = 0 hold as matrices.
1924: @item
1925: The weight vectors are given by @var{w}, which can be omitted.
1926: If @var{w} is not given,
1927: the graded reverse lexicographic order will be used to compute Grobner basis.
1928: @item
1929: When a non-term order is given, the Grobner basis is computed in
1930: the homogenized Weyl algebra (See Section 1.2 of the book of SST).
1931: The homogenization variable h is automatically added.
1932: @end itemize
1933: */
1934: /*&jp-texi
1935: @c sort-sm1_syz
1936: @menu
1937: * sm1_syz::
1938: @end menu
1939: @node sm1_syz,,, SM1 $BH!?t(B
1940: @node sm1_syz_d,,, SM1 $BH!?t(B
1941: @subsection @code{sm1_syz}
1942: @findex sm1_syz
1943: @findex sm1_syz_d
1944: @table @t
1945: @item sm1_syz([@var{f},@var{v},@var{w}]|proc=@var{p})
1946: :: @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N(B syzygy $B$r7W;;$9$k(B.
1947: @end table
1948:
1949: @table @var
1950: @item return
1951: $B%j%9%H(B
1952: @item p
1953: $B?t(B
1954: @item f, v, w
1955: $B%j%9%H(B
1956: @end table
1957:
1958: @itemize @bullet
1959: @item
1960: $BLa$jCM$O<!$N7A$r$7$F$$$k(B:
1961: [@var{s},[@var{g}, @var{m}, @var{t}]].
1962: $B$3$3$G(B @var{s} $B$O(B @var{f} $B$N(B @var{v} $B$rJQ?t$H$9$kHyJ,:nMQAG4D$K$*$1$k(B
1963: syzygy $B$G$"$k(B.
1964: @var{g} $B$O(B @var{f} $B$N(B weight vector @var{w} $B$K4X$9$k%0%l%V%J4pDl$G$"$k(B.
1965: @var{m} $B$OF~NO9TNs(B @var{f} $B$r%0%l%V%J4pDl(B
1966: @var{g} $B$XJQ49$9$k9TNs$G$"$k(B.
1967: @var{t} $B$O%0%l%V%J4pDl(B @var{g} $B$N(B syzygy $B$G$"$k(B.
1968: $B$^$H$a$k$H(B, $B<!$NEy<0$,$J$j$?$D(B:
1969: @var{g} = @var{m} @var{f} ,
1970: @var{s} @var{f} = 0.
1971: @item
1972: Weight $B%Y%/%H%k(B @var{w} $B$O>JN,$7$F$h$$(B.
1973: $B>JN,$7$?>l9g(B, graded reverse lexicographic order $B$r$D$+$C$F(B
1974: $B%V%l%V%J4pDl$r7W;;$9$k(B.
1975: @item
1976: Term order $B$G$J$$=g=x$,M?$($i$l$?>l9g$O(B, $BF1<!2=%o%$%kBe?t$G%0%l%V%J4pDl$,7W;;$5$l$k(B (SST $B$NK\$N(B Section 1.2 $B$r8+$h(B).
1977: $BF1<!2=JQ?t(B @code{h} $B$,7k2L$K2C$o$k(B.
1978: @end itemize
1979: */
1980: /*&C-texi
1981: @example
1982: [293] sm1_syz([[x*dx+y*dy-1,x*y*dx*dy-2],[x,y]]);
1983: [[[y*x*dy*dx-2,-x*dx-y*dy+1]], generators of the syzygy
1984: [[[x*dx+y*dy-1],[y^2*dy^2+2]], grobner basis
1985: [[1,0],[y*dy,-1]], transformation matrix
1986: [[y*x*dy*dx-2,-x*dx-y*dy+1]]]]
1987: @end example
1988: */
1989: /*&C-texi
1990: @example
1991: [294]sm1_syz([[x^2*dx^2+x*dx+y^2*dy^2+y*dy-4,x*y*dx*dy-1],[x,y],[[dx,-1,x,1]]]);
1992: [[[y*x*dy*dx-1,-x^2*dx^2-x*dx-y^2*dy^2-y*dy+4]], generators of the syzygy
1993: [[[x^2*dx^2+h^2*x*dx+y^2*dy^2+h^2*y*dy-4*h^4],[y*x*dy*dx-h^4], GB
1994: [h^4*x*dx+y^3*dy^3+3*h^2*y^2*dy^2-3*h^4*y*dy]],
1995: [[1,0],[0,1],[y*dy,-x*dx]], transformation matrix
1996: [[y*x*dy*dx-h^4,-x^2*dx^2-h^2*x*dx-y^2*dy^2-h^2*y*dy+4*h^4]]]]
1997: @end example
1998: */
1999:
2000:
2001: def sm1_syz(A) {
2002: SM1_FIND_PROC(P);
2003: sm1_push_int0(P,A);
2004: sm1(P," syz ");
2005: ox_check_errors2(P);
2006: return(sm1_pop(P));
2007: }
2008:
2009: def sm1_res_solv(A) {
2010: SM1_FIND_PROC(P);
2011: sm1_push_int0(P,[[A[0],A[1]],A[2]]);
2012: sm1(P," res*solv ");
2013: ox_check_errors2(P);
2014: return(sm1_pop(P));
2015: }
2016:
2017: def sm1_res_solv_h(A) {
2018: SM1_FIND_PROC(P);
2019: sm1_push_int0(P,[[A[0],A[1]],A[2]]);
2020: sm1(P," res*solv*h ");
2021: ox_check_errors2(P);
2022: return(sm1_pop(P));
2023: }
2024:
2025:
2026: def sm1_mul(A,B,V) {
2027: SM1_FIND_PROC(P);
2028: sm1_push_int0(P,[[A,B],V]);
2029: sm1(P," res*mul ");
2030: ox_check_errors2(P);
2031: return(sm1_pop(P));
2032: }
2033:
2034: /*&eg-texi
2035: @menu
2036: * sm1_mul::
2037: @end menu
2038: @node sm1_mul,,, SM1 Functions
2039: @subsection @code{sm1_mul}
2040: @findex sm1_mul
2041: @table @t
2042: @item sm1_mul(@var{f},@var{g},@var{v}|proc=@var{p})
2043: :: ask the sm1 server to multiply @var{f} and @var{g} in the ring of differential operators over @var{v}.
2044: @end table
2045:
2046: @table @var
2047: @item return
2048: Polynomial or List
2049: @item p
2050: Number
2051: @item f, g
2052: Polynomial or List
2053: @item v
2054: List
2055: @end table
2056:
2057: @itemize @bullet
2058: @item Ask the sm1 server to multiply @var{f} and @var{g} in the ring of differential operators over @var{v}.
2059: @item @code{sm1_mul_h} is for homogenized Weyl algebra.
2060: @end itemize
2061: */
2062:
2063: /*&jp-texi
2064: @menu
2065: * sm1_mul::
2066: @end menu
2067: @node sm1_mul,,, SM1 $BH!?t(B
2068: @subsection @code{sm1_mul}
2069: @findex sm1_mul
2070: @table @t
2071: @item sm1_mul(@var{f},@var{g},@var{v}|proc=@var{p})
2072: :: sm1$B%5!<%P(B $B$K(B @var{f} $B$+$1$k(B @var{g} $B$r(B @var{v}
2073: $B>e$NHyJ,:nMQAG4D$G$d$C$F$/$l$k$h$&$KMj$`(B.
2074: @end table
2075:
2076: @table @var
2077: @item return
2078: $BB?9`<0$^$?$O%j%9%H(B
2079: @item p
2080: $B?t(B
2081: @item f, g
2082: $BB?9`<0$^$?$O%j%9%H(B
2083: @item v
2084: $B%j%9%H(B
2085: @end table
2086:
2087: @itemize @bullet
2088: @item sm1$B%5!<%P(B $B$K(B @var{f} $B$+$1$k(B @var{g} $B$r(B @var{v}
2089: $B>e$NHyJ,:nMQAG4D$G$d$C$F$/$l$k$h$&$KMj$`(B.
2090: @item @code{sm1_mul_h} $B$O(B homogenized Weyl $BBe?tMQ(B.
2091: @end itemize
2092: */
2093:
2094: /*&C-texi
2095:
2096: @example
2097: [277] sm1_mul(dx,x,[x]);
2098: x*dx+1
2099: [278] sm1_mul([x,y],[1,2],[x,y]);
2100: x+2*y
2101: [279] sm1_mul([[1,2],[3,4]],[[x,y],[1,2]],[x,y]);
2102: [[x+2,y+4],[3*x+4,3*y+8]]
2103: @end example
2104:
2105: */
2106:
2107:
2108:
2109: def sm1_mul_h(A,B,V) {
2110: SM1_FIND_PROC(P);
2111: sm1_push_int0(P,[[A,B],V]);
2112: sm1(P," res*mul*h ");
2113: ox_check_errors2(P);
2114: return(sm1_pop(P));
2115: }
2116:
2117: def sm1_adjoint(A,V) {
2118: SM1_FIND_PROC(P);
2119: sm1_push_int0(P,[A,V]);
2120: sm1(P," res*adjoint ");
2121: ox_check_errors2(P);
2122: return(sm1_pop(P));
2123: }
2124:
2125: def transpose(A) {
2126: if (type(A) == 4) {
2127: N = length(A); M = length(A[0]);
2128: B = newmat(N,M,A);
2129: C = newmat(M,N);
2130: for (I=0; I<N; I++) {
2131: for (J=0; J<M; J++) {
2132: C[J][I] = B[I][J];
2133: }
2134: }
2135: D = newvect(M);
2136: for (J=0; J<M; J++) {
2137: D[J] = C[J];
2138: }
2139: return(map(vtol,vtol(D)));
2140: }else{
2141: print(A)$
2142: error("tranpose: traspose for this argument has not been implemented.");
2143: }
2144: }
2145:
2146: def sm1_resol1(A) {
2147: SM1_FIND_PROC(P);
2148: sm1_push_int0(P,A);
2149: sm1(P," res*resol1 ");
2150: ox_check_errors2(P);
2151: return(sm1_pop(P));
2152: }
2153:
2154:
2155: def sm1_gcd_aux(A,B) {
2156: if (type(A) == 1 && type(B) == 1) return(igcd(A,B));
2157: else return(gcd(A,B));
2158: }
2159:
2160: def sm1_lcm_aux(V) { /* sm1_lcm_aux([3,5,6]); */
2161: N = length(V);
2162: if (N == 0) return(0);
2163: if (N == 1) return(V[0]);
2164: L = V[0];
2165: for (I=1; I<N; I++) {
2166: L = red(L*V[I]/sm1_gcd_aux(L,V[I]));
2167: }
2168: return(L);
2169: }
2170:
2171: def sm1_mul_v(V,S) {
2172: if (type(V) == 4) {
2173: return(map(sm1_mul_v,V,S));
2174: } else {
2175: return(V*S);
2176: }
2177: }
2178:
2179: def sm1_div_v(V,S) {
2180: if (type(V) == 4) {
2181: return(map(sm1_div_v,V,S));
2182: } else {
2183: return(V/S);
2184: }
2185: }
2186:
2187:
2188: def sm1_rat_to_p_aux(T) { /* cf. sm1_rat2plist2 */
2189: T = red(T);
2190: T1 = nm(T); T1a = ptozp(T1);
2191: T1b = red(T1a/T1);
2192: T2 = dn(T);
2193: return([T1a*dn(T1b),T2*nm(T1b)]);
2194: }
2195:
2196: def sm1_denom_aux0(A) {
2197: return(A[1]);
2198: }
2199: def sm1_num_aux0(P) {
2200: return(P[0]);
2201: }
2202:
2203: def sm1_rat_to_p(T) {
2204: if (type(T) == 4) {
2205: A = map(sm1_rat_to_p,T);
2206: D = map(sm1_denom_aux0,A);
2207: N = map(sm1_num_aux0,A);
2208: L = sm1_lcm_aux(D);
2209: B = newvect(length(N));
2210: for (I=0; I<length(N); I++) {
2211: B[I] = sm1_mul_v(N[I],L/D[I]);
2212: }
2213: return([vtol(B),L]);
2214: }else{
2215: return(sm1_rat_to_p_aux(T));
2216: }
2217: }
2218:
2219:
2220:
2221: /* ---------------------------------------------- */
2222: def sm1_distraction(A) {
2223: SM1_FIND_PROC(P);
2224: sm1_push_int0(P,A);
2225: sm1(P," distraction2* ");
2226: ox_check_errors2(P);
2227: return(sm1_pop(P));
2228: }
2229:
2230: /*&eg-texi
2231: @menu
2232: * sm1_distraction::
2233: @end menu
2234: @node sm1_distraction,,, SM1 Functions
2235: @subsection @code{sm1_distraction}
2236: @findex sm1_distraction
2237: @table @t
2238: @item sm1_distraction([@var{f},@var{v},@var{x},@var{d},@var{s}]|proc=@var{p})
2239: :: ask the @code{sm1} server to compute the distraction of @var{f}.
2240: @end table
2241:
2242: @table @var
2243: @item return
2244: List
2245: @item p
2246: Number
2247: @item f
2248: Polynomial
2249: @item v,x,d,s
2250: List
2251: @end table
2252:
2253: @itemize @bullet
2254: @item It asks the @code{sm1} server of the descriptor number @var{p}
2255: to compute the distraction of @var{f} in the ring of differential
2256: operators with variables @var{v}.
2257: @item @var{x} is a list of x-variables and @var{d} is that of d-variables
2258: to be distracted. @var{s} is a list of variables to express the distracted @var{f}.
2259: @item Distraction is roughly speaking to replace x*dx by a single variable x.
2260: See Saito, Sturmfels, Takayama : Grobner Deformations of Hypergeometric Differential Equations at page 68 for details.
2261: @end itemize
2262: */
2263:
2264: /*&jp-texi
2265: @menu
2266: * sm1_distraction::
2267: @end menu
2268: @node sm1_distraction,,, SM1 $BH!?t(B
2269:
2270: @subsection @code{sm1_distraction}
2271: @findex sm1_distraction
2272: @table @t
2273: @item sm1_distraction([@var{f},@var{v},@var{x},@var{d},@var{s}]|proc=@var{p})
2274: :: @code{sm1} $B$K(B @var{f} $B$N(B distraction $B$r7W;;$7$F$b$i$&(B.
2275: @end table
2276:
2277: @table @var
2278: @item return
2279: $B%j%9%H(B
2280: @item p
2281: $B?t(B
2282: @item f
2283: $BB?9`<0(B
2284: @item v,x,d,s
2285: $B%j%9%H(B
2286: @end table
2287:
2288: @itemize @bullet
2289: @item $B<1JL;R(B @var{p} $B$N(B @code{sm1} $B%5!<%P$K(B,
2290: @var{f} $B$N(B distraction $B$r(B @var{v} $B>e$NHyJ,:nMQAG4D$G7W;;$7$F$b$i$&(B.
2291: @item @var{x} , @var{d} $B$O(B, $B$=$l$>$l(B, distract $B$9$Y$-(B x $BJQ?t(B, d $BJQ?t$N(B
2292: $B%j%9%H(B. Distraction $B$7$?$i(B, @var{s} $B$rJQ?t$H$7$F7k2L$rI=$9(B.
2293: @item Distraction $B$H$$$&$N$O(B x*dx $B$r(B x $B$GCV$-49$($k$3$H$G$"$k(B.
2294: $B>\$7$/$O(B Saito, Sturmfels, Takayama : Grobner Deformations of Hypergeometric Differential Equations $B$N(B page 68 $B$r8+$h(B.
2295: @end itemize
2296: */
2297:
2298: /*&C-texi
2299:
2300: @example
2301: [280] sm1_distraction([x*dx,[x],[x],[dx],[x]]);
2302: x
2303: [281] sm1_distraction([dx^2,[x],[x],[dx],[x]]);
2304: x^2-x
2305: [282] sm1_distraction([x^2,[x],[x],[dx],[x]]);
2306: x^2+3*x+2
2307: [283] fctr(@@);
2308: [[1,1],[x+1,1],[x+2,1]]
2309: [284] sm1_distraction([x*dx*y+x^2*dx^2*dy,[x,y],[x],[dx],[x]]);
2310: (x^2-x)*dy+x*y
2311: @end example
2312: */
2313:
2314: /*&eg-texi
2315: @table @t
2316: @item Reference
2317: @code{distraction2(sm1)},
2318: @end table
2319: */
2320:
2321: /*&jp-texi
2322: @table @t
2323: @item $B;2>H(B
2324: @code{distraction2(sm1)},
2325: @end table
2326: */
2327:
2328: /* Temporary functions */
2329: /* Use this function for a while to wait a fix of asir. */
2330: def sm1_ntoint32(I) { /* Fixed */
2331: SM1_FIND_PROC(P);
2332: if (I >= 0) return(ntoint32(I));
2333: sm1(P," "+rtostr(I)+" ");
2334: return(ox_pop_cmo(P));
2335: }
2336: def sm1_to_ascii_array(S) { /* Use strtoascii */
2337: SM1_FIND_PROC(P);
2338: ox_push_cmo(P,S);
2339: sm1(P," (array) dc { (universalNumber) dc } map ");
2340: return(ox_pop_cmo(P));
2341: }
2342: def sm1_from_ascii_array(S) { /* Use asciitostr */
2343: SM1_FIND_PROC(P);
2344: ox_push_cmo(P,S);
2345: sm1(P," { (integer) dc (string) dc } map cat ");
2346: return(ox_pop_cmo(P));
2347: }
2348:
2349: /*
2350: [288] sm1_to_ascii_array("Hello");
2351: [72,101,108,108,111]
2352: [289] sm1_from_ascii_array(@@);
2353: Hello
2354: */
2355:
2356: /* end of temporary functions */
2357:
2358: def sm1_gkz(S) {
2359: SM1_FIND_PROC(P);
2360: A = S[0];
2361: B = S[1];
2362: AA = [ ];
2363: BB = [ ];
2364: for (I=0; I<length(A); I++) {
2365: AA = append(AA,[map(ntoint32,A[I])]);
2366: BB = append(BB,[ntoint32(0)]);
2367: }
2368: sm1(P,"[ ");
2369: sm1_push_int0(P,AA);
2370: sm1_push_int0(P,BB);
2371: sm1(P," ] gkz ");
2372: ox_check_errors2(P);
2373: R = sm1_pop(P);
2374: RR0 = map(eval_str,R[0]);
2375: RR1 = map(eval_str,R[1]);
2376: RR3 = [ ];
2377: for (I=0; I<length(B); I++) {
2378: RR3 = append(RR3,[ sm1_rat_to_p(RR0[I]-B[I])[0] ]);
2379: }
2380: for (I=length(B); I<length(RR0); I++) {
2381: RR3 = append(RR3,[RR0[I]]);
2382: }
2383: return([RR3,RR1]);
2384: }
2385:
2386:
2387: /*&eg-texi
2388: @menu
2389: * sm1_gkz::
2390: @end menu
2391: @node sm1_gkz,,, SM1 Functions
2392: @subsection @code{sm1_gkz}
2393: @findex sm1_gkz
2394: @table @t
2395: @item sm1_gkz([@var{A},@var{B}]|proc=@var{p})
2396: :: Returns the GKZ system (A-hypergeometric system) associated to the matrix
2397: @var{A} with the parameter vector @var{B}.
2398: @end table
2399:
2400: @table @var
2401: @item return
2402: List
2403: @item p
2404: Number
2405: @item A, B
2406: List
2407: @end table
2408:
2409: @itemize @bullet
2410: @item Returns the GKZ hypergeometric system
2411: (A-hypergeometric system) associated to the matrix
2412: @end itemize
2413: */
2414:
2415: /*&jp-texi
2416: @menu
2417: * sm1_gkz::
2418: @end menu
2419: @node sm1_gkz,,, SM1 $BH!?t(B
2420: @subsection @code{sm1_gkz}
2421: @findex sm1_gkz
2422: @table @t
2423: @item sm1_gkz([@var{A},@var{B}]|proc=@var{p})
2424: :: $B9TNs(B @var{A} $B$H%Q%i%a!<%?(B @var{B} $B$KIU?o$7$?(B GKZ $B7O(B (A-hypergeometric system) $B$r$b$I$9(B.
2425: @end table
2426:
2427: @table @var
2428: @item return
2429: $B%j%9%H(B
2430: @item p
2431: $B?t(B
2432: @item A, B
2433: $B%j%9%H(B
2434: @end table
2435:
2436: @itemize @bullet
2437: @item $B9TNs(B @var{A} $B$H%Q%i%a!<%?(B @var{B} $B$KIU?o$7$?(B GKZ $B7O(B (A-hypergeometric system) $B$r$b$I$9(B.
2438: @end itemize
2439: */
2440:
2441: /*&C-texi
2442:
2443: @example
2444:
2445: [280] sm1_gkz([ [[1,1,1,1],[0,1,3,4]], [0,2] ]);
2446: [[x4*dx4+x3*dx3+x2*dx2+x1*dx1,4*x4*dx4+3*x3*dx3+x2*dx2-2,
2447: -dx1*dx4+dx2*dx3,-dx2^2*dx4+dx1*dx3^2,dx1^2*dx3-dx2^3,-dx2*dx4^2+dx3^3],
2448: [x1,x2,x3,x4]]
2449:
2450: @end example
2451:
2452: */
2453:
2454:
2455: def sm1_appell1(S) {
2456: N = length(S)-2;
2457: B = cdr(cdr(S));
2458: A = S[0];
2459: C = S[1];
2460: V = [ ];
2461: for (I=0; I<N; I++) {
2462: V = append(V,[sm1aux_x(I+1)]);
2463: }
2464: Ans = [ ];
2465: Euler = 0;
2466: for (I=0; I<N; I++) {
2467: Euler = sm1aux_x(I+1)*sm1aux_dx(I+1) + Euler;
2468: }
2469: for (I=0; I<N; I++) {
2470: T = sm1_mul(sm1aux_dx(I+1), Euler+C-1,V)-
2471: sm1_mul(Euler+A, sm1aux_x(I+1)*sm1aux_dx(I+1)+B[I],V);
2472: /* Tmp=sm1_rat_to_p(T);
2473: print(Tmp[0]/Tmp[1]-T)$ */
2474: T = sm1_rat_to_p(T)[0];
2475: Ans = append(Ans,[T]);
2476: }
2477: for (I=0; I<N; I++) {
2478: for (J=I+1; J<N; J++) {
2479: T = (sm1aux_x(I+1)-sm1aux_x(J+1))*sm1aux_dx(I+1)*sm1aux_dx(J+1)
2480: - B[J]*sm1aux_dx(I+1) + B[I]*sm1aux_dx(J+1);
2481: /* Tmp=sm1_rat_to_p(T);
2482: print(Tmp[0]/Tmp[1]-T)$ */
2483: T = sm1_rat_to_p(T)[0];
2484: Ans = append(Ans,[T]);
2485: }
2486: }
2487: return([Ans,V]);
2488: }
2489:
2490:
2491: def sm1aux_dx(I) {
2492: return(strtov("dx"+rtostr(I)));
2493: }
2494: def sm1aux_x(I) {
2495: return(strtov("x"+rtostr(I)));
2496: }
2497:
2498:
2499:
2500: /*&eg-texi
2501: @menu
2502: * sm1_appell1::
2503: @end menu
2504: @node sm1_appell1,,, SM1 Functions
2505: @subsection @code{sm1_appell1}
2506: @findex sm1_appell1
2507: @table @t
2508: @item sm1_appell1(@var{a}|proc=@var{p})
2509: :: Returns the Appell hypergeometric system F_1 or F_D.
2510: @end table
2511:
2512: @table @var
2513: @item return
2514: List
2515: @item p
2516: Number
2517: @item a
2518: List
2519: @end table
2520:
2521: @itemize @bullet
2522: @item Returns the hypergeometric system for the Lauricella function
2523: F_D(a,b1,b2,...,bn,c;x1,...,xn)
2524: where @var{a} =(a,c,b1,...,bn).
2525: When n=2, the Lauricella function is called the Appell function F_1.
2526: The parameters a, c, b1, ..., bn may be rational numbers.
2527: @end itemize
2528: */
2529:
2530: /*&jp-texi
2531: @menu
2532: * sm1_appell1::
2533: @end menu
2534: @node sm1_appell1,,, SM1 $BH!?t(B
2535: @subsection @code{sm1_appell1}
2536: @findex sm1_appell1
2537: @table @t
2538: @item sm1_appell1(@var{a}|proc=@var{p})
2539: :: F_1 $B$^$?$O(B F_D $B$KBP1~$9$kJ}Dx<07O$rLa$9(B.
2540: @end table
2541:
2542: @table @var
2543: @item return
2544: $B%j%9%H(B
2545: @item p
2546: $B?t(B
2547: @item a
2548: $B%j%9%H(B
2549: @end table
2550:
2551: @itemize @bullet
2552: @item Appell $B$N4X?t(B F_1 $B$*$h$S(B $B$=$N(B n $BJQ?t2=$G$"$k(B Lauricella $B$N4X?t(B
2553: F_D(a,b1,b2,...,bn,c;x1,...,xn)
2554: $B$N$_$?$9HyJ,J}Dx<07O$rLa$9(B. $B$3$3$G(B,
2555: @var{a} =(a,c,b1,...,bn).
2556: $B%Q%i%a!<%?$OM-M}?t$G$b$h$$(B.
2557: @end itemize
2558: */
2559:
2560: /*&C-texi
2561:
2562: @example
2563:
2564: [281] sm1_appell1([1,2,3,4]);
2565: [[((-x1+1)*x2*dx1-3*x2)*dx2+(-x1^2+x1)*dx1^2+(-5*x1+2)*dx1-3,
2566: (-x2^2+x2)*dx2^2+((-x1*x2+x1)*dx1-6*x2+2)*dx2-4*x1*dx1-4,
2567: ((-x2+x1)*dx1+3)*dx2-4*dx1], equations
2568: [x1,x2]] the list of variables
2569:
2570: [282] sm1_gb(@@);
2571: [[((-x2+x1)*dx1+3)*dx2-4*dx1,((-x1+1)*x2*dx1-3*x2)*dx2+(-x1^2+x1)*dx1^2
2572: +(-5*x1+2)*dx1-3,(-x2^2+x2)*dx2^2+((-x2^2+x1)*dx1-3*x2+2)*dx2
2573: +(-4*x2-4*x1)*dx1-4,
2574: (x2^3+(-x1-1)*x2^2+x1*x2)*dx2^2+((-x1*x2+x1^2)*dx1+6*x2^2
2575: +(-3*x1-2)*x2+2*x1)*dx2-4*x1^2*dx1+4*x2-4*x1],
2576: [x1*dx1*dx2,-x1^2*dx1^2,-x2^2*dx1*dx2,-x1*x2^2*dx2^2]]
2577:
2578: [283] sm1_rank(sm1_appell1([1/2,3,5,-1/3]));
2579: 1
2580:
2581: [285] Mu=2$ Beta = 1/3$
2582: [287] sm1_rank(sm1_appell1([Mu+Beta,Mu+1,Beta,Beta,Beta]));
2583: 4
2584:
2585:
2586: @end example
2587:
2588: */
2589:
2590: def sm1_appell4(S) {
2591: N = length(S)-2;
2592: B = cdr(cdr(S));
2593: A = S[0];
2594: C = S[1];
2595: V = [ ];
2596: for (I=0; I<N; I++) {
2597: V = append(V,[sm1aux_x(I+1)]);
2598: }
2599: Ans = [ ];
2600: Euler = 0;
2601: for (I=0; I<N; I++) {
2602: Euler = sm1aux_x(I+1)*sm1aux_dx(I+1) + Euler;
2603: }
2604: for (I=0; I<N; I++) {
2605: T = sm1_mul(sm1aux_dx(I+1), sm1aux_x(I+1)*sm1aux_dx(I+1)+B[I]-1,V)-
2606: sm1_mul(Euler+A,Euler+C,V);
2607: /* Tmp=sm1_rat_to_p(T);
2608: print(Tmp[0]/Tmp[1]-T)$ */
2609: T = sm1_rat_to_p(T)[0];
2610: Ans = append(Ans,[T]);
2611: }
2612: return([Ans,V]);
2613: }
2614:
2615: /*&eg-texi
2616: @menu
2617: * sm1_appell4::
2618: @end menu
2619: @node sm1_appell4,,, SM1 Functions
2620: @subsection @code{sm1_appell4}
2621: @findex sm1_appell4
2622: @table @t
2623: @item sm1_appell4(@var{a}|proc=@var{p})
2624: :: Returns the Appell hypergeometric system F_4 or F_C.
2625: @end table
2626:
2627: @table @var
2628: @item return
2629: List
2630: @item p
2631: Number
2632: @item a
2633: List
2634: @end table
2635:
2636: @itemize @bullet
2637: @item Returns the hypergeometric system for the Lauricella function
2638: F_4(a,b,c1,c2,...,cn;x1,...,xn)
2639: where @var{a} =(a,b,c1,...,cn).
2640: When n=2, the Lauricella function is called the Appell function F_4.
2641: The parameters a, b, c1, ..., cn may be rational numbers.
2642: @end itemize
2643: */
2644:
2645: /*&jp-texi
2646: @menu
2647: * sm1_appell4::
2648: @end menu
2649: @node sm1_appell4,,, SM1 $BH!?t(B
2650: @subsection @code{sm1_appell4}
2651: @findex sm1_appell4
2652: @table @t
2653: @item sm1_appell4(@var{a}|proc=@var{p})
2654: :: F_4 $B$^$?$O(B F_C $B$KBP1~$9$kJ}Dx<07O$rLa$9(B.
2655: @end table
2656:
2657: @table @var
2658: @item return
2659: $B%j%9%H(B
2660: @item p
2661: $B?t(B
2662: @item a
2663: $B%j%9%H(B
2664: @end table
2665:
2666: @itemize @bullet
2667: @item Appell $B$N4X?t(B F_4 $B$*$h$S(B $B$=$N(B n $BJQ?t2=$G$"$k(B Lauricella $B$N4X?t(B
2668: F_C(a,b,c1,c2,...,cn;x1,...,xn)
2669: $B$N$_$?$9HyJ,J}Dx<07O$rLa$9(B. $B$3$3$G(B,
2670: @var{a} =(a,b,c1,...,cn).
2671: $B%Q%i%a!<%?$OM-M}?t$G$b$h$$(B.
2672: @end itemize
2673: */
2674:
2675: /*&C-texi
2676:
2677: @example
2678:
2679: [281] sm1_appell4([1,2,3,4]);
2680: [[-x2^2*dx2^2+(-2*x1*x2*dx1-4*x2)*dx2+(-x1^2+x1)*dx1^2+(-4*x1+3)*dx1-2,
2681: (-x2^2+x2)*dx2^2+(-2*x1*x2*dx1-4*x2+4)*dx2-x1^2*dx1^2-4*x1*dx1-2],
2682: equations
2683: [x1,x2]] the list of variables
2684:
2685: [282] sm1_rank(@@);
2686: 4
2687:
2688: @end example
2689:
2690: */
2691:
2692:
2693: def sm1_rank(A) {
2694: SM1_FIND_PROC(P);
2695: sm1_push_int0(P,A);
2696: sm1(P," rank toString .. ");
2697: ox_check_errors2(P);
2698: R = sm1_pop(P);
2699: return(R);
2700: }
2701:
2702: def sm1_rrank(A) {
2703: SM1_FIND_PROC(P);
2704: sm1_push_int0(P,A);
2705: sm1(P," rrank toString .. ");
2706: ox_check_errors2(P);
2707: R = sm1_pop(P);
2708: return(R);
2709: }
2710:
2711:
2712: /*&eg-texi
2713: @menu
2714: * sm1_rank::
2715: @end menu
2716: @node sm1_rank,,, SM1 Functions
2717: @subsection @code{sm1_rank}
2718: @findex sm1_rank
2719: @table @t
2720: @item sm1_rank(@var{a}|proc=@var{p})
2721: :: Returns the holonomic rank of the system of differential equations @var{a}.
2722: @end table
2723:
2724: @table @var
2725: @item return
2726: Number
2727: @item p
2728: Number
2729: @item a
2730: List
2731: @end table
2732:
2733: @itemize @bullet
2734: @item It evaluates the dimension of the space of holomorphic solutions
2735: at a generic point of the system of differential equations @var{a}.
2736: The dimension is called the holonomic rank.
2737: @item @var{a} is a list consisting of a list of differential equations and
2738: a list of variables.
2739: @item @code{sm1_rrank} returns the holonomic rank when @var{a} is regular
2740: holonomic. It is generally faster than @code{sm1_rank}.
2741: @end itemize
2742: */
2743:
2744: /*&jp-texi
2745: @menu
2746: * sm1_rank::
2747: @end menu
2748: @node sm1_rank,,, SM1 $BH!?t(B
2749: @subsection @code{sm1_rank}
2750: @findex sm1_rank
2751: @table @t
2752: @item sm1_rank(@var{a}|proc=@var{p})
2753: :: $BHyJ,J}Dx<07O(B @var{a} $B$N(B holonomic rank $B$rLa$9(B.
2754: @end table
2755:
2756: @table @var
2757: @item return
2758: $B?t(B
2759: @item p
2760: $B?t(B
2761: @item a
2762: $B%j%9%H(B
2763: @end table
2764:
2765: @itemize @bullet
2766: @item $BHyJ,J}Dx<07O(B @var{a} $B$N(B, generic point $B$G$N@5B'2r$N<!85$r(B
2767: $BLa$9(B. $B$3$N<!85$r(B, holonomic rank $B$H8F$V(B.
2768: @item @var{a} $B$OHyJ,:nMQAG$N%j%9%H$HJQ?t$N%j%9%H$h$j$J$k(B.
2769: @item @var{a} $B$,(B regular holonomic $B$N$H$-$O(B @code{sm1_rrank}
2770: $B$b(B holonomic rank $B$rLa$9(B.
2771: $B$$$C$Q$s$K$3$N4X?t$NJ}$,(B @code{sm1_rank} $B$h$jAa$$(B.
2772: @end itemize
2773: */
2774:
2775: /*&C-texi
2776:
2777: @example
2778:
2779: [284] sm1_gkz([ [[1,1,1,1],[0,1,3,4]], [0,2] ]);
2780: [[x4*dx4+x3*dx3+x2*dx2+x1*dx1,4*x4*dx4+3*x3*dx3+x2*dx2-2,
2781: -dx1*dx4+dx2*dx3, -dx2^2*dx4+dx1*dx3^2,dx1^2*dx3-dx2^3,-dx2*dx4^2+dx3^3],
2782: [x1,x2,x3,x4]]
2783: [285] sm1_rrank(@@);
2784: 4
2785:
2786: [286] sm1_gkz([ [[1,1,1,1],[0,1,3,4]], [1,2]]);
2787: [[x4*dx4+x3*dx3+x2*dx2+x1*dx1-1,4*x4*dx4+3*x3*dx3+x2*dx2-2,
2788: -dx1*dx4+dx2*dx3,-dx2^2*dx4+dx1*dx3^2,dx1^2*dx3-dx2^3,-dx2*dx4^2+dx3^3],
2789: [x1,x2,x3,x4]]
2790: [287] sm1_rrank(@@);
2791: 5
2792:
2793: @end example
2794:
2795: */
2796:
2797: def sm1_auto_reduce(T) {
2798: SM1_FIND_PROC(P);
2799: sm1(P,"[(AutoReduce) "+rtostr(T)+" ] system_variable ");
2800: ox_check_errors2(P);
2801: R = sm1_pop(P);
2802: return(R);
2803: }
2804:
2805: /*&eg-texi
2806: @menu
2807: * sm1_auto_reduce::
2808: @end menu
2809: @node sm1_auto_reduce,,, SM1 Functions
2810: @subsection @code{sm1_auto_reduce}
2811: @findex sm1_auto_reduce
2812: @table @t
2813: @item sm1_auto_reduce(@var{s}|proc=@var{p})
2814: :: Set the flag "AutoReduce" to @var{s}.
2815: @end table
2816:
2817: @table @var
2818: @item return
2819: Number
2820: @item p
2821: Number
2822: @item s
2823: Number
2824: @end table
2825:
2826: @itemize @bullet
2827: @item If @var{s} is 1, then all Grobner bases to be computed
2828: will be the reduced Grobner bases.
2829: @item If @var{s} is 0, then Grobner bases are not necessarily the reduced
2830: Grobner bases. This is the default.
2831: @end itemize
2832: */
2833:
2834: /*&jp-texi
2835: @menu
2836: * sm1_auto_reduce::
2837: @end menu
2838: @node sm1_auto_reduce,,, SM1 $BH!?t(B
2839: @subsection @code{sm1_auto_reduce}
2840: @findex sm1_auto_reduce
2841: @table @t
2842: @item sm1_auto_reduce(@var{s}|proc=@var{p})
2843: :: $B%U%i%0(B "AutoReduce" $B$r(B @var{s} $B$K@_Dj(B.
2844: @end table
2845:
2846: @table @var
2847: @item $BLa$jCM(B
2848: $B?t(B
2849: @item p
2850: $B?t(B
2851: @item s
2852: $B?t(B
2853: @end table
2854:
2855: @itemize @bullet
2856: @item @var{s} $B$,(B 1 $B$N$H$-(B, $B0J8e7W;;$5$l$k%0%l%V%J4pDl$O$9$Y$F(B,
2857: reduced $B%0%l%V%J4pDl$H$J$k(B.
2858: @item @var{s} $B$,(B 0 $B$N$H$-(B, $B7W;;$5$l$k%0%l%V%J4pDl$O(B
2859: reduced $B%0%l%V%J4pDl$H$O$+$.$i$J$$(B. $B$3$A$i$,%G%U%)!<%k%H(B.
2860: @end itemize
2861: */
2862:
2863:
2864: def sm1_slope(II,V,FF,VF) {
2865: SM1_FIND_PROC(P);
2866: A =[II,V,FF,VF];
2867: sm1_push_int0(P,A);
2868: sm1(P," slope toString ");
2869: ox_check_errors2(P);
2870: R = eval_str(sm1_pop(P));
2871: return(R);
2872: }
2873:
2874:
2875: /*&eg-texi
2876: @menu
2877: * sm1_slope::
2878: @end menu
2879: @node sm1_slope,,, SM1 Functions
2880: @subsection @code{sm1_slope}
2881: @findex sm1_slope
2882: @table @t
2883: @item sm1_slope(@var{ii},@var{v},@var{f_filtration},@var{v_filtration}|proc=@var{p})
2884: :: Returns the slopes of differential equations @var{ii}.
2885: @end table
2886:
2887: @table @var
2888: @item return
2889: List
2890: @item p
2891: Number
2892: @item ii
2893: List (equations)
2894: @item v
2895: List (variables)
2896: @item f_filtration
2897: List (weight vector)
2898: @item v_filtration
2899: List (weight vector)
2900: @end table
2901:
2902: @itemize @bullet
2903: @item @code{sm1_slope} returns the (geometric) slopes
2904: of the system of differential equations @var{ii}
2905: along the hyperplane specified by
2906: the V filtration @var{v_filtration}.
2907: @item @var{v} is a list of variables.
2908: @item The return value is a list of lists.
2909: The first entry of each list is the slope and the second entry
2910: is the weight vector for which the microcharacteristic variety is
2911: not bihomogeneous.
2912: @end itemize
1.5 ! takayama 2913:
! 2914: @noindent
! 2915: Algorithm:
! 2916: see "A.Assi, F.J.Castro-Jimenez and J.M.Granger,
! 2917: How to calculate the slopes of a D-module, Compositio Math, 104, 1-17, 1996"
! 2918: Note that the signs of the slopes are negative, but the absolute values
! 2919: of the slopes are returned.
! 2920:
1.1 takayama 2921: */
2922:
2923: /*&jp-texi
2924: @menu
2925: * sm1_slope::
2926: @end menu
2927: @node sm1_slope,,, SM1 $BH!?t(B
2928: @subsection @code{sm1_slope}
2929: @findex sm1_slope
2930: @table @t
2931: @item sm1_slope(@var{ii},@var{v},@var{f_filtration},@var{v_filtration}|proc=@var{p})
2932: :: $BHyJ,J}Dx<07O(B @var{ii} $B$N(B slope $B$rLa$9(B.
2933: @end table
2934:
2935: @table @var
2936: @item return
2937: $B?t(B
2938: @item p
2939: $B?t(B
2940: @item ii
2941: $B%j%9%H(B ($BJ}Dx<0(B)
2942: @item v
2943: $B%j%9%H(B ($BJQ?t(B)
2944: @item f_filtration
2945: $B%j%9%H(B (weight vector)
2946: @item v_filtration
2947: $B%j%9%H(B (weight vector)
2948: @end table
2949:
2950: @itemize @bullet
2951: @item @code{sm1_slope} $B$O(B
2952: $BHyJ,J}Dx<07O(B @var{ii} $B$N(B V filtration @var{v_filtration}
2953: $B$G;XDj$9$kD6J?LL$K1h$C$F$N(B (geomeric) slope $B$r7W;;$9$k(B.
2954: @item @var{v} $B$OJQ?t$N%j%9%H(B.
1.5 ! takayama 2955: @item $BLa$jCM$O(B, $B%j%9%H$r@.J,$H$9$k%j%9%H$G$"$k(B.
! 2956: $B@.J,%j%9%H$NBh(B 1 $BMWAG$,(B slope, $BBh(B 2 $BMWAG$O(B, $B$=$N(B weight vector $B$KBP1~$9$k(B
! 2957: microcharacteristic variety $B$,(B bihomogeneous $B$G$J$$(B.
! 2958: @end itemize
! 2959:
! 2960: @noindent
! 2961: Algorithm:
1.1 takayama 2962: "A.Assi, F.J.Castro-Jimenez and J.M.Granger,
2963: How to calculate the slopes of a D-module, Compositio Math, 104, 1-17, 1996"
2964: $B$r$_$h(B.
2965: Slope $B$NK\Mh$NDj5A$G$O(B, $BId9f$,Ii$H$J$k$,(B, $B$3$N%W%m%0%i%`$O(B,
2966: Slope $B$N@dBPCM$rLa$9(B.
2967: */
2968:
2969: /*&C-texi
2970:
2971: @example
2972:
2973: [284] A= sm1_gkz([ [[1,2,3]], [-3] ]);
2974:
2975:
2976: [285] sm1_slope(A[0],A[1],[0,0,0,1,1,1],[0,0,-1,0,0,1]);
2977:
2978: [286] A2 = sm1_gkz([ [[1,1,1,0],[2,-3,1,-3]], [1,0]]);
2979: (* This is an interesting example given by Laura Matusevich,
2980: June 9, 2001 *)
2981:
2982: [287] sm1_slope(A2[0],A2[1],[0,0,0,0,1,1,1,1],[0,0,0,-1,0,0,0,1]);
2983:
2984:
2985: @end example
2986:
2987: */
2988: /*&eg-texi
2989: @table @t
2990: @item Reference
2991: @code{sm_gb}
2992: @end table
2993: */
2994: /*&jp-texi
2995: @table @t
2996: @item $B;2>H(B
2997: @code{sm_gb}
2998: @end table
1.4 takayama 2999: */
3000:
3001:
3002: /*&eg-texi
3003: @include sm1-auto-en.texi
3004: */
3005:
3006: /*&jp-texi
3007: @include sm1-auto-ja.texi
1.1 takayama 3008: */
3009:
3010:
3011: end$
3012:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to sm1.oxweave CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / asir-contrib / packages / doc