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