1 | ////////////////////////////////////////////////////////////////////////////// |
---|
2 | version="version ncModslimgb.lib 4.1.3.0 Apr_2020 "; // $Id$ |
---|
3 | category="Noncommutative"; |
---|
4 | info=" |
---|
5 | LIBRARY: ncModslimgb.lib A library for computing Groebner bases over G-algebras |
---|
6 | defined over the rationals using modular techniques. |
---|
7 | |
---|
8 | AUTHORS: Wolfram Decker, Christian Eder, Viktor Levandovskyy, and |
---|
9 | Sharwan K. Tiwari shrawant@gmail.com |
---|
10 | |
---|
11 | REFERENCES: |
---|
12 | Wolfram Decker, Christian Eder, Viktor Levandovskyy, and |
---|
13 | Sharwan K. Tiwari, Modular Techniques For Noncommutative |
---|
14 | Groebner Bases, https://link.springer.com/article/10.1007/s11786-019-00412-9 |
---|
15 | and https://arxiv.org/abs/1704.02852. |
---|
16 | |
---|
17 | E. A. Arnold, Modular algorithms for computing Groebner bases. |
---|
18 | Journal of Symbolic Computation 35, 403-419 (2003). |
---|
19 | |
---|
20 | N. Idrees, G. Pfister, S. Steidel, Parallelization of Modular |
---|
21 | Algorithms, Journal of Symbolic Computation 46, 672-684 (2011). |
---|
22 | |
---|
23 | PROCEDURES: |
---|
24 | ncmodslimgb(ideal I, list #); Groebner basis of a given left ideal I |
---|
25 | using modular methods (Chinese remainder theorem and Farey map). |
---|
26 | "; |
---|
27 | |
---|
28 | LIB "parallel.lib"; |
---|
29 | LIB "resources.lib"; |
---|
30 | LIB "nctools.lib"; |
---|
31 | LIB "dmod.lib"; |
---|
32 | |
---|
33 | |
---|
34 | static proc mod_init() |
---|
35 | { |
---|
36 | newstruct("idealPrimeTestId", "ideal Ideal"); |
---|
37 | } |
---|
38 | |
---|
39 | //==========================Main Procedure=================================== |
---|
40 | proc ncmodslimgb(ideal I, list #) |
---|
41 | "USAGE: ncmodslimgb(I[, exactness, ncores]); I ideal, optional integers exactness and n(umber of )cores |
---|
42 | RETURN: ideal |
---|
43 | PURPOSE: compute a left Groebner basis of I by modular approach |
---|
44 | ASSUME: basering is a G-algebra; base field is prime field Q of rationals. |
---|
45 | NOTE: - If the given algebra and ideal are graded (it is not checked by this command), then the computed Groebner |
---|
46 | basis will be exact. Otherwise, the result will be correct with a very high probability. |
---|
47 | - The optional parameter `exactness` justifies, whether the final (expensive) |
---|
48 | verification step will be performed or not (exactness=0, default value is 1). |
---|
49 | - The optional parameter `ncores` (default value is 1) provides an integer to use |
---|
50 | the number of cores (this must not exceed the number of available cores in the computing machine). |
---|
51 | EXAMPLE: example ncmodslimgb; shows an example |
---|
52 | " |
---|
53 | { |
---|
54 | int ncores=1; // default |
---|
55 | int exactness = 1; // default |
---|
56 | int sz=size(#); |
---|
57 | |
---|
58 | if(sz>2) |
---|
59 | { |
---|
60 | ERROR("wrong optional parameters"); |
---|
61 | } |
---|
62 | |
---|
63 | while(sz > 0) |
---|
64 | { |
---|
65 | if(typeof(#[sz]) == "int" && #[sz] == 0) |
---|
66 | { |
---|
67 | exactness = #[sz]; |
---|
68 | } |
---|
69 | else |
---|
70 | { |
---|
71 | if(typeof(#[sz]) == "int" && #[sz] > 1) |
---|
72 | { |
---|
73 | ncores=setcores(#[sz]); |
---|
74 | } |
---|
75 | } |
---|
76 | sz = sz-1; |
---|
77 | } |
---|
78 | |
---|
79 | def R0 = basering; |
---|
80 | list rl = ringlist(R0); |
---|
81 | if(rl[1][1] > 0) |
---|
82 | { |
---|
83 | ERROR("Characteristic of basering should be zero, basering should |
---|
84 | have no parameters."); |
---|
85 | } |
---|
86 | |
---|
87 | //check the non-degenracy condition to ensure that the defined is |
---|
88 | //a G-algbera |
---|
89 | // V.L.: commented out, added ASSUME for basering to be a G-algebra |
---|
90 | // ideal ndc = ndcond(); |
---|
91 | // if(ndc != 0) |
---|
92 | // { |
---|
93 | // ERROR("The given input is not a G-algebra"); |
---|
94 | // } |
---|
95 | |
---|
96 | int index = 1; |
---|
97 | int nextbp=1; |
---|
98 | int i,k,c; |
---|
99 | int j = 1; |
---|
100 | int pTest, sizeTest; |
---|
101 | bigint N; |
---|
102 | |
---|
103 | //Initialization of number of primes to be taken |
---|
104 | int n2 = 20; //number of primes to be taken first time |
---|
105 | |
---|
106 | if(ncores > 1) |
---|
107 | { |
---|
108 | int a = n2 % ncores; |
---|
109 | if(a>0) |
---|
110 | { |
---|
111 | n2 = n2 - a + ncores; |
---|
112 | } |
---|
113 | } |
---|
114 | |
---|
115 | //second round onwards, number of primes to be taken, |
---|
116 | //one can decide; |
---|
117 | int n3 = n2; //default |
---|
118 | |
---|
119 | intvec opt = option(get); |
---|
120 | option(redSB); |
---|
121 | |
---|
122 | //PrimeList procedure selects suitable primes such that |
---|
123 | //these primes do not divide coefficients occurring |
---|
124 | //in the generating polynomials of input ideal and |
---|
125 | //in the defining relations of input algebra |
---|
126 | |
---|
127 | intvec L = PrimeList(I, n2, ncores); |
---|
128 | |
---|
129 | list P,T1,T2,LL; |
---|
130 | int sizeT1; |
---|
131 | int sizeT2; |
---|
132 | ideal J,K,H; |
---|
133 | |
---|
134 | // modular algorithm steps start here |
---|
135 | list arguments_farey, results_farey, argumentpar; |
---|
136 | |
---|
137 | while(1) |
---|
138 | { |
---|
139 | //sequential GB computation for the selected primes |
---|
140 | if(ncores == 1) |
---|
141 | { |
---|
142 | while(nextbp <= size(L)) |
---|
143 | { |
---|
144 | P = ModpSlim(I, L[nextbp]); |
---|
145 | T1[index] = P[1]; |
---|
146 | T2[index] = bigint(P[2]); |
---|
147 | index++; |
---|
148 | nextbp++; |
---|
149 | } |
---|
150 | } |
---|
151 | //GB computations in parallel for the primes |
---|
152 | else |
---|
153 | { |
---|
154 | argumentpar = list(); |
---|
155 | for(i = nextbp; i <= size(L); i++) |
---|
156 | { |
---|
157 | argumentpar[i-nextbp+1] = list(I,L[i]); |
---|
158 | } |
---|
159 | P = parallelWaitAll("NcModslimgb::ModpSlim",argumentpar, 0,ncores); |
---|
160 | |
---|
161 | for(i = 1; i <= size(P); i++) |
---|
162 | { |
---|
163 | T1[i+sizeT1] = P[i][1]; |
---|
164 | T2[i+sizeT2] = bigint(P[i][2]); |
---|
165 | } |
---|
166 | } |
---|
167 | |
---|
168 | LL = DeleteUnluckyPrimes(T1,T2); |
---|
169 | T1 = LL[1]; |
---|
170 | T2 = LL[2]; |
---|
171 | |
---|
172 | //Lifting of results via CRT |
---|
173 | N = T2[1]; |
---|
174 | for(i = 2; i <= size(T2); i++) |
---|
175 | { |
---|
176 | N = N*T2[i]; |
---|
177 | } |
---|
178 | H = chinrem(T1,T2); |
---|
179 | |
---|
180 | //Lifting of results to Rationals via Farey map |
---|
181 | //sequential lifting |
---|
182 | if(ncores == 1) |
---|
183 | { |
---|
184 | J = farey(H,N); |
---|
185 | } |
---|
186 | //parallel lifting |
---|
187 | else |
---|
188 | { |
---|
189 | for(i = size(H); i > 0; i--) |
---|
190 | { |
---|
191 | arguments_farey[i] = list(ideal(H[i]), N); |
---|
192 | } |
---|
193 | results_farey = parallelWaitAll("farey", arguments_farey, 0, ncores); |
---|
194 | for(i = size(H); i > 0; i--) |
---|
195 | { |
---|
196 | J[i] = results_farey[i][1]; |
---|
197 | } |
---|
198 | } |
---|
199 | |
---|
200 | //Verification steps |
---|
201 | pTest = PTestGB(I,J,L,ncores); |
---|
202 | if(pTest) |
---|
203 | { |
---|
204 | attrib(J,"isSB",1); |
---|
205 | if(exactness == 0) |
---|
206 | { |
---|
207 | option(set, opt); |
---|
208 | return(J); |
---|
209 | } |
---|
210 | if(exactness == 1) |
---|
211 | { |
---|
212 | //sizeTest = 1 - IsIncluded(I,J,ncores); |
---|
213 | sizeTest = 1 - IsIncludedseq(I,J); |
---|
214 | if(sizeTest == 0) |
---|
215 | { |
---|
216 | K = slimgb(J); |
---|
217 | if(size(reduce(K,J,5)) == 0) |
---|
218 | { |
---|
219 | option(set, opt); |
---|
220 | return(J); |
---|
221 | } |
---|
222 | } |
---|
223 | } |
---|
224 | } |
---|
225 | // If, J is not Groebner basis of I |
---|
226 | // compute for more number of primes |
---|
227 | T1 = H; |
---|
228 | sizeT1=size(T1); |
---|
229 | T2 = N; |
---|
230 | sizeT2=size(T2); |
---|
231 | index = 2; |
---|
232 | nextbp = size(L) + 1; |
---|
233 | L = PrimeList(I,n3,L,ncores); |
---|
234 | } |
---|
235 | } |
---|
236 | example |
---|
237 | { |
---|
238 | "EXAMPLE:"; echo = 2; |
---|
239 | ring r = 0,(x,y),dp; |
---|
240 | poly P = y^4+x^3+x*y^3; // a (3,4)-Reiffen curve |
---|
241 | def A = Sannfs(P); setring A; // computed D-module data from P |
---|
242 | ideal bs = LD, imap(r,P); // preparing the computation of the Bernstein-Sato polynomial |
---|
243 | ideal I1 = ncmodslimgb(bs,0,2); // no final verification, use 2 cores |
---|
244 | I1[1]; // the Bernstein-Sato polynomial of P, univariate in s |
---|
245 | ideal I2 = ncmodslimgb(bs); // do the final verification, use 1 core (default) |
---|
246 | I2[1]; // the Bernstein-Sato polynomial of P, univariate in s |
---|
247 | } |
---|
248 | |
---|
249 | /* |
---|
250 | ring r = 0,(x,y,z),Dp; |
---|
251 | poly F = x^3+y^3+z^3; |
---|
252 | def A = Sannfs(F); |
---|
253 | setring A; |
---|
254 | ideal I=LD,imap(r,F) ; |
---|
255 | ideal J=ncmodslimgb(I); |
---|
256 | */ |
---|
257 | |
---|
258 | static proc PrimeList(ideal I, int n, list #) |
---|
259 | "USAGE: PrimeList(I,n[,ncores]); ( resp. PrimeList(I,n[,L,ncores]); ) I ideal, |
---|
260 | n an integer |
---|
261 | RETURN: n number of primes <= 2147483647 such that these primes do not divide |
---|
262 | any coefficient of any generating polynomial of I. |
---|
263 | EXAMPLE: example PrimeList; shows an example |
---|
264 | { |
---|
265 | intvec L; |
---|
266 | int i,p; |
---|
267 | int ncores = 1; |
---|
268 | |
---|
269 | //Initialize optional parameter ncores |
---|
270 | if(size(#) > 0) |
---|
271 | { |
---|
272 | if(size(#) == 1) |
---|
273 | { |
---|
274 | if(typeof(#[1]) == "int") |
---|
275 | { |
---|
276 | ncores = #[1]; |
---|
277 | # = list(); |
---|
278 | } |
---|
279 | } |
---|
280 | else |
---|
281 | { |
---|
282 | ncores = #[2]; |
---|
283 | } |
---|
284 | } |
---|
285 | if(size(#) == 0) |
---|
286 | { |
---|
287 | p = 2147483647; |
---|
288 | |
---|
289 | //largest prime which can be represented as an @code{int} in Singular |
---|
290 | while(!PrimeTestId(I,p) || !PrimeTestCommutatorRel(p)) |
---|
291 | { |
---|
292 | p = prime(p-1); |
---|
293 | if(p == 2) |
---|
294 | { |
---|
295 | ERROR("no more primes"); |
---|
296 | } |
---|
297 | } |
---|
298 | L[1] = p; |
---|
299 | } |
---|
300 | else |
---|
301 | { |
---|
302 | L = #[1]; |
---|
303 | p = prime(L[size(L)]-1); |
---|
304 | while(!PrimeTestId(I,p) || !PrimeTestCommutatorRel(p)) |
---|
305 | { |
---|
306 | p = prime(p-1); |
---|
307 | if(p == 2) |
---|
308 | { |
---|
309 | ERROR("no more primes"); |
---|
310 | } |
---|
311 | } |
---|
312 | L[size(L)+1] = p; |
---|
313 | } |
---|
314 | if(p == 2) |
---|
315 | { |
---|
316 | ERROR("no more primes"); |
---|
317 | } |
---|
318 | |
---|
319 | //sequential selection of remaining n-1 suitable primes |
---|
320 | if(ncores == 1) |
---|
321 | { |
---|
322 | for(i = 2; i <= n; i++) |
---|
323 | { |
---|
324 | p = prime(p-1); |
---|
325 | while(!PrimeTestId(I,p) || !PrimeTestCommutatorRel(p)) |
---|
326 | { |
---|
327 | p = prime(p-1); |
---|
328 | if(p == 2) |
---|
329 | { |
---|
330 | ERROR("no more primes"); |
---|
331 | } |
---|
332 | } |
---|
333 | L[size(L)+1] = p; |
---|
334 | } |
---|
335 | } |
---|
336 | //parallel selection of remaining n-1 suitable primes |
---|
337 | else |
---|
338 | { |
---|
339 | int neededSize = size(L)+n-1;; |
---|
340 | list parallelResults; |
---|
341 | list parallelResults2; |
---|
342 | list arguments; |
---|
343 | list arguments2; |
---|
344 | int neededPrimes = neededSize-size(L); |
---|
345 | idealPrimeTestId Id; |
---|
346 | Id.Ideal = I; |
---|
347 | export(Id); |
---|
348 | while(neededPrimes > 0) |
---|
349 | { |
---|
350 | arguments = list(); |
---|
351 | for(i = ((neededPrimes div ncores)+1-(neededPrimes%ncores == 0)) *ncores; |
---|
352 | i > 0; i--) |
---|
353 | { |
---|
354 | p = prime(p-1); |
---|
355 | if(p == 2) |
---|
356 | { |
---|
357 | ERROR("no more primes"); |
---|
358 | } |
---|
359 | arguments[i] = list("Id", p); |
---|
360 | arguments2[i] = list(p); |
---|
361 | } |
---|
362 | parallelResults = parallelWaitAll("NcModslimgb::PrimeTestId", arguments, 0, ncores); |
---|
363 | |
---|
364 | //check that primes are suitable for commutator relations |
---|
365 | parallelResults2 = parallelWaitAll("NcModslimgb::PrimeTestCommutatorRel", arguments2, |
---|
366 | 0, ncores); |
---|
367 | |
---|
368 | for(i = size(arguments); i > 0; i--) |
---|
369 | { |
---|
370 | if(parallelResults[i] && parallelResults2[i]) |
---|
371 | { |
---|
372 | L[size(L)+1] = arguments[i][2]; |
---|
373 | } |
---|
374 | } |
---|
375 | neededPrimes = neededSize-size(L); |
---|
376 | } |
---|
377 | kill Id; |
---|
378 | if(size(L) > neededSize) |
---|
379 | { |
---|
380 | L = L[1..neededSize]; |
---|
381 | } |
---|
382 | } |
---|
383 | return(L); |
---|
384 | } |
---|
385 | example |
---|
386 | { |
---|
387 | "EXAMPLE:"; echo = 2; |
---|
388 | ring r = 0,(x,y),dp; |
---|
389 | def a = nc_algebra(2147483647, 1); |
---|
390 | setring a; |
---|
391 | ideal I = x+2147483629y, x3+y3; |
---|
392 | intvec V = PrimeList(I,5); |
---|
393 | V; |
---|
394 | intvec W = PrimeList(I,5,2); // number of cores = 2 |
---|
395 | W; |
---|
396 | } |
---|
397 | |
---|
398 | static proc PrimeTestCommutatorRel(int p) |
---|
399 | "USAGE: PrimeTestCommutatorRel(p); p a prime integer |
---|
400 | RETURN: 1 if p does not divide any coefficient of any defining relation of |
---|
401 | G-algebra, 0 otherwise. |
---|
402 | EXAMPLE: example PrimeTestCommutatorRel; shows an example |
---|
403 | { |
---|
404 | list rl = ringlist(basering); |
---|
405 | int nvar = nvars(basering); |
---|
406 | matrix commrelmatC = UpOneMatrix(nvar); |
---|
407 | matrix commrelmatD[nvar][nvar]; |
---|
408 | if (size(rl) == 6) |
---|
409 | { |
---|
410 | commrelmatC = rl[5]; |
---|
411 | commrelmatD = rl[6]; |
---|
412 | } |
---|
413 | int i, j, k; |
---|
414 | poly f; number cnt; |
---|
415 | for(i = 1; i <= nvar; i++) |
---|
416 | { |
---|
417 | for(j = i+1; j <= nvar; j++) |
---|
418 | { |
---|
419 | cnt = leadcoef(commrelmatC[i,j]); |
---|
420 | if(cnt == 0) |
---|
421 | { |
---|
422 | ERROR("wrong relations"); |
---|
423 | } |
---|
424 | if((bigint(numerator(cnt)) mod p) == 0) |
---|
425 | { |
---|
426 | return(0); |
---|
427 | } |
---|
428 | if((bigint(denominator(cnt)) mod p) == 0) |
---|
429 | { |
---|
430 | return(0); |
---|
431 | } |
---|
432 | } |
---|
433 | } |
---|
434 | // checks for standard polynomials d_ij |
---|
435 | for(i = 1; i <= nvar; i++) |
---|
436 | { |
---|
437 | for(j = i+1; j <= nvar; j++) |
---|
438 | { |
---|
439 | if(commrelmatD[i,j] != 0) |
---|
440 | { |
---|
441 | f = cleardenom(commrelmatD[i,j]); |
---|
442 | cnt = leadcoef(commrelmatD[i,j])/leadcoef(f); |
---|
443 | if((bigint(numerator(cnt)) mod p) == 0) |
---|
444 | { |
---|
445 | return(0); |
---|
446 | } |
---|
447 | if((bigint(denominator(cnt)) mod p) == 0) |
---|
448 | { |
---|
449 | return(0); |
---|
450 | } |
---|
451 | for(k = size(f); k > 0; k--) |
---|
452 | { |
---|
453 | if((bigint(leadcoef(f[k])) mod p) == 0) |
---|
454 | { |
---|
455 | return(0); |
---|
456 | } |
---|
457 | } |
---|
458 | } |
---|
459 | } |
---|
460 | } |
---|
461 | return(1); |
---|
462 | } |
---|
463 | example |
---|
464 | { |
---|
465 | "EXAMPLE:"; echo = 2; |
---|
466 | ring r = 0,(x,y),dp; |
---|
467 | def a = nc_algebra(2147483647,1); |
---|
468 | setring a; |
---|
469 | ideal I = x+2147483629y; |
---|
470 | int p1 = 2147483647; |
---|
471 | int p2 = 2147483629; |
---|
472 | int p3 = 2147483549; |
---|
473 | PrimeTestCommutatorRel(p1); |
---|
474 | PrimeTestCommutatorRel(p2); |
---|
475 | PrimeTestCommutatorRel(p3); |
---|
476 | } |
---|
477 | |
---|
478 | static proc PrimeTestId(def II, bigint p) |
---|
479 | "USAGE: PrimeTestId(I, p); I ideal, p a prime integer |
---|
480 | RETURN: 1 if p does not divide any numerator or denominator of any coefficient |
---|
481 | in any polynomial of I, 0 otherwise. |
---|
482 | EXAMPLE: example PrimeTestId; shows an example |
---|
483 | { |
---|
484 | if(typeof(II) == "string") |
---|
485 | { |
---|
486 | ideal I = `II`.Ideal; |
---|
487 | } |
---|
488 | else |
---|
489 | { |
---|
490 | ideal I = II; |
---|
491 | } |
---|
492 | I = simplify(I, 2); |
---|
493 | int i,j; |
---|
494 | poly f; |
---|
495 | number cnt; |
---|
496 | |
---|
497 | for(i = 1; i <= size(I); i++) |
---|
498 | { |
---|
499 | f = cleardenom(I[i]); |
---|
500 | if(f == 0) |
---|
501 | { |
---|
502 | return(0); |
---|
503 | } |
---|
504 | cnt = leadcoef(I[i])/leadcoef(f); |
---|
505 | if((bigint(numerator(cnt)) mod p) == 0) |
---|
506 | { |
---|
507 | return(0); |
---|
508 | } |
---|
509 | if((bigint(denominator(cnt)) mod p) == 0) |
---|
510 | { |
---|
511 | return(0); |
---|
512 | } |
---|
513 | for(j = size(f); j > 0; j--) |
---|
514 | { |
---|
515 | if((bigint(leadcoef(f[j])) mod p) == 0) |
---|
516 | { |
---|
517 | return(0); |
---|
518 | } |
---|
519 | } |
---|
520 | } |
---|
521 | return(1); |
---|
522 | } |
---|
523 | example |
---|
524 | { |
---|
525 | "EXAMPLE:"; echo = 2; |
---|
526 | ring r = 0,(x,y),dp; |
---|
527 | def a = nc_algebra(2147483647,1); |
---|
528 | setring a; |
---|
529 | ideal I = x+2147483629y; |
---|
530 | int p1 = 2147483647; |
---|
531 | int p2 = 2147483629; |
---|
532 | int p3 = 2147483549; |
---|
533 | PrimeTestId(I,p1); |
---|
534 | PrimeTestId(I,p2); |
---|
535 | PrimeTestId(I,p3); |
---|
536 | } |
---|
537 | |
---|
538 | static proc ModpSlim(ideal I, int p) |
---|
539 | "USAGE: ModpSlim(I, p); I ideal, p a prime |
---|
540 | RETURN: The reduced Groebner basis of I mod p. |
---|
541 | ASSUME: The base field is precisely Q. |
---|
542 | EXAMPLE: example ModpSlim; shows an example |
---|
543 | { |
---|
544 | def R0 = basering; |
---|
545 | list rl = ringlist(R0); |
---|
546 | int nvar = nvars(basering); |
---|
547 | matrix commrelmatC = UpOneMatrix(nvar); |
---|
548 | matrix commrelmatD[nvar][nvar]; |
---|
549 | if (size(rl) == 6) |
---|
550 | { |
---|
551 | commrelmatC = rl[5]; |
---|
552 | commrelmatD = rl[6]; |
---|
553 | } |
---|
554 | // matrix commrelmatC = rl[5]; |
---|
555 | // matrix commrelmatD = rl[6]; |
---|
556 | rl[1] = p; |
---|
557 | def @rr = ring(rl); |
---|
558 | setring @rr; |
---|
559 | list rll = ringlist(@rr); |
---|
560 | |
---|
561 | rll[5] = imap(R0,commrelmatC); |
---|
562 | rll[6] = imap(R0,commrelmatD); |
---|
563 | def @r = ring(rll); |
---|
564 | setring @r; |
---|
565 | kill @rr; |
---|
566 | ideal ii = fetch(R0,I); |
---|
567 | option(redSB); |
---|
568 | ii = slimgb(ii); |
---|
569 | setring R0; |
---|
570 | return(list(fetch(@r,ii),p)); |
---|
571 | } |
---|
572 | example |
---|
573 | { |
---|
574 | "EXAMPLE:"; echo = 2; |
---|
575 | def r = reiffen(4,5); |
---|
576 | setring r; |
---|
577 | def A = Sannfs(RC); |
---|
578 | setring A; |
---|
579 | ideal bs = LD, imap(r,RC); |
---|
580 | int p = 2147483647; |
---|
581 | list l = ModpSlim(bs, p); |
---|
582 | l; |
---|
583 | } |
---|
584 | |
---|
585 | static proc DeleteUnluckyPrimes(list T, list L) |
---|
586 | { |
---|
587 | int sizeModgbs = size(T); |
---|
588 | list class; |
---|
589 | int sizeClass; |
---|
590 | ideal Lm; |
---|
591 | int i; |
---|
592 | int j; |
---|
593 | for(i = 1; i <= sizeModgbs; i++) |
---|
594 | { |
---|
595 | Lm=lead(T[i]); |
---|
596 | attrib(Lm, "isSB", 1); |
---|
597 | for(j = 1; j <= sizeClass; j++) |
---|
598 | { |
---|
599 | if (size(Lm) == size(class[j][1]) |
---|
600 | && size(reduce(Lm, class[j][1],5)) == 0 |
---|
601 | && size(reduce(class[j][1], Lm,5)) == 0) |
---|
602 | { |
---|
603 | class[j][2] = class[j][2]+1; |
---|
604 | class[j][3][class[j][2]] = i; |
---|
605 | break; |
---|
606 | } |
---|
607 | } |
---|
608 | if(j > sizeClass) |
---|
609 | { |
---|
610 | sizeClass++; |
---|
611 | class[sizeClass]=list(); |
---|
612 | class[sizeClass][1]=Lm; |
---|
613 | class[sizeClass][2]=1; |
---|
614 | class[sizeClass][3]=list(i); |
---|
615 | } |
---|
616 | } |
---|
617 | int classMax = 1; |
---|
618 | int max = class[1][2]; |
---|
619 | for (i = 2; i <= sizeClass; i++) |
---|
620 | { |
---|
621 | if (class[i][2] > max) |
---|
622 | { |
---|
623 | ClassMax = i; |
---|
624 | max = class[i][2]; |
---|
625 | } |
---|
626 | } |
---|
627 | list unluckyIndices; |
---|
628 | for (i = 1; i <= sizeClass; i++) |
---|
629 | { |
---|
630 | if (i != classMax) |
---|
631 | { |
---|
632 | unluckyIndices = unluckyIndices + class[i][3]; |
---|
633 | } |
---|
634 | } |
---|
635 | for (i = size(unluckyIndices); i > 0; i--) |
---|
636 | { |
---|
637 | T = delete(T, unluckyIndices[i]); |
---|
638 | L = delete(L, unluckyIndices[i]); |
---|
639 | } |
---|
640 | return(T,L); |
---|
641 | } |
---|
642 | |
---|
643 | static proc PTestGB(ideal I, ideal J, list L, int ncores) |
---|
644 | "USAGE: PTestGB(I, J, L, ncores); I, J ideals, L intvec of primes |
---|
645 | RETURN: 1 (respectively 0) if for a randomly chosen prime p which is not in L |
---|
646 | J mod p is (respectively is not) a Groebner basis of I mod p. |
---|
647 | " |
---|
648 | { |
---|
649 | int i,k,p; |
---|
650 | int ptest; |
---|
651 | def R = basering; |
---|
652 | list r = ringlist(R); |
---|
653 | int nvar = nvars(basering); |
---|
654 | matrix commrelC = UpOneMatrix(nvar); |
---|
655 | matrix commrelD[nvar][nvar]; |
---|
656 | if (size(r) == 6) |
---|
657 | { |
---|
658 | commrelC = r[5]; |
---|
659 | commrelD = r[6]; |
---|
660 | } |
---|
661 | // matrix commrelC = r[5]; |
---|
662 | // matrix commrelD = r[6]; |
---|
663 | while(!ptest) |
---|
664 | { |
---|
665 | ptest = 1; |
---|
666 | p = prime(random(1000000000,2134567879)); |
---|
667 | for(i = 1; i <= size(L); i++) |
---|
668 | { |
---|
669 | if(p == L[i]) |
---|
670 | { |
---|
671 | ptest = 0; |
---|
672 | break; |
---|
673 | } |
---|
674 | } |
---|
675 | if(!PrimeTestCommutatorRel(p)) |
---|
676 | { |
---|
677 | ptest = 0; |
---|
678 | } |
---|
679 | if(ptest) |
---|
680 | { |
---|
681 | for(i = 1; i <= ncols(J); i++) |
---|
682 | { |
---|
683 | for(k = 2; k <= size(J[i]); k++) |
---|
684 | { |
---|
685 | if((bigint(denominator(leadcoef(J[i][k]))) mod p) == 0) |
---|
686 | { |
---|
687 | ptest = 0; |
---|
688 | break; |
---|
689 | } |
---|
690 | } |
---|
691 | if(!ptest) |
---|
692 | { |
---|
693 | break; |
---|
694 | } |
---|
695 | } |
---|
696 | } |
---|
697 | if(ptest) |
---|
698 | { |
---|
699 | if(!PrimeTestId(I,p) ) |
---|
700 | { |
---|
701 | ptest = 0; |
---|
702 | } |
---|
703 | } |
---|
704 | } |
---|
705 | r[1] = p; |
---|
706 | def @RR = ring(r); |
---|
707 | setring @RR; |
---|
708 | list rr=ringlist(@RR); |
---|
709 | rr[5]=imap(R,commrelC); |
---|
710 | rr[6]=imap(R,commrelD); |
---|
711 | def @R=ring(rr); |
---|
712 | setring @R; |
---|
713 | kill @RR; |
---|
714 | |
---|
715 | ideal I = imap(R,I); |
---|
716 | ideal J = imap(R, J); |
---|
717 | attrib(J,"isSB",1); |
---|
718 | ptest = 1; |
---|
719 | //if(IsIncluded(I,J,ncores) == 0) |
---|
720 | if(IsIncludedseq(I, J) == 0) |
---|
721 | { |
---|
722 | ptest = 0; |
---|
723 | } |
---|
724 | |
---|
725 | if(ptest) |
---|
726 | { |
---|
727 | ideal K = slimgb(I); |
---|
728 | // if(IsIncludedseq(J, K,ncores) == 0) |
---|
729 | if(IsIncludedseq(J, K) == 0) |
---|
730 | { |
---|
731 | ptest = 0; |
---|
732 | } |
---|
733 | } |
---|
734 | setring R; |
---|
735 | return(ptest); |
---|
736 | } |
---|
737 | |
---|
738 | proc IsIncludedseq(ideal I, ideal J, list #) |
---|
739 | "USAGE: IsIncludedseq(I,J), where I, J are ideals |
---|
740 | RETURN: 1 if J includes I, 0 if there is a generating element f of I which |
---|
741 | does not reduce to 0 with respect to J. The set of generators of J |
---|
742 | should be a Groebner basis otherwise the result might not be correct. |
---|
743 | { |
---|
744 | int i, k; |
---|
745 | int ncores = 1; |
---|
746 | //def R = basering; |
---|
747 | //setring R; |
---|
748 | attrib(J,"isSB",1); |
---|
749 | |
---|
750 | /*if( size(#) == 1) |
---|
751 | { |
---|
752 | if(typeof(#[1]) == "int") |
---|
753 | { |
---|
754 | ncores = #[1]; |
---|
755 | } |
---|
756 | }*/ |
---|
757 | //sequential reduction |
---|
758 | //if(ncores==1) |
---|
759 | //{ |
---|
760 | for(k = 1; k <= ncols(I); k++) |
---|
761 | { |
---|
762 | if(reduce(I[k],J,1) != 0) |
---|
763 | { |
---|
764 | return(0); |
---|
765 | } |
---|
766 | } |
---|
767 | return(1); |
---|
768 | // } |
---|
769 | |
---|
770 | //parallel reduction |
---|
771 | /* |
---|
772 | else |
---|
773 | { |
---|
774 | list args,results; |
---|
775 | for(k = 1; k <= ncols(I); k++) |
---|
776 | { |
---|
777 | args[k] = list(ideal(I[k]),J,1); |
---|
778 | } |
---|
779 | option(notWarnSB); |
---|
780 | results = parallelWaitAll("reduce",args, 0, ncores); |
---|
781 | for(k=1; k <= size(results); k++) |
---|
782 | { |
---|
783 | if(results[k] != 0) |
---|
784 | { |
---|
785 | return(0); |
---|
786 | } |
---|
787 | } |
---|
788 | return(1); |
---|
789 | }*/ |
---|
790 | } |
---|
791 | //=========================================================== |
---|