[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.4

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

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