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

File: [local] / OpenXM / src / asir-contrib / packages / doc / Attic / sm1.oxweave (download)

Revision 1.3, Thu Jul 12 00:46:29 2001 UTC (22 years, 11 months ago) by takayama
Branch: MAIN
CVS Tags: RELEASE_1_2_1
Changes since 1.2: +9 -5 lines

Added a new optional variable dehomogenize to sm1_gb.

/*$OpenXM: OpenXM/src/asir-contrib/packages/doc/sm1.oxweave,v 1.3 2001/07/12 00:46:29 takayama Exp $ */

/*&C-texi
@c DO NOT EDIT THIS FILE   oxphc.texi
*/
/*&jp-texi
@node SM1 $BH!?t(B,,, Top
@chapter SM1 $BH!?t(B

$B$3$N@a$G$O(B sm1 $B$N(B ox $B%5!<%P(B @code{ox_sm1_forAsir}
$B$H$N%$%s%?%U%'!<%94X?t$r2r@b$9$k(B.
$B$3$l$i$N4X?t$O%U%!%$%k(B  @file{sm1} $B$GDj5A$5$l$F$$$k(B.
@file{sm1} $B$O(B @file{$(OpenXM_HOME)/lib/asir-contrib} $B$K$"$k(B.
$B%7%9%F%`(B @code{sm1} $B$OHyJ,:nMQAG4D$G7W;;$9$k$?$a$N%7%9%F%`$G$"$k(B.
$B7W;;Be?t4v2?$N$$$m$$$m$JITJQNL$N7W;;$,HyJ,:nMQAG$N7W;;$K5"Ce$9$k(B.
@code{sm1} $B$K$D$$$F$NJ8=q$O(B @code{OpenXM/doc/kan96xx} $B$K$"$k(B.

$B$H$3$KCG$j$,$J$$$+$.$j$3$N@a$N$9$Y$F$N4X?t$O(B,
$BM-M}?t78?t$N<0$rF~NO$H$7$F$&$1$D$1$J$$(B.
$B$9$Y$F$NB?9`<0$N78?t$O@0?t$G$J$$$H$$$1$J$$(B.

@tex
$B6u4V(B
$X:={\bf C} \setminus \{ 0, 1 \} = {\bf C} \setminus V(x(x-1))$
$B$N%I%i!<%`%3%[%b%m%872C#$N<!85$r7W;;$7$F$_$h$&(B.
$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
$B$^$o$kFs$D$N%k!<%W$,(B1$B<!85$N%[%b%m%8!<72$N6u4V$r$O$k(B.
$B$7$?$,$C$F(B, 1$B<!85%I%i!<%`%3%[%b%m%872$N<!85$O(B $2$ $B$G$"$k(B.
@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
$B<!85$rEz$($k(B.
@end tex
*/
/*&eg-texi
@node SM1 Functions,,, Top
@chapter SM1 Functions

This chapter describes  interface functions for
sm1 ox server @code{ox_sm1_forAsir}.
These interface functions are defined in the file @file{sm1}.
The file @file{sm1} is @*
at @file{$(OpenXM_HOME)/lib/asir/contrib-packages}.
The system @code{sm1} is a system to compute in the ring of differential
operators.
Many constructions of invariants 
in the computational algebraic geometry reduce
to constructions in the ring of differential operators.
Documents on @code{sm1} are in
the directory @code{OpenXM/doc/kan96xx}.

All the coefficients of input polynomials should be
integers for most functions in this section.
Other functions accept rational numbers as inputs
and it will be explicitely noted in each explanation
of these functions.



@tex
Let us evaluate the dimensions of the de Rham cohomology groups
of 
$X:={\bf C} \setminus \{ 0, 1 \} = {\bf C} \setminus V(x(x-1))$.
The space $X$ is a two punctured plane, so two loops that encircles the
points $x=0$ and $x=1$ respectively spans the first homology group.
Hence, the dimension of the first de Rham cohomology group is $2$.
@code{sm1} answers the dimensions of the 0th and the first
cohomology groups.
@end tex
*/
/*&C-texi
@example

This is Risa/Asir, Version 20000126.
Copyright (C) FUJITSU LABORATORIES LIMITED.
1994-1999. All rights reserved.
xm version 20000202. Copyright (C) OpenXM Developing Team. 2000.
ox_help(0); ox_help("keyword"); ox_grep("keyword"); for help message 
Loading ~/.asirrc

[283] sm1_deRham([x*(x-1),[x]]);
[1,2]
@end example
*/
/*&C-texi
@noindent
The author of @code{sm1} : Nobuki Takayama, @code{takayama@@math.sci.kobe-u.ac.jp} @*
The author of sm1 packages : Toshinori Oaku, @code{oaku@@twcu.ac.jp} @*
Reference: [SST] Saito, M., Sturmfels, B., Takayama, N., 
Grobner Deformations of Hypergeometric Differential Equations,
1999, Springer.
See the appendix.
*/
/*&jp-texi
@section @code{ox_sm1_forAsir} $B%5!<%P(B
*/ 
/*&eg-texi
@section @code{ox_sm1_forAsir} Server
*/ 

/*&eg-texi
@menu
* ox_sm1_forAsir::
@end menu
@node ox_sm1_forAsir,,, Top
@subsection @code{ox_sm1_forAsir}
@findex ox_sm1_forAsir
@table @t
@item ox_sm1_forAsir
::  @code{sm1} server for @code{asir}.
@end table
@itemize @bullet
@item
   @code{ox_sm1_forAsir} is the @code{sm1} server started from asir
    by the command @code{sm1_start}.
    In the standard setting,  @*
    @code{ox_sm1_forAsir} =
         @file{$(OpenXM_HOME)/lib/sm1/bin/ox_sm1}
       +
         @file{$(OpenXM_HOME)/lib/sm1/callsm1.sm1}   (macro file) @* 
       +
         @file{$(OpenXM_HOME)/lib/sm1/callsm1b.sm1}  (macro file) @*
   The macro files @file{callsm1.sm1} and @file{callsm1b.sm1} 
   are searched from
   current directory, @code{$(LOAD_SM1_PATH)}, 
   @code{$(OpenXM_HOME)/lib/sm1},
   @code{/usr/local/lib/sm1}
   in this order.
@item Note for programmers:  See the files
    @file{$(OpenXM_HOME)/src/kxx/oxserver00.c},
    @file{$(OpenXM_HOME)/src/kxx/sm1stackmachine.c}
to build your own server by reading @code{sm1} macros.
@end itemize
*/
/*&jp-texi
@menu
* ox_sm1_forAsir::
@end menu
@node ox_sm1_forAsir,,, Top
@subsection @code{ox_sm1_forAsir}
@findex ox_sm1_forAsir
@table @t
@item ox_sm1_forAsir
::  @code{asir} $B$N$?$a$N(B @code{sm1} $B%5!<%P(B.
@end table
@itemize @bullet
@item
   $B%5!<%P(B @code{ox_sm1_forAsir} $B$O(B @code{asir} $B$h$j%3%^%s%I(B
    @code{sm1_start} $B$G5/F0$5$l$k(B @code{sm1} $B%5!<%P$G$"$k(B.

    $BI8=`E*@_Dj$G$O(B, @*
    @code{ox_sm1_forAsir} =
         @file{$(OpenXM_HOME)/lib/sm1/bin/ox_sm1}
       +
         @file{$(OpenXM_HOME)/lib/sm1/callsm1.sm1}   (macro file) @* 
       +
         @file{$(OpenXM_HOME)/lib/sm1/callsm1b.sm1}  (macro file) @*
  $B$G$"$j(B, $B$3$l$i$N%^%/%m%U%!%$%k$O(B, $B0lHL$K$O(B
   current directory, @code{$(LOAD_SM1_PATH)}, 
   @code{$(OpenXM_HOME)/lib/sm1},
   @code{/usr/local/lib/sm1}
    $B$N=gHV$G$5$,$5$l$k(B.
@item $B%W%m%0%i%^!<$N$?$a$N%N!<%H(B: 
@code{sm1} $B%^%/%m$rFI$_9~$s$G<+J,FH<+$N%5!<%P$r:n$k$K$O(B
    $B<!$N%U%!%$%k$b8+$h(B
    @file{$(OpenXM_HOME)/src/kxx/oxserver00.c},
    @file{$(OpenXM_HOME)/src/kxx/sm1stackmachine.c}
@end itemize
*/

def sm1_check_server(P) {
  M=ox_get_serverinfo(P);
  if (M == []) {
    return(sm1_start());
  }
  if (M[0][1] != "Ox_system=ox_sm1_ox_sm1_forAsir") {
    print("Warning: the server number ",0)$
    print(P,0)$
    print(" is not ox_sm1_forAsir server.")$
    print("Starting ox_sm1_forAsir server on the localhost.")$
    return(sm1_start());
  }
  return(P);
}

/*&jp-texi
@section $BH!?t0lMw(B
*/ 
/*&eg-texi
@section Functions
*/ 

/*&eg-texi
@c sort-sm1_start
@menu
* sm1_start::
@end menu
@node sm1_start,,, SM1 Functions
@subsection @code{sm1_start}
@findex sm1_start
@table @t
@item sm1_start()
::  Start  @code{ox_sm1_forAsir} on the localhost.
@end table

@table @var
@item return
Integer
@end table

@itemize @bullet
@item Start @code{ox_sm1_forAsir} on the localhost.
    It returns the descriptor of @code{ox_sm1_forAsir}.
@item Set @code{Xm_noX = 1} to start @code{ox_sm1_forAsir} 
without a debug window.
@item You might have to set suitable orders of variable by the command
@code{ord}.  For example, 
when you are working in the
ring of differential operators on the variable @code{x} and @code{dx}
(@code{dx} stands for 
@tex $\partial/\partial x$ 
@end tex 
),
@code{sm1} server assumes that
the variable @code{dx} is collected to the right and the variable
@code{x} is collected to the left in the printed expression.
In the example below, you  must not use the variable @code{cc}
for computation in @code{sm1}.
@item The variables from @code{a} to @code{z} except @code{d} and @code{o}
and @code{x0}, ..., @code{x20}, @code{y0}, ..., @code{y20},
@code{z0}, ..., @code{z20} can be used as variables for ring of
differential operators in default. (cf. @code{Sm1_ord_list} in @code{sm1}).
@item The descriptor is stored in @code{Sm1_proc}.
@end itemize
*/
/*&jp-texi
@c sort-sm1_start
@menu
* sm1_start::
@end menu
@node sm1_start,,, SM1 $BH!?t(B
@subsection @code{sm1_start}
@findex sm1_start
@table @t
@item sm1_start()
::  localhost $B$G(B  @code{ox_sm1_forAsir} $B$r%9%?!<%H$9$k(B.
@end table

@table @var
@item return
$B@0?t(B
@end table

@itemize @bullet
@item localhost $B$G(B @code{ox_sm1_forAsir} $B$r%9%?!<%H$9$k(B.
$B%5!<%P(B @code{ox_sm1_forAsir} $B$N<1JLHV9f$rLa$9(B.
@item @code{Xm_noX = 1} $B$H$*$/$H%5!<%P(B @code{ox_sm1_forAsir} $B$r%G%P%C%0MQ$N(B
$B%&%#%s%I%&$J$7$K5/F0$G$-$k(B.
@item $B%3%^%s%I(B @code{ord} $B$rMQ$$$FJQ?t=g=x$r@5$7$/@_Dj$7$F$*$/I,MW$,(B
$B$"$k(B.
$B$?$H$($P(B,
$BJQ?t(B @code{x} $B$H(B @code{dx} $B>e$NHyJ,:nMQAG4D(B
(@code{dx} $B$O(B 
@tex $\partial/\partial x$ 
@end tex 
$B$KBP1~(B)
$B$G7W;;$7$F$$$k$H$-(B,
@code{sm1} $B%5!<%P$O<0$r0u:~$7$?$H$-(B,
$BJQ?t(B @code{dx} $B$O1&B&$K=8$a$lJQ?t(B
@code{x} $B$O:8B&$K$"$D$a$i$l$F$$$k$H2>Dj$7$F$$$k(B.
$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.
@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,
$B$=$l$+$i(B, @code{x0}, ..., @code{x20}, @code{y0}, ..., @code{y20},
@code{z0}, ..., @code{z20} $B$O(B, $B%G%U%)!<%k%H$GHyJ,:nMQAG4D$NJQ?t$H$7$F(B
$B;H$($k(B (cf. @code{Sm1_ord_list} in @code{sm1}).
@item $B<1JLHV9f$O(B @code{Sm1_proc} $B$K3JG<$5$l$k(B.
@end itemize
*/
/*&C-texi
@example
[260] ord([da,a,db,b]);
[da,a,db,b,dx,dy,dz,x,y,z,dt,ds,t,s,u,v,w, 
......... omit ..................
]
[261] a*da;
a*da
[262] cc*dcc;
dcc*cc
[263] sm1_mul(da,a,[a]);     
a*da+1                  
[264] sm1_mul(a,da,[a]);
a*da
@end example
*/
/*&eg-texi
@table @t
@item Reference
    @code{ox_launch}, @code{sm1_push_int0}, @code{sm1_push_poly0},
    @code{ord}
@end table
*/
/*&jp-texi
@table @t
@item $B;2>H(B
    @code{ox_launch}, @code{sm1_push_int0}, @code{sm1_push_poly0},
    @code{ord}
@end table
*/


def sm1_start() {
 extern Sm1_lib;
 extern Xm_noX;
 extern Sm1_proc;
 if (Xm_noX) {
   P = ox_launch_nox(0,Sm1_lib+"/bin/ox_sm1_forAsir");
 }else{
   P = ox_launch(0,Sm1_lib+"/bin/ox_sm1_forAsir");
 }
 if (Xm_noX) {
   sm1(P," oxNoX ");
 }
 ox_check_errors(P);
 Sm1_proc = P;
 return(P);
}


/*   ox_sm1  */
/* P is the process number */
def sm1flush(P) {
  ox_execute_string(P,"[(flush)] extension pop");
}

def sm1push(P,F) {
  G = ox_ptod(F);
  ox_push_cmo(P,G);  
}

/*&eg-texi
@c sort-sm1
@menu
* sm1::
@end menu
@node sm1,,, SM1 Functions
@subsection @code{sm1}
@findex sm1
@table @t
@item sm1(@var{p},@var{s})
::  ask the @code{sm1} server to execute the command string @var{s}.
@end table

@table @var
@item return
Void
@item p
Number
@item s
String
@end table

@itemize @bullet
@item  It asks the @code{sm1} server of the descriptor number @var{p}
to execute the command string @var{s}.
@end itemize
*/
/*&jp-texi
@menu
* sm1::
@end menu
@node sm1,,, SM1 $BH!?t(B
@subsection @code{sm1}
@findex sm1
@table @t
@item sm1(@var{p},@var{s})
::  $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.
@end table

@table @var
@item return
$B$J$7(B
@item p
$B?t(B
@item s
$BJ8;zNs(B
@end table

@itemize @bullet
@item  $B<1JLHV9f(B @var{p} $B$N(B @code{sm1} $B%5!<%P$K(B
$B%3%^%s%INs(B @var{s} $B$r<B9T$7$F$/$l$k$h$&$KMj$`(B.
@end itemize
*/
/*&C-texi
@example
[261] sm1(0," ( (x-1)^2 ) . ");
0
[262] ox_pop_string(0);
x^2-2*x+1
[263] sm1(0," [(x*(x-1))  [(x)]] deRham ");
0
[264] ox_pop_string(0);
[1 , 2]
@end example
*/
def sm1(P,F) {
  ox_execute_string(P,F);
  sm1flush(P);
}
/*&jp-texi
@table @t
@item $B;2>H(B
    @code{sm1_start}, @code{ox_push_int0}, @code{sm1_push_poly0}. 
@end table
*/
/*&eg-texi
@table @t
@item Reference
    @code{sm1_start}, @code{ox_push_int0}, @code{sm1_push_poly0}. 
@end table
*/

def sm1pop(P) {
  return(ox_pop_cmo(P));
}

def sm1_to_asir_form(V) { return(toAsirForm(V)); }
def toAsirForm(V) {
  extern ToAsirForm_V; /* for debug */
  if (type(V) == 4) { /* list */
    if((length(V) == 3) && (V[0] == "sm1_dp")) {
       /* For debugging. */
       if (ToAsir_Debug != 0) {
         ToAsirForm_V = V;
         print(map(type,V[1]));
         print(V);
       }
       /*  */
       Vlist = map(strtov,V[1]);
       return(dp_dtop(V[2],Vlist));
    } else {
       return(map(toAsirForm,V));
    }
  }else{
    return(V);
  }
}

def sm1_toOrdered(V) {
  if (type(V) == 4) { /* list */
    if((length(V) == 3) && (V[0] == "sm1_dp")) {
       Vlist = map(strtov,V[1]);
       Ans = "";
       F = V[2];
       while (F != 0) {
          G = dp_hm(F);
          F = dp_rest(F);
          if (dp_hc(G)>0) {
            Ans += "+";
          }
          Ans += rtostr(dp_dtop(G,Vlist));
       }
       return Ans; 
    } else {
       return(map(sm1_toOrdered,V));
    }
  }else{
    return(V);
  }
}


def sm1_push_poly0_R(A,P,Vlist) {
  return(sm1_push_poly0(P,A,Vlist));
}
def sm1_push_poly0(P,A,Vlist) {
  if (type(Vlist[0]) == 4) {
      Vlist = Vlist[2];   
  }
  /* 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]]
                list of str (sm1)   list of str (asir)    list of var (asir)
     then we execute the code above.
  */
 if (type(A) == 2 || type(A) == 1) { /* recursive poly  or number*/
   A = dp_ptod(A,Vlist);
   ox_push_cmo(P,A);
   return;
 }
 if (type(A) == 0) { /* zero */
   sm1(P," (0). ");
   return;
 }
 if (type(A) == 4) { /* list */
   ox_execute_string(P," [ ");
   map(sm1_push_poly0_R,A,P,Vlist);
   ox_execute_string(P," ] ");
   return;
 }
 ox_push_cmo(P,A);
 ox_check_errors2(P);
 return;
}
/* sm1_push_poly0(0,[0,1,x+y,["Hello",y^3]],[x,y]); */

def sm1_pop_poly0(P,Vlist) {
  if (type(Vlist[0]) == 4) {
      Vlist = Vlist[2];   
  }
  A = ox_pop_cmo(P);
  return(sm1_pop_poly0_0(P,A,Vlist));
}
def sm1_pop_poly0_0_R(A,P,Vlist) {
  return(sm1_pop_poly0_0(P,A,Vlist));
}
def sm1_pop_poly0_0(P,A,Vlist) {
  if (type(A) == 4) {
    return(map(sm1_pop_poly0_0_R,A,P,Vlist));
  }
  if (type(A)== 9) {return(dp_dtop(A,Vlist));}
  return(A);
}

def sm1_push_int0_R(A,P) {
  return(sm1_push_int0(P,A));
}

/*&eg-texi
@c sort-sm1_push_int0
@menu
* sm1_push_int0::
@end menu
@node sm1_push_int0,,, SM1 Functions
@subsection @code{sm1_push_int0}
@findex sm1_push_int0
@table @t
@item sm1_push_int0(@var{p},@var{f})
::   push the object @var{f} to the server with the descriptor number @var{p}.
@end table

@table @var
@item return
Void
@item p
Number
@item f
Object
@end table

@itemize @bullet
@item When @code{type(@var{f})} is 2 (recursive polynomial),
    @var{f} is converted to a string (type == 7) 
    and is sent to the server by @code{ox_push_cmo}.
@item When @code{type(@var{f})} is 0 (zero), 
     it is translated to the 32 bit integer zero
    on the server.  
    Note that @code{ox_push_cmo(@var{p},0)} sends @code{CMO_NULL} to the server.
In other words, the server does not get the 32 bit integer 0 nor
the bignum 0.
@item  @code{sm1} integers are classfied into the 32 bit integer and
the bignum.
When @code{type(@var{f})} is 1 (number), it is translated to the
32 bit integer on the server.
Note that @code{ox_push_cmo(@var{p},1234)} send the bignum 1234 to the
@code{sm1} server.
@item In other cases,  @code{ox_push_cmo} is called without data conversion.
@end itemize
*/
/*&jp-texi
@c sort-sm1_push_int0
@menu
* sm1_push_int0::
@end menu
@node sm1_push_int0,,, SM1 $BH!?t(B
@subsection @code{sm1_push_int0}
@findex sm1_push_int0
@table @t
@item sm1_push_int0(@var{p},@var{f})
::   $B%*%V%8%'%/%H(B @var{f} $B$r<1JL;R(B @var{p} $B$N%5!<%P$XAw$k(B.
@end table

@table @var
@item return
$B$J$7(B
@item p
$B?t(B
@item f
$B%*%V%8%'%/%H(B
@end table

@itemize @bullet
@item @code{type(@var{f})} $B$,(B 2 ($B:F5"B?9`<0(B) $B$N$H$-(B,
    @var{f} $B$OJ8;zNs(B (type == 7) $B$KJQ49$5$l$F(B,
    @code{ox_push_cmo} $B$rMQ$$$F%5!<%P$XAw$i$l$k(B.
@item @code{type(@var{f})} $B$,(B 0 (zero) $B$N$H$-$O(B, 
    $B%5!<%P>e$G$O(B, 32 bit $B@0?t$H2r<a$5$l$k(B.
    $B$J$*(B @code{ox_push_cmo(P,0)} $B$O%5!<%P$KBP$7$F(B @code{CMO_NULL}
$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.
@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.
@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
$B$*$/$k(B.
@code{ox_push_cmo(@var{p},1234)} $B$O(B bignum $B$N(B 1234 $B$r(B
@code{sm1} $B%5!<%P$K$*$/$k$3$H$KCm0U$7$h$&(B.
@item $B$=$NB>$N>l9g$K$O(B  @code{ox_push_cmo} $B$r%G!<%?7?$NJQ49$J$7$K8F$S=P$9(B.
@end itemize
*/
/*&C
@example
[219] P=sm1_start();
0
[220] sm1_push_int0(P,x*dx+1);
0
[221] A=ox_pop_cmo(P);
x*dx+1
[223] type(A);
7   (string)
@end example

@example
[271] sm1_push_int0(0,[x*(x-1),[x]]);
0
[272] ox_execute_string(0," deRham ");
0
[273] ox_pop_cmo(0);
[1,2]
@end example
*/
/*&eg-texi
@table @t
@item Reference
    @code{ox_push_cmo}
@end table
*/
/*&jp-texi
@table @t
@item Reference
    @code{ox_push_cmo}
@end table
*/


def sm1_push_int0(P,A) {
 if (type(A) == 1 || type(A) == 0) { 
   /* recursive poly  or number or 0*/
   A = rtostr(A);
   ox_push_cmo(P,A);
   sm1(P," . (integer) dc ");
   return;
 }
 if (type(A) == 2) {
   A = rtostr(A); ox_push_cmo(P,A);
   return;
 }
 if (type(A) == 4) { /* list */
   ox_execute_string(P," [ ");
   map(sm1_push_int0_R,A,P);
   ox_execute_string(P," ] ");
   return;
 }
 ox_push_cmo(P,A);
 return;
}

def sm1_push_0_R(A,P) {
  return(sm1_push_0(P,A));
}
def sm1_push_0(P,A) {
 if (type(A) == 0) { 
   /* 0 */
   A = rtostr(A);
   ox_push_cmo(P,A);
   sm1(P," .. ");
   return;
 }
 if (type(A) == 2) {
   /* Vlist = vars(A); One should check Vlist is a subset of Vlist3. */
   Vlist2 = sm1_vlist(P);
   Vlist3 = map(strtov,Vlist2[1]);
   B = dp_ptod(A,Vlist3);
   ox_push_cmo(P,B);
   return;
 }
 if (type(A) == 4) { /* list */
   ox_execute_string(P," [ ");
   map(sm1_push_0_R,A,P);
   ox_execute_string(P," ] ");
   return;
 }
 ox_push_cmo(P,A);
 return;
}

def sm1_push(P,A) {
  sm1_push_0(P,A);
}


def sm1_pop(P) {
  extern V_sm1_pop;
  sm1(P," toAsirForm ");
  V_sm1_pop = ox_pop_cmo(P);
  return(toAsirForm(V_sm1_pop));
}

def sm1_pop2(P) {
  extern V_sm1_pop;
  sm1(P," toAsirForm ");
  V_sm1_pop = ox_pop_cmo(P);
  return([toAsirForm(V_sm1_pop),V_sm1_pop]);
}

def sm1_check_arg_gb(A,Fname) {
  /* A = [[x^2+y^2-1,x*y],[x,y],[[x,-1,y,-1]]] */
  if (type(A) != 4) {
     error(Fname+" : argument should be a list.");
  }
  if (length(A) < 2) {
     error(Fname+" : argument should be a list of 2 or 3 elements.");
  }
  if (type(A[0]) != 4) {
     error(Fname+" : example: [[dx^2+dy^2-4,dx*dy-1]<== it should be a list,[x,y]]");
  }
  if (!sm1_isListOfPoly(A[0])) {
     error(Fname+" : example: [[dx^2+dy^2-4,dx*dy-1]<== it should be a list of polynomials or strings,[x,y]]");
  }
  if (!sm1_isListOfVar(A[1])) {
     error(Fname+" : example: [[dx^2+dy^2-4,dx*dy-1],[x,y]<== list of variables or \"x,y\"]");
  }
  if (length(A) >= 3) {
    if (type(A[2]) != 4) {
      error(Fname+" : example:[[dx^2+dy^2-4,dx*dy-1],[x,y],[[x,-1,dx,1]]<== a list of weights]");
    }
    if (type(A[2][0]) != 4) {
      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]");
    }
  }
  return(1);
}

def sm1_isListOfPoly(A) {
  if (type(A) !=4 ) return(0);
  N = length(A);
  for (I=0; I<N; I++) {
    if (!(type(A[I]) == 0 || type(A[I]) == 1 || type(A[I]) == 2 ||
          type(A[I]) == 7 || type(A[I]) == 9)) {
      return(0);
    }
  }
  return(1);
}

def sm1_isListOfVar(A) {
  if (type(A) == 7) return(1); /* "x,y" */
  if (type(A) != 4) return(0);
  N = length(A);
  for (I=0; I<N; I++) {
    if (!(type(A[I]) == 2 ||  type(A[I]) == 7 )) {
      return(0);
    }
  }
  return(1);
}

/*&eg-texi
@c sort-sm1_gb
@menu
* sm1_gb::
@end menu
@node sm1_gb,,, SM1 Functions
@node sm1_gb_d,,, SM1 Functions
@subsection @code{sm1_gb}
@findex sm1_gb
@findex sm1_gb_d
@table @t
@item sm1_gb([@var{f},@var{v},@var{w}]|proc=@var{p},sorted=@var{q},dehomogenize=@var{r})
::  computes the Grobner basis of @var{f} in the ring of differential
operators with the variable @var{v}.
@item sm1_gb_d([@var{f},@var{v},@var{w}]|proc=@var{p})
::  computes the Grobner basis of @var{f} in the ring of differential
operators with the variable @var{v}. 
The result will be returned as a list of distributed polynomials.
@end table

@table @var
@item return
List
@item p, q, r
Number
@item f, v, w
List
@end table

@itemize @bullet
@item
   It returns the Grobner basis of the set of polynomials @var{f} 
   in the ring of deferential operators with the variables @var{v}.
@item
   The weight vectors are given by @var{w}, which can be omitted.
    If @var{w} is not given, 
    the graded reverse lexicographic order will be used to compute Grobner basis.   
@item
   The return value of @code{sm1_gb}
    is the list of the Grobner basis of @var{f} and the initial
    terms (when @var{w} is not given) or initial ideal (when @var{w} is given).
@item
   @code{sm1_gb_d} returns the results by a list of distributed polynomials.
    Monomials in each distributed polynomial are ordered in the given order.
    The return value consists of
    [variable names, order matrix, grobner basis in districuted polynomials,
     initial monomials or initial polynomials].
@item
   When a non-term order is given, the Grobner basis is computed in 
   the homogenized Weyl algebra  (See Section 1.2 of the book of SST).
   The homogenization variable h is automatically added.
@item
   When the optional variable @var{q} is set, @code{sm1_gb} returns,
   as the third return value, a list of
   the Grobner basis and the initial ideal
   with sums of monomials sorted by the given order.
   Each polynomial is expressed as a string temporally for now.
   When the optional variable @var{r} is set to one,
   the polynomials are dehomogenized (,i.e., h is set to 1).
@end itemize
*/
/*&jp-texi
@c sort-sm1_gb
@menu
* sm1_gb::
@end menu
@node sm1_gb,,, SM1 $BH!?t(B
@node sm1_gb_d,,, SM1 $BH!?t(B
@subsection @code{sm1_gb}
@findex sm1_gb
@findex sm1_gb_d
@table @t
@item sm1_gb([@var{f},@var{v},@var{w}]|proc=@var{p},sorted=@var{q},dehomogenize=@var{r})
::  @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N%0%l%V%J4pDl$r7W;;$9$k(B.
@item sm1_gb_d([@var{f},@var{v},@var{w}]|proc=@var{p})
::  @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.
@end table

@table @var
@item return
$B%j%9%H(B
@item p, q, r
$B?t(B
@item f, v, w
$B%j%9%H(B
@end table

@itemize @bullet
@item
   @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N%0%l%V%J4pDl$r7W;;$9$k(B.
@item
   Weight $B%Y%/%H%k(B @var{w} $B$O>JN,$7$F$h$$(B.
   $B>JN,$7$?>l9g(B, graded reverse lexicographic order $B$r$D$+$C$F(B
   $B%V%l%V%J4pDl$r7W;;$9$k(B.
@item
   @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
  ( @var{w} $B$,$J$$$H$-(B ) $B$^$?$O(B $B%$%K%7%!%kB?9`<0(B ( @var{w} $B$,M?$($i$?$H$-(B)
  $B$N%j%9%H$G$"$k(B.
@item
   @code{sm1_gb_d} $B$O7k2L$rJ,;6B?9`<0$N%j%9%H$GLa$9(B.
    $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.
   $BLa$jCM$O(B
    [$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]
   $B$G$"$k(B.
@item
   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).
$BF1<!2=JQ?t(B @code{h} $B$,7k2L$K2C$o$k(B.
@item $B%*%W%7%g%J%kJQ?t(B @var{q} $B$,%;%C%H$5$l$F$$$k$H$-$O(B,
    3 $BHVL\$NLa$jCM$H$7$F(B, $B%0%l%V%J4pDl$*$h$S%$%K%7%!%k$N%j%9%H$,(B
    $BM?$($i$l$?=g=x$G%=!<%H$5$l$?%b%N%_%"%k$NOB$H$7$FLa$5$l$k(B.
    $B$$$^$N$H$3$m$3$NB?9`<0$O(B, $BJ8;zNs$GI=8=$5$l$k(B.
    $B%*%W%7%g%J%kJQ?t(B @var{r} $B$,%;%C%H$5$l$F$$$k$H$-$O(B,
    $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).
@end itemize
*/
/*&C-texi
@example
[293] sm1_gb([[x*dx+y*dy-1,x*y*dx*dy-2],[x,y]]);
[[x*dx+y*dy-1,y^2*dy^2+2],[x*dx,y^2*dy^2]]
@end example
*/
/*&eg-texi
In the example above,
@tex the set $\{ x \partial_x + y \partial_y -1,
                 y^2 \partial_y^2+2\}$ 
is the Gr\"obner basis of the input with respect to the 
graded reverse lexicographic order such that
$ 1 \leq \partial_y \leq \partial_x \leq y \leq x \leq \cdots$.
The set $\{x \partial_x, y^2 \partial_y\}$ is the leading monomials
(the initial monominals) of the Gr\"obner basis.
@end tex
*/
/*&jp-texi
$B>e$NNc$K$*$$$F(B,
@tex $B=89g(B $\{ x \partial_x + y \partial_y -1,
                 y^2 \partial_y^2+2\}$ 
$B$O(B
$ 1 \leq \partial_y \leq \partial_x \leq y \leq x \leq \cdots$
$B$G$"$k$h$&$J(B
graded reverse lexicographic order $B$K4X$9$k%0%l%V%J4pDl$G$"$k(B.
$B=89g(B $\{x \partial_x, y^2 \partial_y\}$ $B$O%0%l%V%J4pDl$N3F85$K(B
$BBP$9$k(B leading monomial (initial monomial) $B$G$"$k(B.
@end tex
*/
/*&C-texi
@example
[294] sm1_gb([[dx^2+dy^2-4,dx*dy-1],[x,y],[[dx,50,dy,2,x,1]]]);
[[dx+dy^3-4*dy,-dy^4+4*dy^2-1],[dx,-dy^4]]
@end example
*/
/*&eg-texi
In the example above, two monomials 
@tex
$m = x^a y^b \partial_x^c \partial_y^d$ and 
$m' = x^{a'} y^{b'} \partial_x^{c'} \partial_y^{d'}$
are firstly compared by the weight vector 
{\tt (dx,dy,x,y) = (50,2,1,0)}
(i.e., $m$ is larger than $m'$ if $50c+2d+a > 50c'+2d'+a'$)
and when the comparison is tie, then these are 
compared by the reverse lexicographic order
(i.e., if $50c+2d+a = 50c'+2d'+a'$, then use the reverse lexicogrpahic order).
@end tex
*/
/*&jp-texi
$B>e$NNc$K$*$$$FFs$D$N%b%N%_%"%k(B
@tex
$m = x^a y^b \partial_x^c \partial_y^d$ $B$*$h$S(B
$m' = x^{a'} y^{b'} \partial_x^{c'} \partial_y^{d'}$
$B$O:G=i$K(B weight vector
{\tt (dx,dy,x,y) = (50,2,1,0)} $B$rMQ$$$FHf3S$5$l$k(B
($B$D$^$j(B $m$ $B$O(B $50c+2d+a > 50c'+2d'+a'$ $B$N$H$-(B
 $m'$ $B$h$jBg$-$$(B )
$B<!$K$3$NHf3S$G>!Ii$,$D$+$J$$$H$-$O(B reverse lexicographic order $B$GHf3S$5$l$k(B
($B$D$^$j(B $50c+2d+a = 50c'+2d'+a'$ $B$N$H$-(B reverse lexicographic order $B$GHf3S(B
$B$5$l$k(B).
@end tex
*/
/*&C-texi
@example
[294] F=sm1_gb([[dx^2+dy^2-4,dx*dy-1],[x,y],[[dx,50,dy,2,x,1]]]|sorted=1);
      map(print,F[2][0])$
      map(print,F[2][1])$
@end example
*/
/*&C-texi
@example
[595]
   sm1_gb([["dx*(x*dx +y*dy-2)-1","dy*(x*dx + y*dy -2)-1"],
             [x,y],[[dx,1,x,-1],[dy,1]]]);

[[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],
 [x*dx^2+(y*dy-h^2)*dx,x*dy*dx+y*dy^2-h^2*dy-h^3,h^3*dx]]

[596]
   sm1_gb_d([["dx (x dx +y dy-2)-1","dy (x dx + y dy -2)-1"],
             "x,y",[[dx,1,x,-1],[dy,1]]]);
[[[e0,x,y,H,E,dx,dy,h],
 [[0,-1,0,0,0,1,0,0],[0,0,0,0,0,0,1,0],[1,0,0,0,0,0,0,0],
  [0,1,1,1,1,1,1,0],[0,0,0,0,0,0,-1,0],[0,0,0,0,0,-1,0,0],
  [0,0,0,0,-1,0,0,0],[0,0,0,-1,0,0,0,0],[0,0,-1,0,0,0,0,0],
  [0,0,0,0,0,0,0,1]]],
[[(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)*
<<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
,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
,1,3>>],
 [(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)*<
<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
,0,0,0,0,3>>,(1)*<<0,0,0,0,0,1,0,3>>]]]
@end example
*/

/*&eg-texi
@table @t
@item Reference
    @code{sm1_reduction}, @code{sm1_rat_to_p}
@end table
*/
/*&jp-texi
@table @t
@item $B;2>H(B
    @code{sm1_reduction}, @code{sm1_rat_to_p}
@end table
*/


def sm1_gb(A) {
  SM1_FIND_PROC(P);
  P = sm1_check_server(P);
  sm1_check_arg_gb(A,"Error in sm1_gb");
  sm1_push_int0(P,A);
  sm1(P," gb ");
  T = sm1_pop2(P);
  return(append(T[0],[sm1_toOrdered(T[1])]));
}
def sm1_gb_d(A) {
  SM1_FIND_PROC(P);
  P = sm1_check_server(P);
  sm1_check_arg_gb(A,"Error in sm1_gb_d");
  sm1_push_int0(P,A);
  sm1(P," gb /gb.tmp1 set ");
  sm1(P," gb.tmp1 getOrderMatrix {{(universalNumber) dc} map } map /gb.tmp2 set ");
  sm1(P," gb.tmp1 0 get 0 get getvNamesCR { [(class) (indeterminate)] dc } map /gb.tmp3 set ");
  sm1(P," gb.tmp1 getRing ring_def "); /* Change the current ring! */
  sm1(P,"[[ gb.tmp3 gb.tmp2] gb.tmp1] ");
  return(ox_pop_cmo(P));
}

def sm1_pgb(A) {
  SM1_FIND_PROC(P);
  P = sm1_check_server(P);
  sm1_check_arg_gb(A,"Error in sm1_pgb");
  sm1(P," set_timer ");
  sm1_push_int0(P,A);
  sm1(P," pgb ");
  B = sm1_pop(P);
  sm1(P," set_timer ");
  return(B);
}

