[BACK]Return to sm1.oxweave CVS log [TXT][DIR] Up to [local] / OpenXM / src / asir-contrib / packages / doc

Annotation of OpenXM/src/asir-contrib/packages/doc/sm1.oxweave, Revision 1.7

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>