%% 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 ;