%% gkz.sm1, 1998, 11/6, 11/8
/gkz.version (2.981108) def
gkz.version [(Version)] system_variable gt
{ (This package requires the latest version of kan/sm1) message
  (Please get it from http://www.math.kobe-u.ac.jp/KAN) message
  error
} { } ifelse

$gkz.sm1 generates gkz systems (C) N.Takayama, 1998, 11/8, cf. rrank in hol.sm1 $ message-quiet
/gkz.verbose 0 def
/gkz.A [[1 1 1 1] [0 1 2 3]] def
/gkz.b [3 5] def


/gkz {
  /arg1 set
  [/in-gkz /aa /typev /setarg /A /b /vx /vy /vyi /w /n /k
   /vvv /www /At /i /ff /ttt /vxd /ttt2 /ttt /i /vxrule
  ] pushVariables 
  [(CurrentRingp) (KanGBmessage)] pushEnv  %% push current global environment.
  [
    /aa arg1 def
    aa isArray { } { (array gkz) message (gkz) usage error } ifelse
    /setarg 0 def
    aa { tag } map /typev set
    typev [ ArrayP ArrayP ] eq
    {  /A aa 0 get def
       /b aa 1 get  def
       /setarg 1 def
    } { } ifelse
    typev [ ] eq
    {
       /A gkz.A def
       /b gkz.b def
       /setarg 1 def
    } { } ifelse
    typev [ ArrayP ] eq
    {  /A aa 0 get def
       /b [ 1 1 A length { pop 0 } for ] def
       /setarg 1 def
    } { } ifelse
    setarg { } { (Argument mismatch) message error } ifelse

    [(KanGBmessage) gkz.verbose] system_variable
    b length /k set
    A 0 get length /n set

   %% vy = [ (y1) (y2)] , vyi = [(yi1) (yi2)], vx = [(x1) (x2) (x3) (x4)]
   [ 1 1 k { } for ] { (y) 2 1 roll gensym } map /vy   set
   [ 1 1 k { } for ] { (yi) 2 1 roll gensym } map /vyi set
   [ 1 1 n { } for ] { (x) 2 1 roll gensym } map /vx   set

   %% vvv = [(y1) (y2) (yi1) (yi2) (x1) (x2) (x3) (x4)]
   /vvv vy vyi join vx join def
   %% www = [(y1) 1 (y2) 1 (yi1) 1 (yi2) 1]
   /www vy vyi join { 1 } map def
   [ vvv from_records  ring_of_polynomials
     [www] weight_vector 0] define_ring

   /At A transpose def
   %% ff = [ x1 - y1 , x2 - y1 y2, x3 - y1 y2^2 , x4 - y1 y2^3 ]
   [
    1 1 n {
      /i set
      (x) i gensym .   vy vyi << At i 1 sub get >> gkz.prod sub
    } for
    1 1 k {
      /i set
      (1). (y) i gensym . (yi) i gensym . mul sub %% 1- y_i yi_i
    } for
   ] /ff set
   gkz.verbose { ff message } { } ifelse
   [ff] groebner_sugar 0 get 
   vy vyi join eliminatev /ttt set
   ttt { toString } map /ttt set
   %%% ttt <== toric ideal

   [ vx from_records ring_of_differential_operators 0] define_ring
%%D-clean  /vvv  [ 1 1 n { /i set [(x) i gensym . (Dx) i gensym . mul] } for ] def
   /vvv  [ 1 1 n { /i set [(x) i gensym . [@@@.Dsymbol (x)] cat i gensym . mul] } for ] def
   A { {(universalNumber) dc} map } map vvv mul transpose 0 get /ff set

   ff b {(universalNumber) dc} map sub {toString} map /ff set
   %%% ff <== linear equations.

   %%% vxd = [(Dx1) ... (Dx4)] 
   /vxd vx {@@@.Dsymbol 2 1 roll 2 cat_n} map def
   %% fix 1999, 3/3 for non-homogeneous toric ideal.
   /vxrule [ 0 1 vx length 1 sub {
      /i set
      [vx i get . vxd i get .] } for
   ] def
%%   ttt { . vx vxd join laplace0 toString } map  /ttt2 set
   ttt { . vxrule replace toString } map  /ttt2 set

   /arg1 [ << ff ttt2 join >> vx ] def  
  ] pop
  popEnv
  popVariables
  arg1
} def


%%  \prod y_j^{v_j}
%% [(y1) (y2)] [(yi1) (yi2)] [ 1 3] gkz.prod ==> y1 y2^3
/gkz.prod {
  /arg3 set
  /arg2 set
  /arg1 set
  [/in-gkz.prod /yy /yyi /vec /ans /i  /mm] pushVariables
  [
    /yy arg1 def
    /yyi arg2 def
    /vec arg3 def
    /ans (1). def
    0 1 << vec length 1 sub >> {
      /i set
      << vec i get >> 0 lt {
        /mm yyi i get . << 0 vec i get sub >> npower def
      }
      { /mm yy i get . << vec i get >> npower  def } 
      ifelse
      /ans ans mm mul def
    } for
    /arg1 ans def
  ] pop
  popVariables
  arg1
} def  
(gkz ) messagen-quiet
 
[(gkz)
 [([ A b] gkz [eq v])
  ([ A  ] gkz [eq v])
  ([    ] gkz [eq v]) 
  (array of array of integer A; array of integer b;)
  (eq is the GKZ system defined by the matrix A and the parameter b.)
  (v is the list of variables.)
  (Default values of A and b are in gkz.A and gkz.b)
  (For details, see Functional analysis and its applications, 23, 1989, 94--106.)
  (    Grobner deformations of hypergeometric differential equations, Springer, 1999)
  (Example 1: [ [[1 1 1 1] [0 1 3 4]] [1 2]] gkz rrank :: )
  (Example 2: [ [[1 1 1 1] [0 1 3 4]] [0 0]] gkz rrank :: )
 ]
] putUsages

( ) message-quiet ;