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