Annotation of OpenXM/src/kan96xx/Doc/gkz.sm1, Revision 1.3
1.2 takayama 1: %% gkz.sm1, 1998, 11/6, 11/8, 2007-06-03
2: /gkz.version (3.000000) def
1.1 maekawa 3: gkz.version [(Version)] system_variable gt
4: { (This package requires the latest version of kan/sm1) message
5: (Please get it from http://www.math.kobe-u.ac.jp/KAN) message
6: error
7: } { } ifelse
8:
1.2 takayama 9: $gkz.sm1 generates gkz, mgkz systems (C) N.Takayama, 1998-2007, cf. rrank in hol.sm1 $ message-quiet
1.1 maekawa 10: /gkz.verbose 0 def
11: /gkz.A [[1 1 1 1] [0 1 2 3]] def
12: /gkz.b [3 5] def
13:
14:
15: /gkz {
16: /arg1 set
17: [/in-gkz /aa /typev /setarg /A /b /vx /vy /vyi /w /n /k
18: /vvv /www /At /i /ff /ttt /vxd /ttt2 /ttt /i /vxrule
19: ] pushVariables
20: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
21: [
22: /aa arg1 def
23: aa isArray { } { (array gkz) message (gkz) usage error } ifelse
24: /setarg 0 def
25: aa { tag } map /typev set
26: typev [ ArrayP ArrayP ] eq
27: { /A aa 0 get def
28: /b aa 1 get def
29: /setarg 1 def
30: } { } ifelse
31: typev [ ] eq
32: {
33: /A gkz.A def
34: /b gkz.b def
35: /setarg 1 def
36: } { } ifelse
37: typev [ ArrayP ] eq
38: { /A aa 0 get def
39: /b [ 1 1 A length { pop 0 } for ] def
40: /setarg 1 def
41: } { } ifelse
42: setarg { } { (Argument mismatch) message error } ifelse
43:
44: [(KanGBmessage) gkz.verbose] system_variable
45: b length /k set
46: A 0 get length /n set
47:
48: %% vy = [ (y1) (y2)] , vyi = [(yi1) (yi2)], vx = [(x1) (x2) (x3) (x4)]
49: [ 1 1 k { } for ] { (y) 2 1 roll gensym } map /vy set
50: [ 1 1 k { } for ] { (yi) 2 1 roll gensym } map /vyi set
51: [ 1 1 n { } for ] { (x) 2 1 roll gensym } map /vx set
52:
53: %% vvv = [(y1) (y2) (yi1) (yi2) (x1) (x2) (x3) (x4)]
54: /vvv vy vyi join vx join def
55: %% www = [(y1) 1 (y2) 1 (yi1) 1 (yi2) 1]
56: /www vy vyi join { 1 } map def
57: [ vvv from_records ring_of_polynomials
58: [www] weight_vector 0] define_ring
59:
60: /At A transpose def
61: %% ff = [ x1 - y1 , x2 - y1 y2, x3 - y1 y2^2 , x4 - y1 y2^3 ]
62: [
63: 1 1 n {
64: /i set
65: (x) i gensym . vy vyi << At i 1 sub get >> gkz.prod sub
66: } for
67: 1 1 k {
68: /i set
69: (1). (y) i gensym . (yi) i gensym . mul sub %% 1- y_i yi_i
70: } for
71: ] /ff set
72: gkz.verbose { ff message } { } ifelse
73: [ff] groebner_sugar 0 get
74: vy vyi join eliminatev /ttt set
75: ttt { toString } map /ttt set
76: %%% ttt <== toric ideal
77:
78: [ vx from_records ring_of_differential_operators 0] define_ring
79: %%D-clean /vvv [ 1 1 n { /i set [(x) i gensym . (Dx) i gensym . mul] } for ] def
80: /vvv [ 1 1 n { /i set [(x) i gensym . [@@@.Dsymbol (x)] cat i gensym . mul] } for ] def
81: A { {(universalNumber) dc} map } map vvv mul transpose 0 get /ff set
82:
83: ff b {(universalNumber) dc} map sub {toString} map /ff set
84: %%% ff <== linear equations.
85:
86: %%% vxd = [(Dx1) ... (Dx4)]
87: /vxd vx {@@@.Dsymbol 2 1 roll 2 cat_n} map def
88: %% fix 1999, 3/3 for non-homogeneous toric ideal.
89: /vxrule [ 0 1 vx length 1 sub {
90: /i set
91: [vx i get . vxd i get .] } for
92: ] def
93: %% ttt { . vx vxd join laplace0 toString } map /ttt2 set
94: ttt { . vxrule replace toString } map /ttt2 set
95:
96: /arg1 [ << ff ttt2 join >> vx ] def
97: ] pop
98: popEnv
99: popVariables
100: arg1
101: } def
102:
103:
104: %% \prod y_j^{v_j}
105: %% [(y1) (y2)] [(yi1) (yi2)] [ 1 3] gkz.prod ==> y1 y2^3
106: /gkz.prod {
107: /arg3 set
108: /arg2 set
109: /arg1 set
110: [/in-gkz.prod /yy /yyi /vec /ans /i /mm] pushVariables
111: [
112: /yy arg1 def
113: /yyi arg2 def
114: /vec arg3 def
115: /ans (1). def
116: 0 1 << vec length 1 sub >> {
117: /i set
118: << vec i get >> 0 lt {
119: /mm yyi i get . << 0 vec i get sub >> npower def
120: }
121: { /mm yy i get . << vec i get >> npower def }
122: ifelse
123: /ans ans mm mul def
124: } for
125: /arg1 ans def
126: ] pop
127: popVariables
128: arg1
129: } def
130: (gkz ) messagen-quiet
131:
132: [(gkz)
133: [([ A b] gkz [eq v])
134: ([ A ] gkz [eq v])
135: ([ ] gkz [eq v])
136: (array of array of integer A; array of integer b;)
137: (eq is the GKZ system defined by the matrix A and the parameter b.)
138: (v is the list of variables.)
139: (Default values of A and b are in gkz.A and gkz.b)
140: (For details, see Functional analysis and its applications, 23, 1989, 94--106.)
141: ( Grobner deformations of hypergeometric differential equations, Springer, 1999)
142: (Example 1: [ [[1 1 1 1] [0 1 3 4]] [1 2]] gkz rrank :: )
143: (Example 2: [ [[1 1 1 1] [0 1 3 4]] [0 0]] gkz rrank :: )
144: ]
145: ] putUsages
146:
1.2 takayama 147:
148: /mgkz.A [[1 1 1 1] [0 1 2 3]] def
149: /mgkz.w [4 0 0 2] def
150: /mgkz.b [3 5] def
151:
152:
153: /mgkz {
154: /arg1 set
155: [/in-mgkz /aa /typev /setarg /A /b /vx /vy /vyi /w /n /k
156: /vvv /www /At /i /ff /ttt /vxd /ttt2 /ttt /i /vxrule
157: /w /mrulex /mruled
158: ] pushVariables
159: [(CurrentRingp) (KanGBmessage)] pushEnv %% push current global environment.
160: [
161: /aa arg1 def
162: aa isArray { } { (array mgkz) message (mgkz) usage error } ifelse
163: /setarg 0 def
164: aa { tag } map /typev set
165: typev [ ArrayP ArrayP ArrayP] eq
166: { /A aa 0 get def
167: /w aa 1 get def
168: /b aa 2 get def
169: /setarg 1 def
170: } { } ifelse
171: typev [ ] eq
172: {
173: /A mgkz.A def
174: /w mgkz.w def
175: /b mgkz.b def
176: /setarg 1 def
177: } { } ifelse
178: setarg { } { (Argument mismatch) message error } ifelse
179:
180: b [0] join /b set
181: [(KanGBmessage) gkz.verbose] system_variable
182: b length /k set
183: A w append /A set
184: A transpose , [ 2 1 k { pop 0 } for 1] append /A set
185: A transpose /A set
186: A 0 get length /n set
187:
188: %% vy = [ (y1) (y2) (y3)] , vyi = [(yi1) (yi2) (yi3)],
189: %% vx = [(x1) (x2) (x3) (x4) (x5)]
190: [ 1 1 k { } for ] { (y) 2 1 roll gensym } map /vy set
191: [ 1 1 k { } for ] { (yi) 2 1 roll gensym } map /vyi set
192: [ 1 1 n { } for ] { (x) 2 1 roll gensym } map /vx set
193:
194: %% vvv = [(y1) (y2) (y3) (yi1) (yi2) (yi3) (x1) (x2) (x3) (x4) (x5)]
195: /vvv vy vyi join vx join def
196: %% www = [(y1) 1 (y2) 1 (y3) 1 (yi1) 1 (yi2) 1 (yi3) 1]
197: /www vy vyi join { 1 } map def
198: [ vvv from_records ring_of_polynomials
199: [www] weight_vector 0] define_ring
200:
201: /At A transpose def
202: %% Apply an algorithm to get the toric ideal.
203: %% Negative components are accepted. yi1=y1^(-1), ...
204: [
205: 1 1 n {
206: /i set
207: (x) i gensym . vy vyi << At i 1 sub get >> gkz.prod sub
208: } for
209: 1 1 k {
210: /i set
211: (1). (y) i gensym . (yi) i gensym . mul sub %% 1- y_i yi_i
212: } for
213: ] /ff set
214: gkz.verbose { ff message } { } ifelse
215: [ff] groebner_sugar 0 get
216: vy vyi join eliminatev /ttt set
217: ttt { toString } map /ttt set
218: %%% ttt <== toric ideal
219:
220: [ vx from_records ring_of_differential_operators 0] define_ring
221: %%D-clean /vvv [ 1 1 n { /i set [(x) i gensym . (Dx) i gensym . mul] } for ] def
222: /vvv [ 1 1 n { /i set [(x) i gensym . [@@@.Dsymbol (x)] cat i gensym . mul] } for ] def
223: A { {(universalNumber) dc} map } map vvv mul transpose 0 get /ff set
224:
225: ff b {(universalNumber) dc} map sub /ff set
226:
227: /mrulex vx , n 1 sub , get . /mrulex set
228: [[mrulex , (0). mrulex sub]] /mrulex set
229: %%% [[(x5). (-x5).]] mrulex
230: ff {mrulex replace} map {toString} map /ff set
231: %%% ff <== linear equations.
232:
233: %%% vxd = [(Dx1) ... (Dx4) (Dx5)]
234: /vxd vx {@@@.Dsymbol 2 1 roll 2 cat_n} map def
235:
236: [[vxd , n 1 sub , get .
237: vx , n 1 sub , get .]] /mruled set
238:
239: %% fix 1999, 3/3 for non-homogeneous toric ideal.
240: /vxrule [ 0 1 vx length 1 sub {
241: /i set
242: [vx i get . vxd i get .] } for
243: ] def
244: %% ttt { . vx vxd join laplace0 toString } map /ttt2 set
245: ttt { . vxrule replace , mruled replace , toString } map /ttt2 set
246:
247: /arg1 [ << ff ttt2 join >> vx ] def
248: ] pop
249: popEnv
250: popVariables
251: arg1
252: } def
253:
254: [(mgkz)
255: [([A w b] gkz [eq v])
256: ([ ] gkz [eq v])
257: (array of array of integer A; array of integer w, b;)
258: (eq is the modified GKZ system defined by the matrix A, weight w, )
259: (and the parameter b.)
260: (v is the list of variables. The last variable is the deformation variable.)
261: (Default values of A and b are in gkz.A and gkz.b)
1.3 ! takayama 262: (For details, see the paper Modified A-hypergeometric system, N.Takayama)
! 263: (http://arxiv.org/abs/0707.0043)
1.2 takayama 264: (Example : [ [[1 2 3]] [1 2 1] [0]] mgkz rank :: )
265: (Example : [ [[1 2 3]] [0]] gkz rank :: )
266: (Example : [ [[1 1 1] [1 2 3]] [1 2 1] [1 0]] mgkz message )
267: ]
268: ] putUsages
269:
270:
1.1 maekawa 271: ( ) message-quiet ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to gkz.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc