/*$OpenXM: OpenXM/src/asir-contrib/packages/doc/sm1.oxweave,v 1.2 2001/07/11 06:23:16 takayama Exp $ */

/*&C-texi
@c DO NOT EDIT THIS FILE   oxphc.texi
*/
/*&jp-texi
@node SM1 函数,,, Top
@chapter SM1 函数

この節では sm1 の ox サーバ @code{ox_sm1_forAsir}
とのインタフェース関数を解説する.
これらの関数はファイル  @file{sm1} で定義されている.
@file{sm1} は @file{$(OpenXM_HOME)/lib/asir-contrib} にある.
システム @code{sm1} は微分作用素環で計算するためのシステムである.
計算代数幾何のいろいろな不変量の計算が微分作用素の計算に帰着する.
@code{sm1} についての文書は @code{OpenXM/doc/kan96xx} にある.

とこに断りがないかぎりこの節のすべての関数は,
有理数係数の式を入力としてうけつけない.
すべての多項式の係数は整数でないといけない.

@tex
空間
$X:={\bf C} \setminus \{ 0, 1 \} = {\bf C} \setminus V(x(x-1))$
のドラームコホモロジ群達の次元を計算してみよう.
$X$ は平面に二つの穴をあけた空間であるので, 点 $x=0$, $x=1$ のまわりを
まわる二つのループが1次元のホモロジー群の空間をはる.
したがって, 1次元ドラームコホモロジ群の次元は $2$ である.
@code{sm1} は $0$ 次元のコホモロジ群の次元および $1$ 次元のコホモロジ群の
次元を答える.
@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} サーバ
*/ 
/*&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} のための @code{sm1} サーバ.
@end table
@itemize @bullet
@item
   サーバ @code{ox_sm1_forAsir} は @code{asir} よりコマンド
    @code{sm1_start} で起動される @code{sm1} サーバである.

    標準的設定では, @*
    @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) @*
  であり, これらのマクロファイルは, 一般には
   current directory, @code{$(LOAD_SM1_PATH)}, 
   @code{$(OpenXM_HOME)/lib/sm1},
   @code{/usr/local/lib/sm1}
    の順番でさがされる.
@item プログラマーのためのノート: 
@code{sm1} マクロを読み込んで自分独自のサーバを作るには
    次のファイルも見よ
    @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 函数一覧
*/ 
/*&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 函数
@subsection @code{sm1_start}
@findex sm1_start
@table @t
@item sm1_start()
::  localhost で  @code{ox_sm1_forAsir} をスタートする.
@end table

@table @var
@item return
整数
@end table

@itemize @bullet
@item localhost で @code{ox_sm1_forAsir} をスタートする.
サーバ @code{ox_sm1_forAsir} の識別番号を戻す.
@item @code{Xm_noX = 1} とおくとサーバ @code{ox_sm1_forAsir} をデバッグ用の
ウィンドウなしに起動できる.
@item コマンド @code{ord} を用いて変数順序を正しく設定しておく必要が
ある.
たとえば,
変数 @code{x} と @code{dx} 上の微分作用素環
(@code{dx} は 
@tex $\partial/\partial x$ 
@end tex 
に対応)
で計算しているとき,
@code{sm1} サーバは式を印刷したとき,
変数 @code{dx} は右側に集めれ変数
@code{x} は左側にあつめられていると仮定している.
次の例では, 変数 @code{cc} を @code{sm1} での計算のために用いてはいけない.
@item @code{a} より @code{z} のなかで,  @code{d} と @code{o} を除いたもの,
それから, @code{x0}, ..., @code{x20}, @code{y0}, ..., @code{y20},
@code{z0}, ..., @code{z20} は, デフォールトで微分作用素環の変数として
使える (cf. @code{Sm1_ord_list} in @code{sm1}).
@item 識別番号は @code{Sm1_proc} に格納される.
@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 参照
    @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 函数
@subsection @code{sm1}
@findex sm1
@table @t
@item sm1(@var{p},@var{s})
::  サーバ @code{sm1} にコマンド列 @var{s} を実行してくれるようにたのむ.
@end table

@table @var
@item return
なし
@item p
数
@item s
文字列
@end table

@itemize @bullet
@item  識別番号 @var{p} の @code{sm1} サーバに
コマンド列 @var{s} を実行してくれるように頼む.
@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 参照
    @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 函数
@subsection @code{sm1_push_int0}
@findex sm1_push_int0
@table @t
@item sm1_push_int0(@var{p},@var{f})
::   オブジェクト @var{f} を識別子 @var{p} のサーバへ送る.
@end table

@table @var
@item return
なし
@item p
数
@item f
オブジェクト
@end table

@itemize @bullet
@item @code{type(@var{f})} が 2 (再帰多項式) のとき,
    @var{f} は文字列 (type == 7) に変換されて,
    @code{ox_push_cmo} を用いてサーバへ送られる.
@item @code{type(@var{f})} が 0 (zero) のときは, 
    サーバ上では, 32 bit 整数と解釈される.
    なお @code{ox_push_cmo(P,0)} はサーバに対して @code{CMO_NULL}
をおくるので, サーバ側では, 32 bit 整数を受け取るわけではない.
@item  @code{sm1} の整数は, 32 bit 整数と bignum にわけることができる.
@code{type(@var{f})} が 1 (数)のとき, この関数は 32 bit integer をサーバに
おくる.
@code{ox_push_cmo(@var{p},1234)} は bignum の 1234 を
@code{sm1} サーバにおくることに注意しよう.
@item その他の場合には  @code{ox_push_cmo} をデータ型の変換なしに呼び出す.
@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})
::  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
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.
@end itemize
*/
/*&jp-texi
@c sort-sm1_gb
@menu
* sm1_gb::
@end menu
@node sm1_gb,,, SM1 函数
@node sm1_gb_d,,, SM1 函数
@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})
::  @var{v} 上の微分作用素環において @var{f} のグレブナ基底を計算する.
@item sm1_gb_d([@var{f},@var{v},@var{w}]|proc=@var{p})
::  @var{v} 上の微分作用素環において @var{f} のグレブナ基底を計算する. 結果を分散多項式のリストで戻す.
@end table

@table @var
@item return
リスト
@item p, q
数
@item f, v, w
リスト
@end table

@itemize @bullet
@item
   @var{v} 上の微分作用素環において @var{f} のグレブナ基底を計算する.
@item
   Weight ベクトル @var{w} は省略してよい.
   省略した場合, graded reverse lexicographic order をつかって
   ブレブナ基底を計算する.
@item
   @code{sm1_gb} の戻り値は @var{f} のグレブナ基底およびイニシャルモノミアル
  ( @var{w} がないとき ) または イニシァル多項式 ( @var{w} が与えらたとき)
  のリストである.
@item
   @code{sm1_gb_d} は結果を分散多項式のリストで戻す.
    多項式の中に現れるモノミアルはグレブナ基底を計算するときに与えらた順序でソートされている.
   戻り値は
    [変数名のリスト, 順序をきめる行列, グレブナ基底, イニシャルモノミアルまたはイニシァル多項式]
   である.
@item
   Term order でない順序が与えられた場合は, 同次化ワイル代数でグレブナ基底が計算される (SST の本の Section 1.2 を見よ).
同次化変数 @code{h} が結果に加わる.
@item オプショナル変数 @var{q} がセットされているときは,
    3 番目の戻り値として, グレブナ基底およびイニシァルのリストが
    与えられた順序でソートされたモノミアルの和として戻される.
    いまのところこの多項式は, 文字列で表現される.
@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
上の例において,
@tex 集合 $\{ x \partial_x + y \partial_y -1,
                 y^2 \partial_y^2+2\}$ 
は
$ 1 \leq \partial_y \leq \partial_x \leq y \leq x \leq \cdots$
であるような
graded reverse lexicographic order に関するグレブナ基底である.
集合 $\{x \partial_x, y^2 \partial_y\}$ はグレブナ基底の各元に
対する leading monomial (initial monomial) である.
@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
上の例において二つのモノミアル
@tex
$m = x^a y^b \partial_x^c \partial_y^d$ および
$m' = x^{a'} y^{b'} \partial_x^{c'} \partial_y^{d'}$
は最初に weight vector
{\tt (dx,dy,x,y) = (50,2,1,0)} を用いて比較される
(つまり $m$ は $50c+2d+a > 50c'+2d'+a'$ のとき
 $m'$ より大きい )
次にこの比較で勝負がつかないときは reverse lexicographic order で比較される
(つまり $50c+2d+a = 50c'+2d'+a'$ のとき reverse lexicographic order で比較
される).
@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 参照
    @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 函数
@subsection @code{sm1_deRham}
@findex sm1_deRham
@table @t
@item sm1_deRham([@var{f},@var{v}]|proc=@var{p})
::  空間 C^n - (the zero set of @var{f}=0) のドラームコホモロジ群の次元を計算してくれるようにサーバに頼む.
@end table

@table @var
@item return
リスト
@item p
数
@item f
文字列 または 多項式
@item v
リスト
@end table

@itemize @bullet
@item この函数は空間 X = C^n \ V(@var{f}) のドラームコホモロジ群の次元を計算する.
   すなわち,
   [dim H^0(X,C), dim H^1(X,C), dim H^2(X,C), ..., dim H^n(X,C)]
   を戻す.
@item   @var{v} は変数のリスト. n = @code{length(@var{v})} である.
@item
   @code{sm1_deRham} は計算機の資源を大量に使用する.
    たとえば @code{sm1_deRham(0,[x*y*z*(x+y+z-1)*(x-y),[x,y,z]])}
   の計算すらすでに非常に大変である.
@item
  b-関数の根を効率よく解析するには, @code{ox_asir} が @code{ox_sm1_forAsir}
  より使用されるべきである.  コマンド @*
   @code{sm1(0,"[(parse) (oxasir.sm1) pushfile] extension");}
   を用いて, @code{ox_asir} との通信モジュールをあらかじめロードしておくとよい.
   このコマンドは @code{ox_asir_forAsir} のスタート時に自動的に実行されている.
@item
  @code{sm1_deRham} を @code{ox_reset(Sm1_proc);} で中断すると, 
  以後 sm1 サーバが非標準モードに入り予期しない動作をする場合
  があるので, コマンド @code{ox_shutdown(Sm1_proc);} で, @code{ox_sm1_forAsir}
  を一時 shutdown してリスタートした方が安全である.
@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 参照
    @code{sm1_start}, @code{deRham} (sm1 command)
@item 参考論文
    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 函数
@subsection @code{sm1_hilbert}
@findex sm1_hilbert
@findex hilbert_polynomial
@table @t
@item sm1_hilbert([@var{f},@var{v}]|proc=@var{p})
:: 多項式の集合 @var{f} のヒルベルト多項式を計算する.
@item hilbert_polynomial(@var{f},@var{v})
:: 多項式の集合 @var{f} のヒルベルト多項式を計算する.
@end table

@table @var
@item return
多項式
@item p
数
@item f, v
リスト
@end table

@itemize @bullet
@item  多項式の集合 @var{f} の変数 @var{v} にかんするヒルベルト多項式 h(k)
   を計算する.
@item
    h(k) = dim_Q F_k/I \cap F_k  ここで F_k は次数が k 以下であるような
    多項式の集合である. I は多項式の集合 @var{f} で生成されるイデアルである.
@item
   sm1_hilbert にかんするノート:
   効率よく計算するには @var{f} はモノミアルの集合にした方がいい.
   実際, この函数はまず @var{f} のグレブナ基底を計算し, それからその initial 
   monomial 達のヒルベルト多項式を計算する. 
  したがって, 入力 @var{f} がすでにグレブナ基底だとこの函数のなかでもう一度
   グレブナ基底の計算がおこなわれる. これは時間の無駄であるし, @code{sm1} の
  多項式グレブナ基底計算は @code{asir} より遅い.
@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 参照
    @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 函数
@subsection @code{sm1_genericAnn}
@findex sm1_genericAnn
@table @t
@item sm1_genericAnn([@var{f},@var{v}]|proc=@var{p})
::  @var{f}^s のみたす微分方程式全体をもとめる.
    @var{v} は変数のリストである.  ここで, s は @var{v}[0] であり,
    @var{f} は変数 @code{rest}(@var{v}) 上の多項式である.
@end table

@table @var
@item return
リスト
@item p
数
@item f
多項式
@item v
リスト
@end table

@itemize @bullet
@item この函数は,
  @var{f}^s のみたす微分方程式全体をもとめる.
    @var{v} は変数のリストである.  ここで, s は @var{v}[0] であり,
    @var{f} は変数 @code{rest}(@var{v}) 上の多項式である.
@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 参照
    @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 函数
@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} と @var{g} の D-module としての 0 次テンソル積を
計算する.
@end table

@table @var
@item return
リスト
@item p
数
@item f, g, v, w
リスト
@end table

@itemize @bullet
@item 
   @var{f} と @var{g} の
   D-加群としての 0 次テンソル積を計算する.
@item
  @var{v} は変数のリストである.
  @var{w} は weight のリストである.  
  整数 @var{w}[i] は変数 @var{v}[i] の weight である.
@item 
   @code{sm1_wTensor0} は @code{ox_sm1} の @code{wRestriction0}
   をよんでいる.
  @code{wRestriction0} は, generic な weight ベクトル @var{w}
  をもとにして制限を計算している.
  Weight ベクトル @var{w} が generic でないと計算がエラーで停止する.
@item F および G を @var{f} と  @var{g} それぞれの解とする.
直観的にいえば, 0 次のテンソル積は 関数 FG のみたす微分方程式系である.
@item 入力 @var{f}, @var{g} が D の左イデアルであっても,
一般に, 出力は自由加群 D^r の部分加群である.
@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 函数
@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
リスト
@item f
多項式
@item g, v, w
リスト
@item p
数  (ox_sm1 のプロセス番号)
@end table

@itemize @bullet
@item  この函数は @var{f} を homogenized ワイル代数において,
多項式集合 @var{g} で簡単化 (reduce) する; つまり,
この函数は, @var{f} に割算アルゴリズムを適用する.
変数集合は @var{v} で指定する.
@var{w} は順序を指定するための ウエイトベクトルであり,
省略してもよい.
@code{sm1_reduction_noH} は, Weyl algebra 用.
@item 戻り値は次の形をしている:
[r,c0,[c1,...,cm],[g1,...gm]] ここで @var{g}=[g1, ..., gm] であり,
r/c0 + c1 g1 + ... + cm gm = 0
がなりたつ.
r/c0 が normal form である.
@item この函数は, 低次項にあらわれる reducible な項も簡単化する.
@item  函数
sm1_reduction_d(P,F,G) および sm1_reduction_noH_d(P,F,G)
は, 分散多項式用である.
@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 参照
    @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 函数
@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 で書かれた OpenMath の木表現 @var{s} を前置記法になおす.
@end table

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

@itemize @bullet
@item XML で書かれた OpenMath の木表現 @var{s} を前置記法になおす.
@item この函数は om_* に将来移すべきである.
@item @code{om_xml_to_cmo(OpenMath Tree Expression)} は CMO_TREE
を戻す. @code{asir} はこの CMO をまだサポートしていない.
@item @code{java} の実行環境が必要.
(たとえば, /usr/local/jdk1.1.8/bin をコマンドサーチパスに入れるなど.)
@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 参照
    @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 函数
@node sm1_syz_d,,, SM1 函数
@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} 上の微分作用素環において @var{f} の syzygy を計算する.
@end table

@table @var
@item return
リスト
@item p
数
@item f, v, w
リスト
@end table

@itemize @bullet
@item
戻り値は次の形をしている:
[@var{s},[@var{g}, @var{m}, @var{t}]].
ここで @var{s} は @var{f} の @var{v} を変数とする微分作用素環における
syzygy である.
@var{g} は @var{f} の weight vector @var{w} に関するグレブナ基底である.
@var{m} は入力行列 @var{f} をグレブナ基底
@var{g} へ変換する行列である.
@var{t} はグレブナ基底 @var{g} の syzygy である.
まとめると, 次の等式がなりたつ:
@var{g} = @var{m} @var{f} ,
@var{s} @var{f} = 0.
@item
   Weight ベクトル @var{w} は省略してよい.
   省略した場合, graded reverse lexicographic order をつかって
   ブレブナ基底を計算する.
@item
   Term order でない順序が与えられた場合は, 同次化ワイル代数でグレブナ基底が計算される (SST の本の Section 1.2 を見よ).
同次化変数 @code{h} が結果に加わる.
@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 函数
@subsection @code{sm1_mul}
@findex sm1_mul
@table @t
@item sm1_mul(@var{f},@var{g},@var{v}|proc=@var{p})
::  sm1サーバ に @var{f} かける @var{g} を @var{v}
上の微分作用素環でやってくれるように頼む.
@end table

@table @var
@item return
多項式またはリスト
@item p
数
@item f, g
多項式またはリスト
@item v
リスト
@end table

@itemize @bullet
@item   sm1サーバ に @var{f} かける @var{g} を @var{v}
上の微分作用素環でやってくれるように頼む.
@item @code{sm1_mul_h} は homogenized Weyl 代数用.
@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 函数

@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} に @var{f} の distraction を計算してもらう.
@end table

@table @var
@item return
リスト
@item p
数
@item f
多項式
@item v,x,d,s
リスト
@end table

@itemize @bullet
@item  識別子 @var{p}  の @code{sm1}  サーバに,
@var{f} の distraction を @var{v} 上の微分作用素環で計算してもらう.
@item @var{x} , @var{d} は, それぞれ, distract すべき x 変数, d 変数の
リスト.  Distraction したら, @var{s} を変数として結果を表す.
@item Distraction というのは x*dx を x で置き換えることである.
詳しくは Saito, Sturmfels, Takayama : Grobner Deformations of Hypergeometric Differential Equations の page 68 を見よ.
@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 参照
    @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 函数
@subsection @code{sm1_gkz}
@findex sm1_gkz
@table @t
@item sm1_gkz([@var{A},@var{B}]|proc=@var{p})
::  行列 @var{A} とパラメータ @var{B} に付随した GKZ 系 (A-hypergeometric system) をもどす.
@end table

@table @var
@item return
リスト
@item p
数
@item A, B
リスト
@end table

@itemize @bullet
@item  行列 @var{A} とパラメータ @var{B} に付随した GKZ 系 (A-hypergeometric system) をもどす.
@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 函数
@subsection @code{sm1_appell1}
@findex sm1_appell1
@table @t
@item sm1_appell1(@var{a}|proc=@var{p})
:: F_1 または F_D に対応する方程式系を戻す. 
@end table

@table @var
@item return
リスト
@item p
数
@item a
リスト
@end table

@itemize @bullet
@item Appell の関数 F_1 および その n 変数化である Lauricella の関数
F_D(a,b1,b2,...,bn,c;x1,...,xn)
のみたす微分方程式系を戻す. ここで,
@var{a} =(a,c,b1,...,bn).
パラメータは有理数でもよい.
@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 函数
@subsection @code{sm1_appell4}
@findex sm1_appell4
@table @t
@item sm1_appell4(@var{a}|proc=@var{p})
:: F_4 または F_C に対応する方程式系を戻す. 
@end table

@table @var
@item return
リスト
@item p
数
@item a
リスト
@end table

@itemize @bullet
@item Appell の関数 F_4 および その n 変数化である Lauricella の関数
F_C(a,b,c1,c2,...,cn;x1,...,xn)
のみたす微分方程式系を戻す. ここで,
@var{a} =(a,b,c1,...,cn).
パラメータは有理数でもよい.
@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 函数
@subsection @code{sm1_rank}
@findex sm1_rank
@table @t
@item sm1_rank(@var{a}|proc=@var{p})
::  微分方程式系 @var{a} の holonomic rank を戻す.
@end table

@table @var
@item return
数
@item p
数
@item a
リスト
@end table

@itemize @bullet
@item 微分方程式系 @var{a} の, generic point での正則解の次元を
戻す. この次元を, holonomic rank と呼ぶ.
@item @var{a} は微分作用素のリストと変数のリストよりなる.
@item  @var{a} が regular holonomic のときは @code{sm1_rrank}
も holonomic rank を戻す.
いっぱんにこの関数の方が @code{sm1_rank} より早い.
@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 函数
@subsection @code{sm1_auto_reduce}
@findex sm1_auto_reduce
@table @t
@item sm1_auto_reduce(@var{s}|proc=@var{p})
::  フラグ "AutoReduce" を @var{s} に設定.
@end table

@table @var
@item 戻り値
数
@item p
数
@item s
数
@end table

@itemize @bullet
@item  @var{s} が 1 のとき, 以後計算されるグレブナ基底はすべて,
reduced グレブナ基底となる.
@item  @var{s} が 0 のとき, 計算されるグレブナ基底は
reduced グレブナ基底とはかぎらない. こちらがデフォールト.
@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 函数
@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})
::  微分方程式系 @var{ii} の slope を戻す.
@end table

@table @var
@item return
数
@item p
数
@item ii
リスト  (方程式)
@item v
リスト (変数)
@item f_filtration
リスト  (weight vector)
@item v_filtration
リスト (weight vector)
@end table

@itemize @bullet
@item @code{sm1_slope} は
微分方程式系 @var{ii} の V filtration  @var{v_filtration}
で指定する超平面に沿っての (geomeric) slope を計算する.
@item @var{v} は変数のリスト.
@item 使用しているアルゴリズムについては,
"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"
をみよ.
Slope の本来の定義では, 符号が負となるが, このプログラムは,
Slope の絶対値を戻す.
@item 戻り値は, リストを成分とするリストである.
成分リストの第 1 要素が slope, 第 2 要素は, その weight vector に対応する
microcharacteristic variety が bihomogeneous でない.
@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 参照
    @code{sm_gb}
@end table
*/


end$