Annotation of OpenXM/src/asir-contrib/packages/doc/sm1.oxweave, Revision 1.1
1.1 ! takayama 1: /*$OpenXM$ */
! 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
! 771: @item sm1_gb([@var{f},@var{v},@var{w}]|proc=@var{p})
! 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
! 783: @item p
! 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.
! 811: @end itemize
! 812: */
! 813: /*&jp-texi
! 814: @c sort-sm1_gb
! 815: @menu
! 816: * sm1_gb::
! 817: @end menu
! 818: @node sm1_gb,,, SM1 $BH!?t(B
! 819: @node sm1_gb_d,,, SM1 $BH!?t(B
! 820: @subsection @code{sm1_gb}
! 821: @findex sm1_gb
! 822: @findex sm1_gb_d
! 823: @table @t
! 824: @item sm1_gb([@var{f},@var{v},@var{w}]|proc=@var{p})
! 825: :: @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N%0%l%V%J4pDl$r7W;;$9$k(B.
! 826: @item sm1_gb_d([@var{f},@var{v},@var{w}]|proc=@var{p})
! 827: :: @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.
! 828: @end table
! 829:
! 830: @table @var
! 831: @item return
! 832: $B%j%9%H(B
! 833: @item p
! 834: $B?t(B
! 835: @item f, v, w
! 836: $B%j%9%H(B
! 837: @end table
! 838:
! 839: @itemize @bullet
! 840: @item
! 841: @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N%0%l%V%J4pDl$r7W;;$9$k(B.
! 842: @item
! 843: Weight $B%Y%/%H%k(B @var{w} $B$O>JN,$7$F$h$$(B.
! 844: $B>JN,$7$?>l9g(B, graded reverse lexicographic order $B$r$D$+$C$F(B
! 845: $B%V%l%V%J4pDl$r7W;;$9$k(B.
! 846: @item
! 847: @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
! 848: ( @var{w} $B$,$J$$$H$-(B ) $B$^$?$O(B $B%$%K%7%!%kB?9`<0(B ( @var{w} $B$,M?$($i$?$H$-(B)
! 849: $B$N%j%9%H$G$"$k(B.
! 850: @item
! 851: @code{sm1_gb_d} $B$O7k2L$rJ,;6B?9`<0$N%j%9%H$GLa$9(B.
! 852: $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.
! 853: $BLa$jCM$O(B
! 854: [$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]
! 855: $B$G$"$k(B.
! 856: @item
! 857: 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).
! 858: $BF1<!2=JQ?t(B @code{h} $B$,7k2L$K2C$o$k(B.
! 859: @end itemize
! 860: */
! 861: /*&C-texi
! 862: @example
! 863: [293] sm1_gb([[x*dx+y*dy-1,x*y*dx*dy-2],[x,y]]);
! 864: [[x*dx+y*dy-1,y^2*dy^2+2],[x*dx,y^2*dy^2]]
! 865: @end example
! 866: */
! 867: /*&eg-texi
! 868: In the example above,
! 869: @tex the set $\{ x \partial_x + y \partial_y -1,
! 870: y^2 \partial_y^2+2\}$
! 871: is the Gr\"obner basis of the input with respect to the
! 872: graded reverse lexicographic order such that
! 873: $ 1 \leq \partial_y \leq \partial_x \leq y \leq x \leq \cdots$.
! 874: The set $\{x \partial_x, y^2 \partial_y\}$ is the leading monomials
! 875: (the initial monominals) of the Gr\"obner basis.
! 876: @end tex
! 877: */
! 878: /*&jp-texi
! 879: $B>e$NNc$K$*$$$F(B,
! 880: @tex $B=89g(B $\{ x \partial_x + y \partial_y -1,
! 881: y^2 \partial_y^2+2\}$
! 882: $B$O(B
! 883: $ 1 \leq \partial_y \leq \partial_x \leq y \leq x \leq \cdots$
! 884: $B$G$"$k$h$&$J(B
! 885: graded reverse lexicographic order $B$K4X$9$k%0%l%V%J4pDl$G$"$k(B.
! 886: $B=89g(B $\{x \partial_x, y^2 \partial_y\}$ $B$O%0%l%V%J4pDl$N3F85$K(B
! 887: $BBP$9$k(B leading monomial (initial monomial) $B$G$"$k(B.
! 888: @end tex
! 889: */
! 890: /*&C-texi
! 891: @example
! 892: [294] sm1_gb([[dx^2+dy^2-4,dx*dy-1],[x,y],[[dx,50,dy,2,x,1]]]);
! 893: [[dx+dy^3-4*dy,-dy^4+4*dy^2-1],[dx,-dy^4]]
! 894: @end example
! 895: */
! 896: /*&eg-texi
! 897: In the example above, two monomials
! 898: @tex
! 899: $m = x^a y^b \partial_x^c \partial_y^d$ and
! 900: $m' = x^{a'} y^{b'} \partial_x^{c'} \partial_y^{d'}$
! 901: are firstly compared by the weight vector
! 902: {\tt (dx,dy,x,y) = (50,2,1,0)}
! 903: (i.e., $m$ is larger than $m'$ if $50c+2d+a > 50c'+2d'+a'$)
! 904: and when the comparison is tie, then these are
! 905: compared by the reverse lexicographic order
! 906: (i.e., if $50c+2d+a = 50c'+2d'+a'$, then use the reverse lexicogrpahic order).
! 907: @end tex
! 908: */
! 909: /*&jp-texi
! 910: $B>e$NNc$K$*$$$FFs$D$N%b%N%_%"%k(B
! 911: @tex
! 912: $m = x^a y^b \partial_x^c \partial_y^d$ $B$*$h$S(B
! 913: $m' = x^{a'} y^{b'} \partial_x^{c'} \partial_y^{d'}$
! 914: $B$O:G=i$K(B weight vector
! 915: {\tt (dx,dy,x,y) = (50,2,1,0)} $B$rMQ$$$FHf3S$5$l$k(B
! 916: ($B$D$^$j(B $m$ $B$O(B $50c+2d+a > 50c'+2d'+a'$ $B$N$H$-(B
! 917: $m'$ $B$h$jBg$-$$(B )
! 918: $B<!$K$3$NHf3S$G>!Ii$,$D$+$J$$$H$-$O(B reverse lexicographic order $B$GHf3S$5$l$k(B
! 919: ($B$D$^$j(B $50c+2d+a = 50c'+2d'+a'$ $B$N$H$-(B reverse lexicographic order $B$GHf3S(B
! 920: $B$5$l$k(B).
! 921: @end tex
! 922: */
! 923: /*&C-texi
! 924: @example
! 925: [595]
! 926: sm1_gb([["dx*(x*dx +y*dy-2)-1","dy*(x*dx + y*dy -2)-1"],
! 927: [x,y],[[dx,1,x,-1],[dy,1]]]);
! 928:
! 929: [[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],
! 930: [x*dx^2+(y*dy-h^2)*dx,x*dy*dx+y*dy^2-h^2*dy-h^3,h^3*dx]]
! 931:
! 932: [596]
! 933: sm1_gb_d([["dx (x dx +y dy-2)-1","dy (x dx + y dy -2)-1"],
! 934: "x,y",[[dx,1,x,-1],[dy,1]]]);
! 935: [[[e0,x,y,H,E,dx,dy,h],
! 936: [[0,-1,0,0,0,1,0,0],[0,0,0,0,0,0,1,0],[1,0,0,0,0,0,0,0],
! 937: [0,1,1,1,1,1,1,0],[0,0,0,0,0,0,-1,0],[0,0,0,0,0,-1,0,0],
! 938: [0,0,0,0,-1,0,0,0],[0,0,0,-1,0,0,0,0],[0,0,-1,0,0,0,0,0],
! 939: [0,0,0,0,0,0,0,1]]],
! 940: [[(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)*
! 941: <<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
! 942: ,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
! 943: ,1,3>>],
! 944: [(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)*<
! 945: <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
! 946: ,0,0,0,0,3>>,(1)*<<0,0,0,0,0,1,0,3>>]]]
! 947: @end example
! 948: */
! 949:
! 950: /*&eg-texi
! 951: @table @t
! 952: @item Reference
! 953: @code{sm1_reduction}, @code{sm1_rat_to_p}
! 954: @end table
! 955: */
! 956: /*&jp-texi
! 957: @table @t
! 958: @item $B;2>H(B
! 959: @code{sm1_reduction}, @code{sm1_rat_to_p}
! 960: @end table
! 961: */
! 962:
! 963:
! 964: def sm1_gb(A) {
! 965: SM1_FIND_PROC(P);
! 966: P = sm1_check_server(P);
! 967: sm1_check_arg_gb(A,"Error in sm1_gb");
! 968: sm1_push_int0(P,A);
! 969: sm1(P," gb ");
! 970: T = sm1_pop2(P);
! 971: return(append(T[0],[sm1_toOrdered(T[1])]));
! 972: }
! 973: def sm1_gb_d(A) {
! 974: SM1_FIND_PROC(P);
! 975: P = sm1_check_server(P);
! 976: sm1_check_arg_gb(A,"Error in sm1_gb_d");
! 977: sm1_push_int0(P,A);
! 978: sm1(P," gb /gb.tmp1 set ");
! 979: sm1(P," gb.tmp1 getOrderMatrix {{(universalNumber) dc} map } map /gb.tmp2 set ");
! 980: sm1(P," gb.tmp1 0 get 0 get getvNamesCR { [(class) (indeterminate)] dc } map /gb.tmp3 set ");
! 981: sm1(P," gb.tmp1 getRing ring_def "); /* Change the current ring! */
! 982: sm1(P,"[[ gb.tmp3 gb.tmp2] gb.tmp1] ");
! 983: return(ox_pop_cmo(P));
! 984: }
! 985:
! 986: def sm1_pgb(A) {
! 987: SM1_FIND_PROC(P);
! 988: P = sm1_check_server(P);
! 989: sm1_check_arg_gb(A,"Error in sm1_pgb");
! 990: sm1(P," set_timer ");
! 991: sm1_push_int0(P,A);
! 992: sm1(P," pgb ");
! 993: B = sm1_pop(P);
! 994: sm1(P," set_timer ");
! 995: return(B);
! 996: }
! 997:
! 998: /*&eg-texi
! 999: @c sort-sm1_deRham
! 1000: @menu
! 1001: * sm1_deRham::
! 1002: @end menu
! 1003: @node sm1_deRham,,, SM1 Functions
! 1004: @subsection @code{sm1_deRham}
! 1005: @findex sm1_deRham
! 1006: @table @t
! 1007: @item sm1_deRham([@var{f},@var{v}]|proc=@var{p})
! 1008: :: ask the server to evaluate the dimensions of the de Rham cohomology groups
! 1009: of C^n - (the zero set of @var{f}=0).
! 1010: @end table
! 1011:
! 1012: @table @var
! 1013: @item return
! 1014: List
! 1015: @item p
! 1016: Number
! 1017: @item f
! 1018: String or polynomial
! 1019: @item v
! 1020: List
! 1021: @end table
! 1022:
! 1023: @itemize @bullet
! 1024: @item It returns the dimensions of the de Rham cohomology groups
! 1025: of X = C^n \ V(@var{f}).
! 1026: In other words, it returns
! 1027: [dim H^0(X,C), dim H^1(X,C), dim H^2(X,C), ..., dim H^n(X,C)].
! 1028: @item @var{v} is a list of variables. n = @code{length(@var{v})}.
! 1029: @item
! 1030: @code{sm1_deRham} requires huge computer resources.
! 1031: For example, @code{sm1_deRham(0,[x*y*z*(x+y+z-1)*(x-y),[x,y,z]])}
! 1032: is already very hard.
! 1033: @item
! 1034: To efficiently analyze the roots of b-function, @code{ox_asir} should be used
! 1035: from @code{ox_sm1_forAsir}.
! 1036: It is recommended to load the communication module for @code{ox_asir}
! 1037: by the command @*
! 1038: @code{sm1(0,"[(parse) (oxasir.sm1) pushfile] extension");}
! 1039: This command is automatically executed when @code{ox_sm1_forAsir} is started.
! 1040: @item If you make an interruption to the function @code{sm1_deRham}
! 1041: by @code{ox_reset(Sm1_proc);}, the server might get out of the standard
! 1042: mode. So, it is strongly recommended to execute the command
! 1043: @code{ox_shutdown(Sm1_proc);} to interrupt and restart the server.
! 1044: @end itemize
! 1045: */
! 1046: /*&jp-texi
! 1047: @c sort-sm1_deRham
! 1048: @menu
! 1049: * sm1_deRham::
! 1050: @end menu
! 1051: @node sm1_deRham,,, SM1 $BH!?t(B
! 1052: @subsection @code{sm1_deRham}
! 1053: @findex sm1_deRham
! 1054: @table @t
! 1055: @item sm1_deRham([@var{f},@var{v}]|proc=@var{p})
! 1056: :: $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.
! 1057: @end table
! 1058:
! 1059: @table @var
! 1060: @item return
! 1061: $B%j%9%H(B
! 1062: @item p
! 1063: $B?t(B
! 1064: @item f
! 1065: $BJ8;zNs(B $B$^$?$O(B $BB?9`<0(B
! 1066: @item v
! 1067: $B%j%9%H(B
! 1068: @end table
! 1069:
! 1070: @itemize @bullet
! 1071: @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.
! 1072: $B$9$J$o$A(B,
! 1073: [dim H^0(X,C), dim H^1(X,C), dim H^2(X,C), ..., dim H^n(X,C)]
! 1074: $B$rLa$9(B.
! 1075: @item @var{v} $B$OJQ?t$N%j%9%H(B. n = @code{length(@var{v})} $B$G$"$k(B.
! 1076: @item
! 1077: @code{sm1_deRham} $B$O7W;;5!$N;q8;$rBgNL$K;HMQ$9$k(B.
! 1078: $B$?$H$($P(B @code{sm1_deRham(0,[x*y*z*(x+y+z-1)*(x-y),[x,y,z]])}
! 1079: $B$N7W;;$9$i$9$G$KHs>o$KBgJQ$G$"$k(B.
! 1080: @item
! 1081: b-$B4X?t$N:,$r8zN($h$/2r@O$9$k$K$O(B, @code{ox_asir} $B$,(B @code{ox_sm1_forAsir}
! 1082: $B$h$j;HMQ$5$l$k$Y$-$G$"$k(B. $B%3%^%s%I(B @*
! 1083: @code{sm1(0,"[(parse) (oxasir.sm1) pushfile] extension");}
! 1084: $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.
! 1085: $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.
! 1086: @item
! 1087: @code{sm1_deRham} $B$r(B @code{ox_reset(Sm1_proc);} $B$GCfCG$9$k$H(B,
! 1088: $B0J8e(B sm1 $B%5!<%P$,HsI8=`%b!<%I$KF~$jM=4|$7$J$$F0:n$r$9$k>l9g(B
! 1089: $B$,$"$k$N$G(B, $B%3%^%s%I(B @code{ox_shutdown(Sm1_proc);} $B$G(B, @code{ox_sm1_forAsir}
! 1090: $B$r0l;~(B shutdown $B$7$F%j%9%?!<%H$7$?J}$,0BA4$G$"$k(B.
! 1091: @end itemize
! 1092: */
! 1093: /*&C-texi
! 1094: @example
! 1095: [332] sm1_deRham([x^3-y^2,[x,y]]);
! 1096: [1,1,0]
! 1097: [333] sm1_deRham([x*(x-1),[x]]);
! 1098: [1,2]
! 1099: @end example
! 1100: */
! 1101: /*&eg-texi
! 1102: @table @t
! 1103: @item Reference
! 1104: @code{sm1_start}, @code{deRham} (sm1 command)
! 1105: @item Reference paper
! 1106: Oaku, Takayama, An algorithm for de Rham cohomology groups of the
! 1107: complement of an affine variety via D-module computation,
! 1108: Journal of pure and applied algebra 139 (1999), 201--233.
! 1109: @end table
! 1110: */
! 1111: /*&jp-texi
! 1112: @table @t
! 1113: @item $B;2>H(B
! 1114: @code{sm1_start}, @code{deRham} (sm1 command)
! 1115: @item $B;29MO@J8(B
! 1116: Oaku, Takayama, An algorithm for de Rham cohomology groups of the
! 1117: complement of an affine variety via D-module computation,
! 1118: Journal of pure and applied algebra 139 (1999), 201--233.
! 1119: @end table
! 1120: */
! 1121:
! 1122:
! 1123: def sm1_deRham(A) {
! 1124: SM1_FIND_PROC(P);
! 1125: P = sm1_check_server(P);
! 1126: sm1(P," set_timer ");
! 1127: sm1_push_int0(P,A);
! 1128: sm1(P," deRham ");
! 1129: B = sm1_pop(P);
! 1130: sm1(P," set_timer ");
! 1131: ox_check_errors2(P);
! 1132: return(B);
! 1133: }
! 1134:
! 1135: def sm1_vlist(P) {
! 1136: sm1(P," getvNamesC ");
! 1137: B=ox_pop_cmo(P);
! 1138: sm1(P," getvNamesC toAsirVar ");
! 1139: C=ox_pop_cmo(P);
! 1140: return([B,C,map(strtov,C)]);
! 1141: }
! 1142: /* [ sm1 names(string), asir names(string), asir names(var)] */
! 1143: /* Vlist = sm1_vlist(P);
! 1144: sm1_push_poly0( x + 20*x, Vlist[2]);
! 1145: sm1_pop_poly0(Vlist[2]);
! 1146: */
! 1147:
! 1148: /* ring of Differential operators */
! 1149: def sm1_ringD(V,W) {
! 1150: SM1_FIND_PROC(P);
! 1151: sm1(P," [ ");
! 1152: if (type(V) == 7) { /* string */
! 1153: ox_push_cmo(P,V);
! 1154: }else if (type(V) == 4) {/* list */
! 1155: V = map(rtostr,V);
! 1156: ox_push_cmo(P,V);
! 1157: sm1(P," from_records ");
! 1158: }else { printf("Error: sm1_ringD"); return(-1); }
! 1159: sm1(P," ring_of_differential_operators ");
! 1160: if (type(W) != 0) {
! 1161: sm1_push_int0(P,W); sm1(P," weight_vector ");
! 1162: }
! 1163: sm1(P," pstack ");
! 1164: sm1(P," 0 ] define_ring getOrderMatrix {{(universalNumber) dc}map}map ");
! 1165: ox_check_errors2(P);
! 1166: M = ox_pop_cmo(P);
! 1167: return([sm1_vlist(P)[2],M]);
! 1168: }
! 1169:
! 1170: def sm1_expand_d(F) {
! 1171: SM1_FIND_PROC(P);
! 1172: ox_push_cmo(P,F);
! 1173: sm1(P, " expand ");
! 1174: return(ox_pop_cmo(P));
! 1175: }
! 1176:
! 1177: def sm1_mul_d(A,B) {
! 1178: SM1_FIND_PROC(P);
! 1179: ox_push_cmo(P,A);
! 1180: ox_push_cmo(P,B);
! 1181: sm1(P," mul ");
! 1182: return(ox_pop_cmo(P));
! 1183: }
! 1184:
! 1185: def sm1_dehomogenize_d(A) {
! 1186: SM1_FIND_PROC(P);
! 1187: ox_push_cmo(P,A);
! 1188: sm1(P," dehomogenize ");
! 1189: return(ox_pop_cmo(P));
! 1190: }
! 1191:
! 1192: def sm1_homogenize_d(A) {
! 1193: SM1_FIND_PROC(P);
! 1194: ox_push_cmo(P,A);
! 1195: sm1(P," homogenize ");
! 1196: return(ox_pop_cmo(P));
! 1197: }
! 1198:
! 1199: def sm1_groebner_d(A) {
! 1200: SM1_FIND_PROC(P);
! 1201: ox_push_cmo(P,A);
! 1202: sm1(P," groebner ");
! 1203: return(ox_pop_cmo(P));
! 1204: }
! 1205:
! 1206: def sm1_reduction_d(F,G) {
! 1207: SM1_FIND_PROC(P);
! 1208: ox_push_cmo(P,F);
! 1209: ox_push_cmo(P,G);
! 1210: sm1(P," reduction ");
! 1211: return(ox_pop_cmo(P));
! 1212: }
! 1213:
! 1214: def sm1_reduction_noH_d(F,G) {
! 1215: SM1_FIND_PROC(P);
! 1216: ox_push_cmo(P,F);
! 1217: ox_push_cmo(P,G);
! 1218: sm1(P," reduction-noH ");
! 1219: return(ox_pop_cmo(P));
! 1220: }
! 1221:
! 1222:
! 1223: /*&eg-texi
! 1224: @c sort-sm1_hilbert
! 1225: @menu
! 1226: * sm1_hilbert::
! 1227: * hilbert_polynomial::
! 1228: @end menu
! 1229: @node sm1_hilbert,,, SM1 Functions
! 1230: @subsection @code{sm1_hilbert}
! 1231: @findex sm1_hilbert
! 1232: @findex hilbert_polynomial
! 1233: @table @t
! 1234: @item sm1_hilbert([@var{f},@var{v}]|proc=@var{p})
! 1235: :: ask the server to compute the Hilbert polynomial for the set of polynomials @var{f}.
! 1236: @item hilbert_polynomial(@var{f},@var{v})
! 1237: :: ask the server to compute the Hilbert polynomial for the set of polynomials @var{f}.
! 1238: @end table
! 1239:
! 1240: @table @var
! 1241: @item return
! 1242: Polynomial
! 1243: @item p
! 1244: Number
! 1245: @item f, v
! 1246: List
! 1247: @end table
! 1248:
! 1249: @itemize @bullet
! 1250: @item It returns the Hilbert polynomial h(k) of the set of polynomials
! 1251: @var{f}
! 1252: with respect to the set of variables @var{v}.
! 1253: @item
! 1254: h(k) = dim_Q F_k/I \cap F_k where F_k the set of polynomials of which
! 1255: degree is less than or equal to k and I is the ideal generated by the
! 1256: set of polynomials @var{f}.
! 1257: @item
! 1258: Note for sm1_hilbert:
! 1259: For an efficient computation, it is preferable that
! 1260: the set of polynomials @var{f} is a set of monomials.
! 1261: In fact, this function firstly compute a Grobner basis of @var{f}, and then
! 1262: compute the Hilbert polynomial of the initial monomials of the basis.
! 1263: If the input @var{f} is already a Grobner
! 1264: basis, a Grobner basis is recomputed in this function,
! 1265: which is a waste of time and Grobner basis computation in the ring of
! 1266: polynomials in @code{sm1} is slower than in @code{asir}.
! 1267: @end itemize
! 1268: */
! 1269: /*&jp-texi
! 1270: @c sort-sm1_hilbert
! 1271: @menu
! 1272: * sm1_hilbert::
! 1273: * hilbert_polynomial::
! 1274: @end menu
! 1275: @node sm1_hilbert,,, SM1 $BH!?t(B
! 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: @menu
! 1372: * sm1_genericAnn::
! 1373: @end menu
! 1374: @node sm1_genericAnn,,, SM1 Functions
! 1375: @subsection @code{sm1_genericAnn}
! 1376: @findex sm1_genericAnn
! 1377: @table @t
! 1378: @item sm1_genericAnn([@var{f},@var{v}]|proc=@var{p})
! 1379: :: It computes the annihilating ideal for @var{f}^s.
! 1380: @var{v} is the list of variables. Here, s is @var{v}[0] and
! 1381: @var{f} is a polynomial in the variables @code{rest}(@var{v}).
! 1382: @end table
! 1383:
! 1384: @table @var
! 1385: @item return
! 1386: List
! 1387: @item p
! 1388: Number
! 1389: @item f
! 1390: Polynomial
! 1391: @item v
! 1392: List
! 1393: @end table
! 1394:
! 1395: @itemize @bullet
! 1396: @item This function computes the annihilating ideal for @var{f}^s.
! 1397: @var{v} is the list of variables. Here, s is @var{v}[0] and
! 1398: @var{f} is a polynomial in the variables @code{rest}(@var{v}).
! 1399: @end itemize
! 1400: */
! 1401: /*&jp-texi
! 1402: @c sort-sm1_genericAnn
! 1403: @menu
! 1404: * sm1_genericAnn::
! 1405: @end menu
! 1406: @node sm1_genericAnn,,, SM1 $BH!?t(B
! 1407: @subsection @code{sm1_genericAnn}
! 1408: @findex sm1_genericAnn
! 1409: @table @t
! 1410: @item sm1_genericAnn([@var{f},@var{v}]|proc=@var{p})
! 1411: :: @var{f}^s $B$N$_$?$9HyJ,J}Dx<0A4BN$r$b$H$a$k(B.
! 1412: @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,
! 1413: @var{f} $B$OJQ?t(B @code{rest}(@var{v}) $B>e$NB?9`<0$G$"$k(B.
! 1414: @end table
! 1415:
! 1416: @table @var
! 1417: @item return
! 1418: $B%j%9%H(B
! 1419: @item p
! 1420: $B?t(B
! 1421: @item f
! 1422: $BB?9`<0(B
! 1423: @item v
! 1424: $B%j%9%H(B
! 1425: @end table
! 1426:
! 1427: @itemize @bullet
! 1428: @item $B$3$NH!?t$O(B,
! 1429: @var{f}^s $B$N$_$?$9HyJ,J}Dx<0A4BN$r$b$H$a$k(B.
! 1430: @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,
! 1431: @var{f} $B$OJQ?t(B @code{rest}(@var{v}) $B>e$NB?9`<0$G$"$k(B.
! 1432: @end itemize
! 1433: */
! 1434: /*&C-texi
! 1435: @example
! 1436: [595] sm1_genericAnn([x^3+y^3+z^3,[s,x,y,z]]);
! 1437: [-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]
! 1438: @end example
! 1439: */
! 1440: /*&eg-texi
! 1441: @table @t
! 1442: @item Reference
! 1443: @code{sm1_start}
! 1444: @end table
! 1445: */
! 1446: /*&jp-texi
! 1447: @table @t
! 1448: @item $B;2>H(B
! 1449: @code{sm1_start}
! 1450: @end table
! 1451: */
! 1452:
! 1453:
! 1454: def sm1_genericAnn(F) {
! 1455: SM1_FIND_PROC(P);
! 1456: sm1_push_int0(P,F[0]);
! 1457: sm1_push_int0(P,F[1]);
! 1458: sm1(P, " genericAnn ");
! 1459: B = sm1_pop(P);
! 1460: return(B);
! 1461: }
! 1462:
! 1463: def sm1_tensor0(F) {
! 1464: SM1_FIND_PROC(P);
! 1465: sm1_push_int0(P,F);
! 1466: sm1(P, " tensor0 ");
! 1467: B = sm1_pop(P);
! 1468: return(B);
! 1469: }
! 1470:
! 1471: /*&eg-texi
! 1472: @c sort-sm1_wTensor0
! 1473: @menu
! 1474: * sm1_wTensor0::
! 1475: @end menu
! 1476: @node sm1_wTensor0,,, SM1 Functions
! 1477: @subsection @code{sm1_wTensor0}
! 1478: @findex sm1_wTensor0
! 1479: @table @t
! 1480: @item sm1_wTensor0([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
! 1481: :: It computes the D-module theoretic 0-th tensor product
! 1482: of @var{f} and @var{g}.
! 1483: @end table
! 1484:
! 1485: @table @var
! 1486: @item return
! 1487: List
! 1488: @item p
! 1489: Number
! 1490: @item f, g, v, w
! 1491: List
! 1492: @end table
! 1493:
! 1494: @itemize @bullet
! 1495: @item
! 1496: It returns the D-module theoretic 0-th tensor product
! 1497: of @var{f} and @var{g}.
! 1498: @item
! 1499: @var{v} is a list of variables.
! 1500: @var{w} is a list of weights. The integer @var{w}[i] is
! 1501: the weight of the variable @var{v}[i].
! 1502: @item
! 1503: @code{sm1_wTensor0} calls @code{wRestriction0} of @code{ox_sm1},
! 1504: which requires a generic weight
! 1505: vector @var{w} to compute the restriction.
! 1506: If @var{w} is not generic, the computation fails.
! 1507: @item Let F and G be solutions of @var{f} and @var{g} respectively.
! 1508: Intuitively speaking, the 0-th tensor product is a system of
! 1509: differential equations which annihilates the function FG.
! 1510: @item The answer is a submodule of a free module D^r in general even if
! 1511: the inputs @var{f} and @var{g} are left ideals of D.
! 1512: @end itemize
! 1513: */
! 1514:
! 1515: /*&jp-texi
! 1516: @c sort-sm1_wTensor0
! 1517: @menu
! 1518: * sm1_wTensor0::
! 1519: @end menu
! 1520: @node sm1_wTensor0,,, SM1 $BH!?t(B
! 1521: @subsection @code{sm1_wTensor0}
! 1522: @findex sm1_wTensor0
! 1523: @table @t
! 1524: @item sm1_wTensor0([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
! 1525: :: @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
! 1526: $B7W;;$9$k(B.
! 1527: @end table
! 1528:
! 1529: @table @var
! 1530: @item return
! 1531: $B%j%9%H(B
! 1532: @item p
! 1533: $B?t(B
! 1534: @item f, g, v, w
! 1535: $B%j%9%H(B
! 1536: @end table
! 1537:
! 1538: @itemize @bullet
! 1539: @item
! 1540: @var{f} $B$H(B @var{g} $B$N(B
! 1541: D-$B2C72$H$7$F$N(B 0 $B<!%F%s%=%k@Q$r7W;;$9$k(B.
! 1542: @item
! 1543: @var{v} $B$OJQ?t$N%j%9%H$G$"$k(B.
! 1544: @var{w} $B$O(B weight $B$N%j%9%H$G$"$k(B.
! 1545: $B@0?t(B @var{w}[i] $B$OJQ?t(B @var{v}[i] $B$N(B weight $B$G$"$k(B.
! 1546: @item
! 1547: @code{sm1_wTensor0} $B$O(B @code{ox_sm1} $B$N(B @code{wRestriction0}
! 1548: $B$r$h$s$G$$$k(B.
! 1549: @code{wRestriction0} $B$O(B, generic $B$J(B weight $B%Y%/%H%k(B @var{w}
! 1550: $B$r$b$H$K$7$F@)8B$r7W;;$7$F$$$k(B.
! 1551: Weight $B%Y%/%H%k(B @var{w} $B$,(B generic $B$G$J$$$H7W;;$,%(%i!<$GDd;_$9$k(B.
! 1552: @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.
! 1553: $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.
! 1554: @item $BF~NO(B @var{f}, @var{g} $B$,(B D $B$N:8%$%G%"%k$G$"$C$F$b(B,
! 1555: $B0lHL$K(B, $B=PNO$O<+M32C72(B D^r $B$NItJ,2C72$G$"$k(B.
! 1556: @end itemize
! 1557: */
! 1558: /*&C-texi
! 1559: @example
! 1560: [258] sm1_wTensor0([[x*dx -1, y*dy -4],[dx+dy,dx-dy^2],[x,y],[1,2]]);
! 1561: [[-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],
! 1562: [-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],
! 1563: [y^2*dy^2+(-y^2-8*y)*dy+4*y+20]]
! 1564: @end example
! 1565: */
! 1566:
! 1567:
! 1568: def sm1_wTensor0(F) {
! 1569: SM1_FIND_PROC(P);
! 1570: sm1_push_int0(P,F);
! 1571: sm1(P, " wTensor0 ");
! 1572: B = sm1_pop(P);
! 1573: return(B);
! 1574: }
! 1575:
! 1576:
! 1577: /*&eg-texi
! 1578: @c sort-sm1_reduction
! 1579: @menu
! 1580: * sm1_reduction::
! 1581: @end menu
! 1582: @node sm1_reduction,,, SM1 Functions
! 1583: @subsection @code{sm1_reduction}
! 1584: @findex sm1_reduction
! 1585: @table @t
! 1586: @item sm1_reduction([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
! 1587: ::
! 1588: @end table
! 1589:
! 1590: @table @var
! 1591: @item return
! 1592: List
! 1593: @item f
! 1594: Polynomial
! 1595: @item g, v, w
! 1596: List
! 1597: @item p
! 1598: Number (the process number of ox_sm1)
! 1599: @end table
! 1600:
! 1601: @itemize @bullet
! 1602: @item It reduces @var{f} by the set of polynomial @var{g}
! 1603: in the homogenized Weyl algebra; it applies the
! 1604: division algorithm to @var{f}. The set of variables is @var{v} and
! 1605: @var{w} is weight vectors to determine the order, which can be ommited.
! 1606: @code{sm1_reduction_noH} is for the Weyl algebra.
! 1607: @item The return value is of the form
! 1608: [r,c0,[c1,...,cm],[g1,...gm]] where @var{g}=[g1, ..., gm] and
! 1609: r/c0 + c1 g1 + ... + cm gm = 0.
! 1610: r/c0 is the normal form.
! 1611: @item The function reduction reduces reducible terms that appear
! 1612: in lower order terms.
! 1613: @item The functions
! 1614: sm1_reduction_d(P,F,G) and sm1_reduction_noH_d(P,F,G)
! 1615: are for distributed polynomials.
! 1616: @end itemize
! 1617: */
! 1618: /*&jp-texi
! 1619: @menu
! 1620: * sm1_reduction::
! 1621: @end menu
! 1622: @node sm1_reduction,,, SM1 $BH!?t(B
! 1623: @subsection @code{sm1_reduction}
! 1624: @findex sm1_reduction
! 1625: @table @t
! 1626: @item sm1_reduction([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
! 1627: ::
! 1628: @end table
! 1629:
! 1630: @table @var
! 1631: @item return
! 1632: $B%j%9%H(B
! 1633: @item f
! 1634: $BB?9`<0(B
! 1635: @item g, v, w
! 1636: $B%j%9%H(B
! 1637: @item p
! 1638: $B?t(B (ox_sm1 $B$N%W%m%;%9HV9f(B)
! 1639: @end table
! 1640:
! 1641: @itemize @bullet
! 1642: @item $B$3$NH!?t$O(B @var{f} $B$r(B homogenized $B%o%$%kBe?t$K$*$$$F(B,
! 1643: $BB?9`<0=89g(B @var{g} $B$G4JC12=(B (reduce) $B$9$k(B; $B$D$^$j(B,
! 1644: $B$3$NH!?t$O(B, @var{f} $B$K3d;;%"%k%4%j%:%`$rE,MQ$9$k(B.
! 1645: $BJQ?t=89g$O(B @var{v} $B$G;XDj$9$k(B.
! 1646: @var{w} $B$O=g=x$r;XDj$9$k$?$a$N(B $B%&%(%$%H%Y%/%H%k$G$"$j(B,
! 1647: $B>JN,$7$F$b$h$$(B.
! 1648: @code{sm1_reduction_noH} $B$O(B, Weyl algebra $BMQ(B.
! 1649: @item $BLa$jCM$O<!$N7A$r$7$F$$$k(B:
! 1650: [r,c0,[c1,...,cm],[g1,...gm]] $B$3$3$G(B @var{g}=[g1, ..., gm] $B$G$"$j(B,
! 1651: r/c0 + c1 g1 + ... + cm gm = 0
! 1652: $B$,$J$j$?$D(B.
! 1653: r/c0 $B$,(B normal form $B$G$"$k(B.
! 1654: @item $B$3$NH!?t$O(B, $BDc<!9`$K$"$i$o$l$k(B reducible $B$J9`$b4JC12=$9$k(B.
! 1655: @item $BH!?t(B
! 1656: sm1_reduction_d(P,F,G) $B$*$h$S(B sm1_reduction_noH_d(P,F,G)
! 1657: $B$O(B, $BJ,;6B?9`<0MQ$G$"$k(B.
! 1658: @end itemize
! 1659: */
! 1660: /*&C-texi
! 1661: @example
! 1662: [259] sm1_reduction([x^2+y^2-4,[y^4-4*y^2+1,x+y^3-4*y],[x,y]]);
! 1663: [x^2+y^2-4,1,[0,0],[x+y^3-4*y,y^4-4*y^2+1]]
! 1664: [260] sm1_reduction([x^2+y^2-4,[y^4-4*y^2+1,x+y^3-4*y],[x,y],[[x,1]]]);
! 1665: [0,1,[-y^2+4,-x+y^3-4*y],[x+y^3-4*y,y^4-4*y^2+1]]
! 1666: @end example
! 1667: */
! 1668: /*&eg-texi
! 1669: @table @t
! 1670: @item Reference
! 1671: @code{sm1_start}, @code{sm1_find_proc}, @code{d_true_nf}
! 1672: @end table
! 1673: */
! 1674: /*&jp-texi
! 1675: @table @t
! 1676: @item $B;2>H(B
! 1677: @code{sm1_start}, @code{sm1_find_proc}, @code{d_true_nf}
! 1678: @end table
! 1679: */
! 1680:
! 1681: def sm1_reduction(A) {
! 1682: /* Example: sm1_reduction(A|proc=10) */
! 1683: SM1_FIND_PROC(P);
! 1684: /* check the arguments */
! 1685: if (type(A) != 4) {
! 1686: error("sm1_reduction(A|proc=p): A must be a list.");
! 1687: }
! 1688: AA = [rtostr(A[0])];
! 1689: AA = append(AA,[ map(rtostr,A[1]) ]);
! 1690: AA = append(AA, cdr(cdr(A)));
! 1691: sm1(P," /reduction*.noH 0 def ");
! 1692: sm1_push_int0(P,AA);
! 1693: sm1(P," reduction* ");
! 1694: ox_check_errors2(P);
! 1695: return(sm1_pop(P));
! 1696: }
! 1697:
! 1698: def sm1_reduction_noH(A) {
! 1699: /* Example: sm1_reduction(A|proc=10) */
! 1700: SM1_FIND_PROC(P);
! 1701: /* check the arguments */
! 1702: if (type(A) != 4) {
! 1703: error("sm1_reduction_noH(A|proc=p): A must be a list.");
! 1704: }
! 1705: AA = [rtostr(A[0])];
! 1706: AA = append(AA,[ map(rtostr,A[1]) ]);
! 1707: AA = append(AA, cdr(cdr(A)));
! 1708: sm1(P," /reduction*.noH 1 def ");
! 1709: sm1_push_int0(P,AA);
! 1710: sm1(P," reduction* ");
! 1711: ox_check_errors2(P);
! 1712: return(sm1_pop(P));
! 1713: }
! 1714:
! 1715: /*&eg-texi
! 1716: @menu
! 1717: * sm1_xml_tree_to_prefix_string::
! 1718: @end menu
! 1719: @node sm1_xml_tree_to_prefix_string,,, SM1 Functions
! 1720: @subsection @code{sm1_xml_tree_to_prefix_string}
! 1721: @findex sm1_xml_tree_to_prefix_string
! 1722: @table @t
! 1723: @item sm1_xml_tree_to_prefix_string(@var{s}|proc=@var{p})
! 1724: :: Translate OpenMath Tree Expression @var{s} in XML to a prefix notation.
! 1725: @end table
! 1726:
! 1727: @table @var
! 1728: @item return
! 1729: String
! 1730: @item p
! 1731: Number
! 1732: @item s
! 1733: String
! 1734: @end table
! 1735:
! 1736: @itemize @bullet
! 1737: @item It translate OpenMath Tree Expression @var{s} in XML to a prefix notation.
! 1738: @item This function should be moved to om_* in a future.
! 1739: @item @code{om_xml_to_cmo(OpenMath Tree Expression)} returns CMO_TREE.
! 1740: asir has not yet understood this CMO.
! 1741: @item @code{java} execution environment is required.
! 1742: (For example, @code{/usr/local/jdk1.1.8/bin} should be in the
! 1743: command search path.)
! 1744: @end itemize
! 1745: */
! 1746: /*&jp-texi
! 1747: @menu
! 1748: * sm1_xml_tree_to_prefix_string::
! 1749: @end menu
! 1750: @node sm1_xml_tree_to_prefix_string,,, SM1 $BH!?t(B
! 1751: @subsection @code{sm1_xml_tree_to_prefix_string}
! 1752: @findex sm1_xml_tree_to_prefix_string
! 1753: @table @t
! 1754: @item sm1_xml_tree_to_prefix_string(@var{s}|proc=@var{p})
! 1755: :: XML $B$G=q$+$l$?(B OpenMath $B$NLZI=8=(B @var{s} $B$rA0CV5-K!$K$J$*$9(B.
! 1756: @end table
! 1757:
! 1758: @table @var
! 1759: @item return
! 1760: String
! 1761: @item p
! 1762: Number
! 1763: @item s
! 1764: String
! 1765: @end table
! 1766:
! 1767: @itemize @bullet
! 1768: @item XML $B$G=q$+$l$?(B OpenMath $B$NLZI=8=(B @var{s} $B$rA0CV5-K!$K$J$*$9(B.
! 1769: @item $B$3$NH!?t$O(B om_* $B$K>-Mh0\$9$Y$-$G$"$k(B.
! 1770: @item @code{om_xml_to_cmo(OpenMath Tree Expression)} $B$O(B CMO_TREE
! 1771: $B$rLa$9(B. @code{asir} $B$O$3$N(B CMO $B$r$^$@%5%]!<%H$7$F$$$J$$(B.
! 1772: @item @code{java} $B$N<B9T4D6-$,I,MW(B.
! 1773: ($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.)
! 1774: @end itemize
! 1775: */
! 1776: /*&C-texi
! 1777: @example
! 1778: [263] load("om");
! 1779: 1
! 1780: [270] F=om_xml(x^4-1);
! 1781: control: wait OX
! 1782: Trying to connect to the server... Done.
! 1783: <OMOBJ><OMA><OMS name="plus" cd="basic"/><OMA>
! 1784: <OMS name="times" cd="basic"/><OMA>
! 1785: <OMS name="power" cd="basic"/><OMV name="x"/><OMI>4</OMI></OMA>
! 1786: <OMI>1</OMI></OMA><OMA><OMS name="times" cd="basic"/><OMA>
! 1787: <OMS name="power" cd="basic"/><OMV name="x"/><OMI>0</OMI></OMA>
! 1788: <OMI>-1</OMI></OMA></OMA></OMOBJ>
! 1789: [271] sm1_xml_tree_to_prefix_string(F);
! 1790: basic_plus(basic_times(basic_power(x,4),1),basic_times(basic_power(x,0),-1))
! 1791: @end example
! 1792: */
! 1793: /*&eg-texi
! 1794: @table @t
! 1795: @item Reference
! 1796: @code{om_*}, @code{OpenXM/src/OpenMath}, @code{eval_str}
! 1797: @end table
! 1798: */
! 1799: /*&jp-texi
! 1800: @table @t
! 1801: @item $B;2>H(B
! 1802: @code{om_*}, @code{OpenXM/src/OpenMath}, @code{eval_str}
! 1803: @end table
! 1804: */
! 1805:
! 1806:
! 1807: def sm1_xml_tree_to_prefix_string(A) {
! 1808: SM1_FIND_PROC(P);
! 1809: /* check the arguments */
! 1810: if (type(A) != 7) {
! 1811: error("sm1_xml_tree_to_prefix_string(A|proc=p): A must be a string.");
! 1812: }
! 1813: ox_push_cmo(P,A);
! 1814: sm1(P," xml_tree_to_prefix_string ");
! 1815: ox_check_errors2(P);
! 1816: return(ox_pop_cmo(P));
! 1817: }
! 1818:
! 1819:
! 1820: def sm1_wbf(A) {
! 1821: SM1_FIND_PROC(P);
! 1822: /* check the arguments */
! 1823: if (type(A) != 4) {
! 1824: error("sm1_wbf(A): A must be a list.");
! 1825: }
! 1826: if (length(A) != 3) {
! 1827: error("sm1_wbf(A): A must be a list of the length 3.");
! 1828: }
! 1829: if (type(A[0]) != 4 || type(A[1]) != 4 || type(A[2]) != 4) {
! 1830: error("sm1_wbf([A,B,C]): A, B, C must be a list.");
! 1831: }
! 1832: if (! (type(A[2][0]) == 7 || type(A[2][0]) == 2)) {
! 1833: error("sm1_wbf([A,B,C]): C must be of a form [v-name, v-weight, ...]");
! 1834: }
! 1835: sm1_push_int0(P,A);
! 1836: sm1(P," wbf ");
! 1837: ox_check_errors2(P);
! 1838: return(sm1_pop(P));
! 1839: }
! 1840: def sm1_wbfRoots(A) {
! 1841: SM1_FIND_PROC(P);
! 1842: /* check the arguments */
! 1843: if (type(A) != 4) {
! 1844: error("sm1_wbfRoots(A): A must be a list.");
! 1845: }
! 1846: if (length(A) != 3) {
! 1847: error("sm1_wbfRoots(A): A must be a list of the length 3.");
! 1848: }
! 1849: if (type(A[0]) != 4 || type(A[1]) != 4 || type(A[2]) != 4) {
! 1850: error("sm1_wbfRoots([A,B,C]): A, B, C must be a list.");
! 1851: }
! 1852: if (! (type(A[2][0]) == 7 || type(A[2][0]) == 2)) {
! 1853: error("sm1_wbfRoots([A,B,C]): C must be of a form [v-name, v-weight, ...]");
! 1854: }
! 1855: sm1_push_int0(P,A);
! 1856: sm1(P," wbfRoots ");
! 1857: ox_check_errors2(P);
! 1858: return(sm1_pop(P));
! 1859: }
! 1860:
! 1861:
! 1862: def sm1_res_div(A) {
! 1863: SM1_FIND_PROC(P);
! 1864: sm1_push_int0(P,[[A[0],A[1]],A[2]]);
! 1865: sm1(P," res*div ");
! 1866: ox_check_errors2(P);
! 1867: return(sm1_pop(P));
! 1868: }
! 1869:
! 1870:
! 1871: /*&eg-texi
! 1872: @c sort-sm1_syz
! 1873: @menu
! 1874: * sm1_syz::
! 1875: @end menu
! 1876: @node sm1_syz,,, SM1 Functions
! 1877: @node sm1_syz_d,,, SM1 Functions
! 1878: @subsection @code{sm1_syz}
! 1879: @findex sm1_syz
! 1880: @findex sm1_syz_d
! 1881: @table @t
! 1882: @item sm1_syz([@var{f},@var{v},@var{w}]|proc=@var{p})
! 1883: :: computes the syzygy of @var{f} in the ring of differential
! 1884: operators with the variable @var{v}.
! 1885: @end table
! 1886:
! 1887: @table @var
! 1888: @item return
! 1889: List
! 1890: @item p
! 1891: Number
! 1892: @item f, v, w
! 1893: List
! 1894: @end table
! 1895:
! 1896: @itemize @bullet
! 1897: @item
! 1898: The return values is of the form
! 1899: [@var{s},[@var{g}, @var{m}, @var{t}]].
! 1900: Here @var{s} is the syzygy of @var{f} in the ring of differential
! 1901: operators with the variable @var{v}.
! 1902: @var{g} is a Groebner basis of @var{f} with the weight vector @var{w},
! 1903: and @var{m} is a matrix that translates the input matrix @var{f} to the Gr\"obner
! 1904: basis @var {g}.
! 1905: @var{t} is the syzygy of the Gr\"obner basis @var{g}.
! 1906: In summary, @var{g} = @var{m} @var{f} and
! 1907: @var{s} @var{f} = 0 hold as matrices.
! 1908: @item
! 1909: The weight vectors are given by @var{w}, which can be omitted.
! 1910: If @var{w} is not given,
! 1911: the graded reverse lexicographic order will be used to compute Grobner basis.
! 1912: @item
! 1913: When a non-term order is given, the Grobner basis is computed in
! 1914: the homogenized Weyl algebra (See Section 1.2 of the book of SST).
! 1915: The homogenization variable h is automatically added.
! 1916: @end itemize
! 1917: */
! 1918: /*&jp-texi
! 1919: @c sort-sm1_syz
! 1920: @menu
! 1921: * sm1_syz::
! 1922: @end menu
! 1923: @node sm1_syz,,, SM1 $BH!?t(B
! 1924: @node sm1_syz_d,,, SM1 $BH!?t(B
! 1925: @subsection @code{sm1_syz}
! 1926: @findex sm1_syz
! 1927: @findex sm1_syz_d
! 1928: @table @t
! 1929: @item sm1_syz([@var{f},@var{v},@var{w}]|proc=@var{p})
! 1930: :: @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N(B syzygy $B$r7W;;$9$k(B.
! 1931: @end table
! 1932:
! 1933: @table @var
! 1934: @item return
! 1935: $B%j%9%H(B
! 1936: @item p
! 1937: $B?t(B
! 1938: @item f, v, w
! 1939: $B%j%9%H(B
! 1940: @end table
! 1941:
! 1942: @itemize @bullet
! 1943: @item
! 1944: $BLa$jCM$O<!$N7A$r$7$F$$$k(B:
! 1945: [@var{s},[@var{g}, @var{m}, @var{t}]].
! 1946: $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
! 1947: syzygy $B$G$"$k(B.
! 1948: @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.
! 1949: @var{m} $B$OF~NO9TNs(B @var{f} $B$r%0%l%V%J4pDl(B
! 1950: @var{g} $B$XJQ49$9$k9TNs$G$"$k(B.
! 1951: @var{t} $B$O%0%l%V%J4pDl(B @var{g} $B$N(B syzygy $B$G$"$k(B.
! 1952: $B$^$H$a$k$H(B, $B<!$NEy<0$,$J$j$?$D(B:
! 1953: @var{g} = @var{m} @var{f} ,
! 1954: @var{s} @var{f} = 0.
! 1955: @item
! 1956: Weight $B%Y%/%H%k(B @var{w} $B$O>JN,$7$F$h$$(B.
! 1957: $B>JN,$7$?>l9g(B, graded reverse lexicographic order $B$r$D$+$C$F(B
! 1958: $B%V%l%V%J4pDl$r7W;;$9$k(B.
! 1959: @item
! 1960: 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).
! 1961: $BF1<!2=JQ?t(B @code{h} $B$,7k2L$K2C$o$k(B.
! 1962: @end itemize
! 1963: */
! 1964: /*&C-texi
! 1965: @example
! 1966: [293] sm1_syz([[x*dx+y*dy-1,x*y*dx*dy-2],[x,y]]);
! 1967: [[[y*x*dy*dx-2,-x*dx-y*dy+1]], generators of the syzygy
! 1968: [[[x*dx+y*dy-1],[y^2*dy^2+2]], grobner basis
! 1969: [[1,0],[y*dy,-1]], transformation matrix
! 1970: [[y*x*dy*dx-2,-x*dx-y*dy+1]]]]
! 1971: @end example
! 1972: */
! 1973: /*&C-texi
! 1974: @example
! 1975: [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]]]);
! 1976: [[[y*x*dy*dx-1,-x^2*dx^2-x*dx-y^2*dy^2-y*dy+4]], generators of the syzygy
! 1977: [[[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
! 1978: [h^4*x*dx+y^3*dy^3+3*h^2*y^2*dy^2-3*h^4*y*dy]],
! 1979: [[1,0],[0,1],[y*dy,-x*dx]], transformation matrix
! 1980: [[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]]]]
! 1981: @end example
! 1982: */
! 1983:
! 1984:
! 1985: def sm1_syz(A) {
! 1986: SM1_FIND_PROC(P);
! 1987: sm1_push_int0(P,A);
! 1988: sm1(P," syz ");
! 1989: ox_check_errors2(P);
! 1990: return(sm1_pop(P));
! 1991: }
! 1992:
! 1993: def sm1_res_solv(A) {
! 1994: SM1_FIND_PROC(P);
! 1995: sm1_push_int0(P,[[A[0],A[1]],A[2]]);
! 1996: sm1(P," res*solv ");
! 1997: ox_check_errors2(P);
! 1998: return(sm1_pop(P));
! 1999: }
! 2000:
! 2001: def sm1_res_solv_h(A) {
! 2002: SM1_FIND_PROC(P);
! 2003: sm1_push_int0(P,[[A[0],A[1]],A[2]]);
! 2004: sm1(P," res*solv*h ");
! 2005: ox_check_errors2(P);
! 2006: return(sm1_pop(P));
! 2007: }
! 2008:
! 2009:
! 2010: def sm1_mul(A,B,V) {
! 2011: SM1_FIND_PROC(P);
! 2012: sm1_push_int0(P,[[A,B],V]);
! 2013: sm1(P," res*mul ");
! 2014: ox_check_errors2(P);
! 2015: return(sm1_pop(P));
! 2016: }
! 2017:
! 2018: /*&eg-texi
! 2019: @menu
! 2020: * sm1_mul::
! 2021: @end menu
! 2022: @node sm1_mul,,, SM1 Functions
! 2023: @subsection @code{sm1_mul}
! 2024: @findex sm1_mul
! 2025: @table @t
! 2026: @item sm1_mul(@var{f},@var{g},@var{v}|proc=@var{p})
! 2027: :: ask the sm1 server to multiply @var{f} and @var{g} in the ring of differential operators over @var{v}.
! 2028: @end table
! 2029:
! 2030: @table @var
! 2031: @item return
! 2032: Polynomial or List
! 2033: @item p
! 2034: Number
! 2035: @item f, g
! 2036: Polynomial or List
! 2037: @item v
! 2038: List
! 2039: @end table
! 2040:
! 2041: @itemize @bullet
! 2042: @item Ask the sm1 server to multiply @var{f} and @var{g} in the ring of differential operators over @var{v}.
! 2043: @item @code{sm1_mul_h} is for homogenized Weyl algebra.
! 2044: @end itemize
! 2045: */
! 2046:
! 2047: /*&jp-texi
! 2048: @menu
! 2049: * sm1_mul::
! 2050: @end menu
! 2051: @node sm1_mul,,, SM1 $BH!?t(B
! 2052: @subsection @code{sm1_mul}
! 2053: @findex sm1_mul
! 2054: @table @t
! 2055: @item sm1_mul(@var{f},@var{g},@var{v}|proc=@var{p})
! 2056: :: sm1$B%5!<%P(B $B$K(B @var{f} $B$+$1$k(B @var{g} $B$r(B @var{v}
! 2057: $B>e$NHyJ,:nMQAG4D$G$d$C$F$/$l$k$h$&$KMj$`(B.
! 2058: @end table
! 2059:
! 2060: @table @var
! 2061: @item return
! 2062: $BB?9`<0$^$?$O%j%9%H(B
! 2063: @item p
! 2064: $B?t(B
! 2065: @item f, g
! 2066: $BB?9`<0$^$?$O%j%9%H(B
! 2067: @item v
! 2068: $B%j%9%H(B
! 2069: @end table
! 2070:
! 2071: @itemize @bullet
! 2072: @item sm1$B%5!<%P(B $B$K(B @var{f} $B$+$1$k(B @var{g} $B$r(B @var{v}
! 2073: $B>e$NHyJ,:nMQAG4D$G$d$C$F$/$l$k$h$&$KMj$`(B.
! 2074: @item @code{sm1_mul_h} $B$O(B homogenized Weyl $BBe?tMQ(B.
! 2075: @end itemize
! 2076: */
! 2077:
! 2078: /*&C-texi
! 2079:
! 2080: @example
! 2081: [277] sm1_mul(dx,x,[x]);
! 2082: x*dx+1
! 2083: [278] sm1_mul([x,y],[1,2],[x,y]);
! 2084: x+2*y
! 2085: [279] sm1_mul([[1,2],[3,4]],[[x,y],[1,2]],[x,y]);
! 2086: [[x+2,y+4],[3*x+4,3*y+8]]
! 2087: @end example
! 2088:
! 2089: */
! 2090:
! 2091:
! 2092:
! 2093: def sm1_mul_h(A,B,V) {
! 2094: SM1_FIND_PROC(P);
! 2095: sm1_push_int0(P,[[A,B],V]);
! 2096: sm1(P," res*mul*h ");
! 2097: ox_check_errors2(P);
! 2098: return(sm1_pop(P));
! 2099: }
! 2100:
! 2101: def sm1_adjoint(A,V) {
! 2102: SM1_FIND_PROC(P);
! 2103: sm1_push_int0(P,[A,V]);
! 2104: sm1(P," res*adjoint ");
! 2105: ox_check_errors2(P);
! 2106: return(sm1_pop(P));
! 2107: }
! 2108:
! 2109: def transpose(A) {
! 2110: if (type(A) == 4) {
! 2111: N = length(A); M = length(A[0]);
! 2112: B = newmat(N,M,A);
! 2113: C = newmat(M,N);
! 2114: for (I=0; I<N; I++) {
! 2115: for (J=0; J<M; J++) {
! 2116: C[J][I] = B[I][J];
! 2117: }
! 2118: }
! 2119: D = newvect(M);
! 2120: for (J=0; J<M; J++) {
! 2121: D[J] = C[J];
! 2122: }
! 2123: return(map(vtol,vtol(D)));
! 2124: }else{
! 2125: print(A)$
! 2126: error("tranpose: traspose for this argument has not been implemented.");
! 2127: }
! 2128: }
! 2129:
! 2130: def sm1_resol1(A) {
! 2131: SM1_FIND_PROC(P);
! 2132: sm1_push_int0(P,A);
! 2133: sm1(P," res*resol1 ");
! 2134: ox_check_errors2(P);
! 2135: return(sm1_pop(P));
! 2136: }
! 2137:
! 2138:
! 2139: def sm1_gcd_aux(A,B) {
! 2140: if (type(A) == 1 && type(B) == 1) return(igcd(A,B));
! 2141: else return(gcd(A,B));
! 2142: }
! 2143:
! 2144: def sm1_lcm_aux(V) { /* sm1_lcm_aux([3,5,6]); */
! 2145: N = length(V);
! 2146: if (N == 0) return(0);
! 2147: if (N == 1) return(V[0]);
! 2148: L = V[0];
! 2149: for (I=1; I<N; I++) {
! 2150: L = red(L*V[I]/sm1_gcd_aux(L,V[I]));
! 2151: }
! 2152: return(L);
! 2153: }
! 2154:
! 2155: def sm1_mul_v(V,S) {
! 2156: if (type(V) == 4) {
! 2157: return(map(sm1_mul_v,V,S));
! 2158: } else {
! 2159: return(V*S);
! 2160: }
! 2161: }
! 2162:
! 2163: def sm1_div_v(V,S) {
! 2164: if (type(V) == 4) {
! 2165: return(map(sm1_div_v,V,S));
! 2166: } else {
! 2167: return(V/S);
! 2168: }
! 2169: }
! 2170:
! 2171:
! 2172: def sm1_rat_to_p_aux(T) { /* cf. sm1_rat2plist2 */
! 2173: T = red(T);
! 2174: T1 = nm(T); T1a = ptozp(T1);
! 2175: T1b = red(T1a/T1);
! 2176: T2 = dn(T);
! 2177: return([T1a*dn(T1b),T2*nm(T1b)]);
! 2178: }
! 2179:
! 2180: def sm1_denom_aux0(A) {
! 2181: return(A[1]);
! 2182: }
! 2183: def sm1_num_aux0(P) {
! 2184: return(P[0]);
! 2185: }
! 2186:
! 2187: def sm1_rat_to_p(T) {
! 2188: if (type(T) == 4) {
! 2189: A = map(sm1_rat_to_p,T);
! 2190: D = map(sm1_denom_aux0,A);
! 2191: N = map(sm1_num_aux0,A);
! 2192: L = sm1_lcm_aux(D);
! 2193: B = newvect(length(N));
! 2194: for (I=0; I<length(N); I++) {
! 2195: B[I] = sm1_mul_v(N[I],L/D[I]);
! 2196: }
! 2197: return([vtol(B),L]);
! 2198: }else{
! 2199: return(sm1_rat_to_p_aux(T));
! 2200: }
! 2201: }
! 2202:
! 2203:
! 2204:
! 2205: /* ---------------------------------------------- */
! 2206: def sm1_distraction(A) {
! 2207: SM1_FIND_PROC(P);
! 2208: sm1_push_int0(P,A);
! 2209: sm1(P," distraction2* ");
! 2210: ox_check_errors2(P);
! 2211: return(sm1_pop(P));
! 2212: }
! 2213:
! 2214: /*&eg-texi
! 2215: @menu
! 2216: * sm1_distraction::
! 2217: @end menu
! 2218: @node sm1_distraction,,, SM1 Functions
! 2219: @subsection @code{sm1_distraction}
! 2220: @findex sm1_distraction
! 2221: @table @t
! 2222: @item sm1_distraction([@var{f},@var{v},@var{x},@var{d},@var{s}]|proc=@var{p})
! 2223: :: ask the @code{sm1} server to compute the distraction of @var{f}.
! 2224: @end table
! 2225:
! 2226: @table @var
! 2227: @item return
! 2228: List
! 2229: @item p
! 2230: Number
! 2231: @item f
! 2232: Polynomial
! 2233: @item v,x,d,s
! 2234: List
! 2235: @end table
! 2236:
! 2237: @itemize @bullet
! 2238: @item It asks the @code{sm1} server of the descriptor number @var{p}
! 2239: to compute the distraction of @var{f} in the ring of differential
! 2240: operators with variables @var{v}.
! 2241: @item @var{x} is a list of x-variables and @var{d} is that of d-variables
! 2242: to be distracted. @var{s} is a list of variables to express the distracted @var{f}.
! 2243: @item Distraction is roughly speaking to replace x*dx by a single variable x.
! 2244: See Saito, Sturmfels, Takayama : Grobner Deformations of Hypergeometric Differential Equations at page 68 for details.
! 2245: @end itemize
! 2246: */
! 2247:
! 2248: /*&jp-texi
! 2249: @menu
! 2250: * sm1_distraction::
! 2251: @end menu
! 2252: @node sm1_distraction,,, SM1 $BH!?t(B
! 2253:
! 2254: @subsection @code{sm1_distraction}
! 2255: @findex sm1_distraction
! 2256: @table @t
! 2257: @item sm1_distraction([@var{f},@var{v},@var{x},@var{d},@var{s}]|proc=@var{p})
! 2258: :: @code{sm1} $B$K(B @var{f} $B$N(B distraction $B$r7W;;$7$F$b$i$&(B.
! 2259: @end table
! 2260:
! 2261: @table @var
! 2262: @item return
! 2263: $B%j%9%H(B
! 2264: @item p
! 2265: $B?t(B
! 2266: @item f
! 2267: $BB?9`<0(B
! 2268: @item v,x,d,s
! 2269: $B%j%9%H(B
! 2270: @end table
! 2271:
! 2272: @itemize @bullet
! 2273: @item $B<1JL;R(B @var{p} $B$N(B @code{sm1} $B%5!<%P$K(B,
! 2274: @var{f} $B$N(B distraction $B$r(B @var{v} $B>e$NHyJ,:nMQAG4D$G7W;;$7$F$b$i$&(B.
! 2275: @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
! 2276: $B%j%9%H(B. Distraction $B$7$?$i(B, @var{s} $B$rJQ?t$H$7$F7k2L$rI=$9(B.
! 2277: @item Distraction $B$H$$$&$N$O(B x*dx $B$r(B x $B$GCV$-49$($k$3$H$G$"$k(B.
! 2278: $B>\$7$/$O(B Saito, Sturmfels, Takayama : Grobner Deformations of Hypergeometric Differential Equations $B$N(B page 68 $B$r8+$h(B.
! 2279: @end itemize
! 2280: */
! 2281:
! 2282: /*&C-texi
! 2283:
! 2284: @example
! 2285: [280] sm1_distraction([x*dx,[x],[x],[dx],[x]]);
! 2286: x
! 2287: [281] sm1_distraction([dx^2,[x],[x],[dx],[x]]);
! 2288: x^2-x
! 2289: [282] sm1_distraction([x^2,[x],[x],[dx],[x]]);
! 2290: x^2+3*x+2
! 2291: [283] fctr(@@);
! 2292: [[1,1],[x+1,1],[x+2,1]]
! 2293: [284] sm1_distraction([x*dx*y+x^2*dx^2*dy,[x,y],[x],[dx],[x]]);
! 2294: (x^2-x)*dy+x*y
! 2295: @end example
! 2296: */
! 2297:
! 2298: /*&eg-texi
! 2299: @table @t
! 2300: @item Reference
! 2301: @code{distraction2(sm1)},
! 2302: @end table
! 2303: */
! 2304:
! 2305: /*&jp-texi
! 2306: @table @t
! 2307: @item $B;2>H(B
! 2308: @code{distraction2(sm1)},
! 2309: @end table
! 2310: */
! 2311:
! 2312: /* Temporary functions */
! 2313: /* Use this function for a while to wait a fix of asir. */
! 2314: def sm1_ntoint32(I) { /* Fixed */
! 2315: SM1_FIND_PROC(P);
! 2316: if (I >= 0) return(ntoint32(I));
! 2317: sm1(P," "+rtostr(I)+" ");
! 2318: return(ox_pop_cmo(P));
! 2319: }
! 2320: def sm1_to_ascii_array(S) { /* Use strtoascii */
! 2321: SM1_FIND_PROC(P);
! 2322: ox_push_cmo(P,S);
! 2323: sm1(P," (array) dc { (universalNumber) dc } map ");
! 2324: return(ox_pop_cmo(P));
! 2325: }
! 2326: def sm1_from_ascii_array(S) { /* Use asciitostr */
! 2327: SM1_FIND_PROC(P);
! 2328: ox_push_cmo(P,S);
! 2329: sm1(P," { (integer) dc (string) dc } map cat ");
! 2330: return(ox_pop_cmo(P));
! 2331: }
! 2332:
! 2333: /*
! 2334: [288] sm1_to_ascii_array("Hello");
! 2335: [72,101,108,108,111]
! 2336: [289] sm1_from_ascii_array(@@);
! 2337: Hello
! 2338: */
! 2339:
! 2340: /* end of temporary functions */
! 2341:
! 2342: def sm1_gkz(S) {
! 2343: SM1_FIND_PROC(P);
! 2344: A = S[0];
! 2345: B = S[1];
! 2346: AA = [ ];
! 2347: BB = [ ];
! 2348: for (I=0; I<length(A); I++) {
! 2349: AA = append(AA,[map(ntoint32,A[I])]);
! 2350: BB = append(BB,[ntoint32(0)]);
! 2351: }
! 2352: sm1(P,"[ ");
! 2353: sm1_push_int0(P,AA);
! 2354: sm1_push_int0(P,BB);
! 2355: sm1(P," ] gkz ");
! 2356: ox_check_errors2(P);
! 2357: R = sm1_pop(P);
! 2358: RR0 = map(eval_str,R[0]);
! 2359: RR1 = map(eval_str,R[1]);
! 2360: RR3 = [ ];
! 2361: for (I=0; I<length(B); I++) {
! 2362: RR3 = append(RR3,[ sm1_rat_to_p(RR0[I]-B[I])[0] ]);
! 2363: }
! 2364: for (I=length(B); I<length(RR0); I++) {
! 2365: RR3 = append(RR3,[RR0[I]]);
! 2366: }
! 2367: return([RR3,RR1]);
! 2368: }
! 2369:
! 2370:
! 2371: /*&eg-texi
! 2372: @menu
! 2373: * sm1_gkz::
! 2374: @end menu
! 2375: @node sm1_gkz,,, SM1 Functions
! 2376: @subsection @code{sm1_gkz}
! 2377: @findex sm1_gkz
! 2378: @table @t
! 2379: @item sm1_gkz([@var{A},@var{B}]|proc=@var{p})
! 2380: :: Returns the GKZ system (A-hypergeometric system) associated to the matrix
! 2381: @var{A} with the parameter vector @var{B}.
! 2382: @end table
! 2383:
! 2384: @table @var
! 2385: @item return
! 2386: List
! 2387: @item p
! 2388: Number
! 2389: @item A, B
! 2390: List
! 2391: @end table
! 2392:
! 2393: @itemize @bullet
! 2394: @item Returns the GKZ hypergeometric system
! 2395: (A-hypergeometric system) associated to the matrix
! 2396: @end itemize
! 2397: */
! 2398:
! 2399: /*&jp-texi
! 2400: @menu
! 2401: * sm1_gkz::
! 2402: @end menu
! 2403: @node sm1_gkz,,, SM1 $BH!?t(B
! 2404: @subsection @code{sm1_gkz}
! 2405: @findex sm1_gkz
! 2406: @table @t
! 2407: @item sm1_gkz([@var{A},@var{B}]|proc=@var{p})
! 2408: :: $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.
! 2409: @end table
! 2410:
! 2411: @table @var
! 2412: @item return
! 2413: $B%j%9%H(B
! 2414: @item p
! 2415: $B?t(B
! 2416: @item A, B
! 2417: $B%j%9%H(B
! 2418: @end table
! 2419:
! 2420: @itemize @bullet
! 2421: @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.
! 2422: @end itemize
! 2423: */
! 2424:
! 2425: /*&C-texi
! 2426:
! 2427: @example
! 2428:
! 2429: [280] sm1_gkz([ [[1,1,1,1],[0,1,3,4]], [0,2] ]);
! 2430: [[x4*dx4+x3*dx3+x2*dx2+x1*dx1,4*x4*dx4+3*x3*dx3+x2*dx2-2,
! 2431: -dx1*dx4+dx2*dx3,-dx2^2*dx4+dx1*dx3^2,dx1^2*dx3-dx2^3,-dx2*dx4^2+dx3^3],
! 2432: [x1,x2,x3,x4]]
! 2433:
! 2434: @end example
! 2435:
! 2436: */
! 2437:
! 2438:
! 2439: def sm1_appell1(S) {
! 2440: N = length(S)-2;
! 2441: B = cdr(cdr(S));
! 2442: A = S[0];
! 2443: C = S[1];
! 2444: V = [ ];
! 2445: for (I=0; I<N; I++) {
! 2446: V = append(V,[sm1aux_x(I+1)]);
! 2447: }
! 2448: Ans = [ ];
! 2449: Euler = 0;
! 2450: for (I=0; I<N; I++) {
! 2451: Euler = sm1aux_x(I+1)*sm1aux_dx(I+1) + Euler;
! 2452: }
! 2453: for (I=0; I<N; I++) {
! 2454: T = sm1_mul(sm1aux_dx(I+1), Euler+C-1,V)-
! 2455: sm1_mul(Euler+A, sm1aux_x(I+1)*sm1aux_dx(I+1)+B[I],V);
! 2456: /* Tmp=sm1_rat_to_p(T);
! 2457: print(Tmp[0]/Tmp[1]-T)$ */
! 2458: T = sm1_rat_to_p(T)[0];
! 2459: Ans = append(Ans,[T]);
! 2460: }
! 2461: for (I=0; I<N; I++) {
! 2462: for (J=I+1; J<N; J++) {
! 2463: T = (sm1aux_x(I+1)-sm1aux_x(J+1))*sm1aux_dx(I+1)*sm1aux_dx(J+1)
! 2464: - B[J]*sm1aux_dx(I+1) + B[I]*sm1aux_dx(J+1);
! 2465: /* Tmp=sm1_rat_to_p(T);
! 2466: print(Tmp[0]/Tmp[1]-T)$ */
! 2467: T = sm1_rat_to_p(T)[0];
! 2468: Ans = append(Ans,[T]);
! 2469: }
! 2470: }
! 2471: return([Ans,V]);
! 2472: }
! 2473:
! 2474:
! 2475: def sm1aux_dx(I) {
! 2476: return(strtov("dx"+rtostr(I)));
! 2477: }
! 2478: def sm1aux_x(I) {
! 2479: return(strtov("x"+rtostr(I)));
! 2480: }
! 2481:
! 2482:
! 2483:
! 2484: /*&eg-texi
! 2485: @menu
! 2486: * sm1_appell1::
! 2487: @end menu
! 2488: @node sm1_appell1,,, SM1 Functions
! 2489: @subsection @code{sm1_appell1}
! 2490: @findex sm1_appell1
! 2491: @table @t
! 2492: @item sm1_appell1(@var{a}|proc=@var{p})
! 2493: :: Returns the Appell hypergeometric system F_1 or F_D.
! 2494: @end table
! 2495:
! 2496: @table @var
! 2497: @item return
! 2498: List
! 2499: @item p
! 2500: Number
! 2501: @item a
! 2502: List
! 2503: @end table
! 2504:
! 2505: @itemize @bullet
! 2506: @item Returns the hypergeometric system for the Lauricella function
! 2507: F_D(a,b1,b2,...,bn,c;x1,...,xn)
! 2508: where @var{a} =(a,c,b1,...,bn).
! 2509: When n=2, the Lauricella function is called the Appell function F_1.
! 2510: The parameters a, c, b1, ..., bn may be rational numbers.
! 2511: @end itemize
! 2512: */
! 2513:
! 2514: /*&jp-texi
! 2515: @menu
! 2516: * sm1_appell1::
! 2517: @end menu
! 2518: @node sm1_appell1,,, SM1 $BH!?t(B
! 2519: @subsection @code{sm1_appell1}
! 2520: @findex sm1_appell1
! 2521: @table @t
! 2522: @item sm1_appell1(@var{a}|proc=@var{p})
! 2523: :: F_1 $B$^$?$O(B F_D $B$KBP1~$9$kJ}Dx<07O$rLa$9(B.
! 2524: @end table
! 2525:
! 2526: @table @var
! 2527: @item return
! 2528: $B%j%9%H(B
! 2529: @item p
! 2530: $B?t(B
! 2531: @item a
! 2532: $B%j%9%H(B
! 2533: @end table
! 2534:
! 2535: @itemize @bullet
! 2536: @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
! 2537: F_D(a,b1,b2,...,bn,c;x1,...,xn)
! 2538: $B$N$_$?$9HyJ,J}Dx<07O$rLa$9(B. $B$3$3$G(B,
! 2539: @var{a} =(a,c,b1,...,bn).
! 2540: $B%Q%i%a!<%?$OM-M}?t$G$b$h$$(B.
! 2541: @end itemize
! 2542: */
! 2543:
! 2544: /*&C-texi
! 2545:
! 2546: @example
! 2547:
! 2548: [281] sm1_appell1([1,2,3,4]);
! 2549: [[((-x1+1)*x2*dx1-3*x2)*dx2+(-x1^2+x1)*dx1^2+(-5*x1+2)*dx1-3,
! 2550: (-x2^2+x2)*dx2^2+((-x1*x2+x1)*dx1-6*x2+2)*dx2-4*x1*dx1-4,
! 2551: ((-x2+x1)*dx1+3)*dx2-4*dx1], equations
! 2552: [x1,x2]] the list of variables
! 2553:
! 2554: [282] sm1_gb(@@);
! 2555: [[((-x2+x1)*dx1+3)*dx2-4*dx1,((-x1+1)*x2*dx1-3*x2)*dx2+(-x1^2+x1)*dx1^2
! 2556: +(-5*x1+2)*dx1-3,(-x2^2+x2)*dx2^2+((-x2^2+x1)*dx1-3*x2+2)*dx2
! 2557: +(-4*x2-4*x1)*dx1-4,
! 2558: (x2^3+(-x1-1)*x2^2+x1*x2)*dx2^2+((-x1*x2+x1^2)*dx1+6*x2^2
! 2559: +(-3*x1-2)*x2+2*x1)*dx2-4*x1^2*dx1+4*x2-4*x1],
! 2560: [x1*dx1*dx2,-x1^2*dx1^2,-x2^2*dx1*dx2,-x1*x2^2*dx2^2]]
! 2561:
! 2562: [283] sm1_rank(sm1_appell1([1/2,3,5,-1/3]));
! 2563: 1
! 2564:
! 2565: [285] Mu=2$ Beta = 1/3$
! 2566: [287] sm1_rank(sm1_appell1([Mu+Beta,Mu+1,Beta,Beta,Beta]));
! 2567: 4
! 2568:
! 2569:
! 2570: @end example
! 2571:
! 2572: */
! 2573:
! 2574: def sm1_appell4(S) {
! 2575: N = length(S)-2;
! 2576: B = cdr(cdr(S));
! 2577: A = S[0];
! 2578: C = S[1];
! 2579: V = [ ];
! 2580: for (I=0; I<N; I++) {
! 2581: V = append(V,[sm1aux_x(I+1)]);
! 2582: }
! 2583: Ans = [ ];
! 2584: Euler = 0;
! 2585: for (I=0; I<N; I++) {
! 2586: Euler = sm1aux_x(I+1)*sm1aux_dx(I+1) + Euler;
! 2587: }
! 2588: for (I=0; I<N; I++) {
! 2589: T = sm1_mul(sm1aux_dx(I+1), sm1aux_x(I+1)*sm1aux_dx(I+1)+B[I]-1,V)-
! 2590: sm1_mul(Euler+A,Euler+C,V);
! 2591: /* Tmp=sm1_rat_to_p(T);
! 2592: print(Tmp[0]/Tmp[1]-T)$ */
! 2593: T = sm1_rat_to_p(T)[0];
! 2594: Ans = append(Ans,[T]);
! 2595: }
! 2596: return([Ans,V]);
! 2597: }
! 2598:
! 2599: /*&eg-texi
! 2600: @menu
! 2601: * sm1_appell4::
! 2602: @end menu
! 2603: @node sm1_appell4,,, SM1 Functions
! 2604: @subsection @code{sm1_appell4}
! 2605: @findex sm1_appell4
! 2606: @table @t
! 2607: @item sm1_appell4(@var{a}|proc=@var{p})
! 2608: :: Returns the Appell hypergeometric system F_4 or F_C.
! 2609: @end table
! 2610:
! 2611: @table @var
! 2612: @item return
! 2613: List
! 2614: @item p
! 2615: Number
! 2616: @item a
! 2617: List
! 2618: @end table
! 2619:
! 2620: @itemize @bullet
! 2621: @item Returns the hypergeometric system for the Lauricella function
! 2622: F_4(a,b,c1,c2,...,cn;x1,...,xn)
! 2623: where @var{a} =(a,b,c1,...,cn).
! 2624: When n=2, the Lauricella function is called the Appell function F_4.
! 2625: The parameters a, b, c1, ..., cn may be rational numbers.
! 2626: @end itemize
! 2627: */
! 2628:
! 2629: /*&jp-texi
! 2630: @menu
! 2631: * sm1_appell4::
! 2632: @end menu
! 2633: @node sm1_appell4,,, SM1 $BH!?t(B
! 2634: @subsection @code{sm1_appell4}
! 2635: @findex sm1_appell4
! 2636: @table @t
! 2637: @item sm1_appell4(@var{a}|proc=@var{p})
! 2638: :: F_4 $B$^$?$O(B F_C $B$KBP1~$9$kJ}Dx<07O$rLa$9(B.
! 2639: @end table
! 2640:
! 2641: @table @var
! 2642: @item return
! 2643: $B%j%9%H(B
! 2644: @item p
! 2645: $B?t(B
! 2646: @item a
! 2647: $B%j%9%H(B
! 2648: @end table
! 2649:
! 2650: @itemize @bullet
! 2651: @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
! 2652: F_C(a,b,c1,c2,...,cn;x1,...,xn)
! 2653: $B$N$_$?$9HyJ,J}Dx<07O$rLa$9(B. $B$3$3$G(B,
! 2654: @var{a} =(a,b,c1,...,cn).
! 2655: $B%Q%i%a!<%?$OM-M}?t$G$b$h$$(B.
! 2656: @end itemize
! 2657: */
! 2658:
! 2659: /*&C-texi
! 2660:
! 2661: @example
! 2662:
! 2663: [281] sm1_appell4([1,2,3,4]);
! 2664: [[-x2^2*dx2^2+(-2*x1*x2*dx1-4*x2)*dx2+(-x1^2+x1)*dx1^2+(-4*x1+3)*dx1-2,
! 2665: (-x2^2+x2)*dx2^2+(-2*x1*x2*dx1-4*x2+4)*dx2-x1^2*dx1^2-4*x1*dx1-2],
! 2666: equations
! 2667: [x1,x2]] the list of variables
! 2668:
! 2669: [282] sm1_rank(@@);
! 2670: 4
! 2671:
! 2672: @end example
! 2673:
! 2674: */
! 2675:
! 2676:
! 2677: def sm1_rank(A) {
! 2678: SM1_FIND_PROC(P);
! 2679: sm1_push_int0(P,A);
! 2680: sm1(P," rank toString .. ");
! 2681: ox_check_errors2(P);
! 2682: R = sm1_pop(P);
! 2683: return(R);
! 2684: }
! 2685:
! 2686: def sm1_rrank(A) {
! 2687: SM1_FIND_PROC(P);
! 2688: sm1_push_int0(P,A);
! 2689: sm1(P," rrank toString .. ");
! 2690: ox_check_errors2(P);
! 2691: R = sm1_pop(P);
! 2692: return(R);
! 2693: }
! 2694:
! 2695:
! 2696: /*&eg-texi
! 2697: @menu
! 2698: * sm1_rank::
! 2699: @end menu
! 2700: @node sm1_rank,,, SM1 Functions
! 2701: @subsection @code{sm1_rank}
! 2702: @findex sm1_rank
! 2703: @table @t
! 2704: @item sm1_rank(@var{a}|proc=@var{p})
! 2705: :: Returns the holonomic rank of the system of differential equations @var{a}.
! 2706: @end table
! 2707:
! 2708: @table @var
! 2709: @item return
! 2710: Number
! 2711: @item p
! 2712: Number
! 2713: @item a
! 2714: List
! 2715: @end table
! 2716:
! 2717: @itemize @bullet
! 2718: @item It evaluates the dimension of the space of holomorphic solutions
! 2719: at a generic point of the system of differential equations @var{a}.
! 2720: The dimension is called the holonomic rank.
! 2721: @item @var{a} is a list consisting of a list of differential equations and
! 2722: a list of variables.
! 2723: @item @code{sm1_rrank} returns the holonomic rank when @var{a} is regular
! 2724: holonomic. It is generally faster than @code{sm1_rank}.
! 2725: @end itemize
! 2726: */
! 2727:
! 2728: /*&jp-texi
! 2729: @menu
! 2730: * sm1_rank::
! 2731: @end menu
! 2732: @node sm1_rank,,, SM1 $BH!?t(B
! 2733: @subsection @code{sm1_rank}
! 2734: @findex sm1_rank
! 2735: @table @t
! 2736: @item sm1_rank(@var{a}|proc=@var{p})
! 2737: :: $BHyJ,J}Dx<07O(B @var{a} $B$N(B holonomic rank $B$rLa$9(B.
! 2738: @end table
! 2739:
! 2740: @table @var
! 2741: @item return
! 2742: $B?t(B
! 2743: @item p
! 2744: $B?t(B
! 2745: @item a
! 2746: $B%j%9%H(B
! 2747: @end table
! 2748:
! 2749: @itemize @bullet
! 2750: @item $BHyJ,J}Dx<07O(B @var{a} $B$N(B, generic point $B$G$N@5B'2r$N<!85$r(B
! 2751: $BLa$9(B. $B$3$N<!85$r(B, holonomic rank $B$H8F$V(B.
! 2752: @item @var{a} $B$OHyJ,:nMQAG$N%j%9%H$HJQ?t$N%j%9%H$h$j$J$k(B.
! 2753: @item @var{a} $B$,(B regular holonomic $B$N$H$-$O(B @code{sm1_rrank}
! 2754: $B$b(B holonomic rank $B$rLa$9(B.
! 2755: $B$$$C$Q$s$K$3$N4X?t$NJ}$,(B @code{sm1_rank} $B$h$jAa$$(B.
! 2756: @end itemize
! 2757: */
! 2758:
! 2759: /*&C-texi
! 2760:
! 2761: @example
! 2762:
! 2763: [284] sm1_gkz([ [[1,1,1,1],[0,1,3,4]], [0,2] ]);
! 2764: [[x4*dx4+x3*dx3+x2*dx2+x1*dx1,4*x4*dx4+3*x3*dx3+x2*dx2-2,
! 2765: -dx1*dx4+dx2*dx3, -dx2^2*dx4+dx1*dx3^2,dx1^2*dx3-dx2^3,-dx2*dx4^2+dx3^3],
! 2766: [x1,x2,x3,x4]]
! 2767: [285] sm1_rrank(@@);
! 2768: 4
! 2769:
! 2770: [286] sm1_gkz([ [[1,1,1,1],[0,1,3,4]], [1,2]]);
! 2771: [[x4*dx4+x3*dx3+x2*dx2+x1*dx1-1,4*x4*dx4+3*x3*dx3+x2*dx2-2,
! 2772: -dx1*dx4+dx2*dx3,-dx2^2*dx4+dx1*dx3^2,dx1^2*dx3-dx2^3,-dx2*dx4^2+dx3^3],
! 2773: [x1,x2,x3,x4]]
! 2774: [287] sm1_rrank(@@);
! 2775: 5
! 2776:
! 2777: @end example
! 2778:
! 2779: */
! 2780:
! 2781: def sm1_auto_reduce(T) {
! 2782: SM1_FIND_PROC(P);
! 2783: sm1(P,"[(AutoReduce) "+rtostr(T)+" ] system_variable ");
! 2784: ox_check_errors2(P);
! 2785: R = sm1_pop(P);
! 2786: return(R);
! 2787: }
! 2788:
! 2789: /*&eg-texi
! 2790: @menu
! 2791: * sm1_auto_reduce::
! 2792: @end menu
! 2793: @node sm1_auto_reduce,,, SM1 Functions
! 2794: @subsection @code{sm1_auto_reduce}
! 2795: @findex sm1_auto_reduce
! 2796: @table @t
! 2797: @item sm1_auto_reduce(@var{s}|proc=@var{p})
! 2798: :: Set the flag "AutoReduce" to @var{s}.
! 2799: @end table
! 2800:
! 2801: @table @var
! 2802: @item return
! 2803: Number
! 2804: @item p
! 2805: Number
! 2806: @item s
! 2807: Number
! 2808: @end table
! 2809:
! 2810: @itemize @bullet
! 2811: @item If @var{s} is 1, then all Grobner bases to be computed
! 2812: will be the reduced Grobner bases.
! 2813: @item If @var{s} is 0, then Grobner bases are not necessarily the reduced
! 2814: Grobner bases. This is the default.
! 2815: @end itemize
! 2816: */
! 2817:
! 2818: /*&jp-texi
! 2819: @menu
! 2820: * sm1_auto_reduce::
! 2821: @end menu
! 2822: @node sm1_auto_reduce,,, SM1 $BH!?t(B
! 2823: @subsection @code{sm1_auto_reduce}
! 2824: @findex sm1_auto_reduce
! 2825: @table @t
! 2826: @item sm1_auto_reduce(@var{s}|proc=@var{p})
! 2827: :: $B%U%i%0(B "AutoReduce" $B$r(B @var{s} $B$K@_Dj(B.
! 2828: @end table
! 2829:
! 2830: @table @var
! 2831: @item $BLa$jCM(B
! 2832: $B?t(B
! 2833: @item p
! 2834: $B?t(B
! 2835: @item s
! 2836: $B?t(B
! 2837: @end table
! 2838:
! 2839: @itemize @bullet
! 2840: @item @var{s} $B$,(B 1 $B$N$H$-(B, $B0J8e7W;;$5$l$k%0%l%V%J4pDl$O$9$Y$F(B,
! 2841: reduced $B%0%l%V%J4pDl$H$J$k(B.
! 2842: @item @var{s} $B$,(B 0 $B$N$H$-(B, $B7W;;$5$l$k%0%l%V%J4pDl$O(B
! 2843: reduced $B%0%l%V%J4pDl$H$O$+$.$i$J$$(B. $B$3$A$i$,%G%U%)!<%k%H(B.
! 2844: @end itemize
! 2845: */
! 2846:
! 2847:
! 2848: def sm1_slope(II,V,FF,VF) {
! 2849: SM1_FIND_PROC(P);
! 2850: A =[II,V,FF,VF];
! 2851: sm1_push_int0(P,A);
! 2852: sm1(P," slope toString ");
! 2853: ox_check_errors2(P);
! 2854: R = eval_str(sm1_pop(P));
! 2855: return(R);
! 2856: }
! 2857:
! 2858:
! 2859: /*&eg-texi
! 2860: @menu
! 2861: * sm1_slope::
! 2862: @end menu
! 2863: @node sm1_slope,,, SM1 Functions
! 2864: @subsection @code{sm1_slope}
! 2865: @findex sm1_slope
! 2866: @table @t
! 2867: @item sm1_slope(@var{ii},@var{v},@var{f_filtration},@var{v_filtration}|proc=@var{p})
! 2868: :: Returns the slopes of differential equations @var{ii}.
! 2869: @end table
! 2870:
! 2871: @table @var
! 2872: @item return
! 2873: List
! 2874: @item p
! 2875: Number
! 2876: @item ii
! 2877: List (equations)
! 2878: @item v
! 2879: List (variables)
! 2880: @item f_filtration
! 2881: List (weight vector)
! 2882: @item v_filtration
! 2883: List (weight vector)
! 2884: @end table
! 2885:
! 2886: @itemize @bullet
! 2887: @item @code{sm1_slope} returns the (geometric) slopes
! 2888: of the system of differential equations @var{ii}
! 2889: along the hyperplane specified by
! 2890: the V filtration @var{v_filtration}.
! 2891: @item @var{v} is a list of variables.
! 2892: @item As to the algorithm,
! 2893: see "A.Assi, F.J.Castro-Jimenez and J.M.Granger,
! 2894: How to calculate the slopes of a D-module, Compositio Math, 104, 1-17, 1996"
! 2895: Note that the signs of the slopes are negative, but the absolute values
! 2896: of the slopes are returned.
! 2897: @item The return value is a list of lists.
! 2898: The first entry of each list is the slope and the second entry
! 2899: is the weight vector for which the microcharacteristic variety is
! 2900: not bihomogeneous.
! 2901: @end itemize
! 2902: */
! 2903:
! 2904: /*&jp-texi
! 2905: @menu
! 2906: * sm1_slope::
! 2907: @end menu
! 2908: @node sm1_slope,,, SM1 $BH!?t(B
! 2909: @subsection @code{sm1_slope}
! 2910: @findex sm1_slope
! 2911: @table @t
! 2912: @item sm1_slope(@var{ii},@var{v},@var{f_filtration},@var{v_filtration}|proc=@var{p})
! 2913: :: $BHyJ,J}Dx<07O(B @var{ii} $B$N(B slope $B$rLa$9(B.
! 2914: @end table
! 2915:
! 2916: @table @var
! 2917: @item return
! 2918: $B?t(B
! 2919: @item p
! 2920: $B?t(B
! 2921: @item ii
! 2922: $B%j%9%H(B ($BJ}Dx<0(B)
! 2923: @item v
! 2924: $B%j%9%H(B ($BJQ?t(B)
! 2925: @item f_filtration
! 2926: $B%j%9%H(B (weight vector)
! 2927: @item v_filtration
! 2928: $B%j%9%H(B (weight vector)
! 2929: @end table
! 2930:
! 2931: @itemize @bullet
! 2932: @item @code{sm1_slope} $B$O(B
! 2933: $BHyJ,J}Dx<07O(B @var{ii} $B$N(B V filtration @var{v_filtration}
! 2934: $B$G;XDj$9$kD6J?LL$K1h$C$F$N(B (geomeric) slope $B$r7W;;$9$k(B.
! 2935: @item @var{v} $B$OJQ?t$N%j%9%H(B.
! 2936: @item $B;HMQ$7$F$$$k%"%k%4%j%:%`$K$D$$$F$O(B,
! 2937: "A.Assi, F.J.Castro-Jimenez and J.M.Granger,
! 2938: How to calculate the slopes of a D-module, Compositio Math, 104, 1-17, 1996"
! 2939: $B$r$_$h(B.
! 2940: Slope $B$NK\Mh$NDj5A$G$O(B, $BId9f$,Ii$H$J$k$,(B, $B$3$N%W%m%0%i%`$O(B,
! 2941: Slope $B$N@dBPCM$rLa$9(B.
! 2942: @item $BLa$jCM$O(B, $B%j%9%H$r@.J,$H$9$k%j%9%H$G$"$k(B.
! 2943: $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
! 2944: microcharacteristic variety $B$,(B bihomogeneous $B$G$J$$(B.
! 2945: @end itemize
! 2946: */
! 2947:
! 2948: /*&C-texi
! 2949:
! 2950: @example
! 2951:
! 2952: [284] A= sm1_gkz([ [[1,2,3]], [-3] ]);
! 2953:
! 2954:
! 2955: [285] sm1_slope(A[0],A[1],[0,0,0,1,1,1],[0,0,-1,0,0,1]);
! 2956:
! 2957: [286] A2 = sm1_gkz([ [[1,1,1,0],[2,-3,1,-3]], [1,0]]);
! 2958: (* This is an interesting example given by Laura Matusevich,
! 2959: June 9, 2001 *)
! 2960:
! 2961: [287] sm1_slope(A2[0],A2[1],[0,0,0,0,1,1,1,1],[0,0,0,-1,0,0,0,1]);
! 2962:
! 2963:
! 2964: @end example
! 2965:
! 2966: */
! 2967: /*&eg-texi
! 2968: @table @t
! 2969: @item Reference
! 2970: @code{sm_gb}
! 2971: @end table
! 2972: */
! 2973: /*&jp-texi
! 2974: @table @t
! 2975: @item $B;2>H(B
! 2976: @code{sm_gb}
! 2977: @end table
! 2978: */
! 2979:
! 2980:
! 2981: end$
! 2982:
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