1 | //////////////////////////////////////////////////////////////// |
---|
2 | version="version fpaprops.lib 4.1.1.4 Oct_2018 "; // $Id$ |
---|
3 | category="Noncommutative"; |
---|
4 | info=" |
---|
5 | LIBRARY: fpaprops.lib Algorithmic ring-theoretic properties of finitely presented algebras (Letterplace) |
---|
6 | AUTHORS: Karim Abou Zeid, karim.abou.zeid at rwth-aachen.de |
---|
7 | |
---|
8 | Support: Project II.6 in the transregional collaborative research centre |
---|
9 | SFB-TRR 195 'Symbolic Tools in Mathematics and their Application' of the German DFG |
---|
10 | |
---|
11 | OVERVIEW: |
---|
12 | In this library, algorithms for computing various ring-theoretic properties of |
---|
13 | finitely presented algebras are implemented. |
---|
14 | Applicability: Letterplace rings. |
---|
15 | |
---|
16 | REFERENCES: |
---|
17 | Huishi Li: Groebner bases in ring theory. World Scientific, 2010. |
---|
18 | |
---|
19 | KEYWORDS: finitely presented algebra; ring theory; Letterplace Groebner basis; |
---|
20 | growth of algebra; Gelfand-Kirillov dimension; global homological dimension; semi-prime ideal; Ufnarovski graph |
---|
21 | |
---|
22 | SEE ALSO: fpadim_lib, freegb_lib |
---|
23 | |
---|
24 | PROCEDURES: |
---|
25 | lpNoetherian(<GB>); check whether A/<LM(GB)> is (left/right) Noetherian |
---|
26 | lpIsSemiPrime(<GB>); check whether A/<LM(GB)> is semi-prime |
---|
27 | lpIsPrime(<GB>); check whether A/<LM(GB)> is prime |
---|
28 | lpGkDim(<GB>); compute the Gelfand Kirillov dimension of A/<GB> |
---|
29 | lpGlDimBound(<GB>); compute an upper bound for the global dimension of A/<GB> |
---|
30 | lpSubstitute(); substitute a variable with polynomials (ring homomorphism) |
---|
31 | lpUfGraph(<GB>); constructs the Ufnarovskij graph for <LM(GB)> |
---|
32 | lpCalcSubstDegBound(); utility for lpSubstitute |
---|
33 | "; |
---|
34 | |
---|
35 | LIB "fpadim.lib"; |
---|
36 | |
---|
37 | /* very fast and cheap test of consistency and functionality |
---|
38 | DO NOT make it static ! |
---|
39 | after adding the new proc, add it here */ |
---|
40 | proc tstfpaprops() |
---|
41 | { |
---|
42 | example lpNoetherian; |
---|
43 | example lpIsSemiPrime; |
---|
44 | example lpIsPrime; |
---|
45 | example lpGkDim; |
---|
46 | example lpGlDimBound; |
---|
47 | example lpSubstitute; |
---|
48 | example lpUfGraph; |
---|
49 | example lpCalcSubstDegBound; |
---|
50 | }; |
---|
51 | |
---|
52 | |
---|
53 | //////////////////////////////////////////////////////////////////// |
---|
54 | proc lpNoetherian(ideal G) |
---|
55 | "USAGE: lpNoetherian(G); G an ideal in a Letterplace ring |
---|
56 | RETURN: int |
---|
57 | @* 0 not Noetherian |
---|
58 | @* 1 left Noetherian |
---|
59 | @* 2 right Noetherian |
---|
60 | @* 3 Noetherian |
---|
61 | @* 4 weak Noetherian |
---|
62 | PURPOSE: Check whether the monomial algebra A/<LM(G)> is (left/right) noetherian |
---|
63 | ASSUME: - basering is a Letterplace ring |
---|
64 | @* - G is a Groebner basis |
---|
65 | THEORY: lpNoetherian works with the monomial algebra A/<LM(G)>. |
---|
66 | If it gives an affirmative answer for one of the properties, then it |
---|
67 | holds for both A/<LM(G)> and A/<G>. However, a negative answer applies |
---|
68 | only to A/<LM(G)> and not necessarily to A/<G>. |
---|
69 | NOTE: Weak Noetherian means that two-sided ideals in A/<LM(G)> satisfy |
---|
70 | the acc (ascending chain condition). |
---|
71 | " |
---|
72 | { |
---|
73 | G = lead(G); |
---|
74 | G = simplify(G, 2+4+8); |
---|
75 | |
---|
76 | // check special case 1 |
---|
77 | int l = 0; |
---|
78 | for (int i = 1; i <= size(G); i++) { |
---|
79 | // find the max degree in G |
---|
80 | int d = deg(G[i]); |
---|
81 | if (d > l) { |
---|
82 | l = d; |
---|
83 | } |
---|
84 | |
---|
85 | // also if G is the whole ring |
---|
86 | if (leadmonom(G[i]) == 1) { |
---|
87 | ERROR("noetherianity not defined for 0-ring") |
---|
88 | } |
---|
89 | kill d; |
---|
90 | } kill i; |
---|
91 | // if longest word has length 1 we handle it as a special case |
---|
92 | if (l == 1) { |
---|
93 | int n = lpVarBlockSize(basering); // variable count |
---|
94 | int k = size(G); |
---|
95 | if (k == n) { // only the field left |
---|
96 | return(3); // every field is noetherian |
---|
97 | } |
---|
98 | if (k == n-1) { // V = {1} with loop |
---|
99 | return(3); |
---|
100 | } |
---|
101 | if (k <= n-2) { // V = {1} with more than one loop |
---|
102 | return(0); |
---|
103 | } |
---|
104 | } |
---|
105 | |
---|
106 | intmat UG = lpUfGraph(G); |
---|
107 | |
---|
108 | // check special case 2 |
---|
109 | intmat zero[nrows(UG)][ncols(UG)]; |
---|
110 | if (UG == zero) { |
---|
111 | return (3); |
---|
112 | } |
---|
113 | |
---|
114 | if (!imHasLoops(UG) && imIsUpRightTriangle(topologicalSort(UG))) { |
---|
115 | // UG is a DAG |
---|
116 | return (3); |
---|
117 | } |
---|
118 | |
---|
119 | // DFS from every vertex, if cycle is found, check every vertex for incomming/outcom |
---|
120 | intvec visited; |
---|
121 | visited[ncols(UG)] = 0; |
---|
122 | int inFlag, outFlag, inOutFlag; |
---|
123 | for (int v = 1; v <= ncols(UG) && (inFlag + outFlag) != 3; v++) { |
---|
124 | int inOutFlags = inOutCommingEdgesInCycles(UG, v, visited, 0); |
---|
125 | if (inOutFlags == 1) { |
---|
126 | inFlag = 1; |
---|
127 | } |
---|
128 | if (inOutFlags == 2) { |
---|
129 | outFlag = 1; |
---|
130 | } |
---|
131 | if (inOutFlags == 3) { |
---|
132 | inFlag = 1; |
---|
133 | outFlag = 1; |
---|
134 | } |
---|
135 | if (inOutFlags == 4) { |
---|
136 | inOutFlag = 1; |
---|
137 | } |
---|
138 | if (inOutFlags == 5) { |
---|
139 | inFlag = 1; |
---|
140 | inOutFlag = 1; |
---|
141 | } |
---|
142 | if (inOutFlags == 6) { |
---|
143 | outFlag = 1; |
---|
144 | inOutFlag = 1; |
---|
145 | } |
---|
146 | if (inOutFlags == 7) { |
---|
147 | inFlag = 1; |
---|
148 | outFlag = 1; |
---|
149 | inOutFlag = 1; |
---|
150 | } |
---|
151 | kill inOutFlags; |
---|
152 | } kill v; |
---|
153 | int noetherian = 3 - 1*inFlag - 2*outFlag; |
---|
154 | if (noetherian == 0) { |
---|
155 | return (4 - 4*inOutFlag); // weak noetherian |
---|
156 | } |
---|
157 | return (noetherian); |
---|
158 | } |
---|
159 | example |
---|
160 | { |
---|
161 | "EXAMPLE:"; echo = 2; |
---|
162 | ring r = 0,(x,y),dp; |
---|
163 | def R = makeLetterplaceRing(5); |
---|
164 | setring R; |
---|
165 | ideal G = x*x, y*x; // K<x,y>/<xx,yx> is right noetherian |
---|
166 | lpNoetherian(G); |
---|
167 | } |
---|
168 | |
---|
169 | static proc inOutCommingEdgesInCycles(intmat G, int v, intvec visited, intvec path) { |
---|
170 | // Mark the current vertex as visited |
---|
171 | visited[v] = 1; |
---|
172 | |
---|
173 | // Store the current vertex in path |
---|
174 | if (path[1] == 0) { |
---|
175 | path[1] = v; |
---|
176 | } else { |
---|
177 | path[size(path) + 1] = v; |
---|
178 | } |
---|
179 | |
---|
180 | int inFlag, outFlag, inOutFlag; |
---|
181 | |
---|
182 | for (int w = 1; w <= ncols(G) && (inFlag + outFlag) != 3; w++) { |
---|
183 | if (G[v,w] == 1) { |
---|
184 | if (visited[w] == 1) { // new cycle |
---|
185 | int tmpInFlag; |
---|
186 | int tmpOutFlag; |
---|
187 | if (v == w) { // cycle is a loop |
---|
188 | for (int u = 1; u <= ncols(G); u++) { |
---|
189 | if (G[v,u] && u != v) { |
---|
190 | outFlag = 1; |
---|
191 | tmpOutFlag = 1; |
---|
192 | } |
---|
193 | if (G[u,v] && u != v) { |
---|
194 | inFlag = 1; |
---|
195 | tmpInFlag = 1; |
---|
196 | } |
---|
197 | } kill u; |
---|
198 | } else { |
---|
199 | for (int i = size(path); i >= 1; i--) { // for each vertex in the path |
---|
200 | // check for neighbors not directly next or prev in cycle |
---|
201 | for (int u = 1; u <= ncols(G); u++) { |
---|
202 | if (G[path[i],u] == 1) { // there is an edge to u |
---|
203 | if (path[i] != v) { |
---|
204 | if (u != path[i+1]) { // and u is not the next element in the cycle |
---|
205 | outFlag = 1; |
---|
206 | tmpOutFlag = 1; |
---|
207 | } |
---|
208 | } else { |
---|
209 | if (u != w) { |
---|
210 | outFlag = 1; |
---|
211 | tmpOutFlag = 1; |
---|
212 | } |
---|
213 | } |
---|
214 | } |
---|
215 | if (G[u,path[i]] == 1) { // there is an edge from u |
---|
216 | if (path[i] != w) { |
---|
217 | if (u != path[i-1]) { // and u is not the previous element in the cylce |
---|
218 | inFlag = 1; |
---|
219 | tmpInFlag = 1; |
---|
220 | } |
---|
221 | } else { |
---|
222 | if (u != v) { |
---|
223 | inFlag = 1; |
---|
224 | tmpInFlag = 1; |
---|
225 | } |
---|
226 | } |
---|
227 | } |
---|
228 | } kill u; |
---|
229 | if (path[i] == w) { |
---|
230 | break; |
---|
231 | } |
---|
232 | } kill i; |
---|
233 | } |
---|
234 | if (tmpInFlag > 0 && tmpOutFlag > 0) { |
---|
235 | // there are both in and outcomming edges in this cycle |
---|
236 | inOutFlag = 1; |
---|
237 | } |
---|
238 | kill tmpInFlag; |
---|
239 | kill tmpOutFlag; |
---|
240 | } else { |
---|
241 | int inOutFlags = inOutCommingEdgesInCycles(G, w, visited, path); |
---|
242 | if (inOutFlags == 1) { |
---|
243 | inFlag = 1; |
---|
244 | } |
---|
245 | if (inOutFlags == 2) { |
---|
246 | outFlag = 1; |
---|
247 | } |
---|
248 | if (inOutFlags == 3) { |
---|
249 | inFlag = 1; |
---|
250 | outFlag = 1; |
---|
251 | } |
---|
252 | if (inOutFlags == 4) { |
---|
253 | inOutFlag = 1; |
---|
254 | } |
---|
255 | if (inOutFlags == 5) { |
---|
256 | inFlag = 1; |
---|
257 | inOutFlag = 1; |
---|
258 | } |
---|
259 | if (inOutFlags == 6) { |
---|
260 | outFlag = 1; |
---|
261 | inOutFlag = 1; |
---|
262 | } |
---|
263 | if (inOutFlags == 7) { |
---|
264 | inFlag = 1; |
---|
265 | outFlag = 1; |
---|
266 | inOutFlag = 1; |
---|
267 | } |
---|
268 | kill inOutFlags; |
---|
269 | } |
---|
270 | } |
---|
271 | } kill w; |
---|
272 | |
---|
273 | return (1*inFlag + 2*outFlag + 4*inOutFlag); |
---|
274 | } |
---|
275 | |
---|
276 | proc lpIsSemiPrime(ideal G) |
---|
277 | "USAGE: lpIsSemiPrime(G); G an ideal in a Letterplace ring |
---|
278 | RETURN: boolean |
---|
279 | PURPOSE: Check whether A/<LM(G)> is semi-prime ring, |
---|
280 | alternatively whether <LM(G)> is a semi-prime ideal in A. |
---|
281 | ASSUME: - basering is a Letterplace ring |
---|
282 | - G is a Groebner basis |
---|
283 | THEORY: A (two-sided) ideal I in the ring A is semi-prime, if for any a in A one has |
---|
284 | aAa subseteq I implies a in I. |
---|
285 | NOTE: lpIsSemiPrime works with the monomial algebra A/<LM(G)>. |
---|
286 | A positive answer holds for both A/<LM(G)> and A/<G>, while |
---|
287 | a negative answer applies only to A/<LM(G)> and not necessarily to |
---|
288 | A/<G>. |
---|
289 | " |
---|
290 | { |
---|
291 | // old theory part: that is when p * (A/<LM(G)>) * p != 0 for all p in (A/<LM(G)> - {0}). |
---|
292 | G = lead(G); |
---|
293 | G = simplify(G, 2+4+8); |
---|
294 | |
---|
295 | // check special case 1 |
---|
296 | int l = 0; |
---|
297 | for (int i = 1; i <= size(G); i++) { |
---|
298 | // find the max degree in G |
---|
299 | int d = deg(G[i]); |
---|
300 | if (d > l) { |
---|
301 | l = d; |
---|
302 | } |
---|
303 | |
---|
304 | // also if G is the whole ring |
---|
305 | if (leadmonom(G[i]) == 1) { |
---|
306 | ERROR("primeness not defined for 0-ring") |
---|
307 | } |
---|
308 | kill d; |
---|
309 | } kill i; |
---|
310 | // if longest word has length 1 we handle it as a special case |
---|
311 | if (l == 1) { |
---|
312 | return(1); |
---|
313 | } |
---|
314 | |
---|
315 | list VUG = lpUfGraph(G, 1); |
---|
316 | intmat UG = VUG[1]; // the Ufnarovskij graph |
---|
317 | ideal V = VUG[2]; // the vertices of UG (standard words with length = l-1) |
---|
318 | |
---|
319 | list LG = lpId2ivLi(G); |
---|
320 | list SW = ivStandardWordsUpToLength(LG, maxDeg(G)); |
---|
321 | list LV = lpId2ivLi(V); |
---|
322 | |
---|
323 | // delete the 0 in SW |
---|
324 | int indexofzero = ivIndexOf(SW, 0); |
---|
325 | if (indexofzero > 0) { // should be always true when |SW| > 0 |
---|
326 | SW = delete(SW, indexofzero); |
---|
327 | } |
---|
328 | |
---|
329 | // check if each monomial in SW is cyclic |
---|
330 | for (int i = 1; i <= size(SW); i++) { |
---|
331 | if (!isCyclicInUfGraph(UG, LV, SW[i])) { |
---|
332 | return (0); |
---|
333 | } |
---|
334 | } kill i; |
---|
335 | |
---|
336 | return (1); |
---|
337 | } |
---|
338 | example |
---|
339 | { |
---|
340 | "EXAMPLE:"; echo = 2; |
---|
341 | ring r = 0,(x1,x2),dp; |
---|
342 | def R = makeLetterplaceRing(5); |
---|
343 | setring R; |
---|
344 | ideal G = x1*x2, x2*x1; // K<x1,x2>/<x1*x2,x2*x1> is semi prime |
---|
345 | lpIsSemiPrime(G); |
---|
346 | } |
---|
347 | |
---|
348 | // checks whether a monomial is a cyclic monomial |
---|
349 | static proc isCyclicInUfGraph(intmat UG, list LV, intvec u) |
---|
350 | { |
---|
351 | if (ncols(UG) == 0) {return (0);} // UG is empty |
---|
352 | if (u == 0) {return (0);} // 0 is never cyclic |
---|
353 | |
---|
354 | int l = size(LV[1]) + 1; |
---|
355 | |
---|
356 | int s = size(u); |
---|
357 | if (s <= l - 1) { |
---|
358 | for (int i = 1; i <= size(LV); i++) { |
---|
359 | // for all vertices where u is a suffix |
---|
360 | if(isSF(u, LV[i])) { |
---|
361 | if (existsRoute(UG, i, i)) { |
---|
362 | return (1); |
---|
363 | } |
---|
364 | } |
---|
365 | } kill i; |
---|
366 | } else { // size(u) > l - 1 |
---|
367 | int m = s - l + 1; |
---|
368 | |
---|
369 | // there must be a route from v0 to vm |
---|
370 | intvec v0 = u[1..(l-1)]; // first in route of u |
---|
371 | intvec vm = u[m+1..m+(l-1)]; // last in route of u |
---|
372 | |
---|
373 | int iv0 = ivIndexOf(LV, v0); |
---|
374 | int ivm = ivIndexOf(LV, vm); |
---|
375 | if (iv0 <= 0 || ivm <= 0) { |
---|
376 | ERROR("u is not a standard word"); |
---|
377 | } |
---|
378 | |
---|
379 | return (existsRoute(UG, ivm, iv0)); |
---|
380 | } |
---|
381 | |
---|
382 | return (0); |
---|
383 | } |
---|
384 | |
---|
385 | proc lpIsPrime(ideal G) |
---|
386 | "USAGE: lpIsPrime(G); G an ideal in a Letterplace ring |
---|
387 | RETURN: boolean |
---|
388 | PURPOSE: Check whether A/<LM(G)> is prime ring, |
---|
389 | alternatively whether <LM(G)> is a prime ideal in A. |
---|
390 | ASSUME: - basering is a Letterplace ring |
---|
391 | - G is a Groebner basis |
---|
392 | THEORY: A (two-sided) ideal I in the ring A is prime, if for any a,b in A one has |
---|
393 | aAb subseteq I implies a in I or b in I. |
---|
394 | NOTE: lpIsPrime works with the monomial algebra A/<LM(G)>. |
---|
395 | A positive answer holds for both A/<LM(G)> and A/<G>, while |
---|
396 | a negative answer applies only to A/<LM(G)> and not necessarily to A/<G>. |
---|
397 | " |
---|
398 | { |
---|
399 | // old theory part: that is when p1 * (A/<LM(G)>) * p2 != 0 for all p1, p2 in (A/<LM(G)> - {0}). |
---|
400 | G = lead(G); |
---|
401 | G = simplify(G, 2+4+8); |
---|
402 | |
---|
403 | // check special case 1 |
---|
404 | int l = 0; |
---|
405 | for (int i = 1; i <= size(G); i++) { |
---|
406 | // find the max degree in G |
---|
407 | int d = deg(G[i]); |
---|
408 | if (d > l) { |
---|
409 | l = d; |
---|
410 | } |
---|
411 | |
---|
412 | // also if G is the whole ring |
---|
413 | if (leadmonom(G[i]) == 1) { |
---|
414 | ERROR("primeness not defined for 0-ring") |
---|
415 | } |
---|
416 | kill d; |
---|
417 | } kill i; |
---|
418 | // if longest word has length 1 we handle it as a special case |
---|
419 | if (l == 1) { |
---|
420 | return(1); |
---|
421 | } |
---|
422 | |
---|
423 | list VUG = lpUfGraph(G, 1); |
---|
424 | intmat UG = VUG[1]; // the Ufnarovskij graph |
---|
425 | ideal V = VUG[2]; // the vertices of UG (standard words with length = l-1) |
---|
426 | |
---|
427 | list LG = lpId2ivLi(G); |
---|
428 | list LV = lpId2ivLi(V); |
---|
429 | |
---|
430 | int n = ncols(UG); |
---|
431 | |
---|
432 | // 1) for each vi vj there exists a route from vi to vj (means UG is connected) |
---|
433 | for (int i = 1; i <= n; i++) { |
---|
434 | for (int j = 1; j <= n; j++) { |
---|
435 | if (!existsRoute(UG, i, j)) { |
---|
436 | return (0); |
---|
437 | } |
---|
438 | } kill j; |
---|
439 | } kill i; |
---|
440 | |
---|
441 | // 2) any standard word with length < l-1 is a suffix of a vertex |
---|
442 | list SW = ivStandardWordsUpToLength(LG, maxDeg(G) - 2); // < maxDeg - 1 |
---|
443 | if (size(SW) > 0 && size(LV) == 0) {return (0);} |
---|
444 | for (int i = 1; i <= size(SW); i++) { |
---|
445 | // check if SW[i] is a suffix of some LV |
---|
446 | for (int j = 1; j <= size(LV); j++) { |
---|
447 | if (!isSF(SW[i], LV[j])) { |
---|
448 | if (j == size(LV)) { |
---|
449 | return (0); |
---|
450 | } |
---|
451 | } else { |
---|
452 | break; |
---|
453 | } |
---|
454 | } |
---|
455 | } kill i; |
---|
456 | |
---|
457 | return (1); |
---|
458 | } |
---|
459 | example |
---|
460 | { |
---|
461 | "EXAMPLE:"; echo = 2; |
---|
462 | ring r = 0,(x,y),dp; |
---|
463 | def R = makeLetterplaceRing(5); |
---|
464 | setring R; |
---|
465 | ideal G = x*x, y*y; // K<x,y>/<xx,yy> is prime |
---|
466 | lpIsPrime(G); |
---|
467 | } |
---|
468 | |
---|
469 | static proc existsRoute(intmat G, int v, int u, list #) |
---|
470 | "USAGE: existsRoute(G,v,u); G a graph, v and u vertices |
---|
471 | NOTE: don't pass anything to # (internal use for recursion) |
---|
472 | routes always have at least one edge |
---|
473 | " |
---|
474 | { |
---|
475 | int n = ncols(G); |
---|
476 | |
---|
477 | // init visited |
---|
478 | intvec visited; |
---|
479 | if (size(#) > 0) { |
---|
480 | if (v == u) {return (1);} // don't check on first call so |route| >= 1 holds |
---|
481 | visited = #[1]; |
---|
482 | } else { // first call |
---|
483 | visited[n] = 0; |
---|
484 | } |
---|
485 | |
---|
486 | // mark current vertex as visited |
---|
487 | visited[v] = 1; |
---|
488 | |
---|
489 | // recursive DFS |
---|
490 | for (int i = 1; i <= n; i++) { |
---|
491 | if (G[v,i] && (!visited[i] || i == u)) { // i == u to allow routes from u to u |
---|
492 | if (existsRoute(G, i, u, visited)) { |
---|
493 | return (1); |
---|
494 | } |
---|
495 | } |
---|
496 | } kill i; |
---|
497 | |
---|
498 | return (0); |
---|
499 | } |
---|
500 | |
---|
501 | static proc UfGraphURTNZDGrowth(intmat UG) { |
---|
502 | // URTNZD = upper right triangle non zero diagonal |
---|
503 | for (int i = 1; i <= ncols(UG); i++) { |
---|
504 | UG[i,i] = 0; // remove all loops |
---|
505 | } kill i; |
---|
506 | intmat UGk = UG; |
---|
507 | intmat zero[nrows(UGk)][ncols(UGk)]; |
---|
508 | int k = 1; |
---|
509 | while (UGk != zero) { |
---|
510 | UGk = UGk * UG; |
---|
511 | k++; |
---|
512 | } |
---|
513 | return (k); |
---|
514 | } |
---|
515 | |
---|
516 | static proc imIsUpRightTriangle(intmat M) { |
---|
517 | for (int i = 1; i <= nrows(M); i++) { |
---|
518 | for (int j = 1; j < i; j++) { |
---|
519 | if(M[i,j] != 0) { return (0); } |
---|
520 | } kill j; |
---|
521 | } kill i; |
---|
522 | return (1); |
---|
523 | } |
---|
524 | |
---|
525 | static proc eliminateZerosUpTriangle(intmat G) { |
---|
526 | // G is expected to be an upper triangle matrix |
---|
527 | for (int i = ncols(G); i >= 1; i--) { // loop order is important because we delete entries |
---|
528 | if (G[i,i] == 0) { // i doesn't have a cycle |
---|
529 | for (int j = 1; j < i; j++) { |
---|
530 | if (G[j,i] == 1) { // j has an edge to i |
---|
531 | for (int k = i + 1; k <= nrows(G); k++) { |
---|
532 | if (G[i,k] == 1) { |
---|
533 | G[j,k] = G[i,k]; // give j all edges from i |
---|
534 | } |
---|
535 | } kill k; |
---|
536 | } |
---|
537 | } kill j; |
---|
538 | G = imDelRowCol(G,i,i); // remove vertex i |
---|
539 | } |
---|
540 | } kill i; |
---|
541 | return (G); |
---|
542 | } |
---|
543 | |
---|
544 | static proc imDelRowCol(intmat M, int row, int col) { |
---|
545 | // row and col are expected to be > 0 |
---|
546 | int nr = nrows(M); |
---|
547 | int nc = ncols(M); |
---|
548 | intmat Mdel[nr - 1][nc - 1]; |
---|
549 | for (int i = 1; i <= nr; i++) { |
---|
550 | for (int j = 1; j <= nc; j++) { |
---|
551 | if(i != row && j != col) { |
---|
552 | int newi = i; |
---|
553 | int newj = j; |
---|
554 | if (i > row) { newi = i - 1; } |
---|
555 | if (j > col) { newj = j - 1; } |
---|
556 | Mdel[newi,newj] = M[i,j]; |
---|
557 | kill newi; kill newj; |
---|
558 | } |
---|
559 | } kill j; |
---|
560 | } kill i; |
---|
561 | return (Mdel); |
---|
562 | } |
---|
563 | |
---|
564 | static proc topologicalSort(intmat G) { |
---|
565 | // NOTE: ignores loops |
---|
566 | // NOTE: this takes O(|V^3|), can be optimized |
---|
567 | int n = ncols(G); |
---|
568 | for (int i = 1; i <= n; i++) { // only use the submat at i |
---|
569 | // find a vertex v in the submat at i with no incoming edges |
---|
570 | int v; |
---|
571 | for (int j = i; j <= n; j++) { |
---|
572 | int incoming = 0; |
---|
573 | for (int k = i; k <= n; k++) { |
---|
574 | if (k != j && G[k,j] == 1) { |
---|
575 | incoming = 1; |
---|
576 | } |
---|
577 | } kill k; |
---|
578 | if (incoming == 0) { |
---|
579 | v = j; |
---|
580 | kill incoming; |
---|
581 | break; |
---|
582 | } else { |
---|
583 | if (j == n) { |
---|
584 | // G contains at least one cycle, abort |
---|
585 | return (G); |
---|
586 | } |
---|
587 | } |
---|
588 | kill incoming; |
---|
589 | } kill j; |
---|
590 | |
---|
591 | // swap v and i |
---|
592 | if (v != i) { |
---|
593 | G = imPermcol(G, v, i); |
---|
594 | G = imPermrow(G, v, i); |
---|
595 | } |
---|
596 | kill v; |
---|
597 | } kill i; |
---|
598 | return (G); |
---|
599 | } |
---|
600 | |
---|
601 | static proc imPermcol (intmat A, int c1, int c2) |
---|
602 | { |
---|
603 | intmat B = A; |
---|
604 | int k = nrows(B); |
---|
605 | B[1..k,c1] = A[1..k,c2]; |
---|
606 | B[1..k,c2] = A[1..k,c1]; |
---|
607 | return (B); |
---|
608 | } |
---|
609 | |
---|
610 | static proc imPermrow (intmat A, int r1, int r2) |
---|
611 | { |
---|
612 | intmat B = A; |
---|
613 | int k = ncols(B); |
---|
614 | B[r1,1..k] = A[r2,1..k]; |
---|
615 | B[r2,1..k] = A[r1,1..k]; |
---|
616 | return (B); |
---|
617 | } |
---|
618 | |
---|
619 | static proc UfGraphGrowth(intmat UG) |
---|
620 | { |
---|
621 | int n = ncols(UG); // number of vertices |
---|
622 | // iterate through all vertices |
---|
623 | |
---|
624 | intvec visited = 0:n; |
---|
625 | intvec cyclic = 0:n; |
---|
626 | intvec countedCycles = -2:n; |
---|
627 | |
---|
628 | int maxCycleCount = 0; |
---|
629 | for (int v = 1; v <= n; v++) { |
---|
630 | countedCycles = countCycles(UG, v, visited, cyclic, 0, countedCycles); |
---|
631 | dbprint("counted " + string(countedCycles[v]) + " cycles from vertex " + string(v) + "/" + string(n) + " (cache: " + string(countedCycles) + ")"); |
---|
632 | if (countedCycles[v] == -1) { |
---|
633 | return(-1); |
---|
634 | } |
---|
635 | if (countedCycles[v] > maxCycleCount) { |
---|
636 | maxCycleCount = countedCycles[v]; |
---|
637 | } |
---|
638 | } kill v; |
---|
639 | return (maxCycleCount); |
---|
640 | } |
---|
641 | |
---|
642 | static proc countCycles(intmat G, int v, intvec visited, intvec cyclic, intvec path, intvec countedCycles) |
---|
643 | "USAGE: countCycles(G, v, visited, cyclic, path); G a Graph, v the vertex to |
---|
644 | start. The parameter visited, cyclic and path should be 0. |
---|
645 | RETURN: int |
---|
646 | @*: Maximal number of distinct cycles |
---|
647 | PURPOSE: Calculate the maximal number of distinct cycles in a single path starting at v |
---|
648 | ASSUME: Basering is a Letterplace ring |
---|
649 | " |
---|
650 | { |
---|
651 | if (countedCycles[v] > -2) { |
---|
652 | return (countedCycles); |
---|
653 | } |
---|
654 | // Mark the current vertex as visited |
---|
655 | visited[v] = 1; |
---|
656 | |
---|
657 | // Store the current vertex in path |
---|
658 | if (path[1] == 0) { |
---|
659 | path[1] = v; |
---|
660 | } else { |
---|
661 | path[size(path) + 1] = v; |
---|
662 | } |
---|
663 | |
---|
664 | int cycles = 0; |
---|
665 | for (int w = 1; w <= ncols(G); w++) { |
---|
666 | if (G[v,w] == 1) { |
---|
667 | if (visited[w] == 1) { // found new cycle |
---|
668 | // 1. for all vertices in path until w, check if they are cyclic |
---|
669 | for (int j = size(path); j >= 1; j--) { |
---|
670 | if(cyclic[path[j]] == 1) { |
---|
671 | // 1.1 if yes, return -1 |
---|
672 | countedCycles[v] = -1; |
---|
673 | return (countedCycles); |
---|
674 | } |
---|
675 | if (path[j] == w) { |
---|
676 | break; |
---|
677 | } |
---|
678 | } kill j; |
---|
679 | |
---|
680 | // 2. otherwise cycles++ |
---|
681 | for (int j = size(path); j >= 1; j--) { |
---|
682 | // 2.2 remove the edges from that cycle and mark the vertices as cyclic |
---|
683 | if (j == size(path)) { // special case in the first iteration |
---|
684 | cyclic[v] = 1; |
---|
685 | G[v, w] = 0; |
---|
686 | } else { |
---|
687 | cyclic[path[j]] = 1; |
---|
688 | G[path[j], path[j+1]] = 0; |
---|
689 | } |
---|
690 | if (path[j] == w) { |
---|
691 | break; |
---|
692 | } |
---|
693 | } kill j; |
---|
694 | |
---|
695 | // 3. countCycles() on all these vertices |
---|
696 | int maxCycleCount = 0; |
---|
697 | for (int j = size(path); j >= 1; j--) { |
---|
698 | countedCycles = countCycles(G, path[j], visited, cyclic, path, countedCycles); |
---|
699 | if(countedCycles[path[j]] == -1) { |
---|
700 | countedCycles[v] = -1; |
---|
701 | return (countedCycles); |
---|
702 | } |
---|
703 | if (countedCycles[path[j]] > maxCycleCount) { |
---|
704 | maxCycleCount = countedCycles[path[j]]; |
---|
705 | } |
---|
706 | if (path[j] == w) { |
---|
707 | break; |
---|
708 | } |
---|
709 | } kill j; |
---|
710 | if (maxCycleCount >= cycles) { |
---|
711 | cycles = maxCycleCount + 1; |
---|
712 | } |
---|
713 | kill maxCycleCount; |
---|
714 | } else { |
---|
715 | countedCycles = countCycles(G, w, visited, cyclic, path, countedCycles); |
---|
716 | if (countedCycles[w] == -1) { |
---|
717 | countedCycles[v] = -1; |
---|
718 | return (countedCycles); |
---|
719 | } |
---|
720 | if (countedCycles[w] > cycles) { |
---|
721 | cycles = countedCycles[w]; |
---|
722 | } |
---|
723 | } |
---|
724 | } |
---|
725 | } kill w; |
---|
726 | countedCycles[v] = cycles; |
---|
727 | return (countedCycles); |
---|
728 | } |
---|
729 | |
---|
730 | proc lpUfGraph(ideal G, list #) |
---|
731 | "USAGE: lpUfGraph(G); G a set of monomials in a letterplace ring. |
---|
732 | @* lpUfGraph(G,1); G a set of monomials in a letterplace ring. |
---|
733 | RETURN: intmat or list |
---|
734 | NOTE: lpUfGraph(G); returns intmat. lpUfGraph(G,1); returns list L with L[1] an intmat and L[2] an ideal. |
---|
735 | The intmat is the Ufnarovskij Graph and the ideal contains the vertices. |
---|
736 | PURPOSE: Constructs the Ufnarovskij graph induced by G |
---|
737 | the adjacency matrix of the Ufnarovskij graph induced by G |
---|
738 | ASSUME: - basering is a Letterplace ring |
---|
739 | - G are the leading monomials of a Groebner basis |
---|
740 | " |
---|
741 | { |
---|
742 | dbprint("computing maxDeg"); |
---|
743 | int l = maxDeg(G); |
---|
744 | if (l - 1 == 0) { |
---|
745 | // TODO: how should the graph look like when l - 1 = 0 ? |
---|
746 | ERROR("Ufnarovskij graph not implemented for l = 1"); |
---|
747 | } |
---|
748 | int lV = lpVarBlockSize(basering); |
---|
749 | // TODO: what if l <= 0? |
---|
750 | dbprint("computing standard words"); |
---|
751 | ideal SW = lpStandardWords(G, l - 1); // vertices |
---|
752 | int n = ncols(SW); |
---|
753 | dbprint("n = " + string(n)); |
---|
754 | intmat UG[n][n]; // Ufnarovskij graph |
---|
755 | for (int i = 1; i <= n; i++) { |
---|
756 | for (int j = 1; j <= n; j++) { |
---|
757 | dbprint("Ufnarovskii graph: " + string((i-1)*n + j) + "/" + string(n*n) + " entries"); |
---|
758 | // [Studzinski page 76] |
---|
759 | poly v = SW[i]; |
---|
760 | poly w = SW[j]; |
---|
761 | intvec v_overlap; |
---|
762 | intvec w_overlap; |
---|
763 | if (l - 1 > 1) { |
---|
764 | v_overlap = leadexp(v); |
---|
765 | w_overlap = leadexp(w); |
---|
766 | v_overlap = v_overlap[(lV+1) .. (l-1)*lV]; |
---|
767 | w_overlap = w_overlap[1 .. (l-2)*lV]; |
---|
768 | } |
---|
769 | if (v_overlap == w_overlap && !lpLmDivides(G, v * lpVarAt(w, l - 1))) { |
---|
770 | UG[i,j] = 1; |
---|
771 | } |
---|
772 | kill v; kill w; kill v_overlap; kill w_overlap; |
---|
773 | } kill j; |
---|
774 | } kill i; |
---|
775 | if (size(#) > 0) { |
---|
776 | if (typeof(#[1]) == "int") { |
---|
777 | if (#[1] != 0) { |
---|
778 | list ret = UG; |
---|
779 | ret[2] = SW; // the vertices |
---|
780 | return (ret); |
---|
781 | } |
---|
782 | } |
---|
783 | } |
---|
784 | return (UG); |
---|
785 | } |
---|
786 | example |
---|
787 | { |
---|
788 | "EXAMPLE:"; echo = 2; |
---|
789 | ring r = 0,(x,y,z),dp; |
---|
790 | def R = makeLetterplaceRing(5); // constructs a Letterplace ring |
---|
791 | setring R; // sets basering to Letterplace ring |
---|
792 | ideal I = x*y, x*z, z*y, z*z; |
---|
793 | lpUfGraph(I); |
---|
794 | lpUfGraph(I,1); |
---|
795 | } |
---|
796 | |
---|
797 | static proc maxDeg(ideal G) |
---|
798 | { |
---|
799 | int l = 0; |
---|
800 | for (int i = 1; i <= size(G); i++) { // find the max degree in G |
---|
801 | int d = deg(G[i]); |
---|
802 | if (d > l) { |
---|
803 | l = d; |
---|
804 | } |
---|
805 | kill d; |
---|
806 | } kill i; |
---|
807 | return (l); |
---|
808 | } |
---|
809 | |
---|
810 | static proc lpStandardWords(ideal G, int length) |
---|
811 | "ASSUME: G is simplified |
---|
812 | " |
---|
813 | { |
---|
814 | if (length < 0) { |
---|
815 | return (delete(ideal(0), 1)); // no standard words |
---|
816 | } |
---|
817 | |
---|
818 | ideal words = maxideal(length); |
---|
819 | for (int i = ncols(words); i >= 1; i--) { |
---|
820 | if (lpLmDivides(G, words[i])) { |
---|
821 | words = delete(words, i); |
---|
822 | } |
---|
823 | } kill i; |
---|
824 | return (words); |
---|
825 | } |
---|
826 | |
---|
827 | static proc ivStandardWords(list G, int length) |
---|
828 | "ASSUME: G is simplified |
---|
829 | " |
---|
830 | { |
---|
831 | if (length <= 0) { |
---|
832 | list words; |
---|
833 | if (length == 0 && !ivdivides(G,0)) { |
---|
834 | words[1] = 0; // iv = 0 means monom = 1 |
---|
835 | } |
---|
836 | return (words); // no standard words |
---|
837 | } |
---|
838 | int lV = lpVarBlockSize(basering); // variable count |
---|
839 | list prevWords = ivStandardWords(G, length - 1); |
---|
840 | list words; |
---|
841 | for (int i = 1; i <= lV; i++) { |
---|
842 | for (int j = 1; j <= size(prevWords); j++) { |
---|
843 | intvec word = prevWords[j]; |
---|
844 | word[length] = i; |
---|
845 | // assumes that G is simplified! |
---|
846 | if (!ivdivides(G, word)) { |
---|
847 | words = insert(words, word); |
---|
848 | } |
---|
849 | kill word; |
---|
850 | } kill j; |
---|
851 | } kill i; |
---|
852 | return (words); |
---|
853 | } |
---|
854 | |
---|
855 | static proc ivStandardWordsUpToLength(list G, int length) |
---|
856 | "ASSUME: G is simplified |
---|
857 | " |
---|
858 | { |
---|
859 | list words = ivStandardWords(G,0); |
---|
860 | if (size(words) == 0) {return (words)} |
---|
861 | for (int i = 1; i <= length; i++) { |
---|
862 | words = words + ivStandardWords(G, i); |
---|
863 | } kill i; |
---|
864 | return (words); |
---|
865 | } |
---|
866 | |
---|
867 | static proc ivdivides(list G, intvec iv) { |
---|
868 | for (int k = 1; k <= size(G); k++) { |
---|
869 | if (isIF(G[k], iv)) { |
---|
870 | return (1); |
---|
871 | } else { |
---|
872 | if (k == size(G)) { |
---|
873 | return (0); |
---|
874 | } |
---|
875 | } |
---|
876 | } kill k; |
---|
877 | return (0); |
---|
878 | } |
---|
879 | |
---|
880 | proc lpGkDim(ideal G) |
---|
881 | "USAGE: lpGkDim(G); G an ideal in a letterplace ring |
---|
882 | RETURN: int |
---|
883 | PURPOSE: Determines the Gelfand Kirillov dimension of A/<G> |
---|
884 | @* -1 means positive infinite |
---|
885 | ASSUME: - basering is a Letterplace ring |
---|
886 | @* - G is a Groebner basis |
---|
887 | " |
---|
888 | { |
---|
889 | G = lead(G); |
---|
890 | G = simplify(G, 2+4+8); |
---|
891 | |
---|
892 | // check special case 1 |
---|
893 | int l = 0; |
---|
894 | for (int i = 1; i <= size(G); i++) { |
---|
895 | // find the max degree in G |
---|
896 | int d = deg(G[i]); |
---|
897 | if (d > l) { |
---|
898 | l = d; |
---|
899 | } |
---|
900 | |
---|
901 | // also if G is the whole ring return minus infinity |
---|
902 | if (leadmonom(G[i]) == 1) { |
---|
903 | ERROR("GK-Dim not defined for 0-ring") |
---|
904 | } |
---|
905 | kill d; |
---|
906 | } kill i; |
---|
907 | // if longest word has length 1, or G is the zero ideal, we handle it as a special case |
---|
908 | if (l == 1 || size(G) == 0) { |
---|
909 | int n = lpVarBlockSize(basering); // variable count |
---|
910 | int k = size(G); |
---|
911 | if (k == n) { // V = {1} no edges |
---|
912 | return(0); |
---|
913 | } |
---|
914 | if (k == n-1) { // V = {1} with loop |
---|
915 | return(1); |
---|
916 | } |
---|
917 | if (k <= n-2) { // V = {1} with more than one loop |
---|
918 | return(-1); |
---|
919 | } |
---|
920 | } |
---|
921 | |
---|
922 | dbprint("computing Ufnarovskii graph"); |
---|
923 | intmat UG = lpUfGraph(G); |
---|
924 | if (printlevel >= voice + 1) { |
---|
925 | UG; |
---|
926 | } |
---|
927 | |
---|
928 | // check special case 2 |
---|
929 | intmat zero[nrows(UG)][ncols(UG)]; |
---|
930 | if (UG == zero) { |
---|
931 | return (0); |
---|
932 | } |
---|
933 | |
---|
934 | // check special case 3 |
---|
935 | dbprint("topological sorting of Ufnarovskii graph"); |
---|
936 | UG = topologicalSort(UG); |
---|
937 | if (printlevel >= voice + 1) { |
---|
938 | UG; |
---|
939 | } |
---|
940 | |
---|
941 | dbprint("check if Ufnarovskii graph is DAG"); |
---|
942 | if (imIsUpRightTriangle(UG)) { |
---|
943 | UG = eliminateZerosUpTriangle(UG); |
---|
944 | if (ncols(UG) == 0 || nrows(UG) == 0) { // when the diagonal was zero |
---|
945 | return (0) |
---|
946 | } |
---|
947 | dbprint("DAG detected, using URTNZD growth alg"); |
---|
948 | return(UfGraphURTNZDGrowth(UG)); |
---|
949 | } |
---|
950 | |
---|
951 | // otherwise count cycles in the Ufnarovskij Graph |
---|
952 | dbprint("not a DAG, using regular growth alg"); |
---|
953 | return(UfGraphGrowth(UG)); |
---|
954 | } |
---|
955 | example |
---|
956 | { |
---|
957 | "EXAMPLE:"; echo = 2; |
---|
958 | ring r = 0,(x,y,z),dp; |
---|
959 | def R = makeLetterplaceRing(5); // constructs a Letterplace ring |
---|
960 | R; |
---|
961 | setring R; // sets basering to Letterplace ring |
---|
962 | ideal I = z;//an example of infinite GK dimension |
---|
963 | lpGkDim(I); |
---|
964 | I = x,y,z; // gkDim = 0 |
---|
965 | lpGkDim(I); |
---|
966 | I = x*y, x*z, z*y, z*z;//gkDim = 2 |
---|
967 | lpGkDim(I); |
---|
968 | ideal G = y*x - x*y, z*x - x*z, z*y - y*z; G = std(G); |
---|
969 | G; |
---|
970 | lpGkDim(G); // 3, as expected for K[x,y,z] |
---|
971 | } |
---|
972 | |
---|
973 | proc lpGlDimBound(ideal G) |
---|
974 | "USAGE: lpGlDimBound(I); I an ideal |
---|
975 | RETURN: int, an upper bound for the global dimension, -1 means infinity |
---|
976 | PURPOSE: computing an upper bound for the global dimension |
---|
977 | ASSUME: - basering is a Letterplace ring, G is a reduced Groebner Basis |
---|
978 | EXAMPLE: example lpGlDimBound; shows example |
---|
979 | NOTE: if I = LM(I), then the global dimension is equal the Gelfand |
---|
980 | Kirillov dimension if it is finite |
---|
981 | Global dimension should be 0 for A/G = K and 1 for A/G = K<x1...xn> |
---|
982 | " |
---|
983 | { |
---|
984 | G = simplify(G,2); // remove zero generators |
---|
985 | // NOTE: Gl should be 0 for A/G = K and 1 for A/G = K<x1...xn> |
---|
986 | // G1 contains generators with single variable in LM |
---|
987 | ideal G1; |
---|
988 | for (int i = 1; i <= size(G); i++) { |
---|
989 | if (ord(G[i]) < 2) { // single variable in LM |
---|
990 | G1 = insertGenerator(G1,G[i]); |
---|
991 | } |
---|
992 | } kill i; |
---|
993 | G1 = simplify(G1,2); // remove zero generators |
---|
994 | |
---|
995 | // G = NF(G,G1) |
---|
996 | for (int i = 1; i <= ncols(G); i++) { // do not use size() here |
---|
997 | G[i] = lpNF(G[i],G1); |
---|
998 | } kill i; |
---|
999 | G = simplify(G,2); // remove zero generators |
---|
1000 | |
---|
1001 | // delete variables in LM(G1) from the ring |
---|
1002 | def save = basering; |
---|
1003 | def R = basering; |
---|
1004 | if (size(G1) > 0) { |
---|
1005 | while (size(G1) > 0) { |
---|
1006 | if (lpVarBlockSize(R) > 1) { |
---|
1007 | def @R = R - string(G1[1]); |
---|
1008 | R = @R; |
---|
1009 | kill @R; |
---|
1010 | setring R; |
---|
1011 | /* ring R = lpDelVar(lp2iv(G1[1])[1]); // TODO replace with proper method */ |
---|
1012 | ideal G1 = imap(save,G1); |
---|
1013 | G1 = simplify(G1, 2); // remove zero generators |
---|
1014 | } else { |
---|
1015 | // only the field is left (no variables) |
---|
1016 | return(0); |
---|
1017 | } |
---|
1018 | } |
---|
1019 | ideal G = imap(save, G); // put this here, because when save == R this call would make G = 0 |
---|
1020 | } |
---|
1021 | |
---|
1022 | // Li p. 184 if G = LM(G), then I = LM(I) and thus glDim = gkDim if it's finite |
---|
1023 | for (int i = 1; i <= size(G); i++) { |
---|
1024 | if (G[i] != lead(G[i])) { |
---|
1025 | break; |
---|
1026 | } else { |
---|
1027 | if (i == size(G)) { // if last iteration |
---|
1028 | int gkDim = lpGkDim(G); |
---|
1029 | if (gkDim >= 0) { |
---|
1030 | return (gkDim); |
---|
1031 | } |
---|
1032 | kill gkDim; |
---|
1033 | } |
---|
1034 | } |
---|
1035 | } kill i; |
---|
1036 | |
---|
1037 | intmat GNC = lpGraphOfNChains(G); |
---|
1038 | |
---|
1039 | // assuming GNC is connected |
---|
1040 | |
---|
1041 | // TODO: maybe loop+cycle checking could be done more efficiently? |
---|
1042 | if (!imHasLoops(GNC) && imIsUpRightTriangle(topologicalSort(GNC))) { |
---|
1043 | // GNC is a DAG |
---|
1044 | intmat GNCk = GNC; |
---|
1045 | intmat zero[1][ncols(GNCk)]; |
---|
1046 | int k = 1; |
---|
1047 | // while first row isn't empty |
---|
1048 | while (GNCk[1,1..(ncols(GNCk))] != zero[1,1..(ncols(zero))]) { |
---|
1049 | GNCk = GNCk * GNC; |
---|
1050 | k++; |
---|
1051 | } |
---|
1052 | // k-1 = number of edges in longest path starting from 1 |
---|
1053 | return (k-1); |
---|
1054 | } else { |
---|
1055 | // GNC contains loops/cycles => there is always an n-chain |
---|
1056 | return (-1); // infinity |
---|
1057 | } |
---|
1058 | } |
---|
1059 | example |
---|
1060 | { |
---|
1061 | "EXAMPLE:"; echo = 2; |
---|
1062 | ring r = 0,(x,y),dp; |
---|
1063 | def R = makeLetterplaceRing(5); // constructs a Letterplace ring |
---|
1064 | setring R; // sets basering to Letterplace ring |
---|
1065 | ideal G = x*x, y*y,x*y*x; // it is a monomial Groebner basis |
---|
1066 | lpGlDimBound(G); |
---|
1067 | ideal H = y*x - x*y; H = std(H); // H is a Groebner basis |
---|
1068 | lpGlDimBound(H); // gl dim of K[x,y] is 2, as expected |
---|
1069 | } |
---|
1070 | |
---|
1071 | static proc imHasLoops(intmat A) { |
---|
1072 | int n = ncols(A); |
---|
1073 | for (int i = 1; i <= n; i++) { |
---|
1074 | if (A[i,i] == 1) { |
---|
1075 | return (1); |
---|
1076 | } |
---|
1077 | } kill i; |
---|
1078 | return (0); |
---|
1079 | } |
---|
1080 | |
---|
1081 | static proc lpGraphOfNChains(ideal G) // G must be reduced |
---|
1082 | { |
---|
1083 | list LG = lpId2ivLi(lead(G)); |
---|
1084 | int n = lpVarBlockSize(basering); |
---|
1085 | int degbound = lpDegBound(basering); |
---|
1086 | |
---|
1087 | list V; |
---|
1088 | for (int i = 0; i <= n; i++) { |
---|
1089 | V[i+1] = i; // add 1 and all variables |
---|
1090 | } kill i; |
---|
1091 | for (int i = 1; i <= size(LG); i++) { |
---|
1092 | intvec u = LG[i]; |
---|
1093 | for (int j = 2; j <= size(u); j++) { |
---|
1094 | intvec v = u[j..size(u)]; |
---|
1095 | if (!contains(V, v)) { |
---|
1096 | V = insert(V, v, size(V)); // add subword j..size |
---|
1097 | } |
---|
1098 | kill v; |
---|
1099 | } kill j; |
---|
1100 | kill u; |
---|
1101 | } kill i; |
---|
1102 | int nV = size(V); |
---|
1103 | intmat GNC[nV][nV]; // graph of n-chains |
---|
1104 | |
---|
1105 | // for vertex 1 |
---|
1106 | for (int i = 2; i <= n + 1; i++) { |
---|
1107 | GNC[1,i] = 1; // 1 has an edge to all variables |
---|
1108 | } kill i; |
---|
1109 | |
---|
1110 | // for the other vertices |
---|
1111 | for (int i = 2; i <= nV; i++) { |
---|
1112 | for (int j = 2; j <= nV; j++) { |
---|
1113 | intvec uv = V[i],V[j]; |
---|
1114 | |
---|
1115 | if (contains(LG, uv)) { |
---|
1116 | GNC[i,j] = 1; |
---|
1117 | } else { |
---|
1118 | // Li p. 177 |
---|
1119 | // search for a right divisor 'w' of uv in G |
---|
1120 | // then check if G doesn't divide the subword uv-1 |
---|
1121 | |
---|
1122 | // look for a right divisor in LG |
---|
1123 | for (int k = 1; k <= size(LG); k++) { |
---|
1124 | if (isSF(LG[k], uv)) { |
---|
1125 | // w = LG[k] |
---|
1126 | if(!ivdivides(LG, uv[1..(size(uv)-1)])) { |
---|
1127 | // G doesn't divide uv-1 |
---|
1128 | GNC[i,j] = 1; |
---|
1129 | break; |
---|
1130 | } |
---|
1131 | } |
---|
1132 | } kill k; |
---|
1133 | } |
---|
1134 | kill uv; |
---|
1135 | } kill j; |
---|
1136 | } kill i; |
---|
1137 | |
---|
1138 | return(GNC); |
---|
1139 | } |
---|
1140 | |
---|
1141 | static proc contains(list L, def item) |
---|
1142 | { |
---|
1143 | for (int i = 1; i <= size(L); i++) { |
---|
1144 | if (L[i] == item) { |
---|
1145 | return (1); |
---|
1146 | } |
---|
1147 | } kill i; |
---|
1148 | return (0); |
---|
1149 | } |
---|
1150 | |
---|
1151 | proc lpSubstitute(poly f, ideal s1, ideal s2, list #) |
---|
1152 | "USAGE: lpSubstitute(f,s1,s2[,G]); f poly, s1 list (ideal) of variables |
---|
1153 | to replace, s2 list (ideal) of polynomials to replace with, G optional ideal to |
---|
1154 | reduce with. |
---|
1155 | RETURN: poly, the substituted polynomial |
---|
1156 | ASSUME: - basering is a Letterplace ring |
---|
1157 | - s1 contains a subset of the set of variables |
---|
1158 | - s2 and s1 are of the same size |
---|
1159 | - G is a Groebner basis, |
---|
1160 | - the current ring has a sufficient degbound (which also can be calculated with lpCalcSubstDegBound()) |
---|
1161 | NOTE: the procedure implements the image of a polynomial f |
---|
1162 | under an endomorphism of a free algebra, defined by s1 and s2: |
---|
1163 | variables, not present in s1, are left unchanged; |
---|
1164 | variable s1[k] is mapped to a polynomial s2[k]. |
---|
1165 | - An optional ideal G extends the endomorphism as above to the morphism into the factor algebra K<X>/G. |
---|
1166 | EXAMPLE: example lpSubstitute; shows examples |
---|
1167 | " |
---|
1168 | { |
---|
1169 | ideal G; |
---|
1170 | if (size(#) > 0) { |
---|
1171 | if (typeof(#[1])=="ideal") { |
---|
1172 | G = #[1]; |
---|
1173 | } |
---|
1174 | } |
---|
1175 | |
---|
1176 | poly fs; |
---|
1177 | for (int i = 1; i <= size(f); i++) { |
---|
1178 | poly fis = leadcoef(f[i]); |
---|
1179 | intvec ivfi = lp2iv(f[i]); |
---|
1180 | for (int j = 1; j <= size(ivfi); j++) { |
---|
1181 | int varindex = ivfi[j]; |
---|
1182 | if (varindex > 0) { |
---|
1183 | int subindex = lpIndexOf(s1, var(varindex)); |
---|
1184 | if (subindex > 0) { |
---|
1185 | s2[subindex] = lpNF(s2[subindex],G); |
---|
1186 | fis = fis * s2[subindex]; |
---|
1187 | } else { |
---|
1188 | fis = fis * lpNF(iv2lp(varindex),G); |
---|
1189 | } |
---|
1190 | /*fis = lpNF(fis,G);*/ |
---|
1191 | kill subindex; |
---|
1192 | } |
---|
1193 | kill varindex; |
---|
1194 | } kill j; |
---|
1195 | kill ivfi; |
---|
1196 | fs = fs + fis; |
---|
1197 | kill fis; |
---|
1198 | } |
---|
1199 | kill i; |
---|
1200 | fs = lpNF(fs, G); |
---|
1201 | return (fs); |
---|
1202 | } |
---|
1203 | example |
---|
1204 | { |
---|
1205 | "EXAMPLE:"; echo = 2; |
---|
1206 | ring r = 0,(x,y,z),dp; |
---|
1207 | def R = makeLetterplaceRing(4); |
---|
1208 | setring R; |
---|
1209 | ideal G = x*y; // optional |
---|
1210 | poly f = 3*x*x+y*x; |
---|
1211 | ideal s1 = x, y; |
---|
1212 | ideal s2 = y*z*z, x; // i.e. x --> yzz and y --> x |
---|
1213 | // the substitution probably needs a higher degbound |
---|
1214 | int minDegBound = lpCalcSubstDegBound(f,s1,s2); |
---|
1215 | minDegBound; // thus the bound needs to be increased |
---|
1216 | setring r; // back to original r |
---|
1217 | def R1 = makeLetterplaceRing(minDegBound); |
---|
1218 | setring R1; |
---|
1219 | lpSubstitute(imap(R,f), imap(R,s1), imap(R,s2)); |
---|
1220 | // the last parameter is optional; above it was G=<xy> |
---|
1221 | // the output will be reduced with respect to G |
---|
1222 | lpSubstitute(imap(R,f), imap(R,s1), imap(R,s2), imap(R,G)); |
---|
1223 | } |
---|
1224 | |
---|
1225 | // another example: |
---|
1226 | /* |
---|
1227 | //////// EXAMPLE B //////// |
---|
1228 | ring r = 0,(x,y,z),dp; |
---|
1229 | def R = makeLetterplaceRing(4); |
---|
1230 | setring R; |
---|
1231 | |
---|
1232 | poly f = 3*x*x+y*x; |
---|
1233 | poly g = z*x+y; |
---|
1234 | poly h = 7*x*z+x; |
---|
1235 | ideal I = f,g,h; |
---|
1236 | ideal s1 = x, y; |
---|
1237 | ideal s2 = y*z*z, x; |
---|
1238 | |
---|
1239 | int minDegBound = lpCalcSubstDegBound(I,s1,s2); |
---|
1240 | setring r; |
---|
1241 | def R1 = makeLetterplaceRing(minDegBound); |
---|
1242 | setring R1; |
---|
1243 | |
---|
1244 | ideal I = imap(R,I); |
---|
1245 | ideal s1 = imap(R,s1); |
---|
1246 | ideal s2 = imap(R,s2); |
---|
1247 | for (int i = 1; i <= size(I); i++) { |
---|
1248 | lpSubstitute(I[i], s1, s2); |
---|
1249 | } |
---|
1250 | */ |
---|
1251 | |
---|
1252 | static proc lpIndexOf(ideal I, poly p) { |
---|
1253 | for (int i = 1; i <= size(I); i++) { |
---|
1254 | if (I[i] == p) { |
---|
1255 | return (i); |
---|
1256 | } |
---|
1257 | } kill i; |
---|
1258 | return (-1); |
---|
1259 | } |
---|
1260 | |
---|
1261 | static proc ivIndexOf(list L, intvec iv) { |
---|
1262 | for (int i = 1; i <= size(L); i++) { |
---|
1263 | if (L[i] == iv) { |
---|
1264 | return (i); |
---|
1265 | } |
---|
1266 | } kill i; |
---|
1267 | return (-1); |
---|
1268 | } |
---|
1269 | |
---|
1270 | |
---|
1271 | static proc lpCalcSubstDegBoundSingle(poly f, ideal s1, ideal s2) |
---|
1272 | "USAGE: lpCalcSubstDegBoundSingle(f,s1,s2); f letterplace polynomial, s1 list (ideal) of variables |
---|
1273 | to replace, s2 list (ideal) of polynomials to replace with |
---|
1274 | RETURN: int, the min degbound required to perform the substitution |
---|
1275 | ASSUME: - basering is a Letterplace ring |
---|
1276 | EXAMPLE: example lpCalcSubstDegBoundSingle; shows examples |
---|
1277 | " |
---|
1278 | { |
---|
1279 | int maxDegBound = 0; |
---|
1280 | for (int i = 1; i <= size(f); i++) { |
---|
1281 | intvec ivfi = lp2iv(f[i]); |
---|
1282 | int tmpDegBound; |
---|
1283 | for (int j = 1; j <= size(ivfi); j++) { |
---|
1284 | int varindex = ivfi[j]; |
---|
1285 | if (varindex > 0) { |
---|
1286 | int subindex = lpIndexOf(s1, var(varindex)); |
---|
1287 | if (subindex > 0) { |
---|
1288 | tmpDegBound = tmpDegBound + deg(s2[subindex]); |
---|
1289 | } else { |
---|
1290 | tmpDegBound = tmpDegBound + 1; |
---|
1291 | } |
---|
1292 | kill subindex; |
---|
1293 | } |
---|
1294 | kill varindex; |
---|
1295 | } kill j; |
---|
1296 | if (tmpDegBound > maxDegBound) { |
---|
1297 | maxDegBound = tmpDegBound; |
---|
1298 | } |
---|
1299 | kill ivfi; kill tmpDegBound; |
---|
1300 | } kill i; |
---|
1301 | |
---|
1302 | // increase degbound by 50% when ideal is provided |
---|
1303 | // needed for lpNF |
---|
1304 | maxDegBound = maxDegBound + (maxDegBound div 2); |
---|
1305 | |
---|
1306 | return (maxDegBound); |
---|
1307 | } |
---|
1308 | example |
---|
1309 | { |
---|
1310 | // see lpCalcSubstDegBound() |
---|
1311 | } |
---|
1312 | |
---|
1313 | proc lpCalcSubstDegBound(ideal I, ideal s1, ideal s2) |
---|
1314 | "USAGE: lpCalcSubstDegBound(I,s1,s2); I ideal of polynomials, s1 ideal of variables to replace, s2 ideal of polynomials to replace with |
---|
1315 | RETURN: int, the min degbound required to perform all of the substitutions |
---|
1316 | ASSUME: - basering is a Letterplace ring |
---|
1317 | EXAMPLE: example lpCalcSubstDegBound; shows examples |
---|
1318 | NOTE: convenience method |
---|
1319 | " |
---|
1320 | { |
---|
1321 | int maxDegBound = 0; |
---|
1322 | for (int i = 1; i <= size(I); i++) { |
---|
1323 | int tmpDegBound = lpCalcSubstDegBoundSingle(I[i], s1, s2, #); |
---|
1324 | if (tmpDegBound > maxDegBound) { |
---|
1325 | maxDegBound = tmpDegBound; |
---|
1326 | } |
---|
1327 | kill tmpDegBound; |
---|
1328 | } kill i; |
---|
1329 | return (maxDegBound); |
---|
1330 | } |
---|
1331 | example |
---|
1332 | { |
---|
1333 | "EXAMPLE:"; echo = 2; |
---|
1334 | ring r = 0,(x,y,z),dp; |
---|
1335 | def R = makeLetterplaceRing(4); |
---|
1336 | setring R; |
---|
1337 | ideal I = 3*x*x+y*x, x*y*x - z; |
---|
1338 | ideal s1 = x, y; // z --> z |
---|
1339 | ideal s2 = y*z*z, x; // i.e. x --> yzz and y --> x |
---|
1340 | // the substitution probably needs a higher degbound |
---|
1341 | lpCalcSubstDegBound(I,s1,s2); |
---|
1342 | lpCalcSubstDegBound(I[1],s1,s2); |
---|
1343 | } |
---|
1344 | |
---|
1345 | static proc isSF(intvec S, intvec I) |
---|
1346 | " |
---|
1347 | PURPOSE: |
---|
1348 | checks, if a word S is a suffix of another word I |
---|
1349 | " |
---|
1350 | { |
---|
1351 | int n = size(S); |
---|
1352 | if (n <= 0 || S == 0) {return(1);} |
---|
1353 | int m = size(I); |
---|
1354 | if (m < n) {return(0);} |
---|
1355 | intvec IS = I[(m-n+1)..m]; |
---|
1356 | if (IS == S) {return(1);} |
---|
1357 | else {return(0);} |
---|
1358 | } |
---|
1359 | |
---|
1360 | static proc isIF(intvec IF, intvec I) |
---|
1361 | " |
---|
1362 | PURPOSE: |
---|
1363 | checks, if a word IF is an infix of another word I |
---|
1364 | " |
---|
1365 | { |
---|
1366 | int n = size(IF); |
---|
1367 | int m = size(I); |
---|
1368 | |
---|
1369 | if (n <= 0 || IF == 0) {return(1);} |
---|
1370 | if (m < n) {return(0);} |
---|
1371 | |
---|
1372 | for (int i = 0; (n + i) <= m; i++){ |
---|
1373 | intvec IIF = I[(1 + i)..(n + i)]; |
---|
1374 | if (IIF == IF) { |
---|
1375 | return(1); |
---|
1376 | } |
---|
1377 | kill IIF; |
---|
1378 | } kill i; |
---|
1379 | return(0); |
---|
1380 | } |
---|
1381 | |
---|
1382 | // no longer working with new interface and new orderings |
---|
1383 | /* // TODO: use original ring attrib to create a new letterplace ring */ |
---|
1384 | /* // removes a variable from a letterplace ring (a bit of a hack) */ |
---|
1385 | /* static proc lpDelVar(int index) { */ |
---|
1386 | /* int lV = lpVarBlockSize(basering); // number of variables in the main block */ |
---|
1387 | /* int d = lpDegBound(basering); // degree bround */ |
---|
1388 | /* list LR = ringlist(basering); */ |
---|
1389 | |
---|
1390 | /* if (!(index >= 1 && index <= lV)) { return (basering); } // invalid index */ |
---|
1391 | |
---|
1392 | /* // remove frome the variable list */ |
---|
1393 | /* for (int i = (d-1)*lV + index; i >= 1; i = i - lV) { */ |
---|
1394 | /* LR[2] = delete(LR[2], i); */ |
---|
1395 | /* } kill i; */ |
---|
1396 | |
---|
1397 | /* // remove from a ordering */ |
---|
1398 | /* intvec aiv = LR[3][1][2]; */ |
---|
1399 | /* aiv = aiv[1..(d*lV-d)]; */ |
---|
1400 | /* LR[3][1][2] = aiv; */ |
---|
1401 | |
---|
1402 | /* // remove block orderings */ |
---|
1403 | /* int del = (lV - index); */ |
---|
1404 | /* int cnt = -1; */ |
---|
1405 | /* for (int i = size(LR[3]); i >= 2; i--) { */ |
---|
1406 | /* if (LR[3][i][2] != 0) { */ |
---|
1407 | /* for (int j = size(LR[3][i][2]); j >= 1; j--) { */ |
---|
1408 | /* cnt++; // next 1 */ |
---|
1409 | /* if (cnt%lV == del) { */ |
---|
1410 | /* // delete */ |
---|
1411 | /* if (size(LR[3][i][2]) > 1) { // if we have more than one element left, delete one */ |
---|
1412 | /* LR[3][i][2] = delete(LR[3][i][2],j); */ |
---|
1413 | /* } else { // otherwise delete the whole block */ |
---|
1414 | /* LR[3] = delete(LR[3], i); */ |
---|
1415 | /* break; */ |
---|
1416 | /* } */ |
---|
1417 | /* } */ |
---|
1418 | /* } kill j; */ |
---|
1419 | /* } */ |
---|
1420 | /* } kill i; */ |
---|
1421 | |
---|
1422 | /* def R = setLetterplaceAttributes(ring(LR),d,lV-1); */ |
---|
1423 | /* return (R); */ |
---|
1424 | /* } */ |
---|
1425 | /* example */ |
---|
1426 | /* { */ |
---|
1427 | /* "EXAMPLE:"; echo = 2; */ |
---|
1428 | /* ring r = 0,(x,y,z),dp; */ |
---|
1429 | /* def A = makeLetterplaceRing(3); */ |
---|
1430 | /* setring A; A; */ |
---|
1431 | /* def R = lpDelVar(2); setring R; R; */ |
---|
1432 | /* } */ |
---|