/*&eg-texi
@c sort-sm1_deRham
@menu
* sm1_deRham::
@end menu
@node sm1_deRham,,, SM1 Functions
@subsection @code{sm1_deRham}
@findex sm1_deRham
@table @t
@item sm1_deRham([@var{f},@var{v}]|proc=@var{p})
::  ask the server to evaluate the dimensions of the de Rham cohomology  groups
of C^n - (the zero set of @var{f}=0).
@end table

@table @var
@item return
List
@item p
Number
@item f
String or polynomial
@item v
List
@end table

@itemize @bullet
@item  It returns the dimensions of the de Rham cohomology groups
    of X = C^n \ V(@var{f}).
   In other words,  it returns
      [dim H^0(X,C), dim H^1(X,C), dim H^2(X,C), ..., dim H^n(X,C)].
@item   @var{v} is a list of variables. n = @code{length(@var{v})}.
@item
   @code{sm1_deRham} requires huge computer resources.
    For example, @code{sm1_deRham(0,[x*y*z*(x+y+z-1)*(x-y),[x,y,z]])}
    is already very hard.
@item
 To efficiently analyze the roots of b-function, @code{ox_asir} should be used 
  from @code{ox_sm1_forAsir}.
    It is recommended to load the communication module for @code{ox_asir}
    by the command @*
   @code{sm1(0,"[(parse) (oxasir.sm1) pushfile] extension");}
 This command is automatically executed when @code{ox_sm1_forAsir} is started.
@item If you make an interruption to the function @code{sm1_deRham}
by @code{ox_reset(Sm1_proc);}, the server might get out of the standard
mode. So, it is strongly recommended to execute the command
@code{ox_shutdown(Sm1_proc);} to interrupt and restart the server.
@end itemize
*/
/*&jp-texi
@c sort-sm1_deRham
@menu
* sm1_deRham::
@end menu
@node sm1_deRham,,, SM1 $BH!?t(B
@subsection @code{sm1_deRham}
@findex sm1_deRham
@table @t
@item sm1_deRham([@var{f},@var{v}]|proc=@var{p})
::  $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.
@end table

@table @var
@item return
$B%j%9%H(B
@item p
$B?t(B
@item f
$BJ8;zNs(B $B$^$?$O(B $BB?9`<0(B
@item v
$B%j%9%H(B
@end table

@itemize @bullet
@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.
   $B$9$J$o$A(B,
   [dim H^0(X,C), dim H^1(X,C), dim H^2(X,C), ..., dim H^n(X,C)]
   $B$rLa$9(B.
@item   @var{v} $B$OJQ?t$N%j%9%H(B. n = @code{length(@var{v})} $B$G$"$k(B.
@item
   @code{sm1_deRham} $B$O7W;;5!$N;q8;$rBgNL$K;HMQ$9$k(B.
    $B$?$H$($P(B @code{sm1_deRham(0,[x*y*z*(x+y+z-1)*(x-y),[x,y,z]])}
   $B$N7W;;$9$i$9$G$KHs>o$KBgJQ$G$"$k(B.
@item
  b-$B4X?t$N:,$r8zN($h$/2r@O$9$k$K$O(B, @code{ox_asir} $B$,(B @code{ox_sm1_forAsir}
  $B$h$j;HMQ$5$l$k$Y$-$G$"$k(B.  $B%3%^%s%I(B @*
   @code{sm1(0,"[(parse) (oxasir.sm1) pushfile] extension");}
   $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.
   $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.
@item
  @code{sm1_deRham} $B$r(B @code{ox_reset(Sm1_proc);} $B$GCfCG$9$k$H(B, 
  $B0J8e(B sm1 $B%5!<%P$,HsI8=`%b!<%I$KF~$jM=4|$7$J$$F0:n$r$9$k>l9g(B
  $B$,$"$k$N$G(B, $B%3%^%s%I(B @code{ox_shutdown(Sm1_proc);} $B$G(B, @code{ox_sm1_forAsir}
  $B$r0l;~(B shutdown $B$7$F%j%9%?!<%H$7$?J}$,0BA4$G$"$k(B.
@end itemize
*/
/*&C-texi
@example
[332] sm1_deRham([x^3-y^2,[x,y]]);
[1,1,0]
[333] sm1_deRham([x*(x-1),[x]]);
[1,2]
@end example
*/
/*&eg-texi
@table @t
@item Reference
    @code{sm1_start}, @code{deRham} (sm1 command)
@item Reference paper
    Oaku, Takayama, An algorithm for de Rham cohomology groups of the
    complement of an affine variety via D-module computation, 
    Journal of pure and applied algebra 139 (1999), 201--233.
@end table
*/
/*&jp-texi
@table @t
@item $B;2>H(B
    @code{sm1_start}, @code{deRham} (sm1 command)
@item $B;29MO@J8(B
    Oaku, Takayama, An algorithm for de Rham cohomology groups of the
    complement of an affine variety via D-module computation, 
    Journal of pure and applied algebra 139 (1999), 201--233.
@end table
*/


def sm1_deRham(A) {
  SM1_FIND_PROC(P);
  P = sm1_check_server(P);
  sm1(P," set_timer ");
  sm1_push_int0(P,A);
  sm1(P," deRham ");
  B = sm1_pop(P);
  sm1(P," set_timer ");
  ox_check_errors2(P);
  return(B);
}

def sm1_vlist(P) {
  sm1(P," getvNamesC ");
  B=ox_pop_cmo(P);
  sm1(P," getvNamesC toAsirVar ");
  C=ox_pop_cmo(P);
  return([B,C,map(strtov,C)]);
}
/* [ sm1 names(string), asir names(string),  asir names(var)] */
/* Vlist = sm1_vlist(P);
   sm1_push_poly0( x + 20*x, Vlist[2]); 
   sm1_pop_poly0(Vlist[2]);
*/

/* ring of Differential operators */
def sm1_ringD(V,W) {
  SM1_FIND_PROC(P);
  sm1(P," [ ");
  if (type(V) == 7) { /* string */
    ox_push_cmo(P,V);
  }else  if (type(V) == 4) {/* list */
    V = map(rtostr,V);
    ox_push_cmo(P,V);
    sm1(P," from_records ");
  }else { printf("Error: sm1_ringD"); return(-1); }
  sm1(P," ring_of_differential_operators ");
  if (type(W) != 0) {
    sm1_push_int0(P,W);  sm1(P," weight_vector ");
  }
  sm1(P," pstack ");
  sm1(P," 0 ] define_ring getOrderMatrix {{(universalNumber) dc}map}map ");
  ox_check_errors2(P);
  M = ox_pop_cmo(P);
  return([sm1_vlist(P)[2],M]);
}    

def sm1_expand_d(F) {
  SM1_FIND_PROC(P);
  ox_push_cmo(P,F);
  sm1(P, " expand ");
  return(ox_pop_cmo(P));
}  

def sm1_mul_d(A,B) {
  SM1_FIND_PROC(P);
  ox_push_cmo(P,A);
  ox_push_cmo(P,B);
  sm1(P," mul ");
  return(ox_pop_cmo(P));
}

def sm1_dehomogenize_d(A) {
  SM1_FIND_PROC(P);
  ox_push_cmo(P,A);
  sm1(P," dehomogenize ");
  return(ox_pop_cmo(P));
}

def sm1_homogenize_d(A) {
  SM1_FIND_PROC(P);
  ox_push_cmo(P,A);
  sm1(P," homogenize ");
  return(ox_pop_cmo(P));
}

def sm1_groebner_d(A) {
  SM1_FIND_PROC(P);
  ox_push_cmo(P,A);
  sm1(P," groebner ");
  return(ox_pop_cmo(P));
}

def sm1_reduction_d(F,G) {
  SM1_FIND_PROC(P);
  ox_push_cmo(P,F);
  ox_push_cmo(P,G);
  sm1(P," reduction ");
  return(ox_pop_cmo(P));
}

def sm1_reduction_noH_d(F,G) {
  SM1_FIND_PROC(P);
  ox_push_cmo(P,F);
  ox_push_cmo(P,G);
  sm1(P," reduction-noH ");
  return(ox_pop_cmo(P));
}


/*&eg-texi
@c sort-sm1_hilbert
@menu
* sm1_hilbert::
* hilbert_polynomial::
@end menu
@node sm1_hilbert,,, SM1 Functions
@subsection @code{sm1_hilbert}
@findex sm1_hilbert
@findex hilbert_polynomial
@table @t
@item sm1_hilbert([@var{f},@var{v}]|proc=@var{p})
::  ask the server to compute the Hilbert polynomial for the set of polynomials @var{f}.
@item hilbert_polynomial(@var{f},@var{v})
::  ask the server to compute the Hilbert polynomial for the set of polynomials @var{f}.
@end table

@table @var
@item return
Polynomial
@item p
Number
@item f, v
List
@end table

@itemize @bullet
@item  It returns the Hilbert polynomial h(k) of the set of polynomials 
    @var{f}
    with respect to the set of variables @var{v}.
@item
    h(k) = dim_Q F_k/I \cap F_k  where F_k the set of polynomials of which
    degree is less than or equal to k and I is the ideal generated by the
    set of polynomials @var{f}.
@item
   Note for sm1_hilbert:
   For an efficient computation, it is preferable that 
   the set of polynomials @var{f} is a set of monomials.
   In fact, this function firstly compute a Grobner basis of @var{f}, and then
   compute the Hilbert polynomial of the initial monomials of the basis. 
   If the input @var{f} is already a Grobner
   basis, a Grobner basis is recomputed in this function, 
   which is a waste of time and Grobner basis computation in the ring of
   polynomials in @code{sm1} is  slower than in @code{asir}.
@end itemize
*/
/*&jp-texi
@c sort-sm1_hilbert
@menu
* sm1_hilbert::
* hilbert_polynomial::
@end menu
@node sm1_hilbert,,, SM1 $BH!?t(B
@subsection @code{sm1_hilbert}
@findex sm1_hilbert
@findex hilbert_polynomial
@table @t
@item sm1_hilbert([@var{f},@var{v}]|proc=@var{p})
:: $BB?9`<0$N=89g(B @var{f} $B$N%R%k%Y%k%HB?9`<0$r7W;;$9$k(B.
@item hilbert_polynomial(@var{f},@var{v})
:: $BB?9`<0$N=89g(B @var{f} $B$N%R%k%Y%k%HB?9`<0$r7W;;$9$k(B.
@end table

@table @var
@item return
$BB?9`<0(B
@item p
$B?t(B
@item f, v
$B%j%9%H(B
@end table

@itemize @bullet
@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)
   $B$r7W;;$9$k(B.
@item
    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
    $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.
@item
   sm1_hilbert $B$K$+$s$9$k%N!<%H(B:
   $B8zN($h$/7W;;$9$k$K$O(B @var{f} $B$O%b%N%_%"%k$N=89g$K$7$?J}$,$$$$(B.
   $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 
   monomial $BC#$N%R%k%Y%k%HB?9`<0$r7W;;$9$k(B. 
  $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
   $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
  $BB?9`<0%0%l%V%J4pDl7W;;$O(B @code{asir} $B$h$jCY$$(B.
@end itemize
*/

/*&C-texi
@example

[346] load("katsura")$
[351] A=hilbert_polynomial(katsura(5),[u0,u1,u2,u3,u4,u5]);
32

@end example

@example
[279] load("katsura")$
[280] A=gr(katsura(5),[u0,u1,u2,u3,u4,u5],0)$
[281] dp_ord();
0
[282] B=map(dp_ht,map(dp_ptod,A,[u0,u1,u2,u3,u4,u5]));
[(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>>,
 (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>>,
 (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>>,
  (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>>,
  (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>>,
 (1)*<<0,1,0,0,0,4>>,(1)*<<0,0,0,0,0,6>>]
[283] C=map(dp_dtop,B,[u0,u1,u2,u3,u4,u5]);
[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,
 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,
 u5^4*u2,u5^4*u1,u5^6]
[284] sm1_hilbert([C,[u0,u1,u2,u3,u4,u5]]);
32
@end example
*/

/*&eg-texi
@table @t
@item Reference
    @code{sm1_start}, @code{sm1_gb}, @code{longname}
@end table
*/
/*&jp-texi
@table @t
@item $B;2>H(B
    @code{sm1_start}, @code{sm1_gb}, @code{longname}
@end table
*/

def sm1_hilbert(A) {
  SM1_FIND_PROC(P);
  P = sm1_check_server(P);
  sm1(P,"[ ");
  sm1_push_int0(P,A[0]);
  sm1_push_int0(P,A[1]);
  sm1(P," ] pgb /sm1_hilbert.gb set ");
  sm1(P," sm1_hilbert.gb 0 get { init toString } map ");
  sm1_push_int0(P,A[1]);
  sm1(P, " hilbert ");
  B = sm1_pop(P);
  return(B[1]/fac(B[0]));
}

