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