/*&eg-texi
@c sort-sm1_genericAnn
@menu
* sm1_genericAnn::
@end menu
@node sm1_genericAnn,,, SM1 Functions
@subsection @code{sm1_genericAnn}
@findex sm1_genericAnn
@table @t
@item sm1_genericAnn([@var{f},@var{v}]|proc=@var{p})
::  It computes  the annihilating ideal for @var{f}^s.
    @var{v} is the list of variables.  Here, s is @var{v}[0] and
    @var{f} is a polynomial in the variables @code{rest}(@var{v}).
@end table

@table @var
@item return
List
@item p
Number
@item f
Polynomial
@item v
List
@end table

@itemize @bullet
@item  This function computes  the annihilating ideal for @var{f}^s.
    @var{v} is the list of variables.  Here, s is @var{v}[0] and
    @var{f} is a polynomial in the variables @code{rest}(@var{v}).
@end itemize
*/
/*&jp-texi
@c sort-sm1_genericAnn
@menu
* sm1_genericAnn::
@end menu
@node sm1_genericAnn,,, SM1 $BH!?t(B
@subsection @code{sm1_genericAnn}
@findex sm1_genericAnn
@table @t
@item sm1_genericAnn([@var{f},@var{v}]|proc=@var{p})
::  @var{f}^s $B$N$_$?$9HyJ,J}Dx<0A4BN$r$b$H$a$k(B.
    @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,
    @var{f} $B$OJQ?t(B @code{rest}(@var{v}) $B>e$NB?9`<0$G$"$k(B.
@end table

@table @var
@item return
$B%j%9%H(B
@item p
$B?t(B
@item f
$BB?9`<0(B
@item v
$B%j%9%H(B
@end table

@itemize @bullet
@item $B$3$NH!?t$O(B,
  @var{f}^s $B$N$_$?$9HyJ,J}Dx<0A4BN$r$b$H$a$k(B.
    @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,
    @var{f} $B$OJQ?t(B @code{rest}(@var{v}) $B>e$NB?9`<0$G$"$k(B.
@end itemize
*/
/*&C-texi
@example
[595] sm1_genericAnn([x^3+y^3+z^3,[s,x,y,z]]);
[-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]
@end example
*/
/*&eg-texi
@table @t
@item Reference
    @code{sm1_start}
@end table
*/
/*&jp-texi
@table @t
@item $B;2>H(B
    @code{sm1_start}
@end table
*/


def sm1_genericAnn(F) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,F[0]);
  sm1_push_int0(P,F[1]);
  sm1(P, " genericAnn ");
  B = sm1_pop(P);
  return(B);
}

def sm1_tensor0(F) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,F);
  sm1(P, " tensor0 ");
  B = sm1_pop(P);
  return(B);
}

/*&eg-texi
@c sort-sm1_wTensor0
@menu
* sm1_wTensor0::
@end menu
@node sm1_wTensor0,,, SM1 Functions
@subsection @code{sm1_wTensor0}
@findex sm1_wTensor0
@table @t
@item sm1_wTensor0([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
::   It computes the D-module theoretic 0-th tensor product
    of @var{f} and @var{g}.
@end table

@table @var
@item return
List
@item p
Number
@item f, g, v, w
List
@end table

@itemize @bullet
@item 
   It returns the D-module theoretic 0-th tensor product
   of @var{f} and @var{g}.
@item
  @var{v} is a list of variables.
  @var{w} is a list of weights.  The integer @var{w}[i] is
  the weight of the variable @var{v}[i].
@item 
   @code{sm1_wTensor0} calls @code{wRestriction0} of @code{ox_sm1}, 
   which requires a generic weight
    vector @var{w} to compute the restriction.
    If @var{w} is not generic, the computation fails.
@item Let F and G be solutions of @var{f} and @var{g} respectively.
Intuitively speaking, the 0-th tensor product is a system of
differential equations which annihilates the function FG.
@item The answer is a submodule of a free module D^r in general even if
the inputs @var{f} and @var{g} are left ideals of D.
@end itemize
*/

/*&jp-texi
@c sort-sm1_wTensor0
@menu
* sm1_wTensor0::
@end menu
@node sm1_wTensor0,,, SM1 $BH!?t(B
@subsection @code{sm1_wTensor0}
@findex sm1_wTensor0
@table @t
@item sm1_wTensor0([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
::   @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
$B7W;;$9$k(B.
@end table

@table @var
@item return
$B%j%9%H(B
@item p
$B?t(B
@item f, g, v, w
$B%j%9%H(B
@end table

@itemize @bullet
@item 
   @var{f} $B$H(B @var{g} $B$N(B
   D-$B2C72$H$7$F$N(B 0 $B<!%F%s%=%k@Q$r7W;;$9$k(B.
@item
  @var{v} $B$OJQ?t$N%j%9%H$G$"$k(B.
  @var{w} $B$O(B weight $B$N%j%9%H$G$"$k(B.  
  $B@0?t(B @var{w}[i] $B$OJQ?t(B @var{v}[i] $B$N(B weight $B$G$"$k(B.
@item 
   @code{sm1_wTensor0} $B$O(B @code{ox_sm1} $B$N(B @code{wRestriction0}
   $B$r$h$s$G$$$k(B.
  @code{wRestriction0} $B$O(B, generic $B$J(B weight $B%Y%/%H%k(B @var{w}
  $B$r$b$H$K$7$F@)8B$r7W;;$7$F$$$k(B.
  Weight $B%Y%/%H%k(B @var{w} $B$,(B generic $B$G$J$$$H7W;;$,%(%i!<$GDd;_$9$k(B.
@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.
$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.
@item $BF~NO(B @var{f}, @var{g} $B$,(B D $B$N:8%$%G%"%k$G$"$C$F$b(B,
$B0lHL$K(B, $B=PNO$O<+M32C72(B D^r $B$NItJ,2C72$G$"$k(B.
@end itemize
*/
/*&C-texi
@example
[258]  sm1_wTensor0([[x*dx -1, y*dy -4],[dx+dy,dx-dy^2],[x,y],[1,2]]);
[[-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],
 [-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],
 [y^2*dy^2+(-y^2-8*y)*dy+4*y+20]]
@end example
*/


def sm1_wTensor0(F) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,F);
  sm1(P, " wTensor0 ");
  B = sm1_pop(P);
  return(B);
}


/*&eg-texi
@c sort-sm1_reduction
@menu
* sm1_reduction::
@end menu
@node sm1_reduction,,, SM1 Functions
@subsection @code{sm1_reduction}
@findex sm1_reduction
@table @t
@item sm1_reduction([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
::  
@end table

@table @var
@item return
List
@item f
Polynomial
@item g, v, w
List
@item p
Number  (the process number of ox_sm1)
@end table

@itemize @bullet
@item  It reduces @var{f} by the set of polynomial @var{g}
in the homogenized Weyl algebra; it applies the
division algorithm to @var{f}. The set of variables is @var{v} and
@var{w} is weight vectors to determine the order, which can be ommited.
@code{sm1_reduction_noH} is for the Weyl algebra.
@item The return value is of the form
[r,c0,[c1,...,cm],[g1,...gm]] where @var{g}=[g1, ..., gm] and
r/c0 + c1 g1 + ... + cm gm = 0.
r/c0 is the normal form.
@item The function reduction reduces reducible terms that appear
in lower order terms.
@item  The functions 
sm1_reduction_d(P,F,G) and sm1_reduction_noH_d(P,F,G)
are for distributed polynomials.
@end itemize
*/
/*&jp-texi
@menu
* sm1_reduction::
@end menu
@node sm1_reduction,,, SM1 $BH!?t(B
@subsection @code{sm1_reduction}
@findex sm1_reduction
@table @t
@item sm1_reduction([@var{f},@var{g},@var{v},@var{w}]|proc=@var{p})
::  
@end table

@table @var
@item return
$B%j%9%H(B
@item f
$BB?9`<0(B
@item g, v, w
$B%j%9%H(B
@item p
$B?t(B  (ox_sm1 $B$N%W%m%;%9HV9f(B)
@end table

@itemize @bullet
@item  $B$3$NH!?t$O(B @var{f} $B$r(B homogenized $B%o%$%kBe?t$K$*$$$F(B,
$BB?9`<0=89g(B @var{g} $B$G4JC12=(B (reduce) $B$9$k(B; $B$D$^$j(B,
$B$3$NH!?t$O(B, @var{f} $B$K3d;;%"%k%4%j%:%`$rE,MQ$9$k(B.
$BJQ?t=89g$O(B @var{v} $B$G;XDj$9$k(B.
@var{w} $B$O=g=x$r;XDj$9$k$?$a$N(B $B%&%(%$%H%Y%/%H%k$G$"$j(B,
$B>JN,$7$F$b$h$$(B.
@code{sm1_reduction_noH} $B$O(B, Weyl algebra $BMQ(B.
@item $BLa$jCM$O<!$N7A$r$7$F$$$k(B:
[r,c0,[c1,...,cm],[g1,...gm]] $B$3$3$G(B @var{g}=[g1, ..., gm] $B$G$"$j(B,
r/c0 + c1 g1 + ... + cm gm = 0
$B$,$J$j$?$D(B.
r/c0 $B$,(B normal form $B$G$"$k(B.
@item $B$3$NH!?t$O(B, $BDc<!9`$K$"$i$o$l$k(B reducible $B$J9`$b4JC12=$9$k(B.
@item  $BH!?t(B
sm1_reduction_d(P,F,G) $B$*$h$S(B sm1_reduction_noH_d(P,F,G)
$B$O(B, $BJ,;6B?9`<0MQ$G$"$k(B.
@end itemize
*/
/*&C-texi
@example
[259] sm1_reduction([x^2+y^2-4,[y^4-4*y^2+1,x+y^3-4*y],[x,y]]);
[x^2+y^2-4,1,[0,0],[x+y^3-4*y,y^4-4*y^2+1]]
[260] sm1_reduction([x^2+y^2-4,[y^4-4*y^2+1,x+y^3-4*y],[x,y],[[x,1]]]);
[0,1,[-y^2+4,-x+y^3-4*y],[x+y^3-4*y,y^4-4*y^2+1]]
@end example
*/
/*&eg-texi
@table @t
@item Reference
    @code{sm1_start}, @code{sm1_find_proc}, @code{d_true_nf}
@end table
*/
/*&jp-texi
@table @t
@item $B;2>H(B
    @code{sm1_start}, @code{sm1_find_proc}, @code{d_true_nf}
@end table
*/

def sm1_reduction(A) {
  /* Example: sm1_reduction(A|proc=10) */
  SM1_FIND_PROC(P);
  /* check the arguments */
  if (type(A) != 4) {
   error("sm1_reduction(A|proc=p): A must be a list.");
  }
  AA = [rtostr(A[0])];
  AA = append(AA,[ map(rtostr,A[1]) ]);
  AA = append(AA, cdr(cdr(A)));
  sm1(P," /reduction*.noH 0 def ");
  sm1_push_int0(P,AA);
  sm1(P," reduction* ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}

def sm1_reduction_noH(A) {
  /* Example: sm1_reduction(A|proc=10) */
  SM1_FIND_PROC(P);
  /* check the arguments */
  if (type(A) != 4) {
   error("sm1_reduction_noH(A|proc=p): A must be a list.");
  }
  AA = [rtostr(A[0])];
  AA = append(AA,[ map(rtostr,A[1]) ]);
  AA = append(AA, cdr(cdr(A)));
  sm1(P," /reduction*.noH 1 def ");
  sm1_push_int0(P,AA);
  sm1(P," reduction* ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}

/*&eg-texi
@menu
* sm1_xml_tree_to_prefix_string::
@end menu
@node sm1_xml_tree_to_prefix_string,,, SM1 Functions
@subsection @code{sm1_xml_tree_to_prefix_string}
@findex sm1_xml_tree_to_prefix_string
@table @t
@item sm1_xml_tree_to_prefix_string(@var{s}|proc=@var{p})
:: Translate OpenMath Tree Expression @var{s} in XML to a prefix notation.
@end table

@table @var
@item return
String
@item p
Number
@item s
String
@end table

@itemize @bullet
@item  It translate OpenMath Tree Expression @var{s} in XML to a prefix notation.
@item This function should be moved to om_* in a future.
@item @code{om_xml_to_cmo(OpenMath Tree Expression)} returns CMO_TREE.
asir has not yet understood this CMO.
@item @code{java} execution environment is required.
(For example, @code{/usr/local/jdk1.1.8/bin} should be in the 
command search path.)
@end itemize
*/
/*&jp-texi
@menu
* sm1_xml_tree_to_prefix_string::
@end menu
@node sm1_xml_tree_to_prefix_string,,, SM1 $BH!?t(B
@subsection @code{sm1_xml_tree_to_prefix_string}
@findex sm1_xml_tree_to_prefix_string
@table @t
@item sm1_xml_tree_to_prefix_string(@var{s}|proc=@var{p})
:: XML $B$G=q$+$l$?(B OpenMath $B$NLZI=8=(B @var{s} $B$rA0CV5-K!$K$J$*$9(B.
@end table

@table @var
@item return
String
@item p
Number
@item s
String
@end table

@itemize @bullet
@item XML $B$G=q$+$l$?(B OpenMath $B$NLZI=8=(B @var{s} $B$rA0CV5-K!$K$J$*$9(B.
@item $B$3$NH!?t$O(B om_* $B$K>-Mh0\$9$Y$-$G$"$k(B.
@item @code{om_xml_to_cmo(OpenMath Tree Expression)} $B$O(B CMO_TREE
$B$rLa$9(B. @code{asir} $B$O$3$N(B CMO $B$r$^$@%5%]!<%H$7$F$$$J$$(B.
@item @code{java} $B$N<B9T4D6-$,I,MW(B.
($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.)
@end itemize
*/
/*&C-texi
@example
[263] load("om");
1
[270] F=om_xml(x^4-1);
control: wait OX
Trying to connect to the server... Done.
<OMOBJ><OMA><OMS name="plus" cd="basic"/><OMA>
<OMS name="times" cd="basic"/><OMA>
<OMS name="power" cd="basic"/><OMV name="x"/><OMI>4</OMI></OMA>
<OMI>1</OMI></OMA><OMA><OMS name="times" cd="basic"/><OMA>
<OMS name="power" cd="basic"/><OMV name="x"/><OMI>0</OMI></OMA>
<OMI>-1</OMI></OMA></OMA></OMOBJ>
[271] sm1_xml_tree_to_prefix_string(F);
basic_plus(basic_times(basic_power(x,4),1),basic_times(basic_power(x,0),-1))
@end example
*/
/*&eg-texi
@table @t
@item Reference
    @code{om_*}, @code{OpenXM/src/OpenMath}, @code{eval_str}
@end table
*/
/*&jp-texi
@table @t
@item $B;2>H(B
    @code{om_*}, @code{OpenXM/src/OpenMath},  @code{eval_str}
@end table
*/


def sm1_xml_tree_to_prefix_string(A) {
  SM1_FIND_PROC(P);
  /* check the arguments */
  if (type(A) != 7) {
   error("sm1_xml_tree_to_prefix_string(A|proc=p): A must be a string.");
  }
  ox_push_cmo(P,A);
  sm1(P," xml_tree_to_prefix_string ");
  ox_check_errors2(P);
  return(ox_pop_cmo(P));
}


def sm1_wbf(A) {
  SM1_FIND_PROC(P);
  /* check the arguments */
  if (type(A) != 4) {
   error("sm1_wbf(A): A must be a list.");
  }
  if (length(A) != 3) {
   error("sm1_wbf(A): A must be a list of the length 3.");
  }
  if (type(A[0]) != 4 || type(A[1]) != 4 || type(A[2]) != 4) {
   error("sm1_wbf([A,B,C]): A, B, C must be a list.");
  }
  if (! (type(A[2][0]) == 7 || type(A[2][0]) == 2)) {
   error("sm1_wbf([A,B,C]): C must be of a form [v-name, v-weight, ...]");
  }
  sm1_push_int0(P,A);
  sm1(P," wbf ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}
def sm1_wbfRoots(A) {
  SM1_FIND_PROC(P);
  /* check the arguments */
  if (type(A) != 4) {
   error("sm1_wbfRoots(A): A must be a list.");
  }
  if (length(A) != 3) {
   error("sm1_wbfRoots(A): A must be a list of the length 3.");
  }
  if (type(A[0]) != 4 || type(A[1]) != 4 || type(A[2]) != 4) {
   error("sm1_wbfRoots([A,B,C]): A, B, C must be a list.");
  }
  if (! (type(A[2][0]) == 7 || type(A[2][0]) == 2)) {
   error("sm1_wbfRoots([A,B,C]): C must be of a form [v-name, v-weight, ...]");
  }
  sm1_push_int0(P,A);
  sm1(P," wbfRoots ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}


def sm1_res_div(A) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,[[A[0],A[1]],A[2]]);
  sm1(P," res*div ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}


/*&eg-texi
@c sort-sm1_syz
@menu
* sm1_syz::
@end menu
@node sm1_syz,,, SM1 Functions
@node sm1_syz_d,,, SM1 Functions
@subsection @code{sm1_syz}
@findex sm1_syz
@findex sm1_syz_d
@table @t
@item sm1_syz([@var{f},@var{v},@var{w}]|proc=@var{p})
::  computes the syzygy of @var{f} in the ring of differential
operators with the variable @var{v}.
@end table

@table @var
@item return
List
@item p
Number
@item f, v, w
List
@end table

@itemize @bullet
@item
The return values is of the form
[@var{s},[@var{g}, @var{m}, @var{t}]].
Here @var{s} is the syzygy of @var{f} in the ring of differential
operators with the variable @var{v}. 
@var{g} is a Groebner basis of @var{f} with the weight vector @var{w},
and @var{m} is a matrix that translates the input matrix @var{f} to the Gr\"obner
basis @var {g}.
@var{t} is the syzygy of the Gr\"obner basis @var{g}.
In summary, @var{g} = @var{m} @var{f} and
@var{s} @var{f} = 0 hold as matrices.
@item
   The weight vectors are given by @var{w}, which can be omitted.
    If @var{w} is not given, 
    the graded reverse lexicographic order will be used to compute Grobner basis.   
@item
   When a non-term order is given, the Grobner basis is computed in 
   the homogenized Weyl algebra  (See Section 1.2 of the book of SST).
   The homogenization variable h is automatically added.
@end itemize
*/
/*&jp-texi
@c sort-sm1_syz
@menu
* sm1_syz::
@end menu
@node sm1_syz,,, SM1 $BH!?t(B
@node sm1_syz_d,,, SM1 $BH!?t(B
@subsection @code{sm1_syz}
@findex sm1_syz
@findex sm1_syz_d
@table @t
@item sm1_syz([@var{f},@var{v},@var{w}]|proc=@var{p})
::  @var{v} $B>e$NHyJ,:nMQAG4D$K$*$$$F(B @var{f} $B$N(B syzygy $B$r7W;;$9$k(B.
@end table

@table @var
@item return
$B%j%9%H(B
@item p
$B?t(B
@item f, v, w
$B%j%9%H(B
@end table

@itemize @bullet
@item
$BLa$jCM$O<!$N7A$r$7$F$$$k(B:
[@var{s},[@var{g}, @var{m}, @var{t}]].
$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
syzygy $B$G$"$k(B.
@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.
@var{m} $B$OF~NO9TNs(B @var{f} $B$r%0%l%V%J4pDl(B
@var{g} $B$XJQ49$9$k9TNs$G$"$k(B.
@var{t} $B$O%0%l%V%J4pDl(B @var{g} $B$N(B syzygy $B$G$"$k(B.
$B$^$H$a$k$H(B, $B<!$NEy<0$,$J$j$?$D(B:
@var{g} = @var{m} @var{f} ,
@var{s} @var{f} = 0.
@item
   Weight $B%Y%/%H%k(B @var{w} $B$O>JN,$7$F$h$$(B.
   $B>JN,$7$?>l9g(B, graded reverse lexicographic order $B$r$D$+$C$F(B
   $B%V%l%V%J4pDl$r7W;;$9$k(B.
@item
   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).
$BF1<!2=JQ?t(B @code{h} $B$,7k2L$K2C$o$k(B.
@end itemize
*/
/*&C-texi
@example
[293] sm1_syz([[x*dx+y*dy-1,x*y*dx*dy-2],[x,y]]);
[[[y*x*dy*dx-2,-x*dx-y*dy+1]],    generators of the syzygy
 [[[x*dx+y*dy-1],[y^2*dy^2+2]],   grobner basis
  [[1,0],[y*dy,-1]],              transformation matrix
 [[y*x*dy*dx-2,-x*dx-y*dy+1]]]]
@end example
*/
/*&C-texi
@example
[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]]]);
[[[y*x*dy*dx-1,-x^2*dx^2-x*dx-y^2*dy^2-y*dy+4]], generators of the syzygy
 [[[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
  [h^4*x*dx+y^3*dy^3+3*h^2*y^2*dy^2-3*h^4*y*dy]],
 [[1,0],[0,1],[y*dy,-x*dx]],     transformation matrix
 [[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]]]]
@end example
*/


def sm1_syz(A) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,A);
  sm1(P," syz ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}

def sm1_res_solv(A) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,[[A[0],A[1]],A[2]]);
  sm1(P," res*solv ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}

def sm1_res_solv_h(A) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,[[A[0],A[1]],A[2]]);
  sm1(P," res*solv*h ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}


def sm1_mul(A,B,V) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,[[A,B],V]);
  sm1(P," res*mul ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}

/*&eg-texi
@menu
* sm1_mul::
@end menu
@node sm1_mul,,, SM1 Functions
@subsection @code{sm1_mul}
@findex sm1_mul
@table @t
@item sm1_mul(@var{f},@var{g},@var{v}|proc=@var{p})
::  ask the sm1 server to multiply @var{f} and @var{g} in the ring of differential operators over @var{v}.
@end table

@table @var
@item return
Polynomial or List
@item p
Number
@item f, g
Polynomial or List
@item v
List
@end table

@itemize @bullet
@item Ask the sm1 server to multiply @var{f} and @var{g} in the ring of differential operators over @var{v}.
@item @code{sm1_mul_h} is for homogenized Weyl algebra.
@end itemize
*/

/*&jp-texi
@menu
* sm1_mul::
@end menu
@node sm1_mul,,, SM1 $BH!?t(B
@subsection @code{sm1_mul}
@findex sm1_mul
@table @t
@item sm1_mul(@var{f},@var{g},@var{v}|proc=@var{p})
::  sm1$B%5!<%P(B $B$K(B @var{f} $B$+$1$k(B @var{g} $B$r(B @var{v}
$B>e$NHyJ,:nMQAG4D$G$d$C$F$/$l$k$h$&$KMj$`(B.
@end table

@table @var
@item return
$BB?9`<0$^$?$O%j%9%H(B
@item p
$B?t(B
@item f, g
$BB?9`<0$^$?$O%j%9%H(B
@item v
$B%j%9%H(B
@end table

@itemize @bullet
@item   sm1$B%5!<%P(B $B$K(B @var{f} $B$+$1$k(B @var{g} $B$r(B @var{v}
$B>e$NHyJ,:nMQAG4D$G$d$C$F$/$l$k$h$&$KMj$`(B.
@item @code{sm1_mul_h} $B$O(B homogenized Weyl $BBe?tMQ(B.
@end itemize
*/

/*&C-texi

@example
[277] sm1_mul(dx,x,[x]);
x*dx+1
[278] sm1_mul([x,y],[1,2],[x,y]);
x+2*y
[279] sm1_mul([[1,2],[3,4]],[[x,y],[1,2]],[x,y]);
[[x+2,y+4],[3*x+4,3*y+8]]
@end example

*/

	
 
def sm1_mul_h(A,B,V) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,[[A,B],V]);
  sm1(P," res*mul*h ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}

def sm1_adjoint(A,V) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,[A,V]);
  sm1(P," res*adjoint ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}
 
def transpose(A) {
  if (type(A) == 4) {
    N = length(A); M = length(A[0]);
    B = newmat(N,M,A);
    C = newmat(M,N);
    for (I=0; I<N; I++) {
      for (J=0; J<M; J++) {
        C[J][I] = B[I][J];
      }
    }
    D = newvect(M);
    for (J=0; J<M; J++) {
      D[J] = C[J];
    }
    return(map(vtol,vtol(D)));
  }else{
    print(A)$
    error("tranpose: traspose for this argument has not been implemented.");
  }
}

def sm1_resol1(A) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,A);
  sm1(P," res*resol1 ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}


def sm1_gcd_aux(A,B) {
  if (type(A) == 1 && type(B) == 1) return(igcd(A,B));
  else return(gcd(A,B));
}

def sm1_lcm_aux(V) {  /* sm1_lcm_aux([3,5,6]); */
  N = length(V);
  if (N == 0) return(0);
  if (N == 1) return(V[0]);
  L = V[0];
  for (I=1; I<N; I++) {
    L = red(L*V[I]/sm1_gcd_aux(L,V[I]));
  } 
  return(L);
}

def sm1_mul_v(V,S) {
  if (type(V) == 4) {
    return(map(sm1_mul_v,V,S));
  } else {
    return(V*S);
  }
}

def sm1_div_v(V,S) {
  if (type(V) == 4) {
    return(map(sm1_div_v,V,S));
  } else {
    return(V/S);
  }
}


def sm1_rat_to_p_aux(T) {  /* cf. sm1_rat2plist2 */
  T = red(T);
  T1 = nm(T); T1a = ptozp(T1); 
  T1b = red(T1a/T1);
  T2 = dn(T); 
  return([T1a*dn(T1b),T2*nm(T1b)]);
}

def sm1_denom_aux0(A) {
  return(A[1]);
}
def sm1_num_aux0(P) {
  return(P[0]);
}

def sm1_rat_to_p(T) {
  if (type(T) == 4) {
     A = map(sm1_rat_to_p,T);
     D = map(sm1_denom_aux0,A);
     N = map(sm1_num_aux0,A);
     L = sm1_lcm_aux(D); 
     B = newvect(length(N));
     for (I=0; I<length(N); I++) {
       B[I] = sm1_mul_v(N[I],L/D[I]);
     }
     return([vtol(B),L]);
  }else{
     return(sm1_rat_to_p_aux(T));
  }
}



/* ---------------------------------------------- */
def sm1_distraction(A) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,A);
  sm1(P," distraction2* ");
  ox_check_errors2(P);
  return(sm1_pop(P));
}

/*&eg-texi
@menu
* sm1_distraction::
@end menu
@node sm1_distraction,,, SM1 Functions
@subsection @code{sm1_distraction}
@findex sm1_distraction
@table @t
@item sm1_distraction([@var{f},@var{v},@var{x},@var{d},@var{s}]|proc=@var{p})
::  ask the @code{sm1} server to compute the distraction of @var{f}.
@end table

@table @var
@item return
List
@item p
Number
@item f
Polynomial
@item v,x,d,s
List
@end table

@itemize @bullet
@item  It asks the @code{sm1} server of the descriptor number @var{p}
to compute the distraction of  @var{f} in the ring of differential
operators with variables @var{v}.
@item @var{x} is a list of x-variables and @var{d} is that of d-variables
to be distracted. @var{s} is a list of variables to express the distracted @var{f}.
@item Distraction is roughly speaking to replace x*dx by a single variable x.
See Saito, Sturmfels, Takayama : Grobner Deformations of Hypergeometric Differential Equations at page 68 for details.
@end itemize
*/

/*&jp-texi
@menu
* sm1_distraction::
@end menu
@node sm1_distraction,,, SM1 $BH!?t(B

@subsection @code{sm1_distraction}
@findex sm1_distraction
@table @t
@item sm1_distraction([@var{f},@var{v},@var{x},@var{d},@var{s}]|proc=@var{p})
::  @code{sm1} $B$K(B @var{f} $B$N(B distraction $B$r7W;;$7$F$b$i$&(B.
@end table

@table @var
@item return
$B%j%9%H(B
@item p
$B?t(B
@item f
$BB?9`<0(B
@item v,x,d,s
$B%j%9%H(B
@end table

@itemize @bullet
@item  $B<1JL;R(B @var{p}  $B$N(B @code{sm1}  $B%5!<%P$K(B,
@var{f} $B$N(B distraction $B$r(B @var{v} $B>e$NHyJ,:nMQAG4D$G7W;;$7$F$b$i$&(B.
@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
$B%j%9%H(B.  Distraction $B$7$?$i(B, @var{s} $B$rJQ?t$H$7$F7k2L$rI=$9(B.
@item Distraction $B$H$$$&$N$O(B x*dx $B$r(B x $B$GCV$-49$($k$3$H$G$"$k(B.
$B>\$7$/$O(B Saito, Sturmfels, Takayama : Grobner Deformations of Hypergeometric Differential Equations $B$N(B page 68 $B$r8+$h(B.
@end itemize
*/

/*&C-texi

@example
[280] sm1_distraction([x*dx,[x],[x],[dx],[x]]);
x
[281] sm1_distraction([dx^2,[x],[x],[dx],[x]]);
x^2-x
[282] sm1_distraction([x^2,[x],[x],[dx],[x]]);
x^2+3*x+2
[283] fctr(@@);
[[1,1],[x+1,1],[x+2,1]]
[284] sm1_distraction([x*dx*y+x^2*dx^2*dy,[x,y],[x],[dx],[x]]);
(x^2-x)*dy+x*y
@end example
*/

/*&eg-texi
@table @t
@item Reference
    @code{distraction2(sm1)}, 
@end table
*/

/*&jp-texi
@table @t
@item $B;2>H(B
    @code{distraction2(sm1)}, 
@end table
*/

/* Temporary functions */
/* Use this function for a while to wait a fix of asir. */
def sm1_ntoint32(I) {   /* Fixed */
  SM1_FIND_PROC(P);
  if (I >= 0) return(ntoint32(I));
  sm1(P," "+rtostr(I)+" ");
  return(ox_pop_cmo(P));
}
def sm1_to_ascii_array(S) {  /* Use strtoascii */
  SM1_FIND_PROC(P);
  ox_push_cmo(P,S);
  sm1(P," (array) dc { (universalNumber) dc } map ");
  return(ox_pop_cmo(P));
}
def sm1_from_ascii_array(S) {  /* Use asciitostr */
  SM1_FIND_PROC(P);
  ox_push_cmo(P,S);
  sm1(P," { (integer) dc (string) dc } map cat ");
  return(ox_pop_cmo(P));
}

/*
[288]  sm1_to_ascii_array("Hello");
[72,101,108,108,111]
[289] sm1_from_ascii_array(@@);
Hello
*/

/* end of temporary functions */

def sm1_gkz(S) {
  SM1_FIND_PROC(P);
  A = S[0];
  B = S[1];
  AA = [ ];
  BB = [ ];
  for (I=0; I<length(A); I++) {
    AA = append(AA,[map(ntoint32,A[I])]);
    BB = append(BB,[ntoint32(0)]);
  }
  sm1(P,"[ ");
  sm1_push_int0(P,AA);
  sm1_push_int0(P,BB);
  sm1(P," ] gkz ");
  ox_check_errors2(P);
  R = sm1_pop(P);
  RR0 = map(eval_str,R[0]);
  RR1 = map(eval_str,R[1]);
  RR3 = [ ];
  for (I=0; I<length(B); I++) {
    RR3 = append(RR3,[ sm1_rat_to_p(RR0[I]-B[I])[0] ]);
  }
  for (I=length(B); I<length(RR0); I++) {
    RR3 = append(RR3,[RR0[I]]);
  }
  return([RR3,RR1]);
}


/*&eg-texi
@menu
* sm1_gkz::
@end menu
@node sm1_gkz,,, SM1 Functions
@subsection @code{sm1_gkz}
@findex sm1_gkz
@table @t
@item sm1_gkz([@var{A},@var{B}]|proc=@var{p})
::  Returns the GKZ system (A-hypergeometric system) associated to the matrix 
@var{A} with the parameter vector @var{B}.
@end table

@table @var
@item return
List
@item p
Number
@item A, B
List
@end table

@itemize @bullet
@item Returns the GKZ hypergeometric system 
(A-hypergeometric system) associated to the matrix 
@end itemize
*/

/*&jp-texi
@menu
* sm1_gkz::
@end menu
@node sm1_gkz,,, SM1 $BH!?t(B
@subsection @code{sm1_gkz}
@findex sm1_gkz
@table @t
@item sm1_gkz([@var{A},@var{B}]|proc=@var{p})
::  $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.
@end table

@table @var
@item return
$B%j%9%H(B
@item p
$B?t(B
@item A, B
$B%j%9%H(B
@end table

@itemize @bullet
@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.
@end itemize
*/

/*&C-texi

@example

[280] sm1_gkz([  [[1,1,1,1],[0,1,3,4]],  [0,2] ]);
[[x4*dx4+x3*dx3+x2*dx2+x1*dx1,4*x4*dx4+3*x3*dx3+x2*dx2-2,
 -dx1*dx4+dx2*dx3,-dx2^2*dx4+dx1*dx3^2,dx1^2*dx3-dx2^3,-dx2*dx4^2+dx3^3],
 [x1,x2,x3,x4]]

@end example

*/


def sm1_appell1(S) {
  N = length(S)-2;
  B = cdr(cdr(S));
  A = S[0];
  C = S[1];
  V = [ ];
  for (I=0; I<N; I++) {
    V = append(V,[sm1aux_x(I+1)]); 
  }
  Ans = [ ];
  Euler = 0;
  for (I=0; I<N; I++) {
    Euler = sm1aux_x(I+1)*sm1aux_dx(I+1) + Euler;
  }
  for (I=0; I<N; I++) {
    T = sm1_mul(sm1aux_dx(I+1), Euler+C-1,V)-
        sm1_mul(Euler+A, sm1aux_x(I+1)*sm1aux_dx(I+1)+B[I],V);
    /* Tmp=sm1_rat_to_p(T);
    print(Tmp[0]/Tmp[1]-T)$ */
    T = sm1_rat_to_p(T)[0];
    Ans = append(Ans,[T]);
  }
  for (I=0; I<N; I++) {
    for (J=I+1; J<N; J++) {
      T = (sm1aux_x(I+1)-sm1aux_x(J+1))*sm1aux_dx(I+1)*sm1aux_dx(J+1)
         - B[J]*sm1aux_dx(I+1) + B[I]*sm1aux_dx(J+1);
      /* Tmp=sm1_rat_to_p(T);
      print(Tmp[0]/Tmp[1]-T)$ */
      T = sm1_rat_to_p(T)[0];
      Ans = append(Ans,[T]);
    }
  }
  return([Ans,V]);
}


def sm1aux_dx(I) {
  return(strtov("dx"+rtostr(I)));
}
def sm1aux_x(I) {
  return(strtov("x"+rtostr(I)));
}



/*&eg-texi
@menu
* sm1_appell1::
@end menu
@node sm1_appell1,,, SM1 Functions
@subsection @code{sm1_appell1}
@findex sm1_appell1
@table @t
@item sm1_appell1(@var{a}|proc=@var{p})
::  Returns the Appell hypergeometric system F_1 or F_D. 
@end table

@table @var
@item return
List
@item p
Number
@item a
List
@end table

@itemize @bullet
@item Returns the hypergeometric system for the Lauricella function
F_D(a,b1,b2,...,bn,c;x1,...,xn)
where @var{a} =(a,c,b1,...,bn).
When n=2, the Lauricella function is called the Appell function F_1.
The parameters a, c, b1, ..., bn may be rational numbers.
@end itemize
*/

/*&jp-texi
@menu
* sm1_appell1::
@end menu
@node sm1_appell1,,, SM1 $BH!?t(B
@subsection @code{sm1_appell1}
@findex sm1_appell1
@table @t
@item sm1_appell1(@var{a}|proc=@var{p})
:: F_1 $B$^$?$O(B F_D $B$KBP1~$9$kJ}Dx<07O$rLa$9(B. 
@end table

@table @var
@item return
$B%j%9%H(B
@item p
$B?t(B
@item a
$B%j%9%H(B
@end table

@itemize @bullet
@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
F_D(a,b1,b2,...,bn,c;x1,...,xn)
$B$N$_$?$9HyJ,J}Dx<07O$rLa$9(B. $B$3$3$G(B,
@var{a} =(a,c,b1,...,bn).
$B%Q%i%a!<%?$OM-M}?t$G$b$h$$(B.
@end itemize
*/

/*&C-texi

@example

[281] sm1_appell1([1,2,3,4]);
[[((-x1+1)*x2*dx1-3*x2)*dx2+(-x1^2+x1)*dx1^2+(-5*x1+2)*dx1-3,
  (-x2^2+x2)*dx2^2+((-x1*x2+x1)*dx1-6*x2+2)*dx2-4*x1*dx1-4,
  ((-x2+x1)*dx1+3)*dx2-4*dx1],       equations
 [x1,x2]]                            the list of variables

[282] sm1_gb(@@);
[[((-x2+x1)*dx1+3)*dx2-4*dx1,((-x1+1)*x2*dx1-3*x2)*dx2+(-x1^2+x1)*dx1^2
  +(-5*x1+2)*dx1-3,(-x2^2+x2)*dx2^2+((-x2^2+x1)*dx1-3*x2+2)*dx2
  +(-4*x2-4*x1)*dx1-4,
  (x2^3+(-x1-1)*x2^2+x1*x2)*dx2^2+((-x1*x2+x1^2)*dx1+6*x2^2
 +(-3*x1-2)*x2+2*x1)*dx2-4*x1^2*dx1+4*x2-4*x1],
 [x1*dx1*dx2,-x1^2*dx1^2,-x2^2*dx1*dx2,-x1*x2^2*dx2^2]]

[283] sm1_rank(sm1_appell1([1/2,3,5,-1/3]));
1

[285] Mu=2$ Beta = 1/3$
[287] sm1_rank(sm1_appell1([Mu+Beta,Mu+1,Beta,Beta,Beta]));
4


@end example

*/

def sm1_appell4(S) {
  N = length(S)-2;
  B = cdr(cdr(S));
  A = S[0];
  C = S[1];
  V = [ ];
  for (I=0; I<N; I++) {
    V = append(V,[sm1aux_x(I+1)]); 
  }
  Ans = [ ];
  Euler = 0;
  for (I=0; I<N; I++) {
    Euler = sm1aux_x(I+1)*sm1aux_dx(I+1) + Euler;
  }
  for (I=0; I<N; I++) {
    T = sm1_mul(sm1aux_dx(I+1), sm1aux_x(I+1)*sm1aux_dx(I+1)+B[I]-1,V)-
        sm1_mul(Euler+A,Euler+C,V);
    /* Tmp=sm1_rat_to_p(T);
    print(Tmp[0]/Tmp[1]-T)$ */
    T = sm1_rat_to_p(T)[0];
    Ans = append(Ans,[T]);
  }
  return([Ans,V]);
}

/*&eg-texi
@menu
* sm1_appell4::
@end menu
@node sm1_appell4,,, SM1 Functions
@subsection @code{sm1_appell4}
@findex sm1_appell4
@table @t
@item sm1_appell4(@var{a}|proc=@var{p})
::  Returns the Appell hypergeometric system F_4 or F_C. 
@end table

@table @var
@item return
List
@item p
Number
@item a
List
@end table

@itemize @bullet
@item Returns the hypergeometric system for the Lauricella function
F_4(a,b,c1,c2,...,cn;x1,...,xn)
where @var{a} =(a,b,c1,...,cn).
When n=2, the Lauricella function is called the Appell function F_4.
The parameters a, b, c1, ..., cn may be rational numbers.
@end itemize
*/

/*&jp-texi
@menu
* sm1_appell4::
@end menu
@node sm1_appell4,,, SM1 $BH!?t(B
@subsection @code{sm1_appell4}
@findex sm1_appell4
@table @t
@item sm1_appell4(@var{a}|proc=@var{p})
:: F_4 $B$^$?$O(B F_C $B$KBP1~$9$kJ}Dx<07O$rLa$9(B. 
@end table

@table @var
@item return
$B%j%9%H(B
@item p
$B?t(B
@item a
$B%j%9%H(B
@end table

@itemize @bullet
@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
F_C(a,b,c1,c2,...,cn;x1,...,xn)
$B$N$_$?$9HyJ,J}Dx<07O$rLa$9(B. $B$3$3$G(B,
@var{a} =(a,b,c1,...,cn).
$B%Q%i%a!<%?$OM-M}?t$G$b$h$$(B.
@end itemize
*/

/*&C-texi

@example

[281] sm1_appell4([1,2,3,4]);
  [[-x2^2*dx2^2+(-2*x1*x2*dx1-4*x2)*dx2+(-x1^2+x1)*dx1^2+(-4*x1+3)*dx1-2,
  (-x2^2+x2)*dx2^2+(-2*x1*x2*dx1-4*x2+4)*dx2-x1^2*dx1^2-4*x1*dx1-2],
                                                              equations
    [x1,x2]]                                      the list of variables

[282] sm1_rank(@@);
4

@end example

*/


def sm1_rank(A) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,A);
  sm1(P," rank toString .. ");
  ox_check_errors2(P);
  R = sm1_pop(P);
  return(R);
}

def sm1_rrank(A) {
  SM1_FIND_PROC(P);
  sm1_push_int0(P,A);
  sm1(P," rrank toString .. ");
  ox_check_errors2(P);
  R = sm1_pop(P);
  return(R);
}


/*&eg-texi
@menu
* sm1_rank::
@end menu
@node sm1_rank,,, SM1 Functions
@subsection @code{sm1_rank}
@findex sm1_rank
@table @t
@item sm1_rank(@var{a}|proc=@var{p})
::  Returns the holonomic rank of the system of differential equations @var{a}.
@end table

@table @var
@item return
Number
@item p
Number
@item a
List
@end table

@itemize @bullet
@item It evaluates the dimension of the space of holomorphic solutions
at a generic point of the system of differential equations @var{a}.
The dimension is called the holonomic rank.
@item @var{a} is a list consisting of a list of differential equations and
a list of variables.
@item @code{sm1_rrank} returns the holonomic rank when @var{a} is regular
holonomic. It is generally faster than @code{sm1_rank}.
@end itemize
*/

/*&jp-texi
@menu
* sm1_rank::
@end menu
@node sm1_rank,,, SM1 $BH!?t(B
@subsection @code{sm1_rank}
@findex sm1_rank
@table @t
@item sm1_rank(@var{a}|proc=@var{p})
::  $BHyJ,J}Dx<07O(B @var{a} $B$N(B holonomic rank $B$rLa$9(B.
@end table

@table @var
@item return
$B?t(B
@item p
$B?t(B
@item a
$B%j%9%H(B
@end table

@itemize @bullet
@item $BHyJ,J}Dx<07O(B @var{a} $B$N(B, generic point $B$G$N@5B'2r$N<!85$r(B
$BLa$9(B. $B$3$N<!85$r(B, holonomic rank $B$H8F$V(B.
@item @var{a} $B$OHyJ,:nMQAG$N%j%9%H$HJQ?t$N%j%9%H$h$j$J$k(B.
@item  @var{a} $B$,(B regular holonomic $B$N$H$-$O(B @code{sm1_rrank}
$B$b(B holonomic rank $B$rLa$9(B.
$B$$$C$Q$s$K$3$N4X?t$NJ}$,(B @code{sm1_rank} $B$h$jAa$$(B.
@end itemize
*/

/*&C-texi

@example

[284]  sm1_gkz([  [[1,1,1,1],[0,1,3,4]],  [0,2] ]);
[[x4*dx4+x3*dx3+x2*dx2+x1*dx1,4*x4*dx4+3*x3*dx3+x2*dx2-2,
  -dx1*dx4+dx2*dx3, -dx2^2*dx4+dx1*dx3^2,dx1^2*dx3-dx2^3,-dx2*dx4^2+dx3^3],
 [x1,x2,x3,x4]]
[285] sm1_rrank(@@);
4

[286]  sm1_gkz([  [[1,1,1,1],[0,1,3,4]],  [1,2]]);
[[x4*dx4+x3*dx3+x2*dx2+x1*dx1-1,4*x4*dx4+3*x3*dx3+x2*dx2-2,
 -dx1*dx4+dx2*dx3,-dx2^2*dx4+dx1*dx3^2,dx1^2*dx3-dx2^3,-dx2*dx4^2+dx3^3],
 [x1,x2,x3,x4]]
[287] sm1_rrank(@@);
5

@end example

*/

def sm1_auto_reduce(T) {
  SM1_FIND_PROC(P);
  sm1(P,"[(AutoReduce) "+rtostr(T)+" ] system_variable ");
  ox_check_errors2(P);
  R = sm1_pop(P);
  return(R);
}

/*&eg-texi
@menu
* sm1_auto_reduce::
@end menu
@node sm1_auto_reduce,,, SM1 Functions
@subsection @code{sm1_auto_reduce}
@findex sm1_auto_reduce
@table @t
@item sm1_auto_reduce(@var{s}|proc=@var{p})
::  Set the flag "AutoReduce" to @var{s}.
@end table

@table @var
@item return
Number
@item p
Number
@item s
Number
@end table

@itemize @bullet
@item  If @var{s} is 1, then all Grobner bases to be computed 
will be the reduced Grobner bases.
@item If @var{s} is 0, then Grobner bases are not necessarily the reduced
Grobner bases.  This is the default.
@end itemize
*/

/*&jp-texi
@menu
* sm1_auto_reduce::
@end menu
@node sm1_auto_reduce,,, SM1 $BH!?t(B
@subsection @code{sm1_auto_reduce}
@findex sm1_auto_reduce
@table @t
@item sm1_auto_reduce(@var{s}|proc=@var{p})
::  $B%U%i%0(B "AutoReduce" $B$r(B @var{s} $B$K@_Dj(B.
@end table

@table @var
@item $BLa$jCM(B
$B?t(B
@item p
$B?t(B
@item s
$B?t(B
@end table

@itemize @bullet
@item  @var{s} $B$,(B 1 $B$N$H$-(B, $B0J8e7W;;$5$l$k%0%l%V%J4pDl$O$9$Y$F(B,
reduced $B%0%l%V%J4pDl$H$J$k(B.
@item  @var{s} $B$,(B 0 $B$N$H$-(B, $B7W;;$5$l$k%0%l%V%J4pDl$O(B
reduced $B%0%l%V%J4pDl$H$O$+$.$i$J$$(B. $B$3$A$i$,%G%U%)!<%k%H(B.
@end itemize
*/

  
def sm1_slope(II,V,FF,VF) {
  SM1_FIND_PROC(P);
  A =[II,V,FF,VF];
  sm1_push_int0(P,A);
  sm1(P," slope toString ");
  ox_check_errors2(P);
  R = eval_str(sm1_pop(P));
  return(R);
}


/*&eg-texi
@menu
* sm1_slope::
@end menu
@node sm1_slope,,, SM1 Functions
@subsection @code{sm1_slope}
@findex sm1_slope
@table @t
@item sm1_slope(@var{ii},@var{v},@var{f_filtration},@var{v_filtration}|proc=@var{p})
::  Returns the slopes of differential equations @var{ii}.
@end table

@table @var
@item return
List
@item p
Number
@item ii
List  (equations)
@item v
List  (variables)
@item f_filtration
List  (weight vector)
@item v_filtration
List (weight vector)
@end table

@itemize @bullet
@item @code{sm1_slope} returns the (geometric) slopes 
of the system of differential equations @var{ii}
along the hyperplane specified by
the V filtration @var{v_filtration}.
@item @var{v} is a list of variables.
@item As to the algorithm,
see "A.Assi, F.J.Castro-Jimenez and J.M.Granger,
How to calculate the slopes of a D-module, Compositio Math, 104, 1-17, 1996"
Note that the signs of the slopes are negative, but the absolute values
of the slopes are returned.
@item The return value is a list of lists.
The first entry of each list is the slope and the second entry
is the weight vector for which the microcharacteristic variety is
not bihomogeneous.
@end itemize
*/

/*&jp-texi
@menu
* sm1_slope::
@end menu
@node sm1_slope,,, SM1 $BH!?t(B
@subsection @code{sm1_slope}
@findex sm1_slope
@table @t
@item sm1_slope(@var{ii},@var{v},@var{f_filtration},@var{v_filtration}|proc=@var{p})
::  $BHyJ,J}Dx<07O(B @var{ii} $B$N(B slope $B$rLa$9(B.
@end table

@table @var
@item return
$B?t(B
@item p
$B?t(B
@item ii
$B%j%9%H(B  ($BJ}Dx<0(B)
@item v
$B%j%9%H(B ($BJQ?t(B)
@item f_filtration
$B%j%9%H(B  (weight vector)
@item v_filtration
$B%j%9%H(B (weight vector)
@end table

@itemize @bullet
@item @code{sm1_slope} $B$O(B
$BHyJ,J}Dx<07O(B @var{ii} $B$N(B V filtration  @var{v_filtration}
$B$G;XDj$9$kD6J?LL$K1h$C$F$N(B (geomeric) slope $B$r7W;;$9$k(B.
@item @var{v} $B$OJQ?t$N%j%9%H(B.
@item $B;HMQ$7$F$$$k%"%k%4%j%:%`$K$D$$$F$O(B,
"A.Assi, F.J.Castro-Jimenez and J.M.Granger,
How to calculate the slopes of a D-module, Compositio Math, 104, 1-17, 1996"
$B$r$_$h(B.
Slope $B$NK\Mh$NDj5A$G$O(B, $BId9f$,Ii$H$J$k$,(B, $B$3$N%W%m%0%i%`$O(B,
Slope $B$N@dBPCM$rLa$9(B.
@item $BLa$jCM$O(B, $B%j%9%H$r@.J,$H$9$k%j%9%H$G$"$k(B.
$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
microcharacteristic variety $B$,(B bihomogeneous $B$G$J$$(B.
@end itemize
*/

/*&C-texi

@example

[284] A= sm1_gkz([  [[1,2,3]],  [-3] ]);


[285] sm1_slope(A[0],A[1],[0,0,0,1,1,1],[0,0,-1,0,0,1]);

[286] A2 = sm1_gkz([ [[1,1,1,0],[2,-3,1,-3]], [1,0]]);
     (* This is an interesting example given by Laura Matusevich, 
        June 9, 2001 *)

[287] sm1_slope(A2[0],A2[1],[0,0,0,0,1,1,1,1],[0,0,0,-1,0,0,0,1]);


@end example

*/
/*&eg-texi
@table @t
@item Reference
    @code{sm_gb}
@end table
*/
/*&jp-texi
@table @t
@item $B;2>H(B
    @code{sm_gb}
@end table
*/


end$