1 /****************************************
2 * Computer Algebra System SINGULAR *
3 ****************************************/
4 /*
5 * ABSTRACT: kernel: utils for kStd
6 */
7
8 // #define PDEBUG 2
9 // #define PDIV_DEBUG
10 #define KUTIL_CC
11
12 #define MYTEST 0
13
14 //All vs Just strategy over rings:
15 // 1 - Just
16 // 0 - All
17 #define ALL_VS_JUST 0
18 //Extended Spoly Strategy:
19 // 0 - new gen sig
20 // 1 - ann*old sig
21 #define EXT_POLY_NEW 0
22
23 #include "kernel/mod2.h"
24
25 #include "misc/mylimits.h"
26 #include "misc/options.h"
27 #include "polys/nc/nc.h"
28 #include "polys/nc/sca.h"
29 #include "polys/weight.h" /* for kDebugPrint: maxdegreeWecart*/
30
31 #include <stdlib.h>
32 #include <string.h>
33
34 #ifdef KDEBUG
35 #undef KDEBUG
36 #define KDEBUG 2
37 #endif
38
39 #ifdef DEBUGF5
40 #undef DEBUGF5
41 //#define DEBUGF5 1
42 #endif
43
44 // define if enterL, enterT should use memmove instead of doing it manually
45 // on topgun, this is slightly faster (see monodromy_l.tst, homog_gonnet.sing)
46 #ifndef SunOS_4
47 #define ENTER_USE_MEMMOVE
48 #endif
49
50 // define, if the my_memmove inlines should be used instead of
51 // system memmove -- it does not seem to pay off, though
52 // #define ENTER_USE_MYMEMMOVE
53
54 #include "kernel/GBEngine/kutil.h"
55 #include "polys/kbuckets.h"
56 #include "coeffs/numbers.h"
57 #include "kernel/polys.h"
58 #include "polys/monomials/ring.h"
59 #include "kernel/ideals.h"
60 #include "kernel/combinatorics/stairc.h"
61 #include "kernel/GBEngine/kstd1.h"
62 #include "polys/operations/pShallowCopyDelete.h"
63
64 #ifdef HAVE_SHIFTBBA
65 #include "polys/shiftop.h"
66 #endif
67
68 #include "polys/prCopy.h"
69
70 #ifdef HAVE_RATGRING
71 #include "kernel/GBEngine/ratgring.h"
72 #endif
73
74 #ifdef KDEBUG
75 #undef KDEBUG
76 #define KDEBUG 2
77 #endif
78
79 #ifdef DEBUGF5
80 #undef DEBUGF5
81 #define DEBUGF5 2
82 #endif
83
84 VAR denominator_list DENOMINATOR_LIST=NULL;
85
86
87 #ifdef ENTER_USE_MYMEMMOVE
_my_memmove_d_gt_s(unsigned long * d,unsigned long * s,long l)88 inline void _my_memmove_d_gt_s(unsigned long* d, unsigned long* s, long l)
89 {
90 REGISTER unsigned long* _dl = (unsigned long*) d;
91 REGISTER unsigned long* _sl = (unsigned long*) s;
92 REGISTER long _i = l - 1;
93
94 do
95 {
96 _dl[_i] = _sl[_i];
97 _i--;
98 }
99 while (_i >= 0);
100 }
101
_my_memmove_d_lt_s(unsigned long * d,unsigned long * s,long l)102 inline void _my_memmove_d_lt_s(unsigned long* d, unsigned long* s, long l)
103 {
104 REGISTER long _ll = l;
105 REGISTER unsigned long* _dl = (unsigned long*) d;
106 REGISTER unsigned long* _sl = (unsigned long*) s;
107 REGISTER long _i = 0;
108
109 do
110 {
111 _dl[_i] = _sl[_i];
112 _i++;
113 }
114 while (_i < _ll);
115 }
116
_my_memmove(void * d,void * s,long l)117 inline void _my_memmove(void* d, void* s, long l)
118 {
119 unsigned long _d = (unsigned long) d;
120 unsigned long _s = (unsigned long) s;
121 unsigned long _l = ((l) + SIZEOF_LONG - 1) >> LOG_SIZEOF_LONG;
122
123 if (_d > _s) _my_memmove_d_gt_s(_d, _s, _l);
124 else _my_memmove_d_lt_s(_d, _s, _l);
125 }
126
127 #undef memmove
128 #define memmove(d,s,l) _my_memmove(d, s, l)
129 #endif
130
131 static poly redMora (poly h,int maxIndex,kStrategy strat);
132 static poly redBba (poly h,int maxIndex,kStrategy strat);
133
134 #ifdef HAVE_RINGS
135 #define pDivComp_EQUAL 2
136 #define pDivComp_LESS 1
137 #define pDivComp_GREATER -1
138 #define pDivComp_INCOMP 0
139 /* Checks the relation of LM(p) and LM(q)
140 LM(p) = LM(q) => return pDivComp_EQUAL
141 LM(p) | LM(q) => return pDivComp_LESS
142 LM(q) | LM(p) => return pDivComp_GREATER
143 else return pDivComp_INCOMP */
pDivCompRing(poly p,poly q)144 static inline int pDivCompRing(poly p, poly q)
145 {
146 if ((currRing->pCompIndex < 0)
147 || (__p_GetComp(p,currRing) == __p_GetComp(q,currRing)))
148 {
149 BOOLEAN a=FALSE, b=FALSE;
150 int i;
151 unsigned long la, lb;
152 unsigned long divmask = currRing->divmask;
153 for (i=0; i<currRing->VarL_Size; i++)
154 {
155 la = p->exp[currRing->VarL_Offset[i]];
156 lb = q->exp[currRing->VarL_Offset[i]];
157 if (la != lb)
158 {
159 if (la < lb)
160 {
161 if (b) return pDivComp_INCOMP;
162 if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
163 return pDivComp_INCOMP;
164 a = TRUE;
165 }
166 else
167 {
168 if (a) return pDivComp_INCOMP;
169 if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
170 return pDivComp_INCOMP;
171 b = TRUE;
172 }
173 }
174 }
175 if (a) return pDivComp_LESS;
176 if (b) return pDivComp_GREATER;
177 if (!a & !b) return pDivComp_EQUAL;
178 }
179 return pDivComp_INCOMP;
180 }
181 #endif
182
pDivComp(poly p,poly q)183 static inline int pDivComp(poly p, poly q)
184 {
185 if ((currRing->pCompIndex < 0)
186 || (__p_GetComp(p,currRing) == __p_GetComp(q,currRing)))
187 {
188 #ifdef HAVE_RATGRING
189 if (rIsRatGRing(currRing))
190 {
191 if (_p_LmDivisibleByPart(p,currRing,
192 q,currRing,
193 currRing->real_var_start, currRing->real_var_end))
194 return 0;
195 return pLmCmp(q,p); // ONLY FOR GLOBAL ORDER!
196 }
197 #endif
198 BOOLEAN a=FALSE, b=FALSE;
199 int i;
200 unsigned long la, lb;
201 unsigned long divmask = currRing->divmask;
202 for (i=0; i<currRing->VarL_Size; i++)
203 {
204 la = p->exp[currRing->VarL_Offset[i]];
205 lb = q->exp[currRing->VarL_Offset[i]];
206 if (la != lb)
207 {
208 if (la < lb)
209 {
210 if (b) return 0;
211 if (((la & divmask) ^ (lb & divmask)) != ((lb - la) & divmask))
212 return 0;
213 a = TRUE;
214 }
215 else
216 {
217 if (a) return 0;
218 if (((la & divmask) ^ (lb & divmask)) != ((la - lb) & divmask))
219 return 0;
220 b = TRUE;
221 }
222 }
223 }
224 if (a) { /*assume(pLmCmp(q,p)==1);*/ return 1; }
225 if (b) { /*assume(pLmCmp(q,p)==-1);*/return -1; }
226 /*assume(pLmCmp(q,p)==0);*/
227 }
228 return 0;
229 }
230
231 #ifdef HAVE_SHIFTBBA
pLPDivComp(poly p,poly q)232 static inline int pLPDivComp(poly p, poly q)
233 {
234 if ((currRing->pCompIndex < 0) || (__p_GetComp(p,currRing) == __p_GetComp(q,currRing)))
235 {
236 // maybe there is a more performant way to do this? This will get called quite often in bba.
237 if (_p_LPLmDivisibleByNoComp(p, q, currRing)) return 1;
238 if (_p_LPLmDivisibleByNoComp(q, p, currRing)) return -1;
239 }
240
241 return 0;
242 }
243 #endif
244
245
246 VAR int HCord;
247 VAR int Kstd1_deg;
248 VAR int Kstd1_mu=32000;
249
250 /*2
251 *deletes higher monomial of p, re-compute ecart and length
252 *works only for orderings with ecart =pFDeg(end)-pFDeg(start)
253 */
deleteHC(LObject * L,kStrategy strat,BOOLEAN fromNext)254 void deleteHC(LObject *L, kStrategy strat, BOOLEAN fromNext)
255 {
256 if (strat->kHEdgeFound)
257 {
258 kTest_L(L,strat->tailRing);
259 poly p1;
260 poly p = L->GetLmTailRing();
261 int l = 1;
262 kBucket_pt bucket = NULL;
263 if (L->bucket != NULL)
264 {
265 kBucketClear(L->bucket, &pNext(p), &L->pLength);
266 L->pLength++;
267 bucket = L->bucket;
268 L->bucket = NULL;
269 }
270
271 if (!fromNext && p_Cmp(p,strat->kNoetherTail(), L->tailRing) == -1)
272 {
273 L->Delete();
274 L->Clear();
275 L->ecart = -1;
276 if (bucket != NULL) kBucketDestroy(&bucket);
277 return;
278 }
279 p1 = p;
280 while (pNext(p1)!=NULL)
281 {
282 if (p_LmCmp(pNext(p1), strat->kNoetherTail(), L->tailRing) == -1)
283 {
284 p_Delete(&pNext(p1), L->tailRing);
285 if (p1 == p)
286 {
287 if (L->t_p != NULL)
288 {
289 assume(L->p != NULL && p == L->t_p);
290 pNext(L->p) = NULL;
291 }
292 L->max_exp = NULL;
293 }
294 else if (fromNext)
295 L->max_exp = p_GetMaxExpP(pNext(L->p), L->tailRing ); // p1;
296 //if (L->pLength != 0)
297 L->pLength = l;
298 // Hmmm when called from updateT, then only
299 // reset ecart when cut
300 if (fromNext)
301 L->ecart = L->pLDeg() - L->GetpFDeg();
302 break;
303 }
304 l++;
305 pIter(p1);
306 }
307 if (! fromNext)
308 {
309 L->SetpFDeg();
310 L->ecart = L->pLDeg(strat->LDegLast) - L->GetpFDeg();
311 }
312 if (bucket != NULL)
313 {
314 if (L->pLength > 1)
315 {
316 kBucketInit(bucket, pNext(p), L->pLength - 1);
317 pNext(p) = NULL;
318 if (L->t_p != NULL) pNext(L->t_p) = NULL;
319 L->pLength = 0;
320 L->bucket = bucket;
321 }
322 else
323 kBucketDestroy(&bucket);
324 }
325 kTest_L(L,strat->tailRing);
326 }
327 }
328
deleteHC(poly * p,int * e,int * l,kStrategy strat)329 void deleteHC(poly* p, int* e, int* l,kStrategy strat)
330 {
331 LObject L(*p, currRing, strat->tailRing);
332
333 deleteHC(&L, strat);
334 *p = L.p;
335 *e = L.ecart;
336 *l = L.length;
337 if (L.t_p != NULL) p_LmFree(L.t_p, strat->tailRing);
338 }
339
340 /*2
341 *tests if p.p=monomial*unit and cancels the unit
342 */
cancelunit(LObject * L,BOOLEAN inNF)343 void cancelunit (LObject* L,BOOLEAN inNF)
344 {
345 if(rHasGlobalOrdering (currRing)) return;
346 if(TEST_OPT_CANCELUNIT) return;
347
348 ring r = L->tailRing;
349 poly p = L->GetLmTailRing();
350 if(p_GetComp(p, r) != 0 && !p_OneComp(p, r)) return;
351
352 number lc=NULL; /*dummy, is always set if rField_is_Ring(r) */
353 if (rField_is_Ring(r) /*&& (rHasLocalOrMixedOrdering(r))*/)
354 lc = pGetCoeff(p);
355
356 // Leading coef have to be a unit
357 // example 2x+4x2 should be simplified to 2x*(1+2x)
358 // and 2 is not a unit in Z
359 //if ( !(n_IsUnit(pGetCoeff(p), r->cf)) ) return;
360
361 // for(i=r->N;i>0;i--)
362 // {
363 // if ((p_GetExp(p,i,r)>0) && (rIsPolyVar(i, r)==TRUE)) return;
364 // }
365 poly h = pNext(p);
366 int i;
367
368 if(rField_is_Ring(currRing))
369 {
370 loop
371 {
372 if (h==NULL)
373 {
374 p_Delete(&pNext(p), r);
375 if (!inNF)
376 {
377 number eins= nCopy(lc);
378 if (L->p != NULL)
379 {
380 pSetCoeff(L->p,eins);
381 if (L->t_p != NULL)
382 pSetCoeff0(L->t_p,eins);
383 }
384 else
385 pSetCoeff(L->t_p,eins);
386 /* p and t_p share the same coeff, if both are !=NULL */
387 /* p==NULL==t_p cannot happen here */
388 }
389 L->ecart = 0;
390 L->length = 1;
391 //if (L->pLength > 0)
392 L->pLength = 1;
393 L->max_exp = NULL;
394
395 if (L->t_p != NULL && pNext(L->t_p) != NULL)
396 p_Delete(&pNext(L->t_p),r);
397 if (L->p != NULL && pNext(L->p) != NULL)
398 pNext(L->p) = NULL;
399 return;
400 }
401 i = rVar(r);
402 loop
403 {
404 if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return; // does not divide
405 i--;
406 if (i == 0) break; // does divide, try next monom
407 }
408 //wrp(p); PrintS(" divide ");wrp(h); PrintLn();
409 // Note: As long as qring j forbidden if j contains integer (i.e. ground rings are
410 // domains), no zerodivisor test needed CAUTION
411 if (!n_DivBy(pGetCoeff(h),lc,r->cf))
412 {
413 return;
414 }
415 pIter(h);
416 }
417 }
418 else
419 {
420 loop
421 {
422 if (h==NULL)
423 {
424 p_Delete(&pNext(p), r);
425 if (!inNF)
426 {
427 number eins=nInit(1);
428 if (L->p != NULL)
429 {
430 pSetCoeff(L->p,eins);
431 if (L->t_p != NULL)
432 pSetCoeff0(L->t_p,eins);
433 }
434 else
435 pSetCoeff(L->t_p,eins);
436 /* p and t_p share the same coeff, if both are !=NULL */
437 /* p==NULL==t_p cannot happen here */
438 }
439 L->ecart = 0;
440 L->length = 1;
441 //if (L->pLength > 0)
442 L->pLength = 1;
443 L->max_exp = NULL;
444
445 if (L->t_p != NULL && pNext(L->t_p) != NULL)
446 p_Delete(&pNext(L->t_p),r);
447 if (L->p != NULL && pNext(L->p) != NULL)
448 pNext(L->p) = NULL;
449
450 return;
451 }
452 i = rVar(r);
453 loop
454 {
455 if (p_GetExp(p,i,r) > p_GetExp(h,i,r)) return; // does not divide
456 i--;
457 if (i == 0) break; // does divide, try next monom
458 }
459 //wrp(p); PrintS(" divide ");wrp(h); PrintLn();
460 pIter(h);
461 }
462 }
463 }
464
465 /*2
466 *pp is the new element in s
467 *returns TRUE (in strat->kHEdgeFound) if
468 *-HEcke is allowed
469 *-we are in the last componente of the vector
470 *-on all axis are monomials (all elements in NotUsedAxis are FALSE)
471 *returns FALSE for pLexOrderings,
472 *assumes in module case an ordering of type c* !!
473 * HEckeTest is only called with strat->kHEdgeFound==FALSE !
474 */
HEckeTest(poly pp,kStrategy strat)475 void HEckeTest (poly pp,kStrategy strat)
476 {
477 int j,/*k,*/p;
478
479 strat->kHEdgeFound=FALSE;
480 if (currRing->pLexOrder || rHasMixedOrdering(currRing))
481 {
482 return;
483 }
484 if (strat->ak > 1) /*we are in the module case*/
485 {
486 return; // until ....
487 //if (!pVectorOut) /*pVectorOut <=> order = c,* */
488 // return FALSE;
489 //if (pGetComp(pp) < strat->ak) /* ak is the number of the last component */
490 // return FALSE;
491 }
492 // k = 0;
493 p=pIsPurePower(pp);
494 if (rField_is_Ring(currRing) && (!n_IsUnit(pGetCoeff(pp),currRing->cf))) return;
495 if (p!=0) strat->NotUsedAxis[p] = FALSE;
496 /*- the leading term of pp is a power of the p-th variable -*/
497 for (j=(currRing->N);j>0; j--)
498 {
499 if (strat->NotUsedAxis[j])
500 {
501 return;
502 }
503 }
504 strat->kHEdgeFound=TRUE;
505 }
506
507 /*2
508 *utilities for TSet, LSet
509 */
initec(const int maxnr)510 inline static intset initec (const int maxnr)
511 {
512 return (intset)omAlloc(maxnr*sizeof(int));
513 }
514
initsevS(const int maxnr)515 inline static unsigned long* initsevS (const int maxnr)
516 {
517 return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
518 }
initS_2_R(const int maxnr)519 inline static int* initS_2_R (const int maxnr)
520 {
521 return (int*)omAlloc0(maxnr*sizeof(int));
522 }
523
enlargeT(TSet & T,TObject ** & R,unsigned long * & sevT,int & length,const int incr)524 static inline void enlargeT (TSet &T, TObject** &R, unsigned long* &sevT,
525 int &length, const int incr)
526 {
527 assume(T!=NULL);
528 assume(sevT!=NULL);
529 assume(R!=NULL);
530 assume((length+incr) > 0);
531
532 int i;
533 T = (TSet)omRealloc0Size(T, length*sizeof(TObject),
534 (length+incr)*sizeof(TObject));
535
536 sevT = (unsigned long*) omReallocSize(sevT, length*sizeof(long*),
537 (length+incr)*sizeof(long*));
538
539 R = (TObject**)omRealloc0Size(R,length*sizeof(TObject*),
540 (length+incr)*sizeof(TObject*));
541 for (i=length-1;i>=0;i--) R[T[i].i_r] = &(T[i]);
542 length += incr;
543 }
544
cleanT(kStrategy strat)545 void cleanT (kStrategy strat)
546 {
547 int i,j;
548 poly p;
549 assume(currRing == strat->tailRing || strat->tailRing != NULL);
550
551 pShallowCopyDeleteProc p_shallow_copy_delete =
552 (strat->tailRing != currRing ?
553 pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
554 NULL);
555 for (j=0; j<=strat->tl; j++)
556 {
557 p = strat->T[j].p;
558 strat->T[j].p=NULL;
559 if (strat->T[j].max_exp != NULL)
560 {
561 p_LmFree(strat->T[j].max_exp, strat->tailRing);
562 }
563 i = -1;
564 loop
565 {
566 i++;
567 if (i>strat->sl)
568 {
569 if (strat->T[j].t_p != NULL)
570 {
571 p_Delete(&(strat->T[j].t_p), strat->tailRing);
572 p_LmFree(p, currRing);
573 }
574 else
575 {
576 #ifdef HAVE_SHIFTBBA
577 if (currRing->isLPring && strat->T[j].shift > 0)
578 {
579 pNext(p) = NULL; // pNext(p) points to the unshifted tail, don't try to delete it here
580 }
581 #endif
582 pDelete(&p);
583 }
584 break;
585 }
586 if (p == strat->S[i])
587 {
588 if (strat->T[j].t_p != NULL)
589 {
590 if (p_shallow_copy_delete!=NULL)
591 {
592 pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
593 currRing->PolyBin);
594 }
595 p_LmFree(strat->T[j].t_p, strat->tailRing);
596 }
597 break;
598 }
599 }
600 }
601 strat->tl=-1;
602 }
603
cleanTSbaRing(kStrategy strat)604 void cleanTSbaRing (kStrategy strat)
605 {
606 int i,j;
607 poly p;
608 assume(currRing == strat->tailRing || strat->tailRing != NULL);
609
610 pShallowCopyDeleteProc p_shallow_copy_delete =
611 (strat->tailRing != currRing ?
612 pGetShallowCopyDeleteProc(strat->tailRing, currRing) :
613 NULL);
614 for (j=0; j<=strat->tl; j++)
615 {
616 p = strat->T[j].p;
617 strat->T[j].p=NULL;
618 if (strat->T[j].max_exp != NULL)
619 {
620 p_LmFree(strat->T[j].max_exp, strat->tailRing);
621 }
622 i = -1;
623 loop
624 {
625 i++;
626 if (i>strat->sl)
627 {
628 if (strat->T[j].t_p != NULL)
629 {
630 p_Delete(&(strat->T[j].t_p), strat->tailRing);
631 p_LmFree(p, currRing);
632 }
633 else
634 {
635 //pDelete(&p);
636 p = NULL;
637 }
638 break;
639 }
640 if (p == strat->S[i])
641 {
642 if (strat->T[j].t_p != NULL)
643 {
644 assume(p_shallow_copy_delete != NULL);
645 pNext(p) = p_shallow_copy_delete(pNext(p),strat->tailRing,currRing,
646 currRing->PolyBin);
647 p_LmFree(strat->T[j].t_p, strat->tailRing);
648 }
649 break;
650 }
651 }
652 }
653 strat->tl=-1;
654 }
655
656 //LSet initL ()
657 //{
658 // int i;
659 // LSet l = (LSet)omAlloc(setmaxL*sizeof(LObject));
660 // return l;
661 //}
662
enlargeL(LSet * L,int * length,const int incr)663 static inline void enlargeL (LSet* L,int* length,const int incr)
664 {
665 assume((*L)!=NULL);
666 assume(((*length)+incr)>0);
667
668 *L = (LSet)omReallocSize((*L),(*length)*sizeof(LObject),
669 ((*length)+incr)*sizeof(LObject));
670 (*length) += incr;
671 }
672
initPairtest(kStrategy strat)673 void initPairtest(kStrategy strat)
674 {
675 strat->pairtest = (BOOLEAN *)omAlloc0((strat->sl+2)*sizeof(BOOLEAN));
676 }
677
678 /*2
679 *test whether (p1,p2) or (p2,p1) is in L up position length
680 *it returns TRUE if yes and the position k
681 */
isInPairsetL(int length,poly p1,poly p2,int * k,kStrategy strat)682 BOOLEAN isInPairsetL(int length,poly p1,poly p2,int* k,kStrategy strat)
683 {
684 LObject *p=&(strat->L[length]);
685
686 *k = length;
687 loop
688 {
689 if ((*k) < 0) return FALSE;
690 if (((p1 == (*p).p1) && (p2 == (*p).p2))
691 || ((p1 == (*p).p2) && (p2 == (*p).p1)))
692 return TRUE;
693 (*k)--;
694 p--;
695 }
696 }
697
698 /*2
699 *in B all pairs have the same element p on the right
700 *it tests whether (q,p) is in B and returns TRUE if yes
701 *and the position k
702 */
isInPairsetB(poly q,int * k,kStrategy strat)703 BOOLEAN isInPairsetB(poly q,int* k,kStrategy strat)
704 {
705 LObject *p=&(strat->B[strat->Bl]);
706
707 *k = strat->Bl;
708 loop
709 {
710 if ((*k) < 0) return FALSE;
711 if (q == (*p).p1)
712 return TRUE;
713 (*k)--;
714 p--;
715 }
716 }
717
kFindInT(poly p,TSet T,int tlength)718 int kFindInT(poly p, TSet T, int tlength)
719 {
720 int i;
721
722 for (i=0; i<=tlength; i++)
723 {
724 if (T[i].p == p) return i;
725 }
726 return -1;
727 }
728
kFindInT(poly p,kStrategy strat)729 int kFindInT(poly p, kStrategy strat)
730 {
731 int i;
732 do
733 {
734 i = kFindInT(p, strat->T, strat->tl);
735 if (i >= 0) return i;
736 strat = strat->next;
737 }
738 while (strat != NULL);
739 return -1;
740 }
741
742 #ifdef HAVE_SHIFTBBA
kFindInTShift(poly p,TSet T,int tlength)743 int kFindInTShift(poly p, TSet T, int tlength)
744 {
745 int i;
746
747 for (i=0; i<=tlength; i++)
748 {
749 // in the Letterplace ring the LMs in T and L are copies thus we have to use pEqualPolys() instead of ==
750 if (pEqualPolys(T[i].p, p)) return i;
751 }
752 return -1;
753 }
754 #endif
755
756 #ifdef HAVE_SHIFTBBA
kFindInTShift(poly p,kStrategy strat)757 int kFindInTShift(poly p, kStrategy strat)
758 {
759 int i;
760 do
761 {
762 i = kFindInTShift(p, strat->T, strat->tl);
763 if (i >= 0) return i;
764 strat = strat->next;
765 }
766 while (strat != NULL);
767 return -1;
768 }
769 #endif
770
771 #ifdef KDEBUG
772
wrp()773 void sTObject::wrp()
774 {
775 if (t_p != NULL) p_wrp(t_p, tailRing);
776 else if (p != NULL) p_wrp(p, currRing, tailRing);
777 else ::wrp(NULL);
778 }
779
780 #define kFalseReturn(x) do { if (!x) return FALSE;} while (0)
781
782 // check that Lm's of a poly from T are "equal"
kTest_LmEqual(poly p,poly t_p,ring tailRing)783 static const char* kTest_LmEqual(poly p, poly t_p, ring tailRing)
784 {
785 int i;
786 for (i=1; i<=tailRing->N; i++)
787 {
788 if (p_GetExp(p, i, currRing) != p_GetExp(t_p, i, tailRing))
789 return "Lm[i] different";
790 }
791 if (p_GetComp(p, currRing) != p_GetComp(t_p, tailRing))
792 return "Lm[0] different";
793 if (pNext(p) != pNext(t_p))
794 return "Lm.next different";
795 if (pGetCoeff(p) != pGetCoeff(t_p))
796 return "Lm.coeff different";
797 return NULL;
798 }
799
800 STATIC_VAR BOOLEAN sloppy_max = FALSE;
kTest_T(TObject * T,ring strat_tailRing,int i,char TN)801 BOOLEAN kTest_T(TObject * T, ring strat_tailRing, int i, char TN)
802 {
803 ring tailRing = T->tailRing;
804 if (strat_tailRing == NULL) strat_tailRing = tailRing;
805 r_assume(strat_tailRing == tailRing);
806
807 poly p = T->p;
808 // ring r = currRing;
809
810 if (T->p == NULL && T->t_p == NULL && i >= 0)
811 return dReportError("%c[%d].poly is NULL", TN, i);
812
813 if (T->p!=NULL)
814 {
815 nTest(pGetCoeff(T->p));
816 if ((T->t_p==NULL)&&(pNext(T->p)!=NULL)) p_Test(pNext(T->p),currRing);
817 }
818 if (T->t_p!=NULL)
819 {
820 nTest(pGetCoeff(T->t_p));
821 if (pNext(T->t_p)!=NULL) p_Test(pNext(T->t_p),strat_tailRing);
822 }
823 if ((T->p!=NULL)&&(T->t_p!=NULL)) assume(pGetCoeff(T->p)==pGetCoeff(T->t_p));
824
825 if (T->tailRing != currRing)
826 {
827 if (T->t_p == NULL && i > 0)
828 return dReportError("%c[%d].t_p is NULL", TN, i);
829 pFalseReturn(p_Test(T->t_p, T->tailRing));
830 if (T->p != NULL) pFalseReturn(p_LmTest(T->p, currRing));
831 if (T->p != NULL && T->t_p != NULL)
832 {
833 const char* msg = kTest_LmEqual(T->p, T->t_p, T->tailRing);
834 if (msg != NULL)
835 return dReportError("%c[%d] %s", TN, i, msg);
836 // r = T->tailRing;
837 p = T->t_p;
838 }
839 if (T->p == NULL)
840 {
841 p = T->t_p;
842 // r = T->tailRing;
843 }
844 if (T->t_p != NULL && i >= 0 && TN == 'T')
845 {
846 if (pNext(T->t_p) == NULL)
847 {
848 if (T->max_exp != NULL)
849 return dReportError("%c[%d].max_exp is not NULL as it should be", TN, i);
850 }
851 else
852 {
853 if (T->max_exp == NULL)
854 return dReportError("%c[%d].max_exp is NULL", TN, i);
855 if (pNext(T->max_exp) != NULL)
856 return dReportError("pNext(%c[%d].max_exp) != NULL", TN, i);
857
858 pFalseReturn(p_CheckPolyRing(T->max_exp, tailRing));
859 omCheckBinAddrSize(T->max_exp, (omSizeWOfBin(tailRing->PolyBin))*SIZEOF_LONG);
860 #if KDEBUG > 0
861 if (! sloppy_max)
862 {
863 poly test_max = p_GetMaxExpP(pNext(T->t_p), tailRing);
864 p_Setm(T->max_exp, tailRing);
865 p_Setm(test_max, tailRing);
866 BOOLEAN equal = p_ExpVectorEqual(T->max_exp, test_max, tailRing);
867 if (! equal)
868 return dReportError("%c[%d].max out of sync", TN, i);
869 p_LmFree(test_max, tailRing);
870 }
871 #endif
872 }
873 }
874 }
875 else
876 {
877 if (T->p == NULL && i > 0)
878 return dReportError("%c[%d].p is NULL", TN, i);
879 #ifdef HAVE_SHIFTBBA
880 if (currRing->isLPring && T->shift > 0)
881 {
882 // in this case, the order is not correct. test LM and tail separately
883 pFalseReturn(p_LmTest(T->p, currRing));
884 pFalseReturn(p_Test(pNext(T->p), currRing));
885 }
886 else
887 #endif
888 {
889 pFalseReturn(p_Test(T->p, currRing));
890 }
891 }
892
893 if ((i >= 0) && (T->pLength != 0)
894 && (! rIsSyzIndexRing(currRing)) && (T->pLength != pLength(p)))
895 {
896 int l=T->pLength;
897 T->pLength=pLength(p);
898 return dReportError("%c[%d] pLength error: has %d, specified to have %d",
899 TN, i , pLength(p), l);
900 }
901
902 // check FDeg, for elements in L and T
903 if (i >= 0 && (TN == 'T' || TN == 'L'))
904 {
905 // FDeg has ir element from T of L set
906 if (T->FDeg != T->pFDeg())
907 {
908 int d=T->FDeg;
909 T->FDeg=T->pFDeg();
910 return dReportError("%c[%d] FDeg error: has %d, specified to have %d",
911 TN, i , T->pFDeg(), d);
912 }
913 }
914
915 // check is_normalized for elements in T
916 if (i >= 0 && TN == 'T')
917 {
918 if (T->is_normalized && ! nIsOne(pGetCoeff(p)))
919 return dReportError("T[%d] is_normalized error", i);
920
921 }
922 return TRUE;
923 }
924
kTest_L(LObject * L,ring strat_tailRing,BOOLEAN testp,int lpos,TSet T,int tlength)925 BOOLEAN kTest_L(LObject *L, ring strat_tailRing,
926 BOOLEAN testp, int lpos, TSet T, int tlength)
927 {
928 if (L->p!=NULL)
929 {
930 if ((L->t_p==NULL)
931 &&(pNext(L->p)!=NULL)
932 &&(pGetCoeff(pNext(L->p))!=NULL)) /* !=strat->tail*/
933 {
934 p_Test(pNext(L->p),currRing);
935 nTest(pGetCoeff(L->p));
936 }
937 }
938 if (L->t_p!=NULL)
939 {
940 if ((pNext(L->t_p)!=NULL)
941 &&(pGetCoeff(pNext(L->t_p))!=NULL)) /* !=strat->tail*/
942 {
943 p_Test(pNext(L->t_p),strat_tailRing);
944 nTest(pGetCoeff(L->t_p));
945 }
946 }
947 if ((L->p!=NULL)&&(L->t_p!=NULL)) assume(pGetCoeff(L->p)==pGetCoeff(L->t_p));
948
949 if (testp)
950 {
951 poly pn = NULL;
952 if (L->bucket != NULL)
953 {
954 kFalseReturn(kbTest(L->bucket));
955 r_assume(L->bucket->bucket_ring == L->tailRing);
956 if (L->p != NULL && pNext(L->p) != NULL)
957 {
958 pn = pNext(L->p);
959 pNext(L->p) = NULL;
960 }
961 }
962 kFalseReturn(kTest_T(L, strat_tailRing, lpos, 'L'));
963 if (pn != NULL)
964 pNext(L->p) = pn;
965
966 ring r;
967 poly p;
968 L->GetLm(p, r);
969 if (L->sev != 0L)
970 {
971 if (p_GetShortExpVector(p, r) != L->sev)
972 {
973 return dReportError("L[%d] wrong sev: has %lo, specified to have %lo",
974 lpos, p_GetShortExpVector(p, r), L->sev);
975 }
976 }
977 }
978 if (L->p1 == NULL)
979 {
980 // L->p2 either NULL or "normal" poly
981 pFalseReturn(pp_Test(L->p2, currRing, L->tailRing));
982 }
983 else if (tlength > 0 && T != NULL && (lpos >=0))
984 {
985 // now p1 and p2 must be != NULL and must be contained in T
986 int i;
987 #ifdef HAVE_SHIFTBBA
988 if (rIsLPRing(currRing))
989 i = kFindInTShift(L->p1, T, tlength);
990 else
991 #endif
992 i = kFindInT(L->p1, T, tlength);
993 if (i < 0)
994 return dReportError("L[%d].p1 not in T",lpos);
995 #ifdef HAVE_SHIFTBBA
996 if (rIsLPRing(currRing))
997 {
998 if (rField_is_Ring(currRing)) return TRUE; // m*shift(q) is not in T
999 i = kFindInTShift(L->p2, T, tlength);
1000 }
1001 else
1002 #endif
1003 i = kFindInT(L->p2, T, tlength);
1004 if (i < 0)
1005 return dReportError("L[%d].p2 not in T",lpos);
1006 }
1007 return TRUE;
1008 }
1009
kTest(kStrategy strat)1010 BOOLEAN kTest (kStrategy strat)
1011 {
1012 int i;
1013 // test P
1014 kFalseReturn(kTest_L(&(strat->P), strat->tailRing,
1015 (strat->P.p != NULL && pNext(strat->P.p)!=strat->tail),
1016 -1, strat->T, strat->tl));
1017
1018 // test T
1019 if (strat->T != NULL)
1020 {
1021 for (i=0; i<=strat->tl; i++)
1022 {
1023 kFalseReturn(kTest_T(&(strat->T[i]), strat->tailRing, i, 'T'));
1024 if (strat->sevT[i] != pGetShortExpVector(strat->T[i].p))
1025 return dReportError("strat->sevT[%d] out of sync", i);
1026 }
1027 }
1028
1029 // test L
1030 if (strat->L != NULL)
1031 {
1032 for (i=0; i<=strat->Ll; i++)
1033 {
1034 kFalseReturn(kTest_L(&(strat->L[i]), strat->tailRing,
1035 strat->L[i].Next() != strat->tail, i,
1036 strat->T, strat->tl));
1037 // may be unused
1038 //if (strat->use_buckets && strat->L[i].Next() != strat->tail &&
1039 // strat->L[i].Next() != NULL && strat->L[i].p1 != NULL)
1040 //{
1041 // assume(strat->L[i].bucket != NULL);
1042 //}
1043 }
1044 }
1045
1046 // test S
1047 if (strat->S != NULL)
1048 kFalseReturn(kTest_S(strat));
1049
1050 return TRUE;
1051 }
1052
kTest_S(kStrategy strat)1053 BOOLEAN kTest_S(kStrategy strat)
1054 {
1055 int i;
1056 BOOLEAN ret = TRUE;
1057 for (i=0; i<=strat->sl; i++)
1058 {
1059 if (strat->S[i] != NULL &&
1060 strat->sevS[i] != pGetShortExpVector(strat->S[i]))
1061 {
1062 return dReportError("S[%d] wrong sev: has %o, specified to have %o",
1063 i , pGetShortExpVector(strat->S[i]), strat->sevS[i]);
1064 }
1065 }
1066 return ret;
1067 }
1068
1069
1070
kTest_TS(kStrategy strat)1071 BOOLEAN kTest_TS(kStrategy strat)
1072 {
1073 int i, j;
1074 // BOOLEAN ret = TRUE;
1075 kFalseReturn(kTest(strat));
1076
1077 // test strat->R, strat->T[i].i_r
1078 for (i=0; i<=strat->tl; i++)
1079 {
1080 if (strat->T[i].i_r < 0 || strat->T[i].i_r > strat->tl)
1081 return dReportError("strat->T[%d].i_r == %d out of bounds", i,
1082 strat->T[i].i_r);
1083 if (strat->R[strat->T[i].i_r] != &(strat->T[i]))
1084 return dReportError("T[%d].i_r with R out of sync", i);
1085 }
1086 // test containment of S inT
1087 if ((strat->S != NULL)&&(strat->tl>=0))
1088 {
1089 for (i=0; i<=strat->sl; i++)
1090 {
1091 j = kFindInT(strat->S[i], strat->T, strat->tl);
1092 if (j < 0)
1093 return dReportError("S[%d] not in T", i);
1094 if (strat->S_2_R[i] != strat->T[j].i_r)
1095 return dReportError("S_2_R[%d]=%d != T[%d].i_r=%d\n",
1096 i, strat->S_2_R[i], j, strat->T[j].i_r);
1097 }
1098 }
1099 // test strat->L[i].i_r1
1100 #ifdef HAVE_SHIFTBBA
1101 if (!rIsLPRing(currRing)) // in the Letterplace ring we currently don't set/use i_r1 and i_r2
1102 #endif
1103 if (strat->L!=NULL)
1104 {
1105 for (i=0; i<=strat->Ll; i++)
1106 {
1107 if (strat->L[i].p1 != NULL && strat->L[i].p2)
1108 {
1109 if (strat->L[i].i_r1 < 0 ||
1110 strat->L[i].i_r1 > strat->tl ||
1111 strat->L[i].T_1(strat)->p != strat->L[i].p1)
1112 return dReportError("L[%d].i_r1 out of sync", i);
1113 if (strat->L[i].i_r2 < 0 ||
1114 strat->L[i].i_r2 > strat->tl ||
1115 strat->L[i].T_2(strat)->p != strat->L[i].p2)
1116 return dReportError("L[%d].i_r2 out of sync", i);
1117 }
1118 else
1119 {
1120 if (strat->L[i].i_r1 != -1)
1121 return dReportError("L[%d].i_r1 out of sync", i);
1122 if (strat->L[i].i_r2 != -1)
1123 return dReportError("L[%d].i_r2 out of sync", i);
1124 }
1125 if (strat->L[i].i_r != -1)
1126 return dReportError("L[%d].i_r out of sync", i);
1127 }
1128 }
1129 return TRUE;
1130 }
1131
1132 #endif // KDEBUG
1133
1134 /*2
1135 *cancels the i-th polynomial in the standardbase s
1136 */
deleteInS(int i,kStrategy strat)1137 void deleteInS (int i,kStrategy strat)
1138 {
1139 #ifdef ENTER_USE_MEMMOVE
1140 memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
1141 memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
1142 memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
1143 memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
1144 #else
1145 int j;
1146 for (j=i; j<strat->sl; j++)
1147 {
1148 strat->S[j] = strat->S[j+1];
1149 strat->ecartS[j] = strat->ecartS[j+1];
1150 strat->sevS[j] = strat->sevS[j+1];
1151 strat->S_2_R[j] = strat->S_2_R[j+1];
1152 }
1153 #endif
1154 if (strat->lenS!=NULL)
1155 {
1156 #ifdef ENTER_USE_MEMMOVE
1157 memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
1158 #else
1159 for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
1160 #endif
1161 }
1162 if (strat->lenSw!=NULL)
1163 {
1164 #ifdef ENTER_USE_MEMMOVE
1165 memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
1166 #else
1167 for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
1168 #endif
1169 }
1170 if (strat->fromQ!=NULL)
1171 {
1172 #ifdef ENTER_USE_MEMMOVE
1173 memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
1174 #else
1175 for (j=i; j<strat->sl; j++)
1176 {
1177 strat->fromQ[j] = strat->fromQ[j+1];
1178 }
1179 #endif
1180 }
1181 strat->S[strat->sl] = NULL;
1182 strat->sl--;
1183 }
1184
1185
1186 /*2
1187 *cancels the i-th polynomial in the standardbase s
1188 */
deleteInSSba(int i,kStrategy strat)1189 void deleteInSSba (int i,kStrategy strat)
1190 {
1191 #ifdef ENTER_USE_MEMMOVE
1192 memmove(&(strat->S[i]), &(strat->S[i+1]), (strat->sl - i)*sizeof(poly));
1193 memmove(&(strat->sig[i]), &(strat->sig[i+1]), (strat->sl - i)*sizeof(poly));
1194 memmove(&(strat->ecartS[i]),&(strat->ecartS[i+1]),(strat->sl - i)*sizeof(int));
1195 memmove(&(strat->sevS[i]),&(strat->sevS[i+1]),(strat->sl - i)*sizeof(unsigned long));
1196 memmove(&(strat->sevSig[i]),&(strat->sevSig[i+1]),(strat->sl - i)*sizeof(unsigned long));
1197 memmove(&(strat->S_2_R[i]),&(strat->S_2_R[i+1]),(strat->sl - i)*sizeof(int));
1198 #else
1199 int j;
1200 for (j=i; j<strat->sl; j++)
1201 {
1202 strat->S[j] = strat->S[j+1];
1203 strat->sig[j] = strat->sig[j+1];
1204 strat->ecartS[j] = strat->ecartS[j+1];
1205 strat->sevS[j] = strat->sevS[j+1];
1206 strat->sevSig[j] = strat->sevSig[j+1];
1207 strat->S_2_R[j] = strat->S_2_R[j+1];
1208 }
1209 #endif
1210 if (strat->lenS!=NULL)
1211 {
1212 #ifdef ENTER_USE_MEMMOVE
1213 memmove(&(strat->lenS[i]),&(strat->lenS[i+1]),(strat->sl - i)*sizeof(int));
1214 #else
1215 for (j=i; j<strat->sl; j++) strat->lenS[j] = strat->lenS[j+1];
1216 #endif
1217 }
1218 if (strat->lenSw!=NULL)
1219 {
1220 #ifdef ENTER_USE_MEMMOVE
1221 memmove(&(strat->lenSw[i]),&(strat->lenSw[i+1]),(strat->sl - i)*sizeof(wlen_type));
1222 #else
1223 for (j=i; j<strat->sl; j++) strat->lenSw[j] = strat->lenSw[j+1];
1224 #endif
1225 }
1226 if (strat->fromQ!=NULL)
1227 {
1228 #ifdef ENTER_USE_MEMMOVE
1229 memmove(&(strat->fromQ[i]),&(strat->fromQ[i+1]),(strat->sl - i)*sizeof(int));
1230 #else
1231 for (j=i; j<strat->sl; j++)
1232 {
1233 strat->fromQ[j] = strat->fromQ[j+1];
1234 }
1235 #endif
1236 }
1237 strat->S[strat->sl] = NULL;
1238 strat->sl--;
1239 }
1240
1241 /*2
1242 *cancels the j-th polynomial in the set
1243 */
deleteInL(LSet set,int * length,int j,kStrategy strat)1244 void deleteInL (LSet set, int *length, int j,kStrategy strat)
1245 {
1246 if (set[j].lcm!=NULL)
1247 {
1248 kDeleteLcm(&set[j]);
1249 }
1250 if (set[j].sig!=NULL)
1251 {
1252 #ifdef HAVE_RINGS
1253 if (pGetCoeff(set[j].sig) != NULL)
1254 pLmDelete(set[j].sig);
1255 else
1256 #endif
1257 pLmFree(set[j].sig);
1258 }
1259 if (set[j].p!=NULL)
1260 {
1261 if (pNext(set[j].p) == strat->tail)
1262 {
1263 #ifdef HAVE_RINGS
1264 if (pGetCoeff(set[j].p) != NULL)
1265 pLmDelete(set[j].p);
1266 else
1267 #endif
1268 pLmFree(set[j].p);
1269 /*- tail belongs to several int spolys -*/
1270 }
1271 else
1272 {
1273 // search p in T, if it is there, do not delete it
1274 if (rHasGlobalOrdering(currRing) || (kFindInT(set[j].p, strat) < 0))
1275 {
1276 // assure that for global orderings kFindInT fails
1277 //assume((rHasLocalOrMixedOrdering(currRing)) && (kFindInT(set[j].p, strat) >= 0));
1278 set[j].Delete();
1279 }
1280 }
1281 }
1282 if (*length > 0 && j < *length)
1283 {
1284 #ifdef ENTER_USE_MEMMOVE
1285 memmove(&(set[j]), &(set[j+1]), (*length - j)*sizeof(LObject));
1286 #else
1287 int i;
1288 for (i=j; i < (*length); i++)
1289 set[i] = set[i+1];
1290 #endif
1291 }
1292 #ifdef KDEBUG
1293 memset(&(set[*length]),0,sizeof(LObject));
1294 #endif
1295 (*length)--;
1296 }
1297
1298 /*2
1299 *enters p at position at in L
1300 */
enterL(LSet * set,int * length,int * LSetmax,LObject p,int at)1301 void enterL (LSet *set,int *length, int *LSetmax, LObject p,int at)
1302 {
1303 // this should be corrected
1304 assume(p.FDeg == p.pFDeg());
1305
1306 if ((*length)>=0)
1307 {
1308 if ((*length) == (*LSetmax)-1) enlargeL(set,LSetmax,setmaxLinc);
1309 if (at <= (*length))
1310 #ifdef ENTER_USE_MEMMOVE
1311 memmove(&((*set)[at+1]), &((*set)[at]), ((*length)-at+1)*sizeof(LObject));
1312 #else
1313 for (i=(*length)+1; i>=at+1; i--) (*set)[i] = (*set)[i-1];
1314 #endif
1315 }
1316 else at = 0;
1317 (*set)[at] = p;
1318 (*length)++;
1319 }
1320
1321 /*2
1322 * computes the normal ecart;
1323 * used in mora case and if pLexOrder & sugar in bba case
1324 */
initEcartNormal(TObject * h)1325 void initEcartNormal (TObject* h)
1326 {
1327 h->FDeg = h->pFDeg();
1328 h->ecart = h->pLDeg() - h->FDeg;
1329 // h->length is set by h->pLDeg
1330 h->length=h->pLength=pLength(h->p);
1331 }
1332
initEcartBBA(TObject * h)1333 void initEcartBBA (TObject* h)
1334 {
1335 h->FDeg = h->pFDeg();
1336 (*h).ecart = 0;
1337 h->length=h->pLength=pLength(h->p);
1338 }
1339
initEcartPairBba(LObject * Lp,poly,poly,int,int)1340 void initEcartPairBba (LObject* Lp,poly /*f*/,poly /*g*/,int /*ecartF*/,int /*ecartG*/)
1341 {
1342 Lp->FDeg = Lp->pFDeg();
1343 (*Lp).ecart = 0;
1344 (*Lp).length = 0;
1345 }
1346
initEcartPairMora(LObject * Lp,poly,poly,int ecartF,int ecartG)1347 void initEcartPairMora (LObject* Lp,poly /*f*/,poly /*g*/,int ecartF,int ecartG)
1348 {
1349 Lp->FDeg = Lp->pFDeg();
1350 (*Lp).ecart = si_max(ecartF,ecartG);
1351 (*Lp).ecart = (*Lp).ecart- (Lp->FDeg -p_FDeg((*Lp).lcm,currRing));
1352 (*Lp).length = 0;
1353 }
1354
1355 /*2
1356 *if ecart1<=ecart2 it returns TRUE
1357 */
sugarDivisibleBy(int ecart1,int ecart2)1358 static inline BOOLEAN sugarDivisibleBy(int ecart1, int ecart2)
1359 {
1360 return (ecart1 <= ecart2);
1361 }
1362
1363 #ifdef HAVE_RINGS
1364 /*2
1365 * put the pair (s[i],p) into the set B, ecart=ecart(p) (ring case)
1366 */
enterOnePairRing(int i,poly p,int,int isFromQ,kStrategy strat,int atR)1367 static void enterOnePairRing (int i,poly p,int /*ecart*/, int isFromQ,kStrategy strat, int atR)
1368 {
1369 assume(atR >= 0);
1370 assume(i<=strat->sl);
1371 assume(p!=NULL);
1372 assume(rField_is_Ring(currRing));
1373 #if ALL_VS_JUST
1374 //Over rings, if we construct the strong pair, do not add the spair
1375 if(rField_is_Ring(currRing))
1376 {
1377 number s,t,d;
1378 d = n_ExtGcd(pGetCoeff(p), pGetCoeff(strat->S[i]), &s, &t, currRing->cf);
1379
1380 if (!nIsZero(s) && !nIsZero(t)) // evtl. durch divBy tests ersetzen
1381 {
1382 nDelete(&d);
1383 nDelete(&s);
1384 nDelete(&t);
1385 return;
1386 }
1387 nDelete(&d);
1388 nDelete(&s);
1389 nDelete(&t);
1390 }
1391 #endif
1392 int j,compare,compareCoeff;
1393 LObject h;
1394
1395 #ifdef KDEBUG
1396 h.ecart=0; h.length=0;
1397 #endif
1398 /*- computes the lcm(s[i],p) -*/
1399 if(pHasNotCFRing(p,strat->S[i]))
1400 {
1401 strat->cp++;
1402 return;
1403 }
1404 h.lcm = p_Lcm(p,strat->S[i],currRing);
1405 pSetCoeff0(h.lcm, n_Lcm(pGetCoeff(p), pGetCoeff(strat->S[i]), currRing->cf));
1406 if (nIsZero(pGetCoeff(h.lcm)))
1407 {
1408 strat->cp++;
1409 pLmDelete(h.lcm);
1410 return;
1411 }
1412 // basic chain criterion
1413 /*
1414 *the set B collects the pairs of type (S[j],p)
1415 *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
1416 *if the leading term of s divides lcm(r,p) then (r,p) will be canceled
1417 *if the leading term of r divides lcm(s,p) then (s,p) will not enter B
1418 */
1419
1420 for(j = strat->Bl;j>=0;j--)
1421 {
1422 compare=pDivCompRing(strat->B[j].lcm,h.lcm);
1423 compareCoeff = n_DivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(h.lcm), currRing->cf);
1424 if(compare == pDivComp_EQUAL)
1425 {
1426 //They have the same LM
1427 if(compareCoeff == pDivComp_LESS)
1428 {
1429 if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1430 {
1431 strat->c3++;
1432 pLmDelete(h.lcm);
1433 return;
1434 }
1435 break;
1436 }
1437 if(compareCoeff == pDivComp_GREATER)
1438 {
1439 deleteInL(strat->B,&strat->Bl,j,strat);
1440 strat->c3++;
1441 }
1442 if(compareCoeff == pDivComp_EQUAL)
1443 {
1444 if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1445 {
1446 strat->c3++;
1447 pLmDelete(h.lcm);
1448 return;
1449 }
1450 break;
1451 }
1452 }
1453 if(compareCoeff == compare || compareCoeff == pDivComp_EQUAL)
1454 {
1455 if(compare == pDivComp_LESS)
1456 {
1457 if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
1458 {
1459 strat->c3++;
1460 pLmDelete(h.lcm);
1461 return;
1462 }
1463 break;
1464 }
1465 if(compare == pDivComp_GREATER)
1466 {
1467 deleteInL(strat->B,&strat->Bl,j,strat);
1468 strat->c3++;
1469 }
1470 }
1471 }
1472 number s, t;
1473 poly m1, m2, gcd = NULL;
1474 s = pGetCoeff(strat->S[i]);
1475 t = pGetCoeff(p);
1476 k_GetLeadTerms(p,strat->S[i],currRing,m1,m2,currRing);
1477 ksCheckCoeff(&s, &t, currRing->cf);
1478 pSetCoeff0(m1, s);
1479 pSetCoeff0(m2, t);
1480 m2 = pNeg(m2);
1481 p_Test(m1,strat->tailRing);
1482 p_Test(m2,strat->tailRing);
1483 poly si = pCopy(strat->S[i]);
1484 poly pm1 = pp_Mult_mm(pNext(p), m1, strat->tailRing);
1485 poly sim2 = pp_Mult_mm(pNext(si), m2, strat->tailRing);
1486 pDelete(&si);
1487 p_LmDelete(m1, currRing);
1488 p_LmDelete(m2, currRing);
1489 if(sim2 == NULL)
1490 {
1491 if(pm1 == NULL)
1492 {
1493 if(h.lcm != NULL)
1494 {
1495 pLmDelete(h.lcm);
1496 h.lcm=NULL;
1497 }
1498 h.Clear();
1499 if (strat->pairtest==NULL) initPairtest(strat);
1500 strat->pairtest[i] = TRUE;
1501 strat->pairtest[strat->sl+1] = TRUE;
1502 return;
1503 }
1504 else
1505 {
1506 gcd = pm1;
1507 pm1 = NULL;
1508 }
1509 }
1510 else
1511 {
1512 if((pGetComp(strat->S[i]) == 0) && (0 != pGetComp(p)))
1513 {
1514 p_SetCompP(sim2, pGetComp(p), strat->tailRing);
1515 pSetmComp(sim2);
1516 }
1517 //p_Write(pm1,strat->tailRing);p_Write(sim2,strat->tailRing);
1518 gcd = p_Add_q(pm1, sim2, strat->tailRing);
1519 }
1520 p_Test(gcd, strat->tailRing);
1521 #ifdef KDEBUG
1522 if (TEST_OPT_DEBUG)
1523 {
1524 wrp(gcd);
1525 PrintLn();
1526 }
1527 #endif
1528 h.p = gcd;
1529 h.i_r = -1;
1530 if(h.p == NULL)
1531 {
1532 if (strat->pairtest==NULL) initPairtest(strat);
1533 strat->pairtest[i] = TRUE;
1534 strat->pairtest[strat->sl+1] = TRUE;
1535 return;
1536 }
1537 h.tailRing = strat->tailRing;
1538 int posx;
1539 //h.pCleardenom();
1540 //pSetm(h.p);
1541 h.i_r1 = -1;h.i_r2 = -1;
1542 strat->initEcart(&h);
1543 #if 1
1544 h.p2 = strat->S[i];
1545 h.p1 = p;
1546 #endif
1547 #if 1
1548 if (atR >= 0)
1549 {
1550 h.i_r1 = atR;
1551 h.i_r2 = strat->S_2_R[i];
1552 }
1553 #endif
1554 if (strat->Bl==-1)
1555 posx =0;
1556 else
1557 posx = strat->posInL(strat->B,strat->Bl,&h,strat);
1558 h.sev = pGetShortExpVector(h.p);
1559 if (currRing!=strat->tailRing)
1560 h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1561 if (strat->P.p!=NULL) strat->P.sev = pGetShortExpVector(strat->P.p);
1562 else strat->P.sev=0L;
1563 enterL(&strat->B,&strat->Bl,&strat->Bmax,h,posx);
1564 kTest_TS(strat);
1565 }
1566
1567 /*2
1568 * put the lcm(s[i],p) into the set B
1569 */
1570
enterOneStrongPoly(int i,poly p,int,int,kStrategy strat,int atR,bool enterTstrong)1571 static BOOLEAN enterOneStrongPoly (int i,poly p,int /*ecart*/, int /*isFromQ*/,kStrategy strat, int atR, bool enterTstrong)
1572 {
1573 number d, s, t;
1574 assume(atR >= 0);
1575 assume(rField_is_Ring(currRing));
1576 poly m1, m2, gcd,si;
1577 if(!enterTstrong)
1578 {
1579 assume(i<=strat->sl);
1580 si = strat->S[i];
1581 }
1582 else
1583 {
1584 assume(i<=strat->tl);
1585 si = strat->T[i].p;
1586 }
1587 //printf("\n--------------------------------\n");
1588 //pWrite(p);pWrite(si);
1589 d = n_ExtGcd(pGetCoeff(p), pGetCoeff(si), &s, &t, currRing->cf);
1590
1591 if (nIsZero(s) || nIsZero(t)) // evtl. durch divBy tests ersetzen
1592 {
1593 nDelete(&d);
1594 nDelete(&s);
1595 nDelete(&t);
1596 return FALSE;
1597 }
1598
1599 k_GetStrongLeadTerms(p, si, currRing, m1, m2, gcd, strat->tailRing);
1600
1601 if (!rHasLocalOrMixedOrdering(currRing))
1602 {
1603 unsigned long sev = pGetShortExpVector(gcd);
1604
1605 for (int j = 0; j < strat->sl; j++)
1606 {
1607 if (j == i)
1608 continue;
1609
1610 if (n_DivBy(d, pGetCoeff(strat->S[j]), currRing->cf)
1611 && !(strat->sevS[j] & ~sev)
1612 && p_LmDivisibleBy(strat->S[j], gcd, currRing))
1613 {
1614 nDelete(&d);
1615 nDelete(&s);
1616 nDelete(&t);
1617 return FALSE;
1618 }
1619 }
1620 }
1621
1622 //p_Test(m1,strat->tailRing);
1623 //p_Test(m2,strat->tailRing);
1624 /*if(!enterTstrong)
1625 {
1626 while (! kCheckStrongCreation(atR, m1, i, m2, strat) )
1627 {
1628 memset(&(strat->P), 0, sizeof(strat->P));
1629 kStratChangeTailRing(strat);
1630 strat->P = *(strat->R[atR]);
1631 p_LmFree(m1, strat->tailRing);
1632 p_LmFree(m2, strat->tailRing);
1633 p_LmFree(gcd, currRing);
1634 k_GetStrongLeadTerms(p, si, currRing, m1, m2, gcd, strat->tailRing);
1635 }
1636 }*/
1637 pSetCoeff0(m1, s);
1638 pSetCoeff0(m2, t);
1639 pSetCoeff0(gcd, d);
1640 p_Test(m1,strat->tailRing);
1641 p_Test(m2,strat->tailRing);
1642 //printf("\n===================================\n");
1643 //pWrite(m1);pWrite(m2);pWrite(gcd);
1644 #ifdef KDEBUG
1645 if (TEST_OPT_DEBUG)
1646 {
1647 // Print("t = %d; s = %d; d = %d\n", nInt(t), nInt(s), nInt(d));
1648 PrintS("m1 = ");
1649 p_wrp(m1, strat->tailRing);
1650 PrintS(" ; m2 = ");
1651 p_wrp(m2, strat->tailRing);
1652 PrintS(" ; gcd = ");
1653 wrp(gcd);
1654 PrintS("\n--- create strong gcd poly: ");
1655 Print("\n p: %d", i);
1656 wrp(p);
1657 Print("\n strat->S[%d]: ", i);
1658 wrp(si);
1659 PrintS(" ---> ");
1660 }
1661 #endif
1662
1663 pNext(gcd) = p_Add_q(pp_Mult_mm(pNext(p), m1, strat->tailRing), pp_Mult_mm(pNext(si), m2, strat->tailRing), strat->tailRing);
1664 p_LmDelete(m1, strat->tailRing);
1665 p_LmDelete(m2, strat->tailRing);
1666 #ifdef KDEBUG
1667 if (TEST_OPT_DEBUG)
1668 {
1669 wrp(gcd);
1670 PrintLn();
1671 }
1672 #endif
1673
1674 LObject h;
1675 h.p = gcd;
1676 h.tailRing = strat->tailRing;
1677 int posx;
1678 h.pCleardenom();
1679 strat->initEcart(&h);
1680 h.sev = pGetShortExpVector(h.p);
1681 h.i_r1 = -1;h.i_r2 = -1;
1682 if (currRing!=strat->tailRing)
1683 h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1684 if(!enterTstrong)
1685 {
1686 #if 1
1687 h.p1 = p;h.p2 = strat->S[i];
1688 #endif
1689 if (atR >= 0)
1690 {
1691 h.i_r2 = strat->S_2_R[i];
1692 h.i_r1 = atR;
1693 }
1694 else
1695 {
1696 h.i_r1 = -1;
1697 h.i_r2 = -1;
1698 }
1699 if (strat->Ll==-1)
1700 posx =0;
1701 else
1702 posx = strat->posInL(strat->L,strat->Ll,&h,strat);
1703 enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
1704 }
1705 else
1706 {
1707 if(h.IsNull()) return FALSE;
1708 //int red_result;
1709 //reduzieren ist teur!!!
1710 //if(strat->L != NULL)
1711 //red_result = strat->red(&h,strat);
1712 if(!h.IsNull())
1713 {
1714 enterT(h, strat,-1);
1715 //int pos = posInS(strat,strat->sl,h.p,h.ecart);
1716 //strat->enterS(h,pos,strat,-1);
1717 }
1718 }
1719 return TRUE;
1720 }
1721
sbaCheckGcdPair(LObject * h,kStrategy strat)1722 BOOLEAN sbaCheckGcdPair (LObject* h,kStrategy strat)
1723 {
1724 if(strat->sl < 0) return FALSE;
1725 int i;
1726 for(i=0;i<strat->sl;i++)
1727 {
1728 //Construct the gcd pair between h and S[i]
1729 number d, s, t;
1730 poly m1, m2, gcd;
1731 d = n_ExtGcd(pGetCoeff(h->p), pGetCoeff(strat->S[i]), &s, &t, currRing->cf);
1732 if (nIsZero(s) || nIsZero(t)) // evtl. durch divBy tests ersetzen
1733 {
1734 nDelete(&d);
1735 nDelete(&s);
1736 nDelete(&t);
1737 }
1738 else
1739 {
1740 k_GetStrongLeadTerms(h->p, strat->S[i], currRing, m1, m2, gcd, strat->tailRing);
1741 pSetCoeff0(m1, s);
1742 pSetCoeff0(m2, t);
1743 pSetCoeff0(gcd, d);
1744 pNext(gcd) = p_Add_q(pp_Mult_mm(pNext(h->p), m1, strat->tailRing), pp_Mult_mm(pNext(strat->S[i]), m2, strat->tailRing), strat->tailRing);
1745 poly pSigMult = p_Copy(h->sig,currRing);
1746 poly sSigMult = p_Copy(strat->sig[i],currRing);
1747 pSigMult = p_Mult_mm(pSigMult,m1,currRing);
1748 sSigMult = p_Mult_mm(sSigMult,m2,currRing);
1749 p_LmDelete(m1, strat->tailRing);
1750 p_LmDelete(m2, strat->tailRing);
1751 poly pairsig = p_Add_q(pSigMult,sSigMult,currRing);
1752 if(pairsig!= NULL && pLtCmp(pairsig,h->sig) == 0)
1753 {
1754 pDelete(&h->p);
1755 h->p = gcd;
1756 pDelete(&h->sig);
1757 h->sig = pairsig;
1758 pNext(h->sig) = NULL;
1759 strat->initEcart(h);
1760 h->sev = pGetShortExpVector(h->p);
1761 h->sevSig = pGetShortExpVector(h->sig);
1762 h->i_r1 = -1;h->i_r2 = -1;
1763 if(h->lcm != NULL)
1764 {
1765 pLmDelete(h->lcm);
1766 h->lcm = NULL;
1767 }
1768 if (currRing!=strat->tailRing)
1769 h->t_p = k_LmInit_currRing_2_tailRing(h->p, strat->tailRing);
1770 return TRUE;
1771 }
1772 //Delete what you didn't use
1773 pDelete(&gcd);
1774 pDelete(&pairsig);
1775 }
1776 }
1777 return FALSE;
1778 }
1779
enterOneStrongPolySig(int i,poly p,poly sig,int,int,kStrategy strat,int atR)1780 static BOOLEAN enterOneStrongPolySig (int i,poly p,poly sig,int /*ecart*/, int /*isFromQ*/,kStrategy strat, int atR)
1781 {
1782 number d, s, t;
1783 assume(atR >= 0);
1784 poly m1, m2, gcd,si;
1785 assume(i<=strat->sl);
1786 si = strat->S[i];
1787 //printf("\n--------------------------------\n");
1788 //pWrite(p);pWrite(si);
1789 d = n_ExtGcd(pGetCoeff(p), pGetCoeff(si), &s, &t, currRing->cf);
1790
1791 if (nIsZero(s) || nIsZero(t)) // evtl. durch divBy tests ersetzen
1792 {
1793 nDelete(&d);
1794 nDelete(&s);
1795 nDelete(&t);
1796 return FALSE;
1797 }
1798
1799 k_GetStrongLeadTerms(p, si, currRing, m1, m2, gcd, strat->tailRing);
1800 //p_Test(m1,strat->tailRing);
1801 //p_Test(m2,strat->tailRing);
1802 /*if(!enterTstrong)
1803 {
1804 while (! kCheckStrongCreation(atR, m1, i, m2, strat) )
1805 {
1806 memset(&(strat->P), 0, sizeof(strat->P));
1807 kStratChangeTailRing(strat);
1808 strat->P = *(strat->R[atR]);
1809 p_LmFree(m1, strat->tailRing);
1810 p_LmFree(m2, strat->tailRing);
1811 p_LmFree(gcd, currRing);
1812 k_GetStrongLeadTerms(p, si, currRing, m1, m2, gcd, strat->tailRing);
1813 }
1814 }*/
1815 pSetCoeff0(m1, s);
1816 pSetCoeff0(m2, t);
1817 pSetCoeff0(gcd, d);
1818 p_Test(m1,strat->tailRing);
1819 p_Test(m2,strat->tailRing);
1820 //printf("\n===================================\n");
1821 //pWrite(m1);pWrite(m2);pWrite(gcd);
1822 #ifdef KDEBUG
1823 if (TEST_OPT_DEBUG)
1824 {
1825 // Print("t = %d; s = %d; d = %d\n", nInt(t), nInt(s), nInt(d));
1826 PrintS("m1 = ");
1827 p_wrp(m1, strat->tailRing);
1828 PrintS(" ; m2 = ");
1829 p_wrp(m2, strat->tailRing);
1830 PrintS(" ; gcd = ");
1831 wrp(gcd);
1832 PrintS("\n--- create strong gcd poly: ");
1833 Print("\n p: %d", i);
1834 wrp(p);
1835 Print("\n strat->S[%d]: ", i);
1836 wrp(si);
1837 PrintS(" ---> ");
1838 }
1839 #endif
1840
1841 pNext(gcd) = p_Add_q(pp_Mult_mm(pNext(p), m1, strat->tailRing), pp_Mult_mm(pNext(si), m2, strat->tailRing), strat->tailRing);
1842
1843 #ifdef KDEBUG
1844 if (TEST_OPT_DEBUG)
1845 {
1846 wrp(gcd);
1847 PrintLn();
1848 }
1849 #endif
1850
1851 //Check and set the signatures
1852 poly pSigMult = p_Copy(sig,currRing);
1853 poly sSigMult = p_Copy(strat->sig[i],currRing);
1854 pSigMult = p_Mult_mm(pSigMult,m1,currRing);
1855 sSigMult = p_Mult_mm(sSigMult,m2,currRing);
1856 p_LmDelete(m1, strat->tailRing);
1857 p_LmDelete(m2, strat->tailRing);
1858 poly pairsig;
1859 if(pLmCmp(pSigMult,sSigMult) == 0)
1860 {
1861 //Same lm, have to add them
1862 pairsig = p_Add_q(pSigMult,sSigMult,currRing);
1863 //This might be zero
1864 }
1865 else
1866 {
1867 //Set the sig to either pSigMult or sSigMult
1868 if(pLtCmp(pSigMult,sSigMult)==1)
1869 {
1870 pairsig = pSigMult;
1871 pDelete(&sSigMult);
1872 }
1873 else
1874 {
1875 pairsig = sSigMult;
1876 pDelete(&pSigMult);
1877 }
1878 }
1879
1880 LObject h;
1881 h.p = gcd;
1882 h.tailRing = strat->tailRing;
1883 h.sig = pairsig;
1884 int posx;
1885 h.pCleardenom();
1886 strat->initEcart(&h);
1887 h.sev = pGetShortExpVector(h.p);
1888 h.i_r1 = -1;h.i_r2 = -1;
1889 if (currRing!=strat->tailRing)
1890 h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
1891 if(h.sig == NULL)
1892 {
1893 //sigdrop since we loose the signature
1894 strat->sigdrop = TRUE;
1895 //Try to reduce it as far as we can via redRing
1896 int red_result = redRing(&h,strat);
1897 if(red_result == 0)
1898 {
1899 // Cancel the sigdrop
1900 p_Delete(&h.sig,currRing);h.sig = NULL;
1901 strat->sigdrop = FALSE;
1902 return FALSE;
1903 }
1904 else
1905 {
1906 strat->enterS(strat->P,strat->sl+1,strat, strat->tl+1);
1907 #if 1
1908 strat->enterS(h,0,strat,strat->tl);
1909 #endif
1910 return FALSE;
1911 }
1912 }
1913 if(!nGreaterZero(pGetCoeff(h.sig)))
1914 {
1915 h.sig = pNeg(h.sig);
1916 h.p = pNeg(h.p);
1917 }
1918
1919 if(rField_is_Ring(currRing) && pLtCmp(h.sig,sig) == -1)
1920 {
1921 strat->sigdrop = TRUE;
1922 // Completely reduce it
1923 int red_result = redRing(&h,strat);
1924 if(red_result == 0)
1925 {
1926 // Reduced to 0
1927 strat->sigdrop = FALSE;
1928 p_Delete(&h.sig,currRing);h.sig = NULL;
1929 return FALSE;
1930 }
1931 else
1932 {
1933 strat->enterS(strat->P,strat->sl+1,strat, strat->tl+1);
1934 // 0 - add just the original poly causing the sigdrop, 1 - add also this
1935 #if 1
1936 strat->enterS(h,0,strat, strat->tl+1);
1937 #endif
1938 return FALSE;
1939 }
1940 }
1941 //Check for sigdrop
1942 if(gcd != NULL && pLtCmp(sig,pairsig) > 0 && pLtCmp(strat->sig[i],pairsig) > 0)
1943 {
1944 strat->sigdrop = TRUE;
1945 //Enter this element to S
1946 strat->enterS(strat->P,strat->sl+1,strat, strat->tl+1);
1947 strat->enterS(h,strat->sl+1,strat,strat->tl+1);
1948 }
1949 #if 1
1950 h.p1 = p;h.p2 = strat->S[i];
1951 #endif
1952 if (atR >= 0)
1953 {
1954 h.i_r2 = strat->S_2_R[i];
1955 h.i_r1 = atR;
1956 }
1957 else
1958 {
1959 h.i_r1 = -1;
1960 h.i_r2 = -1;
1961 }
1962 if (strat->Ll==-1)
1963 posx =0;
1964 else
1965 posx = strat->posInLSba(strat->L,strat->Ll,&h,strat);
1966 enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
1967 return TRUE;
1968 }
1969 #endif
1970
1971 /*2
1972 * put the pair (s[i],p) into the set B, ecart=ecart(p)
1973 */
1974
enterOnePairNormal(int i,poly p,int ecart,int isFromQ,kStrategy strat,int atR=-1)1975 void enterOnePairNormal (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
1976 {
1977 assume(i<=strat->sl);
1978
1979 int l,j,compare;
1980 LObject Lp;
1981 Lp.i_r = -1;
1982
1983 #ifdef KDEBUG
1984 Lp.ecart=0; Lp.length=0;
1985 #endif
1986 /*- computes the lcm(s[i],p) -*/
1987 Lp.lcm = pInit();
1988
1989 #ifndef HAVE_RATGRING
1990 pLcm(p,strat->S[i],Lp.lcm);
1991 #elif defined(HAVE_RATGRING)
1992 if (rIsRatGRing(currRing))
1993 pLcmRat(p,strat->S[i],Lp.lcm, currRing->real_var_start); // int rat_shift
1994 else
1995 pLcm(p,strat->S[i],Lp.lcm);
1996 #endif
1997 pSetm(Lp.lcm);
1998
1999
2000 if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
2001 {
2002 if (strat->fromT && (strat->ecartS[i]>ecart))
2003 {
2004 pLmFree(Lp.lcm);
2005 return;
2006 /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
2007 }
2008 if((!((strat->ecartS[i]>0)&&(ecart>0)))
2009 && pHasNotCF(p,strat->S[i]))
2010 {
2011 /*
2012 *the product criterion has applied for (s,p),
2013 *i.e. lcm(s,p)=product of the leading terms of s and p.
2014 *Suppose (s,r) is in L and the leading term
2015 *of p divides lcm(s,r)
2016 *(==> the leading term of p divides the leading term of r)
2017 *but the leading term of s does not divide the leading term of r
2018 *(notice that tis condition is automatically satisfied if r is still
2019 *in S), then (s,r) can be cancelled.
2020 *This should be done here because the
2021 *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
2022 *
2023 *Moreover, skipping (s,r) holds also for the noncommutative case.
2024 */
2025 strat->cp++;
2026 pLmFree(Lp.lcm);
2027 return;
2028 }
2029 Lp.ecart = si_max(ecart,strat->ecartS[i]);
2030 /*
2031 *the set B collects the pairs of type (S[j],p)
2032 *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
2033 *if the leading term of s divides lcm(r,p) then (r,p) will be canceled
2034 *if the leading term of r divides lcm(s,p) then (s,p) will not enter B
2035 */
2036 {
2037 j = strat->Bl;
2038 loop
2039 {
2040 if (j < 0) break;
2041 compare=pDivComp(strat->B[j].lcm,Lp.lcm);
2042 if ((compare==1)
2043 &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
2044 {
2045 strat->c3++;
2046 if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
2047 {
2048 pLmFree(Lp.lcm);
2049 return;
2050 }
2051 break;
2052 }
2053 else
2054 if ((compare ==-1)
2055 && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
2056 {
2057 deleteInL(strat->B,&strat->Bl,j,strat);
2058 strat->c3++;
2059 }
2060 j--;
2061 }
2062 }
2063 }
2064 else /*sugarcrit*/
2065 {
2066 if (ALLOW_PROD_CRIT(strat))
2067 {
2068 if (strat->fromT && (strat->ecartS[i]>ecart))
2069 {
2070 pLmFree(Lp.lcm);
2071 return;
2072 /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
2073 }
2074 // if currRing->nc_type!=quasi (or skew)
2075 // TODO: enable productCrit for super commutative algebras...
2076 if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
2077 pHasNotCF(p,strat->S[i]))
2078 {
2079 /*
2080 *the product criterion has applied for (s,p),
2081 *i.e. lcm(s,p)=product of the leading terms of s and p.
2082 *Suppose (s,r) is in L and the leading term
2083 *of p divides lcm(s,r)
2084 *(==> the leading term of p divides the leading term of r)
2085 *but the leading term of s does not divide the leading term of r
2086 *(notice that tis condition is automatically satisfied if r is still
2087 *in S), then (s,r) can be canceled.
2088 *This should be done here because the
2089 *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
2090 */
2091 strat->cp++;
2092 pLmFree(Lp.lcm);
2093 return;
2094 }
2095 /*
2096 *the set B collects the pairs of type (S[j],p)
2097 *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
2098 *if the leading term of s divides lcm(r,p) then (r,p) will be canceled
2099 *if the leading term of r divides lcm(s,p) then (s,p) will not enter B
2100 */
2101 for(j = strat->Bl;j>=0;j--)
2102 {
2103 compare=pDivComp(strat->B[j].lcm,Lp.lcm);
2104 if (compare==1)
2105 {
2106 strat->c3++;
2107 if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
2108 {
2109 pLmFree(Lp.lcm);
2110 return;
2111 }
2112 break;
2113 }
2114 else
2115 if (compare ==-1)
2116 {
2117 deleteInL(strat->B,&strat->Bl,j,strat);
2118 strat->c3++;
2119 }
2120 }
2121 }
2122 }
2123 /*
2124 *the pair (S[i],p) enters B if the spoly != 0
2125 */
2126 /*- compute the short s-polynomial -*/
2127 if (strat->fromT && !TEST_OPT_INTSTRATEGY)
2128 pNorm(p);
2129
2130 if ((strat->S[i]==NULL) || (p==NULL))
2131 return;
2132
2133 if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
2134 Lp.p=NULL;
2135 else
2136 {
2137 #ifdef HAVE_PLURAL
2138 if ( rIsPluralRing(currRing) )
2139 {
2140 if(pHasNotCF(p, strat->S[i]))
2141 {
2142 if(ncRingType(currRing) == nc_lie)
2143 {
2144 // generalized prod-crit for lie-type
2145 strat->cp++;
2146 Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i], currRing);
2147 }
2148 else
2149 if( ALLOW_PROD_CRIT(strat) )
2150 {
2151 // product criterion for homogeneous case in SCA
2152 strat->cp++;
2153 Lp.p = NULL;
2154 }
2155 else
2156 {
2157 Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
2158 nc_CreateShortSpoly(strat->S[i], p, currRing);
2159 assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
2160 pNext(Lp.p) = strat->tail; // !!!
2161 }
2162 }
2163 else
2164 {
2165 Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
2166 nc_CreateShortSpoly(strat->S[i], p, currRing);
2167
2168 assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
2169 pNext(Lp.p) = strat->tail; // !!!
2170 }
2171 }
2172 else
2173 #endif
2174 {
2175 assume(!rIsPluralRing(currRing));
2176 Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
2177 }
2178 }
2179 if (Lp.p == NULL)
2180 {
2181 /*- the case that the s-poly is 0 -*/
2182 if (strat->pairtest==NULL) initPairtest(strat);
2183 strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
2184 strat->pairtest[strat->sl+1] = TRUE;
2185 /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
2186 /*
2187 *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
2188 *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
2189 *divide lcm(r,p)). In the last case (s,r) can be canceled if the leading
2190 *term of p divides the lcm(s,r)
2191 *(this canceling should be done here because
2192 *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
2193 *the first case is handeled in chainCrit
2194 */
2195 if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
2196 }
2197 else
2198 {
2199 /*- the pair (S[i],p) enters B -*/
2200 Lp.p1 = strat->S[i];
2201 Lp.p2 = p;
2202
2203 if (
2204 (!rIsPluralRing(currRing))
2205 // || (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
2206 )
2207 {
2208 assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
2209 pNext(Lp.p) = strat->tail; // !!!
2210 }
2211
2212 if (atR >= 0)
2213 {
2214 Lp.i_r1 = strat->S_2_R[i];
2215 Lp.i_r2 = atR;
2216 }
2217 else
2218 {
2219 Lp.i_r1 = -1;
2220 Lp.i_r2 = -1;
2221 }
2222 strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
2223
2224 if (TEST_OPT_INTSTRATEGY)
2225 {
2226 if (!rIsPluralRing(currRing)
2227 && !rField_is_Ring(currRing)
2228 && (Lp.p->coef!=NULL))
2229 nDelete(&(Lp.p->coef));
2230 }
2231
2232 l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
2233 enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
2234 }
2235 }
2236
2237 /// p_HasNotCF for the IDLIFT case and syzComp==1: ignore component
p_HasNotCF_Lift(poly p1,poly p2,const ring r)2238 static inline BOOLEAN p_HasNotCF_Lift(poly p1, poly p2, const ring r)
2239 {
2240 int i = rVar(r);
2241 loop
2242 {
2243 if ((p_GetExp(p1, i, r) > 0) && (p_GetExp(p2, i, r) > 0))
2244 return FALSE;
2245 i--;
2246 if (i == 0)
2247 return TRUE;
2248 }
2249 }
2250
2251 /*2
2252 * put the pair (s[i],p) into the set B, ecart=ecart(p) for idLift(I,T)
2253 * (in the special case: idLift for ideals, i.e. strat->syzComp==1)
2254 * (prod.crit applies)
2255 */
2256
enterOnePairLift(int i,poly p,int ecart,int isFromQ,kStrategy strat,int atR=-1)2257 static void enterOnePairLift (int i,poly p,int ecart, int isFromQ,kStrategy strat, int atR = -1)
2258 {
2259 assume(ALLOW_PROD_CRIT(strat));
2260 assume(!rIsPluralRing(currRing));
2261 assume(i<=strat->sl);
2262 assume(strat->syzComp==1);
2263
2264 if ((strat->S[i]==NULL) || (p==NULL))
2265 return;
2266
2267 int l,j,compare;
2268 LObject Lp;
2269 Lp.i_r = -1;
2270
2271 #ifdef KDEBUG
2272 Lp.ecart=0; Lp.length=0;
2273 #endif
2274 /*- computes the lcm(s[i],p) -*/
2275 Lp.lcm = p_Lcm(p,strat->S[i],currRing);
2276
2277 if (strat->sugarCrit)
2278 {
2279 if((!((strat->ecartS[i]>0)&&(ecart>0)))
2280 && p_HasNotCF_Lift(p,strat->S[i],currRing))
2281 {
2282 /*
2283 *the product criterion has applied for (s,p),
2284 *i.e. lcm(s,p)=product of the leading terms of s and p.
2285 *Suppose (s,r) is in L and the leading term
2286 *of p divides lcm(s,r)
2287 *(==> the leading term of p divides the leading term of r)
2288 *but the leading term of s does not divide the leading term of r
2289 *(notice that tis condition is automatically satisfied if r is still
2290 *in S), then (s,r) can be cancelled.
2291 *This should be done here because the
2292 *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
2293 *
2294 *Moreover, skipping (s,r) holds also for the noncommutative case.
2295 */
2296 strat->cp++;
2297 pLmFree(Lp.lcm);
2298 return;
2299 }
2300 else
2301 Lp.ecart = si_max(ecart,strat->ecartS[i]);
2302 if (strat->fromT && (strat->ecartS[i]>ecart))
2303 {
2304 pLmFree(Lp.lcm);
2305 return;
2306 /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
2307 }
2308 /*
2309 *the set B collects the pairs of type (S[j],p)
2310 *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
2311 *if the leading term of s divides lcm(r,p) then (r,p) will be canceled
2312 *if the leading term of r divides lcm(s,p) then (s,p) will not enter B
2313 */
2314 {
2315 j = strat->Bl;
2316 loop
2317 {
2318 if (j < 0) break;
2319 compare=pDivComp(strat->B[j].lcm,Lp.lcm);
2320 if ((compare==1)
2321 &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
2322 {
2323 strat->c3++;
2324 if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
2325 {
2326 pLmFree(Lp.lcm);
2327 return;
2328 }
2329 break;
2330 }
2331 else
2332 if ((compare ==-1)
2333 && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
2334 {
2335 deleteInL(strat->B,&strat->Bl,j,strat);
2336 strat->c3++;
2337 }
2338 j--;
2339 }
2340 }
2341 }
2342 else /*sugarcrit*/
2343 {
2344 if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
2345 p_HasNotCF_Lift(p,strat->S[i],currRing))
2346 {
2347 /*
2348 *the product criterion has applied for (s,p),
2349 *i.e. lcm(s,p)=product of the leading terms of s and p.
2350 *Suppose (s,r) is in L and the leading term
2351 *of p divides lcm(s,r)
2352 *(==> the leading term of p divides the leading term of r)
2353 *but the leading term of s does not divide the leading term of r
2354 *(notice that tis condition is automatically satisfied if r is still
2355 *in S), then (s,r) can be canceled.
2356 *This should be done here because the
2357 *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
2358 */
2359 strat->cp++;
2360 pLmFree(Lp.lcm);
2361 return;
2362 }
2363 if (strat->fromT && (strat->ecartS[i]>ecart))
2364 {
2365 pLmFree(Lp.lcm);
2366 return;
2367 /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
2368 }
2369 /*
2370 *the set B collects the pairs of type (S[j],p)
2371 *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
2372 *if the leading term of s divides lcm(r,p) then (r,p) will be canceled
2373 *if the leading term of r divides lcm(s,p) then (s,p) will not enter B
2374 */
2375 for(j = strat->Bl;j>=0;j--)
2376 {
2377 compare=pDivComp(strat->B[j].lcm,Lp.lcm);
2378 if (compare==1)
2379 {
2380 strat->c3++;
2381 if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
2382 {
2383 pLmFree(Lp.lcm);
2384 return;
2385 }
2386 break;
2387 }
2388 else
2389 if (compare ==-1)
2390 {
2391 deleteInL(strat->B,&strat->Bl,j,strat);
2392 strat->c3++;
2393 }
2394 }
2395 }
2396 /*
2397 *the pair (S[i],p) enters B if the spoly != 0
2398 */
2399 /*- compute the short s-polynomial -*/
2400 if (strat->fromT && !TEST_OPT_INTSTRATEGY)
2401 pNorm(p);
2402
2403 if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
2404 Lp.p=NULL;
2405 else
2406 {
2407 assume(!rIsPluralRing(currRing));
2408 Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
2409 }
2410 if (Lp.p == NULL)
2411 {
2412 /*- the case that the s-poly is 0 -*/
2413 if (strat->pairtest==NULL) initPairtest(strat);
2414 strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
2415 strat->pairtest[strat->sl+1] = TRUE;
2416 /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
2417 /*
2418 *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
2419 *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
2420 *divide lcm(r,p)). In the last case (s,r) can be canceled if the leading
2421 *term of p divides the lcm(s,r)
2422 *(this canceling should be done here because
2423 *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
2424 *the first case is handeled in chainCrit
2425 */
2426 if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
2427 }
2428 else
2429 {
2430 /*- the pair (S[i],p) enters B -*/
2431 Lp.p1 = strat->S[i];
2432 Lp.p2 = p;
2433
2434 pNext(Lp.p) = strat->tail; // !!!
2435
2436 if (atR >= 0)
2437 {
2438 Lp.i_r1 = strat->S_2_R[i];
2439 Lp.i_r2 = atR;
2440 }
2441 else
2442 {
2443 Lp.i_r1 = -1;
2444 Lp.i_r2 = -1;
2445 }
2446 strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
2447
2448 if (TEST_OPT_INTSTRATEGY)
2449 {
2450 if (!rIsPluralRing(currRing)
2451 && !rField_is_Ring(currRing)
2452 && (Lp.p->coef!=NULL))
2453 nDelete(&(Lp.p->coef));
2454 }
2455
2456 l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
2457 enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
2458 }
2459 }
2460
2461 /*2
2462 * put the pair (s[i],p) into the set B, ecart=ecart(p)
2463 * NOTE: here we need to add the signature-based criteria
2464 */
2465
2466 #ifdef DEBUGF5
enterOnePairSig(int i,poly p,poly pSig,int from,int ecart,int isFromQ,kStrategy strat,int atR=-1)2467 static void enterOnePairSig (int i, poly p, poly pSig, int from, int ecart, int isFromQ, kStrategy strat, int atR = -1)
2468 #else
2469 static void enterOnePairSig (int i, poly p, poly pSig, int, int ecart, int isFromQ, kStrategy strat, int atR = -1)
2470 #endif
2471 {
2472 assume(i<=strat->sl);
2473
2474 int l;
2475 poly m1 = NULL,m2 = NULL; // we need the multipliers for the s-polynomial to compute
2476 // the corresponding signatures for criteria checks
2477 LObject Lp;
2478 poly pSigMult = p_Copy(pSig,currRing);
2479 poly sSigMult = p_Copy(strat->sig[i],currRing);
2480 unsigned long pSigMultNegSev,sSigMultNegSev;
2481 Lp.i_r = -1;
2482
2483 #ifdef KDEBUG
2484 Lp.ecart=0; Lp.length=0;
2485 #endif
2486 /*- computes the lcm(s[i],p) -*/
2487 Lp.lcm = pInit();
2488 k_GetLeadTerms(p,strat->S[i],currRing,m1,m2,currRing);
2489 #ifndef HAVE_RATGRING
2490 pLcm(p,strat->S[i],Lp.lcm);
2491 #elif defined(HAVE_RATGRING)
2492 if (rIsRatGRing(currRing))
2493 pLcmRat(p,strat->S[i],Lp.lcm, currRing->real_var_start); // int rat_shift
2494 else
2495 pLcm(p,strat->S[i],Lp.lcm);
2496 #endif
2497 pSetm(Lp.lcm);
2498
2499 // set coeffs of multipliers m1 and m2
2500 pSetCoeff0(m1, nInit(1));
2501 pSetCoeff0(m2, nInit(1));
2502 //#if 1
2503 #ifdef DEBUGF5
2504 PrintS("P1 ");
2505 pWrite(pHead(p));
2506 PrintS("P2 ");
2507 pWrite(pHead(strat->S[i]));
2508 PrintS("M1 ");
2509 pWrite(m1);
2510 PrintS("M2 ");
2511 pWrite(m2);
2512 #endif
2513 // get multiplied signatures for testing
2514 pSigMult = currRing->p_Procs->pp_Mult_mm(pSigMult,m1,currRing);
2515 pSigMultNegSev = ~p_GetShortExpVector(pSigMult,currRing);
2516 sSigMult = currRing->p_Procs->pp_Mult_mm(sSigMult,m2,currRing);
2517 sSigMultNegSev = ~p_GetShortExpVector(sSigMult,currRing);
2518
2519 //#if 1
2520 #ifdef DEBUGF5
2521 PrintS("----------------\n");
2522 pWrite(pSigMult);
2523 pWrite(sSigMult);
2524 PrintS("----------------\n");
2525 Lp.checked = 0;
2526 #endif
2527 int sigCmp = p_LmCmp(pSigMult,sSigMult,currRing);
2528 //#if 1
2529 #if DEBUGF5
2530 Print("IN PAIR GENERATION - COMPARING SIGS: %d\n",sigCmp);
2531 pWrite(pSigMult);
2532 pWrite(sSigMult);
2533 #endif
2534 if(sigCmp==0)
2535 {
2536 // printf("!!!! EQUAL SIGS !!!!\n");
2537 // pSig = sSig, delete element due to Rewritten Criterion
2538 pDelete(&pSigMult);
2539 pDelete(&sSigMult);
2540 if (rField_is_Ring(currRing))
2541 pLmDelete(Lp.lcm);
2542 else
2543 pLmFree(Lp.lcm);
2544 pDelete (&m1);
2545 pDelete (&m2);
2546 return;
2547 }
2548 // testing by syzCrit = F5 Criterion
2549 // testing by rewCrit1 = Rewritten Criterion
2550 // NOTE: Arri's Rewritten Criterion is tested below, we need Lp.p for it!
2551 if ( strat->syzCrit(pSigMult,pSigMultNegSev,strat) ||
2552 strat->syzCrit(sSigMult,sSigMultNegSev,strat)
2553 || strat->rewCrit1(sSigMult,sSigMultNegSev,Lp.lcm,strat,i+1)
2554 )
2555 {
2556 pDelete(&pSigMult);
2557 pDelete(&sSigMult);
2558 if (rField_is_Ring(currRing))
2559 pLmDelete(Lp.lcm);
2560 else
2561 pLmFree(Lp.lcm);
2562 pDelete (&m1);
2563 pDelete (&m2);
2564 return;
2565 }
2566 /*
2567 *the pair (S[i],p) enters B if the spoly != 0
2568 */
2569 /*- compute the short s-polynomial -*/
2570 if (strat->fromT && !TEST_OPT_INTSTRATEGY)
2571 pNorm(p);
2572
2573 if ((strat->S[i]==NULL) || (p==NULL))
2574 return;
2575
2576 if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
2577 Lp.p=NULL;
2578 else
2579 {
2580 #ifdef HAVE_PLURAL
2581 if ( rIsPluralRing(currRing) )
2582 {
2583 if(pHasNotCF(p, strat->S[i]))
2584 {
2585 if(ncRingType(currRing) == nc_lie)
2586 {
2587 // generalized prod-crit for lie-type
2588 strat->cp++;
2589 Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i], currRing);
2590 }
2591 else
2592 if( ALLOW_PROD_CRIT(strat) )
2593 {
2594 // product criterion for homogeneous case in SCA
2595 strat->cp++;
2596 Lp.p = NULL;
2597 }
2598 else
2599 {
2600 Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
2601 nc_CreateShortSpoly(strat->S[i], p, currRing);
2602
2603 assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
2604 pNext(Lp.p) = strat->tail; // !!!
2605 }
2606 }
2607 else
2608 {
2609 Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
2610 nc_CreateShortSpoly(strat->S[i], p, currRing);
2611
2612 assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
2613 pNext(Lp.p) = strat->tail; // !!!
2614 }
2615 }
2616 else
2617 #endif
2618 {
2619 assume(!rIsPluralRing(currRing));
2620 Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
2621 }
2622 }
2623 // store from which element this pair comes from for further tests
2624 //Lp.from = strat->sl+1;
2625 if(sigCmp==currRing->OrdSgn)
2626 {
2627 // pSig > sSig
2628 pDelete (&sSigMult);
2629 Lp.sig = pSigMult;
2630 Lp.sevSig = ~pSigMultNegSev;
2631 }
2632 else
2633 {
2634 // pSig < sSig
2635 pDelete (&pSigMult);
2636 Lp.sig = sSigMult;
2637 Lp.sevSig = ~sSigMultNegSev;
2638 }
2639 if (Lp.p == NULL)
2640 {
2641 if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
2642 int pos = posInSyz(strat, Lp.sig);
2643 enterSyz(Lp, strat, pos);
2644 }
2645 else
2646 {
2647 // testing by rewCrit3 = Arris Rewritten Criterion (for F5 nothing happens!)
2648 if (strat->rewCrit3(Lp.sig,~Lp.sevSig,Lp.p,strat,strat->sl+1))
2649 {
2650 pLmFree(Lp.lcm);
2651 pDelete(&Lp.sig);
2652 pDelete (&m1);
2653 pDelete (&m2);
2654 return;
2655 }
2656 // in any case Lp is checked up to the next strat->P which is added
2657 // to S right after this critical pair creation.
2658 // NOTE: this even holds if the 2nd generator gives the bigger signature
2659 // moreover, this improves rewCriterion,
2660 // i.e. strat->checked > strat->from if and only if the 2nd generator
2661 // gives the bigger signature.
2662 Lp.checked = strat->sl+1;
2663 // at this point it is clear that the pair will be added to L, since it has
2664 // passed all tests up to now
2665
2666 // adds buchberger's first criterion
2667 if (pLmCmp(m2,pHead(p)) == 0)
2668 {
2669 Lp.prod_crit = TRUE; // Product Criterion
2670 #if 0
2671 int pos = posInSyz(strat, Lp.sig);
2672 enterSyz(Lp, strat, pos);
2673 pDelete (&m1);
2674 pDelete (&m2);
2675 return;
2676 #endif
2677 }
2678 pDelete (&m1);
2679 pDelete (&m2);
2680 #if DEBUGF5
2681 PrintS("SIGNATURE OF PAIR: ");
2682 pWrite(Lp.sig);
2683 #endif
2684 /*- the pair (S[i],p) enters B -*/
2685 Lp.p1 = strat->S[i];
2686 Lp.p2 = p;
2687
2688 if (
2689 (!rIsPluralRing(currRing))
2690 // || (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
2691 )
2692 {
2693 assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
2694 pNext(Lp.p) = strat->tail; // !!!
2695 }
2696
2697 if (atR >= 0)
2698 {
2699 Lp.i_r1 = strat->S_2_R[i];
2700 Lp.i_r2 = atR;
2701 }
2702 else
2703 {
2704 Lp.i_r1 = -1;
2705 Lp.i_r2 = -1;
2706 }
2707 strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
2708
2709 if (TEST_OPT_INTSTRATEGY)
2710 {
2711 if (!rIsPluralRing(currRing)
2712 && !rField_is_Ring(currRing)
2713 && (Lp.p->coef!=NULL))
2714 nDelete(&(Lp.p->coef));
2715 }
2716
2717 l = strat->posInLSba(strat->B,strat->Bl,&Lp,strat);
2718 enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
2719 }
2720 }
2721
2722
2723 #ifdef DEBUGF5
enterOnePairSigRing(int i,poly p,poly pSig,int from,int ecart,int isFromQ,kStrategy strat,int atR=-1)2724 static void enterOnePairSigRing (int i, poly p, poly pSig, int from, int ecart, int isFromQ, kStrategy strat, int atR = -1)
2725 #else
2726 static void enterOnePairSigRing (int i, poly p, poly pSig, int, int ecart, int isFromQ, kStrategy strat, int atR = -1)
2727 #endif
2728 {
2729 #if ALL_VS_JUST
2730 //Over rings, if we construct the strong pair, do not add the spair
2731 if(rField_is_Ring(currRing))
2732 {
2733 number s,t,d;
2734 d = n_ExtGcd(pGetCoeff(p), pGetCoeff(strat->S[i]), &s, &t, currRing->cf);
2735
2736 if (!nIsZero(s) && !nIsZero(t)) // evtl. durch divBy tests ersetzen
2737 {
2738 nDelete(&d);
2739 nDelete(&s);
2740 nDelete(&t);
2741 return;
2742 }
2743 nDelete(&d);
2744 nDelete(&s);
2745 nDelete(&t);
2746 }
2747 #endif
2748 assume(i<=strat->sl);
2749 int l;
2750 poly m1 = NULL,m2 = NULL; // we need the multipliers for the s-polynomial to compute
2751 // the corresponding signatures for criteria checks
2752 LObject Lp;
2753 poly pSigMult = p_Copy(pSig,currRing);
2754 poly sSigMult = p_Copy(strat->sig[i],currRing);
2755 unsigned long pSigMultNegSev,sSigMultNegSev;
2756 Lp.i_r = -1;
2757
2758 #ifdef KDEBUG
2759 Lp.ecart=0; Lp.length=0;
2760 #endif
2761 /*- computes the lcm(s[i],p) -*/
2762 Lp.lcm = pInit();
2763 k_GetLeadTerms(p,strat->S[i],currRing,m1,m2,currRing);
2764 #ifndef HAVE_RATGRING
2765 pLcm(p,strat->S[i],Lp.lcm);
2766 #elif defined(HAVE_RATGRING)
2767 if (rIsRatGRing(currRing))
2768 pLcmRat(p,strat->S[i],Lp.lcm, currRing->real_var_start); // int rat_shift
2769 else
2770 pLcm(p,strat->S[i],Lp.lcm);
2771 #endif
2772 pSetm(Lp.lcm);
2773
2774 // set coeffs of multipliers m1 and m2
2775 if(rField_is_Ring(currRing))
2776 {
2777 number s = nCopy(pGetCoeff(strat->S[i]));
2778 number t = nCopy(pGetCoeff(p));
2779 pSetCoeff0(Lp.lcm, n_Lcm(s, t, currRing->cf));
2780 ksCheckCoeff(&s, &t, currRing->cf);
2781 pSetCoeff0(m1,s);
2782 pSetCoeff0(m2,t);
2783 }
2784 else
2785 {
2786 pSetCoeff0(m1, nInit(1));
2787 pSetCoeff0(m2, nInit(1));
2788 }
2789 #ifdef DEBUGF5
2790 Print("P1 ");
2791 pWrite(pHead(p));
2792 Print("P2 ");
2793 pWrite(pHead(strat->S[i]));
2794 Print("M1 ");
2795 pWrite(m1);
2796 Print("M2 ");
2797 pWrite(m2);
2798 #endif
2799
2800 // get multiplied signatures for testing
2801 pSigMult = pp_Mult_mm(pSigMult,m1,currRing);
2802 if(pSigMult != NULL)
2803 pSigMultNegSev = ~p_GetShortExpVector(pSigMult,currRing);
2804 sSigMult = pp_Mult_mm(sSigMult,m2,currRing);
2805 if(sSigMult != NULL)
2806 sSigMultNegSev = ~p_GetShortExpVector(sSigMult,currRing);
2807 //#if 1
2808 #ifdef DEBUGF5
2809 Print("----------------\n");
2810 pWrite(pSigMult);
2811 pWrite(sSigMult);
2812 Print("----------------\n");
2813 Lp.checked = 0;
2814 #endif
2815 int sigCmp;
2816 if(pSigMult != NULL && sSigMult != NULL)
2817 {
2818 if(rField_is_Ring(currRing))
2819 sigCmp = p_LtCmpNoAbs(pSigMult,sSigMult,currRing);
2820 else
2821 sigCmp = p_LmCmp(pSigMult,sSigMult,currRing);
2822 }
2823 else
2824 {
2825 if(pSigMult == NULL)
2826 {
2827 if(sSigMult == NULL)
2828 sigCmp = 0;
2829 else
2830 sigCmp = -1;
2831 }
2832 else
2833 sigCmp = 1;
2834 }
2835 //#if 1
2836 #if DEBUGF5
2837 Print("IN PAIR GENERATION - COMPARING SIGS: %d\n",sigCmp);
2838 pWrite(pSigMult);
2839 pWrite(sSigMult);
2840 #endif
2841 //In the ring case we already build the sig
2842 if(rField_is_Ring(currRing))
2843 {
2844 if(sigCmp == 0)
2845 {
2846 //sigdrop since we loose the signature
2847 strat->sigdrop = TRUE;
2848 //Try to reduce it as far as we can via redRing
2849 if(rField_is_Ring(currRing))
2850 {
2851 poly p1 = p_Copy(p,currRing);
2852 poly p2 = p_Copy(strat->S[i],currRing);
2853 p1 = p_Mult_mm(p1,m1,currRing);
2854 p2 = p_Mult_mm(p2,m2,currRing);
2855 Lp.p = p_Sub(p1,p2,currRing);
2856 if(Lp.p != NULL)
2857 Lp.sev = p_GetShortExpVector(Lp.p,currRing);
2858 }
2859 int red_result = redRing(&Lp,strat);
2860 if(red_result == 0)
2861 {
2862 // Cancel the sigdrop
2863 p_Delete(&Lp.sig,currRing);Lp.sig = NULL;
2864 strat->sigdrop = FALSE;
2865 return;
2866 }
2867 else
2868 {
2869 strat->enterS(strat->P,strat->sl+1,strat, strat->tl+1);
2870 #if 1
2871 strat->enterS(Lp,0,strat,strat->tl);
2872 #endif
2873 return;
2874 }
2875 }
2876 if(pSigMult != NULL && sSigMult != NULL && p_LmCmp(pSigMult,sSigMult,currRing) == 0)
2877 {
2878 //Same lm, have to substract
2879 Lp.sig = p_Sub(pCopy(pSigMult),pCopy(sSigMult),currRing);
2880 }
2881 else
2882 {
2883 if(sigCmp == 1)
2884 {
2885 Lp.sig = pCopy(pSigMult);
2886 }
2887 if(sigCmp == -1)
2888 {
2889 Lp.sig = pNeg(pCopy(sSigMult));
2890 }
2891 }
2892 Lp.sevSig = p_GetShortExpVector(Lp.sig,currRing);
2893 }
2894
2895 #if 0
2896 if(sigCmp==0)
2897 {
2898 // printf("!!!! EQUAL SIGS !!!!\n");
2899 // pSig = sSig, delete element due to Rewritten Criterion
2900 pDelete(&pSigMult);
2901 pDelete(&sSigMult);
2902 if (rField_is_Ring(currRing))
2903 pLmDelete(Lp.lcm);
2904 else
2905 pLmFree(Lp.lcm);
2906 pDelete (&m1);
2907 pDelete (&m2);
2908 return;
2909 }
2910 #endif
2911 // testing by syzCrit = F5 Criterion
2912 // testing by rewCrit1 = Rewritten Criterion
2913 // NOTE: Arri's Rewritten Criterion is tested below, we need Lp.p for it!
2914 if ( strat->syzCrit(pSigMult,pSigMultNegSev,strat) ||
2915 strat->syzCrit(sSigMult,sSigMultNegSev,strat)
2916 // With this rewCrit activated i get a wrong deletion in sba_int_56.tst
2917 //|| strat->rewCrit1(sSigMult,sSigMultNegSev,Lp.lcm,strat,i+1)
2918 )
2919 {
2920 pDelete(&pSigMult);
2921 pDelete(&sSigMult);
2922 if (rField_is_Ring(currRing))
2923 pLmDelete(Lp.lcm);
2924 else
2925 pLmFree(Lp.lcm);
2926 pDelete (&m1);
2927 pDelete (&m2);
2928 return;
2929 }
2930 /*
2931 *the pair (S[i],p) enters B if the spoly != 0
2932 */
2933 /*- compute the short s-polynomial -*/
2934 if (strat->fromT && !TEST_OPT_INTSTRATEGY)
2935 pNorm(p);
2936
2937 if ((strat->S[i]==NULL) || (p==NULL))
2938 return;
2939
2940 if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
2941 Lp.p=NULL;
2942 else
2943 {
2944 //Build p
2945 if(rField_is_Ring(currRing))
2946 {
2947 poly p1 = p_Copy(p,currRing);
2948 poly p2 = p_Copy(strat->S[i],currRing);
2949 p1 = p_Mult_mm(p1,m1,currRing);
2950 p2 = p_Mult_mm(p2,m2,currRing);
2951 Lp.p = p_Sub(p1,p2,currRing);
2952 if(Lp.p != NULL)
2953 Lp.sev = p_GetShortExpVector(Lp.p,currRing);
2954 }
2955 else
2956 {
2957 #ifdef HAVE_PLURAL
2958 if ( rIsPluralRing(currRing) )
2959 {
2960 if(ncRingType(currRing) == nc_lie)
2961 {
2962 // generalized prod-crit for lie-type
2963 strat->cp++;
2964 Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i], currRing);
2965 }
2966 else
2967 if( ALLOW_PROD_CRIT(strat) )
2968 {
2969 // product criterion for homogeneous case in SCA
2970 strat->cp++;
2971 Lp.p = NULL;
2972 }
2973 else
2974 {
2975 Lp.p = // nc_CreateSpoly(strat->S[i],p,currRing);
2976 nc_CreateShortSpoly(strat->S[i], p, currRing);
2977
2978 assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
2979 pNext(Lp.p) = strat->tail; // !!!
2980 }
2981 }
2982 else
2983 #endif
2984 {
2985 assume(!rIsPluralRing(currRing));
2986 Lp.p = ksCreateShortSpoly(strat->S[i], p, strat->tailRing);
2987 }
2988 }
2989 }
2990 // store from which element this pair comes from for further tests
2991 //Lp.from = strat->sl+1;
2992 if(rField_is_Ring(currRing))
2993 {
2994 //Put the sig to be > 0
2995 if(!nGreaterZero(pGetCoeff(Lp.sig)))
2996 {
2997 Lp.sig = pNeg(Lp.sig);
2998 Lp.p = pNeg(Lp.p);
2999 }
3000 }
3001 else
3002 {
3003 if(sigCmp==currRing->OrdSgn)
3004 {
3005 // pSig > sSig
3006 pDelete (&sSigMult);
3007 Lp.sig = pSigMult;
3008 Lp.sevSig = ~pSigMultNegSev;
3009 }
3010 else
3011 {
3012 // pSig < sSig
3013 pDelete (&pSigMult);
3014 Lp.sig = sSigMult;
3015 Lp.sevSig = ~sSigMultNegSev;
3016 }
3017 }
3018 if (Lp.p == NULL)
3019 {
3020 if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
3021 int pos = posInSyz(strat, Lp.sig);
3022 enterSyz(Lp, strat, pos);
3023 }
3024 else
3025 {
3026 // testing by rewCrit3 = Arris Rewritten Criterion (for F5 nothing happens!)
3027 if (strat->rewCrit3(Lp.sig,~Lp.sevSig,Lp.p,strat,strat->sl+1))
3028 {
3029 pLmFree(Lp.lcm);
3030 pDelete(&Lp.sig);
3031 pDelete (&m1);
3032 pDelete (&m2);
3033 return;
3034 }
3035 // in any case Lp is checked up to the next strat->P which is added
3036 // to S right after this critical pair creation.
3037 // NOTE: this even holds if the 2nd generator gives the bigger signature
3038 // moreover, this improves rewCriterion,
3039 // i.e. strat->checked > strat->from if and only if the 2nd generator
3040 // gives the bigger signature.
3041 Lp.checked = strat->sl+1;
3042 // at this point it is clear that the pair will be added to L, since it has
3043 // passed all tests up to now
3044
3045 // adds buchberger's first criterion
3046 if (pLmCmp(m2,pHead(p)) == 0)
3047 {
3048 Lp.prod_crit = TRUE; // Product Criterion
3049 #if 0
3050 int pos = posInSyz(strat, Lp.sig);
3051 enterSyz(Lp, strat, pos);
3052 pDelete (&m1);
3053 pDelete (&m2);
3054 return;
3055 #endif
3056 }
3057 pDelete (&m1);
3058 pDelete (&m2);
3059 #if DEBUGF5
3060 PrintS("SIGNATURE OF PAIR: ");
3061 pWrite(Lp.sig);
3062 #endif
3063 /*- the pair (S[i],p) enters B -*/
3064 Lp.p1 = strat->S[i];
3065 Lp.p2 = p;
3066
3067 if (
3068 (!rIsPluralRing(currRing))
3069 // || (rIsPluralRing(currRing) && (ncRingType(currRing) != nc_lie))
3070 && !rField_is_Ring(currRing)
3071 )
3072 {
3073 assume(pNext(Lp.p)==NULL); // TODO: this may be violated whenever ext.prod.crit. for Lie alg. is used
3074 pNext(Lp.p) = strat->tail; // !!!
3075 }
3076
3077 if (atR >= 0)
3078 {
3079 Lp.i_r1 = strat->S_2_R[i];
3080 Lp.i_r2 = atR;
3081 }
3082 else
3083 {
3084 Lp.i_r1 = -1;
3085 Lp.i_r2 = -1;
3086 }
3087 strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
3088
3089 if (TEST_OPT_INTSTRATEGY)
3090 {
3091 if (!rIsPluralRing(currRing)
3092 && !rField_is_Ring(currRing)
3093 && (Lp.p->coef!=NULL))
3094 nDelete(&(Lp.p->coef));
3095 }
3096 // Check for sigdrop
3097 if(rField_is_Ring(currRing) && pLtCmp(Lp.sig,pSig) == -1)
3098 {
3099 strat->sigdrop = TRUE;
3100 // Completely reduce it
3101 int red_result = redRing(&Lp,strat);
3102 if(red_result == 0)
3103 {
3104 // Reduced to 0
3105 strat->sigdrop = FALSE;
3106 p_Delete(&Lp.sig,currRing);Lp.sig = NULL;
3107 return;
3108 }
3109 else
3110 {
3111 strat->enterS(strat->P,strat->sl+1,strat, strat->tl+1);
3112 // 0 - add just the original poly causing the sigdrop, 1 - add also this
3113 #if 1
3114 strat->enterS(Lp,0,strat, strat->tl+1);
3115 #endif
3116 return;
3117 }
3118 }
3119 l = strat->posInLSba(strat->L,strat->Ll,&Lp,strat);
3120 enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
3121 }
3122 }
3123
3124 /*2
3125 * put the pair (s[i],p) into the set L, ecart=ecart(p)
3126 * in the case that s forms a SB of (s)
3127 */
enterOnePairSpecial(int i,poly p,int ecart,kStrategy strat,int atR=-1)3128 void enterOnePairSpecial (int i,poly p,int ecart,kStrategy strat, int atR = -1)
3129 {
3130 //PrintS("try ");wrp(strat->S[i]);PrintS(" and ");wrp(p);PrintLn();
3131 if(pHasNotCF(p,strat->S[i]))
3132 {
3133 //PrintS("prod-crit\n");
3134 if(ALLOW_PROD_CRIT(strat))
3135 {
3136 //PrintS("prod-crit\n");
3137 strat->cp++;
3138 return;
3139 }
3140 }
3141
3142 int l;
3143 LObject Lp;
3144 Lp.i_r = -1;
3145
3146 Lp.lcm = p_Lcm(p,strat->S[i],currRing);
3147 /*- compute the short s-polynomial -*/
3148
3149 #ifdef HAVE_PLURAL
3150 if (rIsPluralRing(currRing))
3151 {
3152 Lp.p = nc_CreateShortSpoly(strat->S[i],p, currRing); // ??? strat->tailRing?
3153 }
3154 else
3155 #endif
3156 Lp.p = ksCreateShortSpoly(strat->S[i],p,strat->tailRing);
3157
3158 if (Lp.p == NULL)
3159 {
3160 //PrintS("short spoly==NULL\n");
3161 pLmFree(Lp.lcm);
3162 }
3163 else
3164 {
3165 /*- the pair (S[i],p) enters L -*/
3166 Lp.p1 = strat->S[i];
3167 Lp.p2 = p;
3168 if (atR >= 0)
3169 {
3170 Lp.i_r1 = strat->S_2_R[i];
3171 Lp.i_r2 = atR;
3172 }
3173 else
3174 {
3175 Lp.i_r1 = -1;
3176 Lp.i_r2 = -1;
3177 }
3178 assume(pNext(Lp.p) == NULL);
3179 pNext(Lp.p) = strat->tail;
3180 strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
3181 if (TEST_OPT_INTSTRATEGY)
3182 {
3183 if (!rIsPluralRing(currRing)
3184 && !rField_is_Ring(currRing)
3185 && (Lp.p->coef!=NULL))
3186 nDelete(&(Lp.p->coef));
3187 }
3188 l = strat->posInL(strat->L,strat->Ll,&Lp,strat);
3189 //Print("-> L[%d]\n",l);
3190 enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,l);
3191 }
3192 }
3193
3194 /*2
3195 * merge set B into L
3196 */
kMergeBintoL(kStrategy strat)3197 void kMergeBintoL(kStrategy strat)
3198 {
3199 int j=strat->Ll+strat->Bl+1;
3200 if (j>strat->Lmax)
3201 {
3202 j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc-strat->Lmax;
3203 enlargeL(&(strat->L),&(strat->Lmax),j);
3204 }
3205 j = strat->Ll;
3206 int i;
3207 for (i=strat->Bl; i>=0; i--)
3208 {
3209 j = strat->posInL(strat->L,j,&(strat->B[i]),strat);
3210 enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
3211 }
3212 strat->Bl = -1;
3213 }
3214
3215 /*2
3216 * merge set B into L
3217 */
kMergeBintoLSba(kStrategy strat)3218 void kMergeBintoLSba(kStrategy strat)
3219 {
3220 int j=strat->Ll+strat->Bl+1;
3221 if (j>strat->Lmax)
3222 {
3223 j=((j+setmaxLinc-1)/setmaxLinc)*setmaxLinc-strat->Lmax;
3224 enlargeL(&(strat->L),&(strat->Lmax),j);
3225 }
3226 j = strat->Ll;
3227 int i;
3228 for (i=strat->Bl; i>=0; i--)
3229 {
3230 j = strat->posInLSba(strat->L,j,&(strat->B[i]),strat);
3231 enterL(&strat->L,&strat->Ll,&strat->Lmax,strat->B[i],j);
3232 }
3233 strat->Bl = -1;
3234 }
3235
3236 /*2
3237 *the pairset B of pairs of type (s[i],p) is complete now. It will be updated
3238 *using the chain-criterion in B and L and enters B to L
3239 */
chainCritNormal(poly p,int ecart,kStrategy strat)3240 void chainCritNormal (poly p,int ecart,kStrategy strat)
3241 {
3242 int i,j,l;
3243
3244 /*
3245 *pairtest[i] is TRUE if spoly(S[i],p) == 0.
3246 *In this case all elements in B such
3247 *that their lcm is divisible by the leading term of S[i] can be canceled
3248 */
3249 if (strat->pairtest!=NULL)
3250 {
3251 #ifdef HAVE_SHIFTBBA
3252 // only difference is pLPDivisibleBy instead of pDivisibleBy
3253 if (rIsLPRing(currRing))
3254 {
3255 for (j=0; j<=strat->sl; j++)
3256 {
3257 if (strat->pairtest[j])
3258 {
3259 for (i=strat->Bl; i>=0; i--)
3260 {
3261 if (pLPDivisibleBy(strat->S[j],strat->B[i].lcm))
3262 {
3263 deleteInL(strat->B,&strat->Bl,i,strat);
3264 strat->c3++;
3265 }
3266 }
3267 }
3268 }
3269 }
3270 else
3271 #endif
3272 {
3273 /*- i.e. there is an i with pairtest[i]==TRUE -*/
3274 for (j=0; j<=strat->sl; j++)
3275 {
3276 if (strat->pairtest[j])
3277 {
3278 for (i=strat->Bl; i>=0; i--)
3279 {
3280 if (pDivisibleBy(strat->S[j],strat->B[i].lcm))
3281 {
3282 deleteInL(strat->B,&strat->Bl,i,strat);
3283 strat->c3++;
3284 }
3285 }
3286 }
3287 }
3288 }
3289 omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
3290 strat->pairtest=NULL;
3291 }
3292 if (strat->Gebauer || strat->fromT)
3293 {
3294 if (strat->sugarCrit)
3295 {
3296 /*
3297 *suppose L[j] == (s,r) and p/lcm(s,r)
3298 *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
3299 *and in case the sugar is o.k. then L[j] can be canceled
3300 */
3301 for (j=strat->Ll; j>=0; j--)
3302 {
3303 if (sugarDivisibleBy(ecart,strat->L[j].ecart)
3304 && ((pNext(strat->L[j].p) == strat->tail) || (rHasGlobalOrdering(currRing)))
3305 && pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
3306 {
3307 if (strat->L[j].p == strat->tail)
3308 {
3309 deleteInL(strat->L,&strat->Ll,j,strat);
3310 strat->c3++;
3311 }
3312 }
3313 }
3314 /*
3315 *this is GEBAUER-MOELLER:
3316 *in B all elements with the same lcm except the "best"
3317 *(i.e. the last one in B with this property) will be canceled
3318 */
3319 j = strat->Bl;
3320 loop /*cannot be changed into a for !!! */
3321 {
3322 if (j <= 0) break;
3323 i = j-1;
3324 loop
3325 {
3326 if (i < 0) break;
3327 if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
3328 {
3329 strat->c3++;
3330 if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
3331 {
3332 deleteInL(strat->B,&strat->Bl,i,strat);
3333 j--;
3334 }
3335 else
3336 {
3337 deleteInL(strat->B,&strat->Bl,j,strat);
3338 break;
3339 }
3340 }
3341 i--;
3342 }
3343 j--;
3344 }
3345 }
3346 else /*sugarCrit*/
3347 {
3348 /*
3349 *suppose L[j] == (s,r) and p/lcm(s,r)
3350 *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
3351 *and in case the sugar is o.k. then L[j] can be canceled
3352 */
3353 for (j=strat->Ll; j>=0; j--)
3354 {
3355 if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
3356 {
3357 if ((pNext(strat->L[j].p) == strat->tail)||(rHasGlobalOrdering(currRing)))
3358 {
3359 deleteInL(strat->L,&strat->Ll,j,strat);
3360 strat->c3++;
3361 }
3362 }
3363 }
3364 /*
3365 *this is GEBAUER-MOELLER:
3366 *in B all elements with the same lcm except the "best"
3367 *(i.e. the last one in B with this property) will be canceled
3368 */
3369 j = strat->Bl;
3370 loop /*cannot be changed into a for !!! */
3371 {
3372 if (j <= 0) break;
3373 for(i=j-1; i>=0; i--)
3374 {
3375 if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
3376 {
3377 strat->c3++;
3378 deleteInL(strat->B,&strat->Bl,i,strat);
3379 j--;
3380 }
3381 }
3382 j--;
3383 }
3384 }
3385 /*
3386 *the elements of B enter L
3387 */
3388 kMergeBintoL(strat);
3389 }
3390 else
3391 {
3392 for (j=strat->Ll; j>=0; j--)
3393 {
3394 if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
3395 {
3396 if ((pNext(strat->L[j].p) == strat->tail)||(rHasGlobalOrdering(currRing)))
3397 {
3398 deleteInL(strat->L,&strat->Ll,j,strat);
3399 strat->c3++;
3400 }
3401 }
3402 }
3403 /*
3404 *this is our MODIFICATION of GEBAUER-MOELLER:
3405 *First the elements of B enter L,
3406 *then we fix a lcm and the "best" element in L
3407 *(i.e the last in L with this lcm and of type (s,p))
3408 *and cancel all the other elements of type (r,p) with this lcm
3409 *except the case the element (s,r) has also the same lcm
3410 *and is on the worst position with respect to (s,p) and (r,p)
3411 */
3412 /*
3413 *B enters to L/their order with respect to B is permutated for elements
3414 *B[i].p with the same leading term
3415 */
3416 kMergeBintoL(strat);
3417 j = strat->Ll;
3418 loop /*cannot be changed into a for !!! */
3419 {
3420 if (j <= 0)
3421 {
3422 /*now L[0] cannot be canceled any more and the tail can be removed*/
3423 if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
3424 break;
3425 }
3426 if (strat->L[j].p2 == p)
3427 {
3428 i = j-1;
3429 loop
3430 {
3431 if (i < 0) break;
3432 if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
3433 {
3434 /*L[i] could be canceled but we search for a better one to cancel*/
3435 strat->c3++;
3436 if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
3437 && (pNext(strat->L[l].p) == strat->tail)
3438 && (!pLmEqual(strat->L[i].p,strat->L[l].p))
3439 && pDivisibleBy(p,strat->L[l].lcm))
3440 {
3441 /*
3442 *"NOT equal(...)" because in case of "equal" the element L[l]
3443 *is "older" and has to be from theoretical point of view behind
3444 *L[i], but we do not want to reorder L
3445 */
3446 strat->L[i].p2 = strat->tail;
3447 /*
3448 *L[l] will be canceled, we cannot cancel L[i] later on,
3449 *so we mark it with "tail"
3450 */
3451 deleteInL(strat->L,&strat->Ll,l,strat);
3452 i--;
3453 }
3454 else
3455 {
3456 deleteInL(strat->L,&strat->Ll,i,strat);
3457 }
3458 j--;
3459 }
3460 i--;
3461 }
3462 }
3463 else if (strat->L[j].p2 == strat->tail)
3464 {
3465 /*now L[j] cannot be canceled any more and the tail can be removed*/
3466 strat->L[j].p2 = p;
3467 }
3468 j--;
3469 }
3470 }
3471 }
3472 /*2
3473 *the pairset B of pairs of type (s[i],p) is complete now. It will be updated
3474 *without the chain-criterion in B and L and enters B to L
3475 */
chainCritOpt_1(poly,int,kStrategy strat)3476 void chainCritOpt_1 (poly,int,kStrategy strat)
3477 {
3478 if (strat->pairtest!=NULL)
3479 {
3480 omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
3481 strat->pairtest=NULL;
3482 }
3483 /*
3484 *the elements of B enter L
3485 */
3486 kMergeBintoL(strat);
3487 }
3488 /*2
3489 *the pairset B of pairs of type (s[i],p) is complete now. It will be updated
3490 *using the chain-criterion in B and L and enters B to L
3491 */
chainCritSig(poly p,int,kStrategy strat)3492 void chainCritSig (poly p,int /*ecart*/,kStrategy strat)
3493 {
3494 int i,j,l;
3495 kMergeBintoLSba(strat);
3496 j = strat->Ll;
3497 loop /*cannot be changed into a for !!! */
3498 {
3499 if (j <= 0)
3500 {
3501 /*now L[0] cannot be canceled any more and the tail can be removed*/
3502 if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
3503 break;
3504 }
3505 if (strat->L[j].p2 == p)
3506 {
3507 i = j-1;
3508 loop
3509 {
3510 if (i < 0) break;
3511 if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
3512 {
3513 /*L[i] could be canceled but we search for a better one to cancel*/
3514 strat->c3++;
3515 if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
3516 && (pNext(strat->L[l].p) == strat->tail)
3517 && (!pLmEqual(strat->L[i].p,strat->L[l].p))
3518 && pDivisibleBy(p,strat->L[l].lcm))
3519 {
3520 /*
3521 *"NOT equal(...)" because in case of "equal" the element L[l]
3522 *is "older" and has to be from theoretical point of view behind
3523 *L[i], but we do not want to reorder L
3524 */
3525 strat->L[i].p2 = strat->tail;
3526 /*
3527 *L[l] will be canceled, we cannot cancel L[i] later on,
3528 *so we mark it with "tail"
3529 */
3530 deleteInL(strat->L,&strat->Ll,l,strat);
3531 i--;
3532 }
3533 else
3534 {
3535 deleteInL(strat->L,&strat->Ll,i,strat);
3536 }
3537 j--;
3538 }
3539 i--;
3540 }
3541 }
3542 else if (strat->L[j].p2 == strat->tail)
3543 {
3544 /*now L[j] cannot be canceled any more and the tail can be removed*/
3545 strat->L[j].p2 = p;
3546 }
3547 j--;
3548 }
3549 }
3550 #ifdef HAVE_RATGRING
chainCritPart(poly p,int ecart,kStrategy strat)3551 void chainCritPart (poly p,int ecart,kStrategy strat)
3552 {
3553 int i,j,l;
3554
3555 /*
3556 *pairtest[i] is TRUE if spoly(S[i],p) == 0.
3557 *In this case all elements in B such
3558 *that their lcm is divisible by the leading term of S[i] can be canceled
3559 */
3560 if (strat->pairtest!=NULL)
3561 {
3562 /*- i.e. there is an i with pairtest[i]==TRUE -*/
3563 for (j=0; j<=strat->sl; j++)
3564 {
3565 if (strat->pairtest[j])
3566 {
3567 for (i=strat->Bl; i>=0; i--)
3568 {
3569 if (_p_LmDivisibleByPart(strat->S[j],currRing,
3570 strat->B[i].lcm,currRing,
3571 currRing->real_var_start,currRing->real_var_end))
3572 {
3573 if(TEST_OPT_DEBUG)
3574 {
3575 Print("chain-crit-part: S[%d]=",j);
3576 p_wrp(strat->S[j],currRing);
3577 Print(" divide B[%d].lcm=",i);
3578 p_wrp(strat->B[i].lcm,currRing);
3579 PrintLn();
3580 }
3581 deleteInL(strat->B,&strat->Bl,i,strat);
3582 strat->c3++;
3583 }
3584 }
3585 }
3586 }
3587 omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
3588 strat->pairtest=NULL;
3589 }
3590 if (strat->Gebauer || strat->fromT)
3591 {
3592 if (strat->sugarCrit)
3593 {
3594 /*
3595 *suppose L[j] == (s,r) and p/lcm(s,r)
3596 *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
3597 *and in case the sugar is o.k. then L[j] can be canceled
3598 */
3599 for (j=strat->Ll; j>=0; j--)
3600 {
3601 if (sugarDivisibleBy(ecart,strat->L[j].ecart)
3602 && ((pNext(strat->L[j].p) == strat->tail) || (rHasGlobalOrdering(currRing)))
3603 && pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
3604 {
3605 if (strat->L[j].p == strat->tail)
3606 {
3607 if(TEST_OPT_DEBUG)
3608 {
3609 PrintS("chain-crit-part: pCompareChainPart p=");
3610 p_wrp(p,currRing);
3611 Print(" delete L[%d]",j);
3612 p_wrp(strat->L[j].lcm,currRing);
3613 PrintLn();
3614 }
3615 deleteInL(strat->L,&strat->Ll,j,strat);
3616 strat->c3++;
3617 }
3618 }
3619 }
3620 /*
3621 *this is GEBAUER-MOELLER:
3622 *in B all elements with the same lcm except the "best"
3623 *(i.e. the last one in B with this property) will be canceled
3624 */
3625 j = strat->Bl;
3626 loop /*cannot be changed into a for !!! */
3627 {
3628 if (j <= 0) break;
3629 i = j-1;
3630 loop
3631 {
3632 if (i < 0) break;
3633 if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
3634 {
3635 strat->c3++;
3636 if (sugarDivisibleBy(strat->B[j].ecart,strat->B[i].ecart))
3637 {
3638 if(TEST_OPT_DEBUG)
3639 {
3640 Print("chain-crit-part: sugar B[%d].lcm=",j);
3641 p_wrp(strat->B[j].lcm,currRing);
3642 Print(" delete B[%d]",i);
3643 p_wrp(strat->B[i].lcm,currRing);
3644 PrintLn();
3645 }
3646 deleteInL(strat->B,&strat->Bl,i,strat);
3647 j--;
3648 }
3649 else
3650 {
3651 if(TEST_OPT_DEBUG)
3652 {
3653 Print("chain-crit-part: sugar B[%d].lcm=",i);
3654 p_wrp(strat->B[i].lcm,currRing);
3655 Print(" delete B[%d]",j);
3656 p_wrp(strat->B[j].lcm,currRing);
3657 PrintLn();
3658 }
3659 deleteInL(strat->B,&strat->Bl,j,strat);
3660 break;
3661 }
3662 }
3663 i--;
3664 }
3665 j--;
3666 }
3667 }
3668 else /*sugarCrit*/
3669 {
3670 /*
3671 *suppose L[j] == (s,r) and p/lcm(s,r)
3672 *and lcm(s,r)#lcm(s,p) and lcm(s,r)#lcm(r,p)
3673 *and in case the sugar is o.k. then L[j] can be canceled
3674 */
3675 for (j=strat->Ll; j>=0; j--)
3676 {
3677 if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
3678 {
3679 if ((pNext(strat->L[j].p) == strat->tail)||(rHasGlobalOrdering(currRing)))
3680 {
3681 if(TEST_OPT_DEBUG)
3682 {
3683 PrintS("chain-crit-part: sugar:pCompareChainPart p=");
3684 p_wrp(p,currRing);
3685 Print(" delete L[%d]",j);
3686 p_wrp(strat->L[j].lcm,currRing);
3687 PrintLn();
3688 }
3689 deleteInL(strat->L,&strat->Ll,j,strat);
3690 strat->c3++;
3691 }
3692 }
3693 }
3694 /*
3695 *this is GEBAUER-MOELLER:
3696 *in B all elements with the same lcm except the "best"
3697 *(i.e. the last one in B with this property) will be canceled
3698 */
3699 j = strat->Bl;
3700 loop /*cannot be changed into a for !!! */
3701 {
3702 if (j <= 0) break;
3703 for(i=j-1; i>=0; i--)
3704 {
3705 if (pLmEqual(strat->B[j].lcm,strat->B[i].lcm))
3706 {
3707 if(TEST_OPT_DEBUG)
3708 {
3709 Print("chain-crit-part: equal lcm B[%d].lcm=",j);
3710 p_wrp(strat->B[j].lcm,currRing);
3711 Print(" delete B[%d]\n",i);
3712 }
3713 strat->c3++;
3714 deleteInL(strat->B,&strat->Bl,i,strat);
3715 j--;
3716 }
3717 }
3718 j--;
3719 }
3720 }
3721 /*
3722 *the elements of B enter L
3723 */
3724 kMergeBintoL(strat);
3725 }
3726 else
3727 {
3728 for (j=strat->Ll; j>=0; j--)
3729 {
3730 if (pCompareChainPart(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
3731 {
3732 if ((pNext(strat->L[j].p) == strat->tail)||(rHasGlobalOrdering(currRing)))
3733 {
3734 if(TEST_OPT_DEBUG)
3735 {
3736 PrintS("chain-crit-part: pCompareChainPart p=");
3737 p_wrp(p,currRing);
3738 Print(" delete L[%d]",j);
3739 p_wrp(strat->L[j].lcm,currRing);
3740 PrintLn();
3741 }
3742 deleteInL(strat->L,&strat->Ll,j,strat);
3743 strat->c3++;
3744 }
3745 }
3746 }
3747 /*
3748 *this is our MODIFICATION of GEBAUER-MOELLER:
3749 *First the elements of B enter L,
3750 *then we fix a lcm and the "best" element in L
3751 *(i.e the last in L with this lcm and of type (s,p))
3752 *and cancel all the other elements of type (r,p) with this lcm
3753 *except the case the element (s,r) has also the same lcm
3754 *and is on the worst position with respect to (s,p) and (r,p)
3755 */
3756 /*
3757 *B enters to L/their order with respect to B is permutated for elements
3758 *B[i].p with the same leading term
3759 */
3760 kMergeBintoL(strat);
3761 j = strat->Ll;
3762 loop /*cannot be changed into a for !!! */
3763 {
3764 if (j <= 0)
3765 {
3766 /*now L[0] cannot be canceled any more and the tail can be removed*/
3767 if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
3768 break;
3769 }
3770 if (strat->L[j].p2 == p)
3771 {
3772 i = j-1;
3773 loop
3774 {
3775 if (i < 0) break;
3776 if ((strat->L[i].p2 == p) && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
3777 {
3778 /*L[i] could be canceled but we search for a better one to cancel*/
3779 strat->c3++;
3780 if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
3781 && (pNext(strat->L[l].p) == strat->tail)
3782 && (!pLmEqual(strat->L[i].p,strat->L[l].p))
3783 && _p_LmDivisibleByPart(p,currRing,
3784 strat->L[l].lcm,currRing,
3785 currRing->real_var_start, currRing->real_var_end))
3786
3787 {
3788 /*
3789 *"NOT equal(...)" because in case of "equal" the element L[l]
3790 *is "older" and has to be from theoretical point of view behind
3791 *L[i], but we do not want to reorder L
3792 */
3793 strat->L[i].p2 = strat->tail;
3794 /*
3795 *L[l] will be canceled, we cannot cancel L[i] later on,
3796 *so we mark it with "tail"
3797 */
3798 if(TEST_OPT_DEBUG)
3799 {
3800 PrintS("chain-crit-part: divisible_by p=");
3801 p_wrp(p,currRing);
3802 Print(" delete L[%d]",l);
3803 p_wrp(strat->L[l].lcm,currRing);
3804 PrintLn();
3805 }
3806 deleteInL(strat->L,&strat->Ll,l,strat);
3807 i--;
3808 }
3809 else
3810 {
3811 if(TEST_OPT_DEBUG)
3812 {
3813 PrintS("chain-crit-part: divisible_by(2) p=");
3814 p_wrp(p,currRing);
3815 Print(" delete L[%d]",i);
3816 p_wrp(strat->L[i].lcm,currRing);
3817 PrintLn();
3818 }
3819 deleteInL(strat->L,&strat->Ll,i,strat);
3820 }
3821 j--;
3822 }
3823 i--;
3824 }
3825 }
3826 else if (strat->L[j].p2 == strat->tail)
3827 {
3828 /*now L[j] cannot be canceled any more and the tail can be removed*/
3829 strat->L[j].p2 = p;
3830 }
3831 j--;
3832 }
3833 }
3834 }
3835 #endif
3836
3837 /*2
3838 *(s[0],h),...,(s[k],h) will be put to the pairset L
3839 */
initenterpairs(poly h,int k,int ecart,int isFromQ,kStrategy strat,int atR)3840 void initenterpairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR/* = -1*/)
3841 {
3842
3843 if ((strat->syzComp==0)
3844 || (pGetComp(h)<=strat->syzComp))
3845 {
3846 int j;
3847 BOOLEAN new_pair=FALSE;
3848
3849 if (pGetComp(h)==0)
3850 {
3851 /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
3852 if ((isFromQ)&&(strat->fromQ!=NULL))
3853 {
3854 for (j=0; j<=k; j++)
3855 {
3856 if (!strat->fromQ[j])
3857 {
3858 new_pair=TRUE;
3859 strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
3860 //Print("j:%d, Ll:%d\n",j,strat->Ll);
3861 }
3862 }
3863 }
3864 else
3865 {
3866 new_pair=TRUE;
3867 for (j=0; j<=k; j++)
3868 {
3869 strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
3870 //Print("j:%d, Ll:%d\n",j,strat->Ll);
3871 }
3872 }
3873 }
3874 else
3875 {
3876 for (j=0; j<=k; j++)
3877 {
3878 if ((pGetComp(h)==pGetComp(strat->S[j]))
3879 || (pGetComp(strat->S[j])==0))
3880 {
3881 new_pair=TRUE;
3882 strat->enterOnePair(j,h,ecart,isFromQ,strat, atR);
3883 //Print("j:%d, Ll:%d\n",j,strat->Ll);
3884 }
3885 }
3886 }
3887 if (new_pair)
3888 {
3889 #ifdef HAVE_RATGRING
3890 if (currRing->real_var_start>0)
3891 chainCritPart(h,ecart,strat);
3892 else
3893 #endif
3894 strat->chainCrit(h,ecart,strat);
3895 }
3896 kMergeBintoL(strat);
3897 }
3898 }
3899
3900 /*2
3901 *(s[0],h),...,(s[k],h) will be put to the pairset L
3902 *using signatures <= only for signature-based standard basis algorithms
3903 */
3904
initenterpairsSig(poly h,poly hSig,int hFrom,int k,int ecart,int isFromQ,kStrategy strat,int atR=-1)3905 void initenterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
3906 {
3907
3908 if ((strat->syzComp==0)
3909 || (pGetComp(h)<=strat->syzComp))
3910 {
3911 int j;
3912 BOOLEAN new_pair=FALSE;
3913
3914 if (pGetComp(h)==0)
3915 {
3916 /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
3917 if ((isFromQ)&&(strat->fromQ!=NULL))
3918 {
3919 for (j=0; j<=k; j++)
3920 {
3921 if (!strat->fromQ[j])
3922 {
3923 new_pair=TRUE;
3924 enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
3925 //Print("j:%d, Ll:%d\n",j,strat->Ll);
3926 }
3927 }
3928 }
3929 else
3930 {
3931 new_pair=TRUE;
3932 for (j=0; j<=k; j++)
3933 {
3934 enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
3935 //Print("j:%d, Ll:%d\n",j,strat->Ll);
3936 }
3937 }
3938 }
3939 else
3940 {
3941 for (j=0; j<=k; j++)
3942 {
3943 if ((pGetComp(h)==pGetComp(strat->S[j]))
3944 || (pGetComp(strat->S[j])==0))
3945 {
3946 new_pair=TRUE;
3947 enterOnePairSig(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
3948 //Print("j:%d, Ll:%d\n",j,strat->Ll);
3949 }
3950 }
3951 }
3952
3953 if (new_pair)
3954 {
3955 #ifdef HAVE_RATGRING
3956 if (currRing->real_var_start>0)
3957 chainCritPart(h,ecart,strat);
3958 else
3959 #endif
3960 strat->chainCrit(h,ecart,strat);
3961 }
3962 }
3963 }
3964
initenterpairsSigRing(poly h,poly hSig,int hFrom,int k,int ecart,int isFromQ,kStrategy strat,int atR=-1)3965 void initenterpairsSigRing (poly h,poly hSig,int hFrom,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
3966 {
3967
3968 if ((strat->syzComp==0)
3969 || (pGetComp(h)<=strat->syzComp))
3970 {
3971 int j;
3972
3973 if (pGetComp(h)==0)
3974 {
3975 /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
3976 if ((isFromQ)&&(strat->fromQ!=NULL))
3977 {
3978 for (j=0; j<=k && !strat->sigdrop; j++)
3979 {
3980 if (!strat->fromQ[j])
3981 {
3982 enterOnePairSigRing(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
3983 //Print("j:%d, Ll:%d\n",j,strat->Ll);
3984 }
3985 }
3986 }
3987 else
3988 {
3989 for (j=0; j<=k && !strat->sigdrop; j++)
3990 {
3991 enterOnePairSigRing(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
3992 //Print("j:%d, Ll:%d\n",j,strat->Ll);
3993 }
3994 }
3995 }
3996 else
3997 {
3998 for (j=0; j<=k && !strat->sigdrop; j++)
3999 {
4000 if ((pGetComp(h)==pGetComp(strat->S[j]))
4001 || (pGetComp(strat->S[j])==0))
4002 {
4003 enterOnePairSigRing(j,h,hSig,hFrom,ecart,isFromQ,strat, atR);
4004 //Print("j:%d, Ll:%d\n",j,strat->Ll);
4005 }
4006 }
4007 }
4008
4009 #if 0
4010 if (new_pair)
4011 {
4012 #ifdef HAVE_RATGRING
4013 if (currRing->real_var_start>0)
4014 chainCritPart(h,ecart,strat);
4015 else
4016 #endif
4017 strat->chainCrit(h,ecart,strat);
4018 }
4019 #endif
4020 }
4021 }
4022 #ifdef HAVE_RINGS
4023 /*2
4024 *the pairset B of pairs of type (s[i],p) is complete now. It will be updated
4025 *using the chain-criterion in B and L and enters B to L
4026 */
chainCritRing(poly p,int,kStrategy strat)4027 void chainCritRing (poly p,int, kStrategy strat)
4028 {
4029 int i,j,l;
4030 /*
4031 *pairtest[i] is TRUE if spoly(S[i],p) == 0.
4032 *In this case all elements in B such
4033 *that their lcm is divisible by the leading term of S[i] can be canceled
4034 */
4035 if (strat->pairtest!=NULL)
4036 {
4037 {
4038 /*- i.e. there is an i with pairtest[i]==TRUE -*/
4039 for (j=0; j<=strat->sl; j++)
4040 {
4041 if (strat->pairtest[j])
4042 {
4043 for (i=strat->Bl; i>=0; i--)
4044 {
4045 if (pDivisibleBy(strat->S[j],strat->B[i].lcm) && n_DivBy(pGetCoeff(strat->B[i].lcm), pGetCoeff(strat->S[j]),currRing->cf))
4046 {
4047 #ifdef KDEBUG
4048 if (TEST_OPT_DEBUG)
4049 {
4050 PrintS("--- chain criterion func chainCritRing type 1\n");
4051 PrintS("strat->S[j]:");
4052 wrp(strat->S[j]);
4053 PrintS(" strat->B[i].lcm:");
4054 wrp(strat->B[i].lcm);PrintLn();
4055 pWrite(strat->B[i].p);
4056 pWrite(strat->B[i].p1);
4057 pWrite(strat->B[i].p2);
4058 wrp(strat->B[i].lcm);
4059 PrintLn();
4060 }
4061 #endif
4062 deleteInL(strat->B,&strat->Bl,i,strat);
4063 strat->c3++;
4064 }
4065 }
4066 }
4067 }
4068 }
4069 omFreeSize(strat->pairtest,(strat->sl+2)*sizeof(BOOLEAN));
4070 strat->pairtest=NULL;
4071 }
4072 assume(!(strat->Gebauer || strat->fromT));
4073 for (j=strat->Ll; j>=0; j--)
4074 {
4075 if ((strat->L[j].lcm != NULL) && n_DivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(p), currRing->cf))
4076 {
4077 if (pCompareChain(p,strat->L[j].p1,strat->L[j].p2,strat->L[j].lcm))
4078 {
4079 if ((pNext(strat->L[j].p) == strat->tail) || (rHasGlobalOrdering(currRing)))
4080 {
4081 deleteInL(strat->L,&strat->Ll,j,strat);
4082 strat->c3++;
4083 #ifdef KDEBUG
4084 if (TEST_OPT_DEBUG)
4085 {
4086 PrintS("--- chain criterion func chainCritRing type 2\n");
4087 PrintS("strat->L[j].p:");
4088 wrp(strat->L[j].p);
4089 PrintS(" p:");
4090 wrp(p);
4091 PrintLn();
4092 }
4093 #endif
4094 }
4095 }
4096 }
4097 }
4098 /*
4099 *this is our MODIFICATION of GEBAUER-MOELLER:
4100 *First the elements of B enter L,
4101 *then we fix a lcm and the "best" element in L
4102 *(i.e the last in L with this lcm and of type (s,p))
4103 *and cancel all the other elements of type (r,p) with this lcm
4104 *except the case the element (s,r) has also the same lcm
4105 *and is on the worst position with respect to (s,p) and (r,p)
4106 */
4107 /*
4108 *B enters to L/their order with respect to B is permutated for elements
4109 *B[i].p with the same leading term
4110 */
4111 kMergeBintoL(strat);
4112 j = strat->Ll;
4113 loop /*cannot be changed into a for !!! */
4114 {
4115 if (j <= 0)
4116 {
4117 /*now L[0] cannot be canceled any more and the tail can be removed*/
4118 if (strat->L[0].p2 == strat->tail) strat->L[0].p2 = p;
4119 break;
4120 }
4121 if (strat->L[j].p2 == p) // Was the element added from B?
4122 {
4123 i = j-1;
4124 loop
4125 {
4126 if (i < 0) break;
4127 // Element is from B and has the same lcm as L[j]
4128 if ((strat->L[i].p2 == p) && n_DivBy(pGetCoeff(strat->L[j].lcm), pGetCoeff(strat->L[i].lcm), currRing->cf)
4129 && pLmEqual(strat->L[j].lcm,strat->L[i].lcm))
4130 {
4131 /*L[i] could be canceled but we search for a better one to cancel*/
4132 strat->c3++;
4133 #ifdef KDEBUG
4134 if (TEST_OPT_DEBUG)
4135 {
4136 PrintS("--- chain criterion func chainCritRing type 3\n");
4137 PrintS("strat->L[j].lcm:");
4138 wrp(strat->L[j].lcm);
4139 PrintS(" strat->L[i].lcm:");
4140 wrp(strat->L[i].lcm);
4141 PrintLn();
4142 }
4143 #endif
4144 if (isInPairsetL(i-1,strat->L[j].p1,strat->L[i].p1,&l,strat)
4145 && (pNext(strat->L[l].p) == strat->tail)
4146 && (!pLmEqual(strat->L[i].p,strat->L[l].p))
4147 && pDivisibleBy(p,strat->L[l].lcm))
4148 {
4149 /*
4150 *"NOT equal(...)" because in case of "equal" the element L[l]
4151 *is "older" and has to be from theoretical point of view behind
4152 *L[i], but we do not want to reorder L
4153 */
4154 strat->L[i].p2 = strat->tail;
4155 /*
4156 *L[l] will be canceled, we cannot cancel L[i] later on,
4157 *so we mark it with "tail"
4158 */
4159 deleteInL(strat->L,&strat->Ll,l,strat);
4160 i--;
4161 }
4162 else
4163 {
4164 deleteInL(strat->L,&strat->Ll,i,strat);
4165 }
4166 j--;
4167 }
4168 i--;
4169 }
4170 }
4171 else if (strat->L[j].p2 == strat->tail)
4172 {
4173 /*now L[j] cannot be canceled any more and the tail can be removed*/
4174 strat->L[j].p2 = p;
4175 }
4176 j--;
4177 }
4178 }
4179 #endif
4180
4181 #ifdef HAVE_RINGS
4182 /*2
4183 *(s[0],h),...,(s[k],h) will be put to the pairset L
4184 */
initenterstrongPairs(poly h,int k,int ecart,int isFromQ,kStrategy strat,int atR=-1)4185 void initenterstrongPairs (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
4186 {
4187 if (!nIsOne(pGetCoeff(h)))
4188 {
4189 int j;
4190 BOOLEAN new_pair=FALSE;
4191
4192 if (pGetComp(h)==0)
4193 {
4194 /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
4195 if ((isFromQ)&&(strat->fromQ!=NULL))
4196 {
4197 for (j=0; j<=k; j++)
4198 {
4199 if (!strat->fromQ[j])
4200 {
4201 new_pair=TRUE;
4202 enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR, FALSE);
4203 }
4204 }
4205 }
4206 else
4207 {
4208 new_pair=TRUE;
4209 for (j=0; j<=k; j++)
4210 {
4211 enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR, FALSE);
4212 }
4213 }
4214 }
4215 else
4216 {
4217 for (j=0; j<=k; j++)
4218 {
4219 if ((pGetComp(h)==pGetComp(strat->S[j]))
4220 || (pGetComp(strat->S[j])==0))
4221 {
4222 new_pair=TRUE;
4223 enterOneStrongPoly(j,h,ecart,isFromQ,strat, atR, FALSE);
4224 }
4225 }
4226 }
4227 if (new_pair)
4228 {
4229 #ifdef HAVE_RATGRING
4230 if (currRing->real_var_start>0)
4231 chainCritPart(h,ecart,strat);
4232 else
4233 #endif
4234 strat->chainCrit(h,ecart,strat);
4235 }
4236 kMergeBintoL(strat);
4237 }
4238 }
4239
initenterstrongPairsSig(poly h,poly hSig,int k,int ecart,int isFromQ,kStrategy strat,int atR=-1)4240 static void initenterstrongPairsSig (poly h,poly hSig, int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
4241 {
4242 const int iCompH = pGetComp(h);
4243 if (!nIsOne(pGetCoeff(h)))
4244 {
4245 int j;
4246
4247 for (j=0; j<=k && !strat->sigdrop; j++)
4248 {
4249 // Print("j:%d, Ll:%d\n",j,strat->Ll);
4250 // if (((unsigned long) pGetCoeff(h) % (unsigned long) pGetCoeff(strat->S[j]) != 0) &&
4251 // ((unsigned long) pGetCoeff(strat->S[j]) % (unsigned long) pGetCoeff(h) != 0))
4252 if (((iCompH == pGetComp(strat->S[j]))
4253 || (0 == pGetComp(strat->S[j])))
4254 && ((iCompH<=strat->syzComp)||(strat->syzComp==0)))
4255 {
4256 enterOneStrongPolySig(j,h,hSig,ecart,isFromQ,strat, atR);
4257 }
4258 }
4259 }
4260 }
4261 #endif
4262
4263 #ifdef HAVE_RINGS
4264 /*2
4265 * Generates spoly(0, h) if applicable. Assumes ring in Z/2^n.
4266 */
enterExtendedSpoly(poly h,kStrategy strat)4267 void enterExtendedSpoly(poly h,kStrategy strat)
4268 {
4269 if (nIsOne(pGetCoeff(h))) return;
4270 number gcd;
4271 bool go = false;
4272 if (n_DivBy((number) 0, pGetCoeff(h), currRing->cf))
4273 {
4274 gcd = n_Ann(pGetCoeff(h),currRing->cf);
4275 go = true;
4276 }
4277 else
4278 gcd = n_Gcd((number) 0, pGetCoeff(h), strat->tailRing->cf);
4279 if (go || !nIsOne(gcd))
4280 {
4281 poly p = h->next;
4282 if (!go)
4283 {
4284 number tmp = gcd;
4285 gcd = n_Ann(gcd,currRing->cf);
4286 nDelete(&tmp);
4287 }
4288 p_Test(p,strat->tailRing);
4289 p = __pp_Mult_nn(p, gcd, strat->tailRing);
4290 nDelete(&gcd);
4291
4292 if (p != NULL)
4293 {
4294 if (TEST_OPT_PROT)
4295 {
4296 PrintS("Z");
4297 }
4298 #ifdef KDEBUG
4299 if (TEST_OPT_DEBUG)
4300 {
4301 PrintS("--- create zero spoly: ");
4302 p_wrp(h,currRing,strat->tailRing);
4303 PrintS(" ---> ");
4304 }
4305 #endif
4306 poly tmp = pInit();
4307 pSetCoeff0(tmp, pGetCoeff(p));
4308 for (int i = 1; i <= rVar(currRing); i++)
4309 {
4310 pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
4311 }
4312 if (rRing_has_Comp(currRing) && rRing_has_Comp(strat->tailRing))
4313 {
4314 p_SetComp(tmp, __p_GetComp(p, strat->tailRing), currRing);
4315 }
4316 p_Setm(tmp, currRing);
4317 p = p_LmFreeAndNext(p, strat->tailRing);
4318 pNext(tmp) = p;
4319 LObject Lp;
4320 Lp.Init();
4321 Lp.p = tmp;
4322 Lp.tailRing = strat->tailRing;
4323 int posx;
4324 if (Lp.p!=NULL)
4325 {
4326 strat->initEcart(&Lp);
4327 if (strat->Ll==-1)
4328 posx =0;
4329 else
4330 posx = strat->posInL(strat->L,strat->Ll,&Lp,strat);
4331 Lp.sev = pGetShortExpVector(Lp.p);
4332 if (strat->tailRing != currRing)
4333 {
4334 Lp.t_p = k_LmInit_currRing_2_tailRing(Lp.p, strat->tailRing);
4335 }
4336 #ifdef KDEBUG
4337 if (TEST_OPT_DEBUG)
4338 {
4339 p_wrp(tmp,currRing,strat->tailRing);
4340 PrintLn();
4341 }
4342 #endif
4343 enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,posx);
4344 }
4345 }
4346 }
4347 nDelete(&gcd);
4348 }
4349
enterExtendedSpolySig(poly h,poly hSig,kStrategy strat)4350 void enterExtendedSpolySig(poly h,poly hSig,kStrategy strat)
4351 {
4352 if (nIsOne(pGetCoeff(h))) return;
4353 number gcd;
4354 bool go = false;
4355 if (n_DivBy((number) 0, pGetCoeff(h), currRing->cf))
4356 {
4357 gcd = n_Ann(pGetCoeff(h),currRing->cf);
4358 go = true;
4359 }
4360 else
4361 gcd = n_Gcd((number) 0, pGetCoeff(h), strat->tailRing->cf);
4362 if (go || !nIsOne(gcd))
4363 {
4364 poly p = h->next;
4365 if (!go)
4366 {
4367 number tmp = gcd;
4368 gcd = n_Ann(gcd,currRing->cf);
4369 nDelete(&tmp);
4370 }
4371 p_Test(p,strat->tailRing);
4372 p = __pp_Mult_nn(p, gcd, strat->tailRing);
4373
4374 if (p != NULL)
4375 {
4376 if (TEST_OPT_PROT)
4377 {
4378 PrintS("Z");
4379 }
4380 #ifdef KDEBUG
4381 if (TEST_OPT_DEBUG)
4382 {
4383 PrintS("--- create zero spoly: ");
4384 p_wrp(h,currRing,strat->tailRing);
4385 PrintS(" ---> ");
4386 }
4387 #endif
4388 poly tmp = pInit();
4389 pSetCoeff0(tmp, pGetCoeff(p));
4390 for (int i = 1; i <= rVar(currRing); i++)
4391 {
4392 pSetExp(tmp, i, p_GetExp(p, i, strat->tailRing));
4393 }
4394 if (rRing_has_Comp(currRing) && rRing_has_Comp(strat->tailRing))
4395 {
4396 p_SetComp(tmp, __p_GetComp(p, strat->tailRing), currRing);
4397 }
4398 p_Setm(tmp, currRing);
4399 p = p_LmFreeAndNext(p, strat->tailRing);
4400 pNext(tmp) = p;
4401 LObject Lp;
4402 Lp.Init();
4403 Lp.p = tmp;
4404 //printf("\nOld\n");pWrite(h);pWrite(hSig);
4405 #if EXT_POLY_NEW
4406 Lp.sig = __pp_Mult_nn(hSig, gcd, currRing);
4407 if(Lp.sig == NULL || nIsZero(pGetCoeff(Lp.sig)))
4408 {
4409 strat->sigdrop = TRUE;
4410 //Try to reduce it as far as we can via redRing
4411 int red_result = redRing(&Lp,strat);
4412 if(red_result == 0)
4413 {
4414 // Cancel the sigdrop
4415 p_Delete(&Lp.sig,currRing);Lp.sig = NULL;
4416 strat->sigdrop = FALSE;
4417 return;
4418 }
4419 else
4420 {
4421 strat->enterS(strat->P,strat->sl+1,strat, strat->tl+1);
4422 #if 1
4423 strat->enterS(Lp,0,strat,strat->tl);
4424 #endif
4425 return;
4426 }
4427
4428 }
4429 #else
4430 Lp.sig = pOne();
4431 if(strat->Ll >= 0)
4432 p_SetComp(Lp.sig,pGetComp(strat->L[0].sig)+1,currRing);
4433 else
4434 p_SetComp(Lp.sig,pGetComp(hSig)+1,currRing);
4435 #endif
4436 Lp.tailRing = strat->tailRing;
4437 int posx;
4438 if (Lp.p!=NULL)
4439 {
4440 strat->initEcart(&Lp);
4441 if (strat->Ll==-1)
4442 posx =0;
4443 else
4444 posx = strat->posInLSba(strat->L,strat->Ll,&Lp,strat);
4445 Lp.sev = pGetShortExpVector(Lp.p);
4446 if (strat->tailRing != currRing)
4447 {
4448 Lp.t_p = k_LmInit_currRing_2_tailRing(Lp.p, strat->tailRing);
4449 }
4450 #ifdef KDEBUG
4451 if (TEST_OPT_DEBUG)
4452 {
4453 p_wrp(tmp,currRing,strat->tailRing);
4454 PrintLn();
4455 }
4456 #endif
4457 //pWrite(h);pWrite(hSig);pWrite(Lp.p);pWrite(Lp.sig);printf("\n------------------\n");getchar();
4458 enterL(&strat->L,&strat->Ll,&strat->Lmax,Lp,posx);
4459 }
4460 }
4461 nDelete(&gcd);
4462 }
4463 nDelete(&gcd);
4464 }
4465 #endif
4466
4467 #ifdef HAVE_RINGS
clearSbatch(poly h,int k,int pos,kStrategy strat)4468 void clearSbatch (poly h,int k,int pos,kStrategy strat)
4469 {
4470 int j = pos;
4471 if ( (!strat->fromT)
4472 && ((strat->syzComp==0)
4473 ||(pGetComp(h)<=strat->syzComp)
4474 ))
4475 {
4476 // Print("start clearS k=%d, pos=%d, sl=%d\n",k,pos,strat->sl);
4477 unsigned long h_sev = pGetShortExpVector(h);
4478 loop
4479 {
4480 if (j > k) break;
4481 clearS(h,h_sev, &j,&k,strat);
4482 j++;
4483 }
4484 // Print("end clearS sl=%d\n",strat->sl);
4485 }
4486 }
4487 #endif
4488
4489 #ifdef HAVE_RINGS
4490 /*2
4491 * Generates a sufficient set of spolys (maybe just a finite generating
4492 * set of the syzygys)
4493 */
superenterpairs(poly h,int k,int ecart,int pos,kStrategy strat,int atR)4494 void superenterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
4495 {
4496 assume (rField_is_Ring(currRing));
4497 #if HAVE_SHIFTBBA
4498 assume(!rIsLPRing(currRing)); /* LP should use enterpairsShift */
4499 #endif
4500 // enter also zero divisor * poly, if this is non zero and of smaller degree
4501 if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat);
4502 initenterstrongPairs(h, k, ecart, 0, strat, atR);
4503 initenterpairs(h, k, ecart, 0, strat, atR);
4504 clearSbatch(h, k, pos, strat);
4505 }
4506
superenterpairsSig(poly h,poly hSig,int hFrom,int k,int ecart,int pos,kStrategy strat,int atR)4507 void superenterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int pos,kStrategy strat, int atR)
4508 {
4509 assume (rField_is_Ring(currRing));
4510 // enter also zero divisor * poly, if this is non zero and of smaller degree
4511 if (!(rField_is_Domain(currRing))) enterExtendedSpolySig(h, hSig, strat);
4512 if(strat->sigdrop) return;
4513 initenterpairsSigRing(h, hSig, hFrom, k, ecart, 0, strat, atR);
4514 if(strat->sigdrop) return;
4515 initenterstrongPairsSig(h, hSig, k, ecart, 0, strat, atR);
4516 if(strat->sigdrop) return;
4517 clearSbatch(h, k, pos, strat);
4518 }
4519 #endif
4520
4521 /*2
4522 *(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
4523 *superfluous elements in S will be deleted
4524 */
enterpairs(poly h,int k,int ecart,int pos,kStrategy strat,int atR)4525 void enterpairs (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
4526 {
4527 int j=pos;
4528
4529 assume (!rField_is_Ring(currRing));
4530 initenterpairs(h,k,ecart,0,strat, atR);
4531 if ( (!strat->fromT)
4532 && ((strat->syzComp==0)
4533 ||(pGetComp(h)<=strat->syzComp)))
4534 {
4535 unsigned long h_sev = pGetShortExpVector(h);
4536 loop
4537 {
4538 if (j > k) break;
4539 clearS(h,h_sev, &j,&k,strat);
4540 j++;
4541 }
4542 }
4543 }
4544
4545 /*2
4546 *(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
4547 *superfluous elements in S will be deleted
4548 *this is a special variant of signature-based algorithms including the
4549 *signatures for criteria checks
4550 */
enterpairsSig(poly h,poly hSig,int hFrom,int k,int ecart,int pos,kStrategy strat,int atR)4551 void enterpairsSig (poly h,poly hSig,int hFrom,int k,int ecart,int pos,kStrategy strat, int atR)
4552 {
4553 int j=pos;
4554 assume (!rField_is_Ring(currRing));
4555 initenterpairsSig(h,hSig,hFrom,k,ecart,0,strat, atR);
4556 if ( (!strat->fromT)
4557 && ((strat->syzComp==0)
4558 ||(pGetComp(h)<=strat->syzComp)))
4559 {
4560 unsigned long h_sev = pGetShortExpVector(h);
4561 loop
4562 {
4563 if (j > k) break;
4564 clearS(h,h_sev, &j,&k,strat);
4565 j++;
4566 }
4567 }
4568 }
4569
4570 /*2
4571 *(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
4572 *superfluous elements in S will be deleted
4573 */
enterpairsSpecial(poly h,int k,int ecart,int pos,kStrategy strat,int atR=-1)4574 void enterpairsSpecial (poly h,int k,int ecart,int pos,kStrategy strat, int atR = -1)
4575 {
4576 int j;
4577 const int iCompH = pGetComp(h);
4578
4579 if (rField_is_Ring(currRing))
4580 {
4581 for (j=0; j<=k; j++)
4582 {
4583 const int iCompSj = pGetComp(strat->S[j]);
4584 if ((iCompH==iCompSj)
4585 //|| (0==iCompH) // can only happen,if iCompSj==0
4586 || (0==iCompSj))
4587 {
4588 enterOnePairRing(j,h,ecart,FALSE,strat, atR);
4589 }
4590 }
4591 kMergeBintoL(strat);
4592 }
4593 else
4594 {
4595 for (j=0; j<=k; j++)
4596 {
4597 const int iCompSj = pGetComp(strat->S[j]);
4598 if ((iCompH==iCompSj)
4599 //|| (0==iCompH) // can only happen,if iCompSj==0
4600 || (0==iCompSj))
4601 {
4602 enterOnePairSpecial(j,h,ecart,strat, atR);
4603 }
4604 }
4605 }
4606
4607 if (strat->noClearS) return;
4608
4609 // #ifdef HAVE_PLURAL
4610 /*
4611 if (rIsPluralRing(currRing))
4612 {
4613 j=pos;
4614 loop
4615 {
4616 if (j > k) break;
4617
4618 if (pLmDivisibleBy(h, strat->S[j]))
4619 {
4620 deleteInS(j, strat);
4621 j--;
4622 k--;
4623 }
4624
4625 j++;
4626 }
4627 }
4628 else
4629 */
4630 // #endif // ??? Why was the following cancelation disabled for non-commutative rings?
4631 {
4632 j=pos;
4633 loop
4634 {
4635 unsigned long h_sev = pGetShortExpVector(h);
4636 if (j > k) break;
4637 clearS(h,h_sev,&j,&k,strat);
4638 j++;
4639 }
4640 }
4641 }
4642
4643 /*2
4644 *reorders s with respect to posInS,
4645 *suc is the first changed index or zero
4646 */
4647
reorderS(int * suc,kStrategy strat)4648 void reorderS (int* suc,kStrategy strat)
4649 {
4650 int i,j,at,ecart, s2r;
4651 int fq=0;
4652 unsigned long sev;
4653 poly p;
4654 int new_suc=strat->sl+1;
4655 i= *suc;
4656 if (i<0) i=0;
4657
4658 for (; i<=strat->sl; i++)
4659 {
4660 at = posInS(strat,i-1,strat->S[i],strat->ecartS[i]);
4661 if (at != i)
4662 {
4663 if (new_suc > at) new_suc = at;
4664 p = strat->S[i];
4665 ecart = strat->ecartS[i];
4666 sev = strat->sevS[i];
4667 s2r = strat->S_2_R[i];
4668 if (strat->fromQ!=NULL) fq=strat->fromQ[i];
4669 for (j=i; j>=at+1; j--)
4670 {
4671 strat->S[j] = strat->S[j-1];
4672 strat->ecartS[j] = strat->ecartS[j-1];
4673 strat->sevS[j] = strat->sevS[j-1];
4674 strat->S_2_R[j] = strat->S_2_R[j-1];
4675 }
4676 strat->S[at] = p;
4677 strat->ecartS[at] = ecart;
4678 strat->sevS[at] = sev;
4679 strat->S_2_R[at] = s2r;
4680 if (strat->fromQ!=NULL)
4681 {
4682 for (j=i; j>=at+1; j--)
4683 {
4684 strat->fromQ[j] = strat->fromQ[j-1];
4685 }
4686 strat->fromQ[at]=fq;
4687 }
4688 }
4689 }
4690 if (new_suc <= strat->sl) *suc=new_suc;
4691 else *suc=-1;
4692 }
4693
4694
4695 /*2
4696 *looks up the position of p in set
4697 *set[0] is the smallest with respect to the ordering-procedure deg/pComp
4698 * Assumption: posInS only depends on the leading term
4699 * otherwise, bba has to be changed
4700 */
posInS(const kStrategy strat,const int length,const poly p,const int ecart_p)4701 int posInS (const kStrategy strat, const int length,const poly p,
4702 const int ecart_p)
4703 {
4704 if(length==-1) return 0;
4705 polyset set=strat->S;
4706 int i;
4707 int an = 0;
4708 int en = length;
4709 int cmp_int = currRing->OrdSgn;
4710 if ((rHasMixedOrdering(currRing))
4711 #ifdef HAVE_PLURAL
4712 && (currRing->real_var_start==0)
4713 #endif
4714 #if 0
4715 || ((strat->ak>0) && ((currRing->order[0]==ringorder_c)||((currRing->order[0]==ringorder_C))))
4716 #endif
4717 )
4718 {
4719 int o=p_Deg(p,currRing);
4720 int oo=p_Deg(set[length],currRing);
4721
4722 if ((oo<o)
4723 || ((o==oo) && (pLmCmp(set[length],p)!= cmp_int)))
4724 return length+1;
4725
4726 loop
4727 {
4728 if (an >= en-1)
4729 {
4730 if ((p_Deg(set[an],currRing)>=o) && (pLmCmp(set[an],p) == cmp_int))
4731 {
4732 return an;
4733 }
4734 return en;
4735 }
4736 i=(an+en) / 2;
4737 if ((p_Deg(set[i],currRing)>=o) && (pLmCmp(set[i],p) == cmp_int)) en=i;
4738 else an=i;
4739 }
4740 }
4741 else
4742 {
4743 if (rField_is_Ring(currRing))
4744 {
4745 if (pLmCmp(set[length],p)== -cmp_int)
4746 return length+1;
4747 int cmp;
4748 loop
4749 {
4750 if (an >= en-1)
4751 {
4752 cmp = pLmCmp(set[an],p);
4753 if (cmp == cmp_int) return an;
4754 if (cmp == -cmp_int) return en;
4755 if (n_DivBy(pGetCoeff(p), pGetCoeff(set[an]), currRing->cf)) return en;
4756 return an;
4757 }
4758 i = (an+en) / 2;
4759 cmp = pLmCmp(set[i],p);
4760 if (cmp == cmp_int) en = i;
4761 else if (cmp == -cmp_int) an = i;
4762 else
4763 {
4764 if (n_DivBy(pGetCoeff(p), pGetCoeff(set[i]), currRing->cf)) an = i;
4765 else en = i;
4766 }
4767 }
4768 }
4769 else
4770 if (pLmCmp(set[length],p)== -cmp_int)
4771 return length+1;
4772
4773 loop
4774 {
4775 if (an >= en-1)
4776 {
4777 if (pLmCmp(set[an],p) == cmp_int) return an;
4778 if (pLmCmp(set[an],p) == -cmp_int) return en;
4779 if ((cmp_int!=1)
4780 && ((strat->ecartS[an])>ecart_p))
4781 return an;
4782 return en;
4783 }
4784 i=(an+en) / 2;
4785 if (pLmCmp(set[i],p) == cmp_int) en=i;
4786 else if (pLmCmp(set[i],p) == -cmp_int) an=i;
4787 else
4788 {
4789 if ((cmp_int!=1)
4790 &&((strat->ecartS[i])<ecart_p))
4791 en=i;
4792 else
4793 an=i;
4794 }
4795 }
4796 }
4797 }
4798
4799
4800 // sorts by degree and pLtCmp
4801 // but puts pure monomials at the beginning
posInSMonFirst(const kStrategy strat,const int length,const poly p)4802 int posInSMonFirst (const kStrategy strat, const int length,const poly p)
4803 {
4804 if (length<0) return 0;
4805 polyset set=strat->S;
4806 if(pNext(p) == NULL)
4807 {
4808 int mon = 0;
4809 for(int i = 0;i<=length;i++)
4810 {
4811 if(set[i] != NULL && pNext(set[i]) == NULL)
4812 mon++;
4813 }
4814 int o = p_Deg(p,currRing);
4815 int op = p_Deg(set[mon],currRing);
4816
4817 if ((op < o)
4818 || ((op == o) && (pLtCmp(set[mon],p) == -1)))
4819 return length+1;
4820 int i;
4821 int an = 0;
4822 int en= mon;
4823 loop
4824 {
4825 if (an >= en-1)
4826 {
4827 op = p_Deg(set[an],currRing);
4828 if ((op < o)
4829 || ((op == o) && (pLtCmp(set[an],p) == -1)))
4830 return en;
4831 return an;
4832 }
4833 i=(an+en) / 2;
4834 op = p_Deg(set[i],currRing);
4835 if ((op < o)
4836 || ((op == o) && (pLtCmp(set[i],p) == -1)))
4837 an=i;
4838 else
4839 en=i;
4840 }
4841 }
4842 else /*if(pNext(p) != NULL)*/
4843 {
4844 int o = p_Deg(p,currRing);
4845 int op = p_Deg(set[length],currRing);
4846
4847 if ((op < o)
4848 || ((op == o) && (pLtCmp(set[length],p) == -1)))
4849 return length+1;
4850 int i;
4851 int an = 0;
4852 for(i=0;i<=length;i++)
4853 if(set[i] != NULL && pNext(set[i]) == NULL)
4854 an++;
4855 int en= length;
4856 loop
4857 {
4858 if (an >= en-1)
4859 {
4860 op = p_Deg(set[an],currRing);
4861 if ((op < o)
4862 || ((op == o) && (pLtCmp(set[an],p) == -1)))
4863 return en;
4864 return an;
4865 }
4866 i=(an+en) / 2;
4867 op = p_Deg(set[i],currRing);
4868 if ((op < o)
4869 || ((op == o) && (pLtCmp(set[i],p) == -1)))
4870 an=i;
4871 else
4872 en=i;
4873 }
4874 }
4875 }
4876
4877 // sorts by degree and pLtCmp in the block between start,end;
4878 // but puts pure monomials at the beginning
posInIdealMonFirst(const ideal F,const poly p,int start,int end)4879 int posInIdealMonFirst (const ideal F, const poly p,int start,int end)
4880 {
4881 if(end < 0 || end >= IDELEMS(F))
4882 end = IDELEMS(F);
4883 if (end<0) return 0;
4884 if(pNext(p) == NULL) return start;
4885 polyset set=F->m;
4886 int o = p_Deg(p,currRing);
4887 int op;
4888 int i;
4889 int an = start;
4890 for(i=start;i<end;i++)
4891 if(set[i] != NULL && pNext(set[i]) == NULL)
4892 an++;
4893 if(an == end-1)
4894 return end;
4895 int en= end;
4896 loop
4897 {
4898 if(an>=en)
4899 return en;
4900 if (an == en-1)
4901 {
4902 op = p_Deg(set[an],currRing);
4903 if ((op < o)
4904 || ((op == o) && (pLtCmp(set[an],p) == -1)))
4905 return en;
4906 return an;
4907 }
4908 i=(an+en) / 2;
4909 op = p_Deg(set[i],currRing);
4910 if ((op < o)
4911 || ((op == o) && (pLtCmp(set[i],p) == -1)))
4912 an=i;
4913 else
4914 en=i;
4915 }
4916 }
4917
4918
4919 /*2
4920 * looks up the position of p in set
4921 * the position is the last one
4922 */
posInT0(const TSet,const int length,LObject &)4923 int posInT0 (const TSet,const int length,LObject &)
4924 {
4925 return (length+1);
4926 }
4927
4928
4929 /*2
4930 * looks up the position of p in T
4931 * set[0] is the smallest with respect to the ordering-procedure
4932 * pComp
4933 */
posInT1(const TSet set,const int length,LObject & p)4934 int posInT1 (const TSet set,const int length,LObject &p)
4935 {
4936 if (length==-1) return 0;
4937
4938 if (pLmCmp(set[length].p,p.p)!= currRing->OrdSgn) return length+1;
4939
4940 int i;
4941 int an = 0;
4942 int en= length;
4943
4944 loop
4945 {
4946 if (an >= en-1)
4947 {
4948 if (pLmCmp(set[an].p,p.p) == currRing->OrdSgn) return an;
4949 return en;
4950 }
4951 i=(an+en) / 2;
4952 if (pLmCmp(set[i].p,p.p) == currRing->OrdSgn) en=i;
4953 else an=i;
4954 }
4955 }
4956
4957 /*2
4958 * looks up the position of p in T
4959 * set[0] is the smallest with respect to the ordering-procedure
4960 * length
4961 */
posInT2(const TSet set,const int length,LObject & p)4962 int posInT2 (const TSet set,const int length,LObject &p)
4963 {
4964 if (length==-1) return 0;
4965 p.GetpLength();
4966 if (set[length].length<p.length) return length+1;
4967
4968 int i;
4969 int an = 0;
4970 int en= length;
4971
4972 loop
4973 {
4974 if (an >= en-1)
4975 {
4976 if (set[an].length>p.length) return an;
4977 return en;
4978 }
4979 i=(an+en) / 2;
4980 if (set[i].length>p.length) en=i;
4981 else an=i;
4982 }
4983 }
4984
4985 /*2
4986 * looks up the position of p in T
4987 * set[0] is the smallest with respect to the ordering-procedure
4988 * totaldegree,pComp
4989 */
posInT11(const TSet set,const int length,LObject & p)4990 int posInT11 (const TSet set,const int length,LObject &p)
4991 {
4992 if (length==-1) return 0;
4993
4994 int o = p.GetpFDeg();
4995 int op = set[length].GetpFDeg();
4996
4997 if ((op < o)
4998 || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
4999 return length+1;
5000
5001 int i;
5002 int an = 0;
5003 int en= length;
5004
5005 loop
5006 {
5007 if (an >= en-1)
5008 {
5009 op= set[an].GetpFDeg();
5010 if ((op > o)
5011 || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
5012 return an;
5013 return en;
5014 }
5015 i=(an+en) / 2;
5016 op = set[i].GetpFDeg();
5017 if (( op > o)
5018 || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
5019 en=i;
5020 else
5021 an=i;
5022 }
5023 }
5024
5025 #ifdef HAVE_RINGS
posInT11Ring(const TSet set,const int length,LObject & p)5026 int posInT11Ring (const TSet set,const int length,LObject &p)
5027 {
5028 if (length==-1) return 0;
5029
5030 int o = p.GetpFDeg();
5031 int op = set[length].GetpFDeg();
5032
5033 if ((op < o)
5034 || ((op == o) && (pLtCmpOrdSgnDiffP(set[length].p,p.p))))
5035 return length+1;
5036
5037 int i;
5038 int an = 0;
5039 int en= length;
5040
5041 loop
5042 {
5043 if (an >= en-1)
5044 {
5045 op= set[an].GetpFDeg();
5046 if ((op > o)
5047 || (( op == o) && (pLtCmpOrdSgnEqP(set[an].p,p.p))))
5048 return an;
5049 return en;
5050 }
5051 i=(an+en) / 2;
5052 op = set[i].GetpFDeg();
5053 if (( op > o)
5054 || (( op == o) && (pLtCmpOrdSgnEqP(set[i].p,p.p))))
5055 en=i;
5056 else
5057 an=i;
5058 }
5059 }
5060 #endif
5061
5062 /*2 Pos for rings T: Here I am
5063 * looks up the position of p in T
5064 * set[0] is the smallest with respect to the ordering-procedure
5065 * totaldegree,pComp
5066 */
posInTrg0(const TSet set,const int length,LObject & p)5067 int posInTrg0 (const TSet set,const int length,LObject &p)
5068 {
5069 if (length==-1) return 0;
5070 int o = p.GetpFDeg();
5071 int op = set[length].GetpFDeg();
5072 int i;
5073 int an = 0;
5074 int en = length;
5075 int cmp_int = currRing->OrdSgn;
5076 if ((op < o) || (pLmCmp(set[length].p,p.p)== -cmp_int))
5077 return length+1;
5078 int cmp;
5079 loop
5080 {
5081 if (an >= en-1)
5082 {
5083 op = set[an].GetpFDeg();
5084 if (op > o) return an;
5085 if (op < 0) return en;
5086 cmp = pLmCmp(set[an].p,p.p);
5087 if (cmp == cmp_int) return an;
5088 if (cmp == -cmp_int) return en;
5089 if (nGreater(pGetCoeff(p.p), pGetCoeff(set[an].p))) return en;
5090 return an;
5091 }
5092 i = (an + en) / 2;
5093 op = set[i].GetpFDeg();
5094 if (op > o) en = i;
5095 else if (op < o) an = i;
5096 else
5097 {
5098 cmp = pLmCmp(set[i].p,p.p);
5099 if (cmp == cmp_int) en = i;
5100 else if (cmp == -cmp_int) an = i;
5101 else if (nGreater(pGetCoeff(p.p), pGetCoeff(set[i].p))) an = i;
5102 else en = i;
5103 }
5104 }
5105 }
5106 /*
5107 int o = p.GetpFDeg();
5108 int op = set[length].GetpFDeg();
5109
5110 if ((op < o)
5111 || ((op == o) && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
5112 return length+1;
5113
5114 int i;
5115 int an = 0;
5116 int en= length;
5117
5118 loop
5119 {
5120 if (an >= en-1)
5121 {
5122 op= set[an].GetpFDeg();
5123 if ((op > o)
5124 || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
5125 return an;
5126 return en;
5127 }
5128 i=(an+en) / 2;
5129 op = set[i].GetpFDeg();
5130 if (( op > o)
5131 || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
5132 en=i;
5133 else
5134 an=i;
5135 }
5136 }
5137 */
5138 /*2
5139 * looks up the position of p in T
5140 * set[0] is the smallest with respect to the ordering-procedure
5141 * totaldegree,pComp
5142 */
posInT110(const TSet set,const int length,LObject & p)5143 int posInT110 (const TSet set,const int length,LObject &p)
5144 {
5145 if (length==-1) return 0;
5146 p.GetpLength();
5147
5148 int o = p.GetpFDeg();
5149 int op = set[length].GetpFDeg();
5150
5151 if (( op < o)
5152 || (( op == o) && (set[length].length<p.length))
5153 || (( op == o) && (set[length].length == p.length)
5154 && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
5155 return length+1;
5156
5157 int i;
5158 int an = 0;
5159 int en= length;
5160 loop
5161 {
5162 if (an >= en-1)
5163 {
5164 op = set[an].GetpFDeg();
5165 if (( op > o)
5166 || (( op == o) && (set[an].length > p.length))
5167 || (( op == o) && (set[an].length == p.length)
5168 && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
5169 return an;
5170 return en;
5171 }
5172 i=(an+en) / 2;
5173 op = set[i].GetpFDeg();
5174 if (( op > o)
5175 || (( op == o) && (set[i].length > p.length))
5176 || (( op == o) && (set[i].length == p.length)
5177 && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
5178 en=i;
5179 else
5180 an=i;
5181 }
5182 }
5183
5184 #ifdef HAVE_RINGS
posInT110Ring(const TSet set,const int length,LObject & p)5185 int posInT110Ring (const TSet set,const int length,LObject &p)
5186 {
5187 if (length==-1) return 0;
5188 p.GetpLength();
5189
5190 int o = p.GetpFDeg();
5191 int op = set[length].GetpFDeg();
5192
5193 if (( op < o)
5194 || (( op == o) && (set[length].length<p.length))
5195 || (( op == o) && (set[length].length == p.length)
5196 && (pLtCmpOrdSgnDiffP(set[length].p,p.p))))
5197 return length+1;
5198
5199 int i;
5200 int an = 0;
5201 int en= length;
5202 loop
5203 {
5204 if (an >= en-1)
5205 {
5206 op = set[an].GetpFDeg();
5207 if (( op > o)
5208 || (( op == o) && (set[an].length > p.length))
5209 || (( op == o) && (set[an].length == p.length)
5210 && (pLtCmpOrdSgnEqP(set[an].p,p.p))))
5211 return an;
5212 return en;
5213 }
5214 i=(an+en) / 2;
5215 op = set[i].GetpFDeg();
5216 if (( op > o)
5217 || (( op == o) && (set[i].length > p.length))
5218 || (( op == o) && (set[i].length == p.length)
5219 && (pLtCmpOrdSgnEqP(set[i].p,p.p))))
5220 en=i;
5221 else
5222 an=i;
5223 }
5224 }
5225 #endif
5226
5227 /*2
5228 * looks up the position of p in set
5229 * set[0] is the smallest with respect to the ordering-procedure
5230 * pFDeg
5231 */
posInT13(const TSet set,const int length,LObject & p)5232 int posInT13 (const TSet set,const int length,LObject &p)
5233 {
5234 if (length==-1) return 0;
5235
5236 int o = p.GetpFDeg();
5237
5238 if (set[length].GetpFDeg() <= o)
5239 return length+1;
5240
5241 int i;
5242 int an = 0;
5243 int en= length;
5244 loop
5245 {
5246 if (an >= en-1)
5247 {
5248 if (set[an].GetpFDeg() > o)
5249 return an;
5250 return en;
5251 }
5252 i=(an+en) / 2;
5253 if (set[i].GetpFDeg() > o)
5254 en=i;
5255 else
5256 an=i;
5257 }
5258 }
5259
5260 // determines the position based on: 1.) Ecart 2.) pLength
posInT_EcartpLength(const TSet set,const int length,LObject & p)5261 int posInT_EcartpLength(const TSet set,const int length,LObject &p)
5262 {
5263 if (length==-1) return 0;
5264 int ol = p.GetpLength();
5265 int op=p.ecart;
5266 int oo=set[length].ecart;
5267
5268 if ((oo < op) || ((oo==op) && (set[length].length <= ol)))
5269 return length+1;
5270
5271 int i;
5272 int an = 0;
5273 int en= length;
5274 loop
5275 {
5276 if (an >= en-1)
5277 {
5278 int oo=set[an].ecart;
5279 if((oo > op)
5280 || ((oo==op) && (set[an].pLength > ol)))
5281 return an;
5282 return en;
5283 }
5284 i=(an+en) / 2;
5285 int oo=set[i].ecart;
5286 if ((oo > op)
5287 || ((oo == op) && (set[i].pLength > ol)))
5288 en=i;
5289 else
5290 an=i;
5291 }
5292 }
5293
5294 /*2
5295 * looks up the position of p in set
5296 * set[0] is the smallest with respect to the ordering-procedure
5297 * maximaldegree, pComp
5298 */
posInT15(const TSet set,const int length,LObject & p)5299 int posInT15 (const TSet set,const int length,LObject &p)
5300 /*{
5301 *int j=0;
5302 * int o;
5303 *
5304 * o = p.GetpFDeg()+p.ecart;
5305 * loop
5306 * {
5307 * if ((set[j].GetpFDeg()+set[j].ecart > o)
5308 * || ((set[j].GetpFDeg()+set[j].ecart == o)
5309 * && (pLmCmp(set[j].p,p.p) == currRing->OrdSgn)))
5310 * {
5311 * return j;
5312 * }
5313 * j++;
5314 * if (j > length) return j;
5315 * }
5316 *}
5317 */
5318 {
5319 if (length==-1) return 0;
5320
5321 int o = p.GetpFDeg() + p.ecart;
5322 int op = set[length].GetpFDeg()+set[length].ecart;
5323
5324 if ((op < o)
5325 || ((op == o)
5326 && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
5327 return length+1;
5328
5329 int i;
5330 int an = 0;
5331 int en= length;
5332 loop
5333 {
5334 if (an >= en-1)
5335 {
5336 op = set[an].GetpFDeg()+set[an].ecart;
5337 if (( op > o)
5338 || (( op == o) && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
5339 return an;
5340 return en;
5341 }
5342 i=(an+en) / 2;
5343 op = set[i].GetpFDeg()+set[i].ecart;
5344 if (( op > o)
5345 || (( op == o) && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
5346 en=i;
5347 else
5348 an=i;
5349 }
5350 }
5351
5352 #ifdef HAVE_RINGS
posInT15Ring(const TSet set,const int length,LObject & p)5353 int posInT15Ring (const TSet set,const int length,LObject &p)
5354 {
5355 if (length==-1) return 0;
5356
5357 int o = p.GetpFDeg() + p.ecart;
5358 int op = set[length].GetpFDeg()+set[length].ecart;
5359
5360 if ((op < o)
5361 || ((op == o)
5362 && (pLtCmpOrdSgnDiffP(set[length].p,p.p))))
5363 return length+1;
5364
5365 int i;
5366 int an = 0;
5367 int en= length;
5368 loop
5369 {
5370 if (an >= en-1)
5371 {
5372 op = set[an].GetpFDeg()+set[an].ecart;
5373 if (( op > o)
5374 || (( op == o) && (pLtCmpOrdSgnEqP(set[an].p,p.p))))
5375 return an;
5376 return en;
5377 }
5378 i=(an+en) / 2;
5379 op = set[i].GetpFDeg()+set[i].ecart;
5380 if (( op > o)
5381 || (( op == o) && (pLtCmpOrdSgnEqP(set[i].p,p.p))))
5382 en=i;
5383 else
5384 an=i;
5385 }
5386 }
5387 #endif
5388
5389 /*2
5390 * looks up the position of p in set
5391 * set[0] is the smallest with respect to the ordering-procedure
5392 * pFDeg+ecart, ecart, pComp
5393 */
posInT17(const TSet set,const int length,LObject & p)5394 int posInT17 (const TSet set,const int length,LObject &p)
5395 /*
5396 *{
5397 * int j=0;
5398 * int o;
5399 *
5400 * o = p.GetpFDeg()+p.ecart;
5401 * loop
5402 * {
5403 * if ((pFDeg(set[j].p)+set[j].ecart > o)
5404 * || (((pFDeg(set[j].p)+set[j].ecart == o)
5405 * && (set[j].ecart < p.ecart)))
5406 * || ((pFDeg(set[j].p)+set[j].ecart == o)
5407 * && (set[j].ecart==p.ecart)
5408 * && (pLmCmp(set[j].p,p.p)==currRing->OrdSgn)))
5409 * return j;
5410 * j++;
5411 * if (j > length) return j;
5412 * }
5413 * }
5414 */
5415 {
5416 if (length==-1) return 0;
5417
5418 int o = p.GetpFDeg() + p.ecart;
5419 int op = set[length].GetpFDeg()+set[length].ecart;
5420
5421 if ((op < o)
5422 || (( op == o) && (set[length].ecart > p.ecart))
5423 || (( op == o) && (set[length].ecart==p.ecart)
5424 && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
5425 return length+1;
5426
5427 int i;
5428 int an = 0;
5429 int en= length;
5430 loop
5431 {
5432 if (an >= en-1)
5433 {
5434 op = set[an].GetpFDeg()+set[an].ecart;
5435 if (( op > o)
5436 || (( op == o) && (set[an].ecart < p.ecart))
5437 || (( op == o) && (set[an].ecart==p.ecart)
5438 && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
5439 return an;
5440 return en;
5441 }
5442 i=(an+en) / 2;
5443 op = set[i].GetpFDeg()+set[i].ecart;
5444 if ((op > o)
5445 || (( op == o) && (set[i].ecart < p.ecart))
5446 || (( op == o) && (set[i].ecart == p.ecart)
5447 && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
5448 en=i;
5449 else
5450 an=i;
5451 }
5452 }
5453
5454 #ifdef HAVE_RINGS
posInT17Ring(const TSet set,const int length,LObject & p)5455 int posInT17Ring (const TSet set,const int length,LObject &p)
5456 {
5457 if (length==-1) return 0;
5458
5459 int o = p.GetpFDeg() + p.ecart;
5460 int op = set[length].GetpFDeg()+set[length].ecart;
5461
5462 if ((op < o)
5463 || (( op == o) && (set[length].ecart > p.ecart))
5464 || (( op == o) && (set[length].ecart==p.ecart)
5465 && (pLtCmpOrdSgnDiffP(set[length].p,p.p))))
5466 return length+1;
5467
5468 int i;
5469 int an = 0;
5470 int en= length;
5471 loop
5472 {
5473 if (an >= en-1)
5474 {
5475 op = set[an].GetpFDeg()+set[an].ecart;
5476 if (( op > o)
5477 || (( op == o) && (set[an].ecart < p.ecart))
5478 || (( op == o) && (set[an].ecart==p.ecart)
5479 && (pLtCmpOrdSgnEqP(set[an].p,p.p))))
5480 return an;
5481 return en;
5482 }
5483 i=(an+en) / 2;
5484 op = set[i].GetpFDeg()+set[i].ecart;
5485 if ((op > o)
5486 || (( op == o) && (set[i].ecart < p.ecart))
5487 || (( op == o) && (set[i].ecart == p.ecart)
5488 && (pLtCmpOrdSgnEqP(set[i].p,p.p))))
5489 en=i;
5490 else
5491 an=i;
5492 }
5493 }
5494 #endif
5495
5496 /*2
5497 * looks up the position of p in set
5498 * set[0] is the smallest with respect to the ordering-procedure
5499 * pGetComp, pFDeg+ecart, ecart, pComp
5500 */
posInT17_c(const TSet set,const int length,LObject & p)5501 int posInT17_c (const TSet set,const int length,LObject &p)
5502 {
5503 if (length==-1) return 0;
5504
5505 int cc = (-1+2*currRing->order[0]==ringorder_c);
5506 /* cc==1 for (c,..), cc==-1 for (C,..) */
5507 int o = p.GetpFDeg() + p.ecart;
5508 int c = pGetComp(p.p)*cc;
5509
5510 if (pGetComp(set[length].p)*cc < c)
5511 return length+1;
5512 if (pGetComp(set[length].p)*cc == c)
5513 {
5514 int op = set[length].GetpFDeg()+set[length].ecart;
5515 if ((op < o)
5516 || ((op == o) && (set[length].ecart > p.ecart))
5517 || ((op == o) && (set[length].ecart==p.ecart)
5518 && (pLmCmp(set[length].p,p.p) != currRing->OrdSgn)))
5519 return length+1;
5520 }
5521
5522 int i;
5523 int an = 0;
5524 int en= length;
5525 loop
5526 {
5527 if (an >= en-1)
5528 {
5529 if (pGetComp(set[an].p)*cc < c)
5530 return en;
5531 if (pGetComp(set[an].p)*cc == c)
5532 {
5533 int op = set[an].GetpFDeg()+set[an].ecart;
5534 if ((op > o)
5535 || ((op == o) && (set[an].ecart < p.ecart))
5536 || ((op == o) && (set[an].ecart==p.ecart)
5537 && (pLmCmp(set[an].p,p.p) == currRing->OrdSgn)))
5538 return an;
5539 }
5540 return en;
5541 }
5542 i=(an+en) / 2;
5543 if (pGetComp(set[i].p)*cc > c)
5544 en=i;
5545 else if (pGetComp(set[i].p)*cc == c)
5546 {
5547 int op = set[i].GetpFDeg()+set[i].ecart;
5548 if ((op > o)
5549 || ((op == o) && (set[i].ecart < p.ecart))
5550 || ((op == o) && (set[i].ecart == p.ecart)
5551 && (pLmCmp(set[i].p,p.p) == currRing->OrdSgn)))
5552 en=i;
5553 else
5554 an=i;
5555 }
5556 else
5557 an=i;
5558 }
5559 }
5560
5561 #ifdef HAVE_RINGS
posInT17_cRing(const TSet set,const int length,LObject & p)5562 int posInT17_cRing (const TSet set,const int length,LObject &p)
5563 {
5564 if (length==-1) return 0;
5565
5566 int cc = (-1+2*currRing->order[0]==ringorder_c);
5567 /* cc==1 for (c,..), cc==-1 for (C,..) */
5568 int o = p.GetpFDeg() + p.ecart;
5569 int c = pGetComp(p.p)*cc;
5570
5571 if (pGetComp(set[length].p)*cc < c)
5572 return length+1;
5573 if (pGetComp(set[length].p)*cc == c)
5574 {
5575 int op = set[length].GetpFDeg()+set[length].ecart;
5576 if ((op < o)
5577 || ((op == o) && (set[length].ecart > p.ecart))
5578 || ((op == o) && (set[length].ecart==p.ecart)
5579 && (pLtCmpOrdSgnDiffP(set[length].p,p.p))))
5580 return length+1;
5581 }
5582
5583 int i;
5584 int an = 0;
5585 int en= length;
5586 loop
5587 {
5588 if (an >= en-1)
5589 {
5590 if (pGetComp(set[an].p)*cc < c)
5591 return en;
5592 if (pGetComp(set[an].p)*cc == c)
5593 {
5594 int op = set[an].GetpFDeg()+set[an].ecart;
5595 if ((op > o)
5596 || ((op == o) && (set[an].ecart < p.ecart))
5597 || ((op == o) && (set[an].ecart==p.ecart)
5598 && (pLtCmpOrdSgnEqP(set[an].p,p.p))))
5599 return an;
5600 }
5601 return en;
5602 }
5603 i=(an+en) / 2;
5604 if (pGetComp(set[i].p)*cc > c)
5605 en=i;
5606 else if (pGetComp(set[i].p)*cc == c)
5607 {
5608 int op = set[i].GetpFDeg()+set[i].ecart;
5609 if ((op > o)
5610 || ((op == o) && (set[i].ecart < p.ecart))
5611 || ((op == o) && (set[i].ecart == p.ecart)
5612 && (pLtCmpOrdSgnEqP(set[i].p,p.p))))
5613 en=i;
5614 else
5615 an=i;
5616 }
5617 else
5618 an=i;
5619 }
5620 }
5621 #endif
5622
5623 /*2
5624 * looks up the position of p in set
5625 * set[0] is the smallest with respect to
5626 * ecart, pFDeg, length
5627 */
posInT19(const TSet set,const int length,LObject & p)5628 int posInT19 (const TSet set,const int length,LObject &p)
5629 {
5630 p.GetpLength();
5631 if (length==-1) return 0;
5632
5633 int o = p.ecart;
5634 int op=p.GetpFDeg();
5635
5636 if (set[length].ecart < o)
5637 return length+1;
5638 if (set[length].ecart == o)
5639 {
5640 int oo=set[length].GetpFDeg();
5641 if ((oo < op) || ((oo==op) && (set[length].length < p.length)))
5642 return length+1;
5643 }
5644
5645 int i;
5646 int an = 0;
5647 int en= length;
5648 loop
5649 {
5650 if (an >= en-1)
5651 {
5652 if (set[an].ecart > o)
5653 return an;
5654 if (set[an].ecart == o)
5655 {
5656 int oo=set[an].GetpFDeg();
5657 if((oo > op)
5658 || ((oo==op) && (set[an].length > p.length)))
5659 return an;
5660 }
5661 return en;
5662 }
5663 i=(an+en) / 2;
5664 if (set[i].ecart > o)
5665 en=i;
5666 else if (set[i].ecart == o)
5667 {
5668 int oo=set[i].GetpFDeg();
5669 if ((oo > op)
5670 || ((oo == op) && (set[i].length > p.length)))
5671 en=i;
5672 else
5673 an=i;
5674 }
5675 else
5676 an=i;
5677 }
5678 }
5679
5680 /*2
5681 *looks up the position of polynomial p in set
5682 *set[length] is the smallest element in set with respect
5683 *to the ordering-procedure pComp
5684 */
posInLSpecial(const LSet set,const int length,LObject * p,const kStrategy)5685 int posInLSpecial (const LSet set, const int length,
5686 LObject *p,const kStrategy)
5687 {
5688 if (length<0) return 0;
5689
5690 int d=p->GetpFDeg();
5691 int op=set[length].GetpFDeg();
5692
5693 if ((op > d)
5694 || ((op == d) && (p->p1!=NULL)&&(set[length].p1==NULL))
5695 || (pLmCmp(set[length].p,p->p)== currRing->OrdSgn))
5696 return length+1;
5697
5698 int i;
5699 int an = 0;
5700 int en= length;
5701 loop
5702 {
5703 if (an >= en-1)
5704 {
5705 op=set[an].GetpFDeg();
5706 if ((op > d)
5707 || ((op == d) && (p->p1!=NULL) && (set[an].p1==NULL))
5708 || (pLmCmp(set[an].p,p->p)== currRing->OrdSgn))
5709 return en;
5710 return an;
5711 }
5712 i=(an+en) / 2;
5713 op=set[i].GetpFDeg();
5714 if ((op>d)
5715 || ((op==d) && (p->p1!=NULL) && (set[i].p1==NULL))
5716 || (pLmCmp(set[i].p,p->p) == currRing->OrdSgn))
5717 an=i;
5718 else
5719 en=i;
5720 }
5721 }
5722
5723 /*2
5724 *looks up the position of polynomial p in set
5725 *set[length] is the smallest element in set with respect
5726 *to the ordering-procedure pComp
5727 */
posInL0(const LSet set,const int length,LObject * p,const kStrategy)5728 int posInL0 (const LSet set, const int length,
5729 LObject* p,const kStrategy)
5730 {
5731 if (length<0) return 0;
5732
5733 if (pLmCmp(set[length].p,p->p)== currRing->OrdSgn)
5734 return length+1;
5735
5736 int i;
5737 int an = 0;
5738 int en= length;
5739 loop
5740 {
5741 if (an >= en-1)
5742 {
5743 if (pLmCmp(set[an].p,p->p) == currRing->OrdSgn) return en;
5744 return an;
5745 }
5746 i=(an+en) / 2;
5747 if (pLmCmp(set[i].p,p->p) == currRing->OrdSgn) an=i;
5748 else en=i;
5749 /*aend. fuer lazy == in !=- machen */
5750 }
5751 }
5752
5753 #ifdef HAVE_RINGS
posInL0Ring(const LSet set,const int length,LObject * p,const kStrategy)5754 int posInL0Ring (const LSet set, const int length,
5755 LObject* p,const kStrategy)
5756 {
5757 if (length<0) return 0;
5758
5759 if (pLtCmpOrdSgnEqP(set[length].p,p->p))
5760 return length+1;
5761
5762 int i;
5763 int an = 0;
5764 int en= length;
5765 loop
5766 {
5767 if (an >= en-1)
5768 {
5769 if (pLtCmpOrdSgnEqP(set[an].p,p->p)) return en;
5770 return an;
5771 }
5772 i=(an+en) / 2;
5773 if (pLtCmpOrdSgnEqP(set[i].p,p->p)) an=i;
5774 else en=i;
5775 /*aend. fuer lazy == in !=- machen */
5776 }
5777 }
5778 #endif
5779
5780 /*2
5781 * looks up the position of polynomial p in set
5782 * e is the ecart of p
5783 * set[length] is the smallest element in set with respect
5784 * to the signature order
5785 */
posInLSig(const LSet set,const int length,LObject * p,const kStrategy)5786 int posInLSig (const LSet set, const int length,
5787 LObject* p,const kStrategy /*strat*/)
5788 {
5789 if (length<0) return 0;
5790 if (pLtCmp(set[length].sig,p->sig)== currRing->OrdSgn)
5791 return length+1;
5792
5793 int i;
5794 int an = 0;
5795 int en= length;
5796 loop
5797 {
5798 if (an >= en-1)
5799 {
5800 if (pLtCmp(set[an].sig,p->sig) == currRing->OrdSgn) return en;
5801 return an;
5802 }
5803 i=(an+en) / 2;
5804 if (pLtCmp(set[i].sig,p->sig) == currRing->OrdSgn) an=i;
5805 else en=i;
5806 /*aend. fuer lazy == in !=- machen */
5807 }
5808 }
5809 //sorts the pair list in this order: pLtCmp on the sigs, FDeg, pLtCmp on the polys
posInLSigRing(const LSet set,const int length,LObject * p,const kStrategy)5810 int posInLSigRing (const LSet set, const int length,
5811 LObject* p,const kStrategy /*strat*/)
5812 {
5813 assume(currRing->OrdSgn == 1 && rField_is_Ring(currRing));
5814 if (length<0) return 0;
5815 if (pLtCmp(set[length].sig,p->sig)== 1)
5816 return length+1;
5817
5818 int an,en,i;
5819 an = 0;
5820 en = length+1;
5821 int cmp;
5822 loop
5823 {
5824 if (an >= en-1)
5825 {
5826 if(an == en)
5827 return en;
5828 cmp = pLtCmp(set[an].sig,p->sig);
5829 if (cmp == 1)
5830 return en;
5831 if (cmp == -1)
5832 return an;
5833 if (cmp == 0)
5834 {
5835 if (set[an].FDeg > p->FDeg)
5836 return en;
5837 if (set[an].FDeg < p->FDeg)
5838 return an;
5839 if (set[an].FDeg == p->FDeg)
5840 {
5841 cmp = pLtCmp(set[an].p,p->p);
5842 if(cmp == 1)
5843 return en;
5844 else
5845 return an;
5846 }
5847 }
5848 }
5849 i=(an+en) / 2;
5850 cmp = pLtCmp(set[i].sig,p->sig);
5851 if (cmp == 1)
5852 an = i;
5853 if (cmp == -1)
5854 en = i;
5855 if (cmp == 0)
5856 {
5857 if (set[i].FDeg > p->FDeg)
5858 an = i;
5859 if (set[i].FDeg < p->FDeg)
5860 en = i;
5861 if (set[i].FDeg == p->FDeg)
5862 {
5863 cmp = pLtCmp(set[i].p,p->p);
5864 if(cmp == 1)
5865 an = i;
5866 else
5867 en = i;
5868 }
5869 }
5870 }
5871 }
5872
posInLRing(const LSet set,const int length,LObject * p,const kStrategy)5873 int posInLRing (const LSet set, const int length,
5874 LObject* p,const kStrategy /*strat*/)
5875 {
5876 if (length < 0) return 0;
5877 if (set[length].FDeg > p->FDeg)
5878 return length+1;
5879 if (set[length].FDeg == p->FDeg)
5880 if(set[length].GetpLength() > p->GetpLength())
5881 return length+1;
5882 int i;
5883 int an = 0;
5884 int en= length+1;
5885 loop
5886 {
5887 if (an >= en-1)
5888 {
5889 if(an == en)
5890 return en;
5891 if (set[an].FDeg > p->FDeg)
5892 return en;
5893 if(set[an].FDeg == p->FDeg)
5894 {
5895 if(set[an].GetpLength() > p->GetpLength())
5896 return en;
5897 else
5898 {
5899 if(set[an].GetpLength() == p->GetpLength())
5900 {
5901 if(nGreater(set[an].p->coef, p->p->coef))
5902 return en;
5903 else
5904 return an;
5905 }
5906 else
5907 {
5908 return an;
5909 }
5910 }
5911 }
5912 else
5913 return an;
5914 }
5915 i=(an+en) / 2;
5916 if (set[i].FDeg > p->FDeg)
5917 an=i;
5918 else
5919 {
5920 if(set[i].FDeg == p->FDeg)
5921 {
5922 if(set[i].GetpLength() > p->GetpLength())
5923 an=i;
5924 else
5925 {
5926 if(set[i].GetpLength() == p->GetpLength())
5927 {
5928 if(nGreater(set[i].p->coef, p->p->coef))
5929 an = i;
5930 else
5931 en = i;
5932 }
5933 else
5934 {
5935 en=i;
5936 }
5937 }
5938 }
5939 else
5940 en=i;
5941 }
5942 }
5943 }
5944
5945 // for sba, sorting syzygies
posInSyz(const kStrategy strat,poly sig)5946 int posInSyz (const kStrategy strat, poly sig)
5947 {
5948 if (strat->syzl==0) return 0;
5949 if (pLtCmp(strat->syz[strat->syzl-1],sig) != currRing->OrdSgn)
5950 return strat->syzl;
5951 int i;
5952 int an = 0;
5953 int en= strat->syzl-1;
5954 loop
5955 {
5956 if (an >= en-1)
5957 {
5958 if (pLtCmp(strat->syz[an],sig) != currRing->OrdSgn) return en;
5959 return an;
5960 }
5961 i=(an+en) / 2;
5962 if (pLtCmp(strat->syz[i],sig) != currRing->OrdSgn) an=i;
5963 else en=i;
5964 /*aend. fuer lazy == in !=- machen */
5965 }
5966 }
5967
5968 /*2
5969 *
5970 * is only used in F5C, must ensure that the interreduction process does add new
5971 * critical pairs to strat->L only behind all other critical pairs which are
5972 * still in strat->L!
5973 */
posInLF5C(const LSet,const int,LObject *,const kStrategy strat)5974 int posInLF5C (const LSet /*set*/, const int /*length*/,
5975 LObject* /*p*/,const kStrategy strat)
5976 {
5977 return strat->Ll+1;
5978 }
5979
5980 /*2
5981 * looks up the position of polynomial p in set
5982 * e is the ecart of p
5983 * set[length] is the smallest element in set with respect
5984 * to the ordering-procedure totaldegree,pComp
5985 */
posInL11(const LSet set,const int length,LObject * p,const kStrategy)5986 int posInL11 (const LSet set, const int length,
5987 LObject* p,const kStrategy)
5988 {
5989 if (length<0) return 0;
5990
5991 int o = p->GetpFDeg();
5992 int op = set[length].GetpFDeg();
5993
5994 if ((op > o)
5995 || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
5996 return length+1;
5997 int i;
5998 int an = 0;
5999 int en= length;
6000 loop
6001 {
6002 if (an >= en-1)
6003 {
6004 op = set[an].GetpFDeg();
6005 if ((op > o)
6006 || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
6007 return en;
6008 return an;
6009 }
6010 i=(an+en) / 2;
6011 op = set[i].GetpFDeg();
6012 if ((op > o)
6013 || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
6014 an=i;
6015 else
6016 en=i;
6017 }
6018 }
6019
6020 #ifdef HAVE_RINGS
6021 /*2
6022 * looks up the position of polynomial p in set
6023 * set[length] is the smallest element in set with respect
6024 * to the ordering-procedure pLmCmp,totaldegree,coefficient
6025 * For the same totaldegree, original pairs (from F) will
6026 * be put at the end and smalles coefficents
6027 */
posInL11Ring(const LSet set,const int length,LObject * p,const kStrategy)6028 int posInL11Ring (const LSet set, const int length,
6029 LObject* p,const kStrategy)
6030 {
6031 if (length<0) return 0;
6032
6033 int o = p->GetpFDeg();
6034 int op = set[length].GetpFDeg();
6035
6036 if ((op > o)
6037 || ((op == o) && (pLtCmpOrdSgnDiffM(set[length].p,p->p))))
6038 return length+1;
6039 int i;
6040 int an = 0;
6041 int en= length;
6042 loop
6043 {
6044 if (an >= en-1)
6045 {
6046 op = set[an].GetpFDeg();
6047 if ((op > o)
6048 || ((op == o) && (pLtCmpOrdSgnDiffM(set[an].p,p->p))))
6049 return en;
6050 return an;
6051 }
6052 i=(an+en) / 2;
6053 op = set[i].GetpFDeg();
6054 if ((op > o)
6055 || ((op == o) && (pLtCmpOrdSgnDiffM(set[i].p,p->p))))
6056 an=i;
6057 else
6058 en=i;
6059 }
6060 }
6061
posInLF5CRing(const LSet set,int start,const int length,LObject * p,const kStrategy)6062 int posInLF5CRing (const LSet set, int start,const int length,
6063 LObject* p,const kStrategy)
6064 {
6065 if (length<0) return 0;
6066 if(start == (length +1)) return (length+1);
6067 int o = p->GetpFDeg();
6068 int op = set[length].GetpFDeg();
6069
6070 if ((op > o)
6071 || ((op == o) && (pLtCmpOrdSgnDiffM(set[length].p,p->p))))
6072 return length+1;
6073 int i;
6074 int an = start;
6075 int en= length;
6076 loop
6077 {
6078 if (an >= en-1)
6079 {
6080 op = set[an].GetpFDeg();
6081 if ((op > o)
6082 || ((op == o) && (pLtCmpOrdSgnDiffM(set[an].p,p->p))))
6083 return en;
6084 return an;
6085 }
6086 i=(an+en) / 2;
6087 op = set[i].GetpFDeg();
6088 if ((op > o)
6089 || ((op == o) && (pLtCmpOrdSgnDiffM(set[i].p,p->p))))
6090 an=i;
6091 else
6092 en=i;
6093 }
6094 }
6095 #endif
6096
6097 #ifdef HAVE_RINGS
posInL11Ringls(const LSet set,const int length,LObject * p,const kStrategy)6098 int posInL11Ringls (const LSet set, const int length,
6099 LObject* p,const kStrategy)
6100 {
6101 if (length < 0) return 0;
6102 int an,en,i;
6103 an = 0;
6104 en = length+1;
6105 loop
6106 {
6107 if (an >= en-1)
6108 {
6109 if(an == en)
6110 return en;
6111 if (set[an].FDeg > p->FDeg)
6112 return en;
6113 if (set[an].FDeg < p->FDeg)
6114 return an;
6115 if (set[an].FDeg == p->FDeg)
6116 {
6117 number lcset,lcp;
6118 lcset = pGetCoeff(set[an].p);
6119 lcp = pGetCoeff(p->p);
6120 if(!nGreaterZero(lcset))
6121 {
6122 set[an].p=p_Neg(set[an].p,currRing);
6123 if (set[an].t_p!=NULL)
6124 pSetCoeff0(set[an].t_p,pGetCoeff(set[an].p));
6125 lcset=pGetCoeff(set[an].p);
6126 }
6127 if(!nGreaterZero(lcp))
6128 {
6129 p->p=p_Neg(p->p,currRing);
6130 if (p->t_p!=NULL)
6131 pSetCoeff0(p->t_p,pGetCoeff(p->p));
6132 lcp=pGetCoeff(p->p);
6133 }
6134 if(nGreater(lcset, lcp))
6135 {
6136 return en;
6137 }
6138 else
6139 {
6140 return an;
6141 }
6142 }
6143 }
6144 i=(an+en) / 2;
6145 if (set[i].FDeg > p->FDeg)
6146 an=i;
6147 if (set[i].FDeg < p->FDeg)
6148 en=i;
6149 if (set[i].FDeg == p->FDeg)
6150 {
6151 number lcset,lcp;
6152 lcset = pGetCoeff(set[i].p);
6153 lcp = pGetCoeff(p->p);
6154 if(!nGreaterZero(lcset))
6155 {
6156 set[i].p=p_Neg(set[i].p,currRing);
6157 if (set[i].t_p!=NULL)
6158 pSetCoeff0(set[i].t_p,pGetCoeff(set[i].p));
6159 lcset=pGetCoeff(set[i].p);
6160 }
6161 if(!nGreaterZero(lcp))
6162 {
6163 p->p=p_Neg(p->p,currRing);
6164 if (p->t_p!=NULL)
6165 pSetCoeff0(p->t_p,pGetCoeff(p->p));
6166 lcp=pGetCoeff(p->p);
6167 }
6168 if(nGreater(lcset, lcp))
6169 {
6170 an = i;
6171 }
6172 else
6173 {
6174 en = i;
6175 }
6176 }
6177 }
6178 }
6179 #endif
6180
6181 /*2 Position for rings L: Here I am
6182 * looks up the position of polynomial p in set
6183 * e is the ecart of p
6184 * set[length] is the smallest element in set with respect
6185 * to the ordering-procedure totaldegree,pComp
6186 */
getIndexRng(long coeff)6187 inline int getIndexRng(long coeff)
6188 {
6189 if (coeff == 0) return -1;
6190 long tmp = coeff;
6191 int ind = 0;
6192 while (tmp % 2 == 0)
6193 {
6194 tmp = tmp / 2;
6195 ind++;
6196 }
6197 return ind;
6198 }
6199
posInLrg0(const LSet set,const int length,LObject * p,const kStrategy)6200 int posInLrg0 (const LSet set, const int length,
6201 LObject* p,const kStrategy)
6202 /* if (nGreater(pGetCoeff(p), pGetCoeff(set[an]))) return en;
6203 if (pLmCmp(set[i],p) == cmp_int) en = i;
6204 else if (pLmCmp(set[i],p) == -cmp_int) an = i;
6205 else
6206 {
6207 if (nGreater(pGetCoeff(p), pGetCoeff(set[i]))) an = i;
6208 else en = i;
6209 }*/
6210 {
6211 if (length < 0) return 0;
6212
6213 int o = p->GetpFDeg();
6214 int op = set[length].GetpFDeg();
6215
6216 if ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
6217 return length + 1;
6218 int i;
6219 int an = 0;
6220 int en = length;
6221 loop
6222 {
6223 if (an >= en - 1)
6224 {
6225 op = set[an].GetpFDeg();
6226 if ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
6227 return en;
6228 return an;
6229 }
6230 i = (an+en) / 2;
6231 op = set[i].GetpFDeg();
6232 if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
6233 an = i;
6234 else
6235 en = i;
6236 }
6237 }
6238
6239 /*{
6240 if (length < 0) return 0;
6241
6242 int o = p->GetpFDeg();
6243 int op = set[length].GetpFDeg();
6244
6245 int inde = getIndexRng((unsigned long) pGetCoeff(set[length].p));
6246 int indp = getIndexRng((unsigned long) pGetCoeff(p->p));
6247 int inda;
6248 int indi;
6249
6250 if ((inda > indp) || ((inda == inde) && ((op > o) || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))))
6251 return length + 1;
6252 int i;
6253 int an = 0;
6254 inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
6255 int en = length;
6256 loop
6257 {
6258 if (an >= en-1)
6259 {
6260 op = set[an].GetpFDeg();
6261 if ((indp > inda) || ((indp == inda) && ((op > o) || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))))
6262 return en;
6263 return an;
6264 }
6265 i = (an + en) / 2;
6266 indi = getIndexRng((unsigned long) pGetCoeff(set[i].p));
6267 op = set[i].GetpFDeg();
6268 if ((indi > indp) || ((indi == indp) && ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))))
6269 // if ((op > o) || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
6270 {
6271 an = i;
6272 inda = getIndexRng((unsigned long) pGetCoeff(set[an].p));
6273 }
6274 else
6275 en = i;
6276 }
6277 } */
6278
6279 /*2
6280 * looks up the position of polynomial p in set
6281 * set[length] is the smallest element in set with respect
6282 * to the ordering-procedure totaldegree,pLength0
6283 */
posInL110(const LSet set,const int length,LObject * p,const kStrategy)6284 int posInL110 (const LSet set, const int length,
6285 LObject* p,const kStrategy)
6286 {
6287 if (length<0) return 0;
6288
6289 int o = p->GetpFDeg();
6290 int op = set[length].GetpFDeg();
6291
6292 if ((op > o)
6293 || ((op == o) && (set[length].length >p->length))
6294 || ((op == o) && (set[length].length <= p->length)
6295 && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
6296 return length+1;
6297 int i;
6298 int an = 0;
6299 int en= length;
6300 loop
6301 {
6302 if (an >= en-1)
6303 {
6304 op = set[an].GetpFDeg();
6305 if ((op > o)
6306 || ((op == o) && (set[an].length >p->length))
6307 || ((op == o) && (set[an].length <=p->length)
6308 && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
6309 return en;
6310 return an;
6311 }
6312 i=(an+en) / 2;
6313 op = set[i].GetpFDeg();
6314 if ((op > o)
6315 || ((op == o) && (set[i].length > p->length))
6316 || ((op == o) && (set[i].length <= p->length)
6317 && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
6318 an=i;
6319 else
6320 en=i;
6321 }
6322 }
6323
6324 #ifdef HAVE_RINGS
posInL110Ring(const LSet set,const int length,LObject * p,const kStrategy)6325 int posInL110Ring (const LSet set, const int length,
6326 LObject* p,const kStrategy)
6327 {
6328 if (length<0) return 0;
6329
6330 int o = p->GetpFDeg();
6331 int op = set[length].GetpFDeg();
6332
6333 if ((op > o)
6334 || ((op == o) && (set[length].length >p->length))
6335 || ((op == o) && (set[length].length <= p->length)
6336 && (pLtCmpOrdSgnDiffM(set[length].p,p->p))))
6337 return length+1;
6338 int i;
6339 int an = 0;
6340 int en= length;
6341 loop
6342 {
6343 if (an >= en-1)
6344 {
6345 op = set[an].GetpFDeg();
6346 if ((op > o)
6347 || ((op == o) && (set[an].length >p->length))
6348 || ((op == o) && (set[an].length <=p->length)
6349 && (pLtCmpOrdSgnDiffM(set[an].p,p->p))))
6350 return en;
6351 return an;
6352 }
6353 i=(an+en) / 2;
6354 op = set[i].GetpFDeg();
6355 if ((op > o)
6356 || ((op == o) && (set[i].length > p->length))
6357 || ((op == o) && (set[i].length <= p->length)
6358 && (pLtCmpOrdSgnDiffM(set[i].p,p->p))))
6359 an=i;
6360 else
6361 en=i;
6362 }
6363 }
6364 #endif
6365
6366 /*2
6367 * looks up the position of polynomial p in set
6368 * e is the ecart of p
6369 * set[length] is the smallest element in set with respect
6370 * to the ordering-procedure totaldegree
6371 */
posInL13(const LSet set,const int length,LObject * p,const kStrategy)6372 int posInL13 (const LSet set, const int length,
6373 LObject* p,const kStrategy)
6374 {
6375 if (length<0) return 0;
6376
6377 int o = p->GetpFDeg();
6378
6379 if (set[length].GetpFDeg() > o)
6380 return length+1;
6381
6382 int i;
6383 int an = 0;
6384 int en= length;
6385 loop
6386 {
6387 if (an >= en-1)
6388 {
6389 if (set[an].GetpFDeg() >= o)
6390 return en;
6391 return an;
6392 }
6393 i=(an+en) / 2;
6394 if (set[i].GetpFDeg() >= o)
6395 an=i;
6396 else
6397 en=i;
6398 }
6399 }
6400
6401 /*2
6402 * looks up the position of polynomial p in set
6403 * e is the ecart of p
6404 * set[length] is the smallest element in set with respect
6405 * to the ordering-procedure maximaldegree,pComp
6406 */
posInL15(const LSet set,const int length,LObject * p,const kStrategy)6407 int posInL15 (const LSet set, const int length,
6408 LObject* p,const kStrategy)
6409 {
6410 if (length<0) return 0;
6411
6412 int o = p->GetpFDeg() + p->ecart;
6413 int op = set[length].GetpFDeg() + set[length].ecart;
6414
6415 if ((op > o)
6416 || ((op == o) && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
6417 return length+1;
6418 int i;
6419 int an = 0;
6420 int en= length;
6421 loop
6422 {
6423 if (an >= en-1)
6424 {
6425 op = set[an].GetpFDeg() + set[an].ecart;
6426 if ((op > o)
6427 || ((op == o) && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
6428 return en;
6429 return an;
6430 }
6431 i=(an+en) / 2;
6432 op = set[i].GetpFDeg() + set[i].ecart;
6433 if ((op > o)
6434 || ((op == o) && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
6435 an=i;
6436 else
6437 en=i;
6438 }
6439 }
6440
6441 #ifdef HAVE_RINGS
posInL15Ring(const LSet set,const int length,LObject * p,const kStrategy)6442 int posInL15Ring (const LSet set, const int length,
6443 LObject* p,const kStrategy)
6444 {
6445 if (length<0) return 0;
6446
6447 int o = p->GetpFDeg() + p->ecart;
6448 int op = set[length].GetpFDeg() + set[length].ecart;
6449
6450 if ((op > o)
6451 || ((op == o) && (pLtCmpOrdSgnDiffM(set[length].p,p->p))))
6452 return length+1;
6453 int i;
6454 int an = 0;
6455 int en= length;
6456 loop
6457 {
6458 if (an >= en-1)
6459 {
6460 op = set[an].GetpFDeg() + set[an].ecart;
6461 if ((op > o)
6462 || ((op == o) && (pLtCmpOrdSgnDiffM(set[an].p,p->p))))
6463 return en;
6464 return an;
6465 }
6466 i=(an+en) / 2;
6467 op = set[i].GetpFDeg() + set[i].ecart;
6468 if ((op > o)
6469 || ((op == o) && (pLtCmpOrdSgnDiffM(set[i].p,p->p))))
6470 an=i;
6471 else
6472 en=i;
6473 }
6474 }
6475 #endif
6476
6477 /*2
6478 * looks up the position of polynomial p in set
6479 * e is the ecart of p
6480 * set[length] is the smallest element in set with respect
6481 * to the ordering-procedure totaldegree
6482 */
posInL17(const LSet set,const int length,LObject * p,const kStrategy)6483 int posInL17 (const LSet set, const int length,
6484 LObject* p,const kStrategy)
6485 {
6486 if (length<0) return 0;
6487
6488 int o = p->GetpFDeg() + p->ecart;
6489
6490 if ((set[length].GetpFDeg() + set[length].ecart > o)
6491 || ((set[length].GetpFDeg() + set[length].ecart == o)
6492 && (set[length].ecart > p->ecart))
6493 || ((set[length].GetpFDeg() + set[length].ecart == o)
6494 && (set[length].ecart == p->ecart)
6495 && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
6496 return length+1;
6497 int i;
6498 int an = 0;
6499 int en= length;
6500 loop
6501 {
6502 if (an >= en-1)
6503 {
6504 if ((set[an].GetpFDeg() + set[an].ecart > o)
6505 || ((set[an].GetpFDeg() + set[an].ecart == o)
6506 && (set[an].ecart > p->ecart))
6507 || ((set[an].GetpFDeg() + set[an].ecart == o)
6508 && (set[an].ecart == p->ecart)
6509 && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
6510 return en;
6511 return an;
6512 }
6513 i=(an+en) / 2;
6514 if ((set[i].GetpFDeg() + set[i].ecart > o)
6515 || ((set[i].GetpFDeg() + set[i].ecart == o)
6516 && (set[i].ecart > p->ecart))
6517 || ((set[i].GetpFDeg() +set[i].ecart == o)
6518 && (set[i].ecart == p->ecart)
6519 && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
6520 an=i;
6521 else
6522 en=i;
6523 }
6524 }
6525
6526 #ifdef HAVE_RINGS
posInL17Ring(const LSet set,const int length,LObject * p,const kStrategy)6527 int posInL17Ring (const LSet set, const int length,
6528 LObject* p,const kStrategy)
6529 {
6530 if (length<0) return 0;
6531
6532 int o = p->GetpFDeg() + p->ecart;
6533
6534 if ((set[length].GetpFDeg() + set[length].ecart > o)
6535 || ((set[length].GetpFDeg() + set[length].ecart == o)
6536 && (set[length].ecart > p->ecart))
6537 || ((set[length].GetpFDeg() + set[length].ecart == o)
6538 && (set[length].ecart == p->ecart)
6539 && (pLtCmpOrdSgnDiffM(set[length].p,p->p))))
6540 return length+1;
6541 int i;
6542 int an = 0;
6543 int en= length;
6544 loop
6545 {
6546 if (an >= en-1)
6547 {
6548 if ((set[an].GetpFDeg() + set[an].ecart > o)
6549 || ((set[an].GetpFDeg() + set[an].ecart == o)
6550 && (set[an].ecart > p->ecart))
6551 || ((set[an].GetpFDeg() + set[an].ecart == o)
6552 && (set[an].ecart == p->ecart)
6553 && (pLtCmpOrdSgnDiffM(set[an].p,p->p))))
6554 return en;
6555 return an;
6556 }
6557 i=(an+en) / 2;
6558 if ((set[i].GetpFDeg() + set[i].ecart > o)
6559 || ((set[i].GetpFDeg() + set[i].ecart == o)
6560 && (set[i].ecart > p->ecart))
6561 || ((set[i].GetpFDeg() +set[i].ecart == o)
6562 && (set[i].ecart == p->ecart)
6563 && (pLtCmpOrdSgnDiffM(set[i].p,p->p))))
6564 an=i;
6565 else
6566 en=i;
6567 }
6568 }
6569 #endif
6570
6571 /*2
6572 * looks up the position of polynomial p in set
6573 * e is the ecart of p
6574 * set[length] is the smallest element in set with respect
6575 * to the ordering-procedure pComp
6576 */
posInL17_c(const LSet set,const int length,LObject * p,const kStrategy)6577 int posInL17_c (const LSet set, const int length,
6578 LObject* p,const kStrategy)
6579 {
6580 if (length<0) return 0;
6581
6582 int cc = (-1+2*currRing->order[0]==ringorder_c);
6583 /* cc==1 for (c,..), cc==-1 for (C,..) */
6584 long c = pGetComp(p->p)*cc;
6585 int o = p->GetpFDeg() + p->ecart;
6586
6587 if (pGetComp(set[length].p)*cc > c)
6588 return length+1;
6589 if (pGetComp(set[length].p)*cc == c)
6590 {
6591 if ((set[length].GetpFDeg() + set[length].ecart > o)
6592 || ((set[length].GetpFDeg() + set[length].ecart == o)
6593 && (set[length].ecart > p->ecart))
6594 || ((set[length].GetpFDeg() + set[length].ecart == o)
6595 && (set[length].ecart == p->ecart)
6596 && (pLmCmp(set[length].p,p->p) != -currRing->OrdSgn)))
6597 return length+1;
6598 }
6599 int i;
6600 int an = 0;
6601 int en= length;
6602 loop
6603 {
6604 if (an >= en-1)
6605 {
6606 if (pGetComp(set[an].p)*cc > c)
6607 return en;
6608 if (pGetComp(set[an].p)*cc == c)
6609 {
6610 if ((set[an].GetpFDeg() + set[an].ecart > o)
6611 || ((set[an].GetpFDeg() + set[an].ecart == o)
6612 && (set[an].ecart > p->ecart))
6613 || ((set[an].GetpFDeg() + set[an].ecart == o)
6614 && (set[an].ecart == p->ecart)
6615 && (pLmCmp(set[an].p,p->p) != -currRing->OrdSgn)))
6616 return en;
6617 }
6618 return an;
6619 }
6620 i=(an+en) / 2;
6621 if (pGetComp(set[i].p)*cc > c)
6622 an=i;
6623 else if (pGetComp(set[i].p)*cc == c)
6624 {
6625 if ((set[i].GetpFDeg() + set[i].ecart > o)
6626 || ((set[i].GetpFDeg() + set[i].ecart == o)
6627 && (set[i].ecart > p->ecart))
6628 || ((set[i].GetpFDeg() +set[i].ecart == o)
6629 && (set[i].ecart == p->ecart)
6630 && (pLmCmp(set[i].p,p->p) != -currRing->OrdSgn)))
6631 an=i;
6632 else
6633 en=i;
6634 }
6635 else
6636 en=i;
6637 }
6638 }
6639
6640 #ifdef HAVE_RINGS
posInL17_cRing(const LSet set,const int length,LObject * p,const kStrategy)6641 int posInL17_cRing (const LSet set, const int length,
6642 LObject* p,const kStrategy)
6643 {
6644 if (length<0) return 0;
6645
6646 int cc = (-1+2*currRing->order[0]==ringorder_c);
6647 /* cc==1 for (c,..), cc==-1 for (C,..) */
6648 unsigned long c = pGetComp(p->p)*cc;
6649 int o = p->GetpFDeg() + p->ecart;
6650
6651 if (pGetComp(set[length].p)*cc > c)
6652 return length+1;
6653 if (pGetComp(set[length].p)*cc == c)
6654 {
6655 if ((set[length].GetpFDeg() + set[length].ecart > o)
6656 || ((set[length].GetpFDeg() + set[length].ecart == o)
6657 && (set[length].ecart > p->ecart))
6658 || ((set[length].GetpFDeg() + set[length].ecart == o)
6659 && (set[length].ecart == p->ecart)
6660 && (pLtCmpOrdSgnDiffM(set[length].p,p->p))))
6661 return length+1;
6662 }
6663 int i;
6664 int an = 0;
6665 int en= length;
6666 loop
6667 {
6668 if (an >= en-1)
6669 {
6670 if (pGetComp(set[an].p)*cc > c)
6671 return en;
6672 if (pGetComp(set[an].p)*cc == c)
6673 {
6674 if ((set[an].GetpFDeg() + set[an].ecart > o)
6675 || ((set[an].GetpFDeg() + set[an].ecart == o)
6676 && (set[an].ecart > p->ecart))
6677 || ((set[an].GetpFDeg() + set[an].ecart == o)
6678 && (set[an].ecart == p->ecart)
6679 && (pLtCmpOrdSgnDiffM(set[an].p,p->p))))
6680 return en;
6681 }
6682 return an;
6683 }
6684 i=(an+en) / 2;
6685 if (pGetComp(set[i].p)*cc > c)
6686 an=i;
6687 else if (pGetComp(set[i].p)*cc == c)
6688 {
6689 if ((set[i].GetpFDeg() + set[i].ecart > o)
6690 || ((set[i].GetpFDeg() + set[i].ecart == o)
6691 && (set[i].ecart > p->ecart))
6692 || ((set[i].GetpFDeg() +set[i].ecart == o)
6693 && (set[i].ecart == p->ecart)
6694 && (pLtCmpOrdSgnDiffM(set[i].p,p->p))))
6695 an=i;
6696 else
6697 en=i;
6698 }
6699 else
6700 en=i;
6701 }
6702 }
6703 #endif
6704
6705 /*
6706 * SYZYGY CRITERION for signature-based standard basis algorithms
6707 */
syzCriterion(poly sig,unsigned long not_sevSig,kStrategy strat)6708 BOOLEAN syzCriterion(poly sig, unsigned long not_sevSig, kStrategy strat)
6709 {
6710 //#if 1
6711 #ifdef DEBUGF5
6712 PrintS("syzygy criterion checks: ");
6713 pWrite(sig);
6714 #endif
6715 for (int k=0; k<strat->syzl; k++)
6716 {
6717 //printf("-%d",k);
6718 //#if 1
6719 #ifdef DEBUGF5
6720 Print("checking with: %d / %d -- \n",k,strat->syzl);
6721 pWrite(pHead(strat->syz[k]));
6722 #endif
6723 if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing)
6724 && (!rField_is_Ring(currRing) ||
6725 (n_DivBy(pGetCoeff(sig), pGetCoeff(strat->syz[k]),currRing->cf) && pLtCmp(sig,strat->syz[k]) == 1)))
6726 {
6727 //#if 1
6728 #ifdef DEBUGF5
6729 PrintS("DELETE!\n");
6730 #endif
6731 strat->nrsyzcrit++;
6732 //printf("- T -\n\n");
6733 return TRUE;
6734 }
6735 }
6736 //printf("- F -\n\n");
6737 return FALSE;
6738 }
6739
6740 /*
6741 * SYZYGY CRITERION for signature-based standard basis algorithms
6742 */
syzCriterionInc(poly sig,unsigned long not_sevSig,kStrategy strat)6743 BOOLEAN syzCriterionInc(poly sig, unsigned long not_sevSig, kStrategy strat)
6744 {
6745 //#if 1
6746 if(sig == NULL)
6747 return FALSE;
6748 #ifdef DEBUGF5
6749 PrintS("--- syzygy criterion checks: ");
6750 pWrite(sig);
6751 #endif
6752 int comp = __p_GetComp(sig, currRing);
6753 int min, max;
6754 if (comp<=1)
6755 return FALSE;
6756 else
6757 {
6758 min = strat->syzIdx[comp-2];
6759 //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-2],comp-2);
6760 //printf("SYZIDX %d/%d\n",strat->syzIdx[comp-1],comp-1);
6761 //printf("SYZIDX %d/%d\n",strat->syzIdx[comp],comp);
6762 if (comp == strat->currIdx)
6763 {
6764 max = strat->syzl;
6765 }
6766 else
6767 {
6768 max = strat->syzIdx[comp-1];
6769 }
6770 for (int k=min; k<max; k++)
6771 {
6772 #ifdef F5DEBUG
6773 Print("COMP %d/%d - MIN %d - MAX %d - SYZL %ld\n",comp,strat->currIdx,min,max,strat->syzl);
6774 Print("checking with: %d -- ",k);
6775 pWrite(pHead(strat->syz[k]));
6776 #endif
6777 if (p_LmShortDivisibleBy(strat->syz[k], strat->sevSyz[k], sig, not_sevSig, currRing)
6778 && (!rField_is_Ring(currRing) ||
6779 (n_DivBy(pGetCoeff(sig), pGetCoeff(strat->syz[k]),currRing->cf) && pLtCmp(sig,strat->syz[k]) == 1)))
6780 {
6781 strat->nrsyzcrit++;
6782 return TRUE;
6783 }
6784 }
6785 return FALSE;
6786 }
6787 }
6788
6789 /*
6790 * REWRITTEN CRITERION for signature-based standard basis algorithms
6791 */
faugereRewCriterion(poly sig,unsigned long not_sevSig,poly,kStrategy strat,int start=0)6792 BOOLEAN faugereRewCriterion(poly sig, unsigned long not_sevSig, poly /*lm*/, kStrategy strat, int start=0)
6793 {
6794 //printf("Faugere Rewritten Criterion\n");
6795 if(rField_is_Ring(currRing))
6796 return FALSE;
6797 //#if 1
6798 #ifdef DEBUGF5
6799 PrintS("rewritten criterion checks: ");
6800 pWrite(sig);
6801 #endif
6802 for(int k = strat->sl; k>=start; k--)
6803 {
6804 //#if 1
6805 #ifdef DEBUGF5
6806 PrintS("checking with: ");
6807 pWrite(strat->sig[k]);
6808 pWrite(pHead(strat->S[k]));
6809 #endif
6810 if (p_LmShortDivisibleBy(strat->sig[k], strat->sevSig[k], sig, not_sevSig, currRing))
6811 {
6812 //#if 1
6813 #ifdef DEBUGF5
6814 PrintS("DELETE!\n");
6815 #endif
6816 strat->nrrewcrit++;
6817 return TRUE;
6818 }
6819 //k--;
6820 }
6821 #ifdef DEBUGF5
6822 PrintS("ALL ELEMENTS OF S\n----------------------------------------\n");
6823 for(int kk = 0; kk<strat->sl+1; kk++)
6824 {
6825 pWrite(pHead(strat->S[kk]));
6826 }
6827 PrintS("------------------------------\n");
6828 #endif
6829 return FALSE;
6830 }
6831
6832 /*
6833 * REWRITTEN CRITERION for signature-based standard basis algorithms
6834 ***************************************************************************
6835 * TODO:This should become the version of Arri/Perry resp. Bjarke/Stillman *
6836 ***************************************************************************
6837 */
6838
6839 // real implementation of arri's rewritten criterion, only called once in
6840 // kstd2.cc, right before starting reduction
6841 // IDEA: Arri says that it is enough to consider 1 polynomial for each unique
6842 // signature appearing during the computations. Thus we first of all go
6843 // through strat->L and delete all other pairs of the same signature,
6844 // keeping only the one with least possible leading monomial. After this
6845 // we check if we really need to compute this critical pair at all: There
6846 // can be elements already in strat->S whose signatures divide the
6847 // signature of the critical pair in question and whose multiplied
6848 // leading monomials are smaller than the leading monomial of the
6849 // critical pair. In this situation we can discard the critical pair
6850 // completely.
arriRewCriterion(poly,unsigned long,poly,kStrategy strat,int start=0)6851 BOOLEAN arriRewCriterion(poly /*sig*/, unsigned long /*not_sevSig*/, poly /*lm*/, kStrategy strat, int start=0)
6852 {
6853 if(rField_is_Ring(currRing))
6854 return FALSE;
6855 poly p1 = pOne();
6856 poly p2 = pOne();
6857 for (int ii=strat->sl; ii>start; ii--)
6858 {
6859 if (p_LmShortDivisibleBy(strat->sig[ii], strat->sevSig[ii], strat->P.sig, ~strat->P.sevSig, currRing))
6860 {
6861 p_ExpVectorSum(p1,strat->P.sig,strat->S[ii],currRing);
6862 p_ExpVectorSum(p2,strat->sig[ii],strat->P.p,currRing);
6863 if (!(pLmCmp(p1,p2) == 1))
6864 {
6865 pDelete(&p1);
6866 pDelete(&p2);
6867 return TRUE;
6868 }
6869 }
6870 }
6871 pDelete(&p1);
6872 pDelete(&p2);
6873 return FALSE;
6874 }
6875
arriRewCriterionPre(poly sig,unsigned long not_sevSig,poly lm,kStrategy strat,int)6876 BOOLEAN arriRewCriterionPre(poly sig, unsigned long not_sevSig, poly lm, kStrategy strat, int /*start=0*/)
6877 {
6878 //Over Rings, there are still some changes to do: considering coeffs
6879 if(rField_is_Ring(currRing))
6880 return FALSE;
6881 int found = -1;
6882 for (int i=strat->Bl; i>-1; i--)
6883 {
6884 if (pLmEqual(strat->B[i].sig,sig))
6885 {
6886 found = i;
6887 break;
6888 }
6889 }
6890 if (found != -1)
6891 {
6892 if (pLmCmp(lm,strat->B[found].GetLmCurrRing()) == -1)
6893 {
6894 deleteInL(strat->B,&strat->Bl,found,strat);
6895 }
6896 else
6897 {
6898 return TRUE;
6899 }
6900 }
6901 poly p1 = pOne();
6902 poly p2 = pOne();
6903 for (int ii=strat->sl; ii>-1; ii--)
6904 {
6905 if (p_LmShortDivisibleBy(strat->sig[ii], strat->sevSig[ii], sig, not_sevSig, currRing))
6906 {
6907 p_ExpVectorSum(p1,sig,strat->S[ii],currRing);
6908 p_ExpVectorSum(p2,strat->sig[ii],lm,currRing);
6909 if (!(pLmCmp(p1,p2) == 1))
6910 {
6911 pDelete(&p1);
6912 pDelete(&p2);
6913 return TRUE;
6914 }
6915 }
6916 }
6917 pDelete(&p1);
6918 pDelete(&p2);
6919 return FALSE;
6920 }
6921
6922 /***************************************************************
6923 *
6924 * Tail reductions
6925 *
6926 ***************************************************************/
kFindDivisibleByInS_T(kStrategy strat,int end_pos,LObject * L,TObject * T,long ecart)6927 TObject* kFindDivisibleByInS_T(kStrategy strat, int end_pos, LObject* L, TObject *T, long ecart)
6928 {
6929 int j = 0;
6930 const unsigned long not_sev = ~L->sev;
6931 const unsigned long* sev = strat->sevS;
6932 poly p;
6933 ring r;
6934 L->GetLm(p, r);
6935
6936 assume(~not_sev == p_GetShortExpVector(p, r));
6937
6938 if (r == currRing)
6939 {
6940 if(!rField_is_Ring(r))
6941 {
6942 loop
6943 {
6944 if (j > end_pos) return NULL;
6945 #if defined(PDEBUG) || defined(PDIV_DEBUG)
6946 if (strat->S[j]!= NULL && p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
6947 (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
6948 {
6949 break;
6950 }
6951 #else
6952 if (!(sev[j] & not_sev) &&
6953 (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
6954 p_LmDivisibleBy(strat->S[j], p, r))
6955 {
6956 break;
6957 }
6958 #endif
6959 j++;
6960 }
6961 }
6962 #ifdef HAVE_RINGS
6963 else
6964 {
6965 loop
6966 {
6967 if (j > end_pos) return NULL;
6968 #if defined(PDEBUG) || defined(PDIV_DEBUG)
6969 if (strat->S[j]!= NULL && p_LmShortDivisibleBy(strat->S[j], sev[j], p, not_sev, r) &&
6970 (ecart== LONG_MAX || ecart>= strat->ecartS[j]) && n_DivBy(pGetCoeff(p), pGetCoeff(strat->S[j]), r->cf))
6971 {
6972 break;
6973 }
6974 #else
6975 if (!(sev[j] & not_sev) &&
6976 (ecart== LONG_MAX || ecart>= strat->ecartS[j]) &&
6977 p_LmDivisibleBy(strat->S[j], p, r) && n_DivBy(pGetCoeff(p), pGetCoeff(strat->S[j]), r->cf))
6978 {
6979 break;
6980 }
6981 #endif
6982 j++;
6983 }
6984 }
6985 #endif
6986 // if called from NF, T objects do not exist:
6987 if (strat->tl < 0 || strat->S_2_R[j] == -1)
6988 {
6989 T->Set(strat->S[j], r, strat->tailRing);
6990 assume(T->GetpLength()==pLength(T->p != __null ? T->p : T->t_p));
6991 return T;
6992 }
6993 else
6994 {
6995 ///// assume (j >= 0 && j <= strat->tl && strat->S_2_T(j) != NULL
6996 ///// && strat->S_2_T(j)->p == strat->S[j]); // wrong?
6997 // assume (j >= 0 && j <= strat->sl && strat->S_2_T(j) != NULL && strat->S_2_T(j)->p == strat->S[j]);
6998 return strat->S_2_T(j);
6999 }
7000 }
7001 else
7002 {
7003 TObject* t;
7004 if(!rField_is_Ring(r))
7005 {
7006 loop
7007 {
7008 if (j > end_pos) return NULL;
7009 assume(strat->S_2_R[j] != -1);
7010 #if defined(PDEBUG) || defined(PDIV_DEBUG)
7011 t = strat->S_2_T(j);
7012 assume(t != NULL && t->t_p != NULL && t->tailRing == r);
7013 if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
7014 (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
7015 {
7016 t->pLength=pLength(t->t_p);
7017 return t;
7018 }
7019 #else
7020 if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
7021 {
7022 t = strat->S_2_T(j);
7023 assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
7024 if (p_LmDivisibleBy(t->t_p, p, r))
7025 {
7026 t->pLength=pLength(t->t_p);
7027 return t;
7028 }
7029 }
7030 #endif
7031 j++;
7032 }
7033 }
7034 #ifdef HAVE_RINGS
7035 else
7036 {
7037 loop
7038 {
7039 if (j > end_pos) return NULL;
7040 assume(strat->S_2_R[j] != -1);
7041 #if defined(PDEBUG) || defined(PDIV_DEBUG)
7042 t = strat->S_2_T(j);
7043 assume(t != NULL && t->t_p != NULL && t->tailRing == r);
7044 if (p_LmShortDivisibleBy(t->t_p, sev[j], p, not_sev, r) &&
7045 (ecart== LONG_MAX || ecart>= strat->ecartS[j]) && n_DivBy(pGetCoeff(p), pGetCoeff(t->t_p), r->cf))
7046 {
7047 t->pLength=pLength(t->t_p);
7048 return t;
7049 }
7050 #else
7051 if (! (sev[j] & not_sev) && (ecart== LONG_MAX || ecart>= strat->ecartS[j]))
7052 {
7053 t = strat->S_2_T(j);
7054 assume(t != NULL && t->t_p != NULL && t->tailRing == r && t->p == strat->S[j]);
7055 if (p_LmDivisibleBy(t->t_p, p, r) && n_DivBy(pGetCoeff(p), pGetCoeff(t->t_p), r->cf))
7056 {
7057 t->pLength=pLength(t->t_p);
7058 return t;
7059 }
7060 }
7061 #endif
7062 j++;
7063 }
7064 }
7065 #endif
7066 }
7067 }
7068
redtail(LObject * L,int end_pos,kStrategy strat)7069 poly redtail (LObject* L, int end_pos, kStrategy strat)
7070 {
7071 poly h, hn;
7072 strat->redTailChange=FALSE;
7073
7074 L->GetP();
7075 poly p = L->p;
7076 if (strat->noTailReduction || pNext(p) == NULL)
7077 return p;
7078
7079 LObject Ln(strat->tailRing);
7080 TObject* With;
7081 // placeholder in case strat->tl < 0
7082 TObject With_s(strat->tailRing);
7083 h = p;
7084 hn = pNext(h);
7085 long op = strat->tailRing->pFDeg(hn, strat->tailRing);
7086 long e;
7087 int l;
7088 BOOLEAN save_HE=strat->kHEdgeFound;
7089 strat->kHEdgeFound |=
7090 ((Kstd1_deg>0) && (op<=Kstd1_deg)) || TEST_OPT_INFREDTAIL;
7091
7092 while(hn != NULL)
7093 {
7094 op = strat->tailRing->pFDeg(hn, strat->tailRing);
7095 if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
7096 e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
7097 loop
7098 {
7099 Ln.Set(hn, strat->tailRing);
7100 Ln.sev = p_GetShortExpVector(hn, strat->tailRing);
7101 if (strat->kHEdgeFound)
7102 With = kFindDivisibleByInS_T(strat, end_pos, &Ln, &With_s);
7103 else
7104 With = kFindDivisibleByInS_T(strat, end_pos, &Ln, &With_s, e);
7105 if (With == NULL) break;
7106 With->length=0;
7107 With->pLength=0;
7108 strat->redTailChange=TRUE;
7109 if (ksReducePolyTail(L, With, h, strat->kNoetherTail()))
7110 {
7111 // reducing the tail would violate the exp bound
7112 if (kStratChangeTailRing(strat, L))
7113 {
7114 strat->kHEdgeFound = save_HE;
7115 return redtail(L, end_pos, strat);
7116 }
7117 else
7118 return NULL;
7119 }
7120 hn = pNext(h);
7121 if (hn == NULL) goto all_done;
7122 op = strat->tailRing->pFDeg(hn, strat->tailRing);
7123 if ((Kstd1_deg>0)&&(op>Kstd1_deg)) goto all_done;
7124 e = strat->tailRing->pLDeg(hn, &l, strat->tailRing) - op;
7125 }
7126 h = hn;
7127 hn = pNext(h);
7128 }
7129
7130 all_done:
7131 if (strat->redTailChange)
7132 {
7133 L->pLength = 0;
7134 }
7135 strat->kHEdgeFound = save_HE;
7136 return p;
7137 }
7138
redtail(poly p,int end_pos,kStrategy strat)7139 poly redtail (poly p, int end_pos, kStrategy strat)
7140 {
7141 LObject L(p, currRing);
7142 return redtail(&L, end_pos, strat);
7143 }
7144
redtailBba(LObject * L,int end_pos,kStrategy strat,BOOLEAN withT,BOOLEAN normalize)7145 poly redtailBba (LObject* L, int end_pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
7146 {
7147 strat->redTailChange=FALSE;
7148 if (strat->noTailReduction) return L->GetLmCurrRing();
7149 poly h, p;
7150 p = h = L->GetLmTailRing();
7151 if ((h==NULL) || (pNext(h)==NULL))
7152 return L->GetLmCurrRing();
7153
7154 TObject* With;
7155 // placeholder in case strat->tl < 0
7156 TObject With_s(strat->tailRing);
7157
7158 LObject Ln(pNext(h), strat->tailRing);
7159 Ln.GetpLength();
7160
7161 pNext(h) = NULL;
7162 if (L->p != NULL)
7163 {
7164 pNext(L->p) = NULL;
7165 if (L->t_p != NULL) pNext(L->t_p) = NULL;
7166 }
7167 L->pLength = 1;
7168
7169 Ln.PrepareRed(strat->use_buckets);
7170
7171 int cnt=REDTAIL_CANONICALIZE;
7172 while(!Ln.IsNull())
7173 {
7174 loop
7175 {
7176 if (TEST_OPT_IDLIFT)
7177 {
7178 if (Ln.p!=NULL)
7179 {
7180 if (__p_GetComp(Ln.p,currRing)> strat->syzComp) break;
7181 }
7182 else
7183 {
7184 if (__p_GetComp(Ln.t_p,strat->tailRing)> strat->syzComp) break;
7185 }
7186 }
7187 Ln.SetShortExpVector();
7188 if (withT)
7189 {
7190 int j;
7191 j = kFindDivisibleByInT(strat, &Ln);
7192 if (j < 0) break;
7193 With = &(strat->T[j]);
7194 assume(With->GetpLength()==pLength(With->p != __null ? With->p : With->t_p));
7195 }
7196 else
7197 {
7198 With = kFindDivisibleByInS_T(strat, end_pos, &Ln, &With_s);
7199 if (With == NULL) break;
7200 assume(With->GetpLength()==pLength(With->p != __null ? With->p : With->t_p));
7201 }
7202 cnt--;
7203 if (cnt==0)
7204 {
7205 cnt=REDTAIL_CANONICALIZE;
7206 /*poly tmp=*/Ln.CanonicalizeP();
7207 if (normalize)
7208 {
7209 Ln.Normalize();
7210 //pNormalize(tmp);
7211 //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
7212 }
7213 }
7214 if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
7215 {
7216 With->pNorm();
7217 }
7218 strat->redTailChange=TRUE;
7219 if (ksReducePolyTail(L, With, &Ln))
7220 {
7221 // reducing the tail would violate the exp bound
7222 // set a flag and hope for a retry (in bba)
7223 strat->completeReduce_retry=TRUE;
7224 if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
7225 do
7226 {
7227 pNext(h) = Ln.LmExtractAndIter();
7228 pIter(h);
7229 L->pLength++;
7230 } while (!Ln.IsNull());
7231 goto all_done;
7232 }
7233 if (Ln.IsNull()) goto all_done;
7234 if (! withT) With_s.Init(currRing);
7235 }
7236 pNext(h) = Ln.LmExtractAndIter();
7237 pIter(h);
7238 pNormalize(h);
7239 L->pLength++;
7240 }
7241
7242 all_done:
7243 Ln.Delete();
7244 if (L->p != NULL) pNext(L->p) = pNext(p);
7245
7246 if (strat->redTailChange)
7247 {
7248 L->length = 0;
7249 L->pLength = 0;
7250 }
7251
7252 //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
7253 //L->Normalize(); // HANNES: should have a test
7254 kTest_L(L,strat->tailRing);
7255 return L->GetLmCurrRing();
7256 }
7257
redtailBbaBound(LObject * L,int end_pos,kStrategy strat,int bound,BOOLEAN withT,BOOLEAN normalize)7258 poly redtailBbaBound (LObject* L, int end_pos, kStrategy strat, int bound, BOOLEAN withT, BOOLEAN normalize)
7259 {
7260 strat->redTailChange=FALSE;
7261 if (strat->noTailReduction) return L->GetLmCurrRing();
7262 poly h, p;
7263 p = h = L->GetLmTailRing();
7264 if ((h==NULL) || (pNext(h)==NULL))
7265 return L->GetLmCurrRing();
7266
7267 TObject* With;
7268 // placeholder in case strat->tl < 0
7269 TObject With_s(strat->tailRing);
7270
7271 LObject Ln(pNext(h), strat->tailRing);
7272 Ln.pLength = L->GetpLength() - 1;
7273
7274 pNext(h) = NULL;
7275 if (L->p != NULL) pNext(L->p) = NULL;
7276 L->pLength = 1;
7277
7278 Ln.PrepareRed(strat->use_buckets);
7279
7280 int cnt=REDTAIL_CANONICALIZE;
7281 while(!Ln.IsNull())
7282 {
7283 loop
7284 {
7285 if (TEST_OPT_IDLIFT)
7286 {
7287 if (Ln.p!=NULL)
7288 {
7289 if (__p_GetComp(Ln.p,currRing)> strat->syzComp) break;
7290 }
7291 else
7292 {
7293 if (__p_GetComp(Ln.t_p,strat->tailRing)> strat->syzComp) break;
7294 }
7295 }
7296 Ln.SetShortExpVector();
7297 if (withT)
7298 {
7299 int j;
7300 j = kFindDivisibleByInT(strat, &Ln);
7301 if (j < 0) break;
7302 With = &(strat->T[j]);
7303 }
7304 else
7305 {
7306 With = kFindDivisibleByInS_T(strat, end_pos, &Ln, &With_s);
7307 if (With == NULL) break;
7308 }
7309 cnt--;
7310 if (cnt==0)
7311 {
7312 cnt=REDTAIL_CANONICALIZE;
7313 /*poly tmp=*/Ln.CanonicalizeP();
7314 if (normalize)
7315 {
7316 Ln.Normalize();
7317 //pNormalize(tmp);
7318 //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
7319 }
7320 }
7321 if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
7322 {
7323 With->pNorm();
7324 }
7325 strat->redTailChange=TRUE;
7326 if (ksReducePolyTail(L, With, &Ln))
7327 {
7328 // reducing the tail would violate the exp bound
7329 // set a flag and hope for a retry (in bba)
7330 strat->completeReduce_retry=TRUE;
7331 if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
7332 do
7333 {
7334 pNext(h) = Ln.LmExtractAndIter();
7335 pIter(h);
7336 L->pLength++;
7337 } while (!Ln.IsNull());
7338 goto all_done;
7339 }
7340 if(!Ln.IsNull())
7341 {
7342 Ln.GetP();
7343 Ln.p = pJet(Ln.p,bound);
7344 }
7345 if (Ln.IsNull())
7346 {
7347 goto all_done;
7348 }
7349 if (! withT) With_s.Init(currRing);
7350 }
7351 pNext(h) = Ln.LmExtractAndIter();
7352 pIter(h);
7353 pNormalize(h);
7354 L->pLength++;
7355 }
7356
7357 all_done:
7358 Ln.Delete();
7359 if (L->p != NULL) pNext(L->p) = pNext(p);
7360
7361 if (strat->redTailChange)
7362 {
7363 L->length = 0;
7364 L->pLength = 0;
7365 }
7366
7367 //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
7368 //L->Normalize(); // HANNES: should have a test
7369 kTest_L(L,strat->tailRing);
7370 return L->GetLmCurrRing();
7371 }
7372
7373 #ifdef HAVE_RINGS
redtailBbaAlsoLC_Z(LObject * L,int end_pos,kStrategy strat)7374 void redtailBbaAlsoLC_Z (LObject* L, int end_pos, kStrategy strat )
7375 // normalize=FALSE, withT=FALSE, coeff=Z
7376 {
7377 strat->redTailChange=FALSE;
7378
7379 poly h, p;
7380 p = h = L->GetLmTailRing();
7381 if ((h==NULL) || (pNext(h)==NULL))
7382 return;
7383
7384 TObject* With;
7385 LObject Ln(pNext(h), strat->tailRing);
7386 Ln.GetpLength();
7387
7388 pNext(h) = NULL;
7389 if (L->p != NULL)
7390 {
7391 pNext(L->p) = NULL;
7392 if (L->t_p != NULL) pNext(L->t_p) = NULL;
7393 }
7394 L->pLength = 1;
7395
7396 Ln.PrepareRed(strat->use_buckets);
7397
7398 int cnt=REDTAIL_CANONICALIZE;
7399
7400 while(!Ln.IsNull())
7401 {
7402 loop
7403 {
7404 if (TEST_OPT_IDLIFT)
7405 {
7406 if (Ln.p!=NULL)
7407 {
7408 if (__p_GetComp(Ln.p,currRing)> strat->syzComp) break;
7409 }
7410 else
7411 {
7412 if (__p_GetComp(Ln.t_p,strat->tailRing)> strat->syzComp) break;
7413 }
7414 }
7415 Ln.SetShortExpVector();
7416 int j;
7417 j = kFindDivisibleByInT(strat, &Ln);
7418 if (j < 0)
7419 {
7420 j = kFindDivisibleByInT_Z(strat, &Ln);
7421 if (j < 0)
7422 {
7423 break;
7424 }
7425 else
7426 {
7427 /* reduction not cancelling a tail term, but reducing its coefficient */
7428 With = &(strat->T[j]);
7429 assume(With->GetpLength()==pLength(With->p != __null ? With->p : With->t_p));
7430 cnt--;
7431 if (cnt==0)
7432 {
7433 cnt=REDTAIL_CANONICALIZE;
7434 /*poly tmp=*/Ln.CanonicalizeP();
7435 }
7436 strat->redTailChange=TRUE;
7437 /* reduction cancelling a tail term */
7438 if (ksReducePolyTailLC_Z(L, With, &Ln))
7439 {
7440 // reducing the tail would violate the exp bound
7441 // set a flag and hope for a retry (in bba)
7442 strat->completeReduce_retry=TRUE;
7443 if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
7444 do
7445 {
7446 pNext(h) = Ln.LmExtractAndIter();
7447 pIter(h);
7448 L->pLength++;
7449 } while (!Ln.IsNull());
7450 goto all_done;
7451 }
7452 /* we have to break since we did not cancel the term, but only decreased
7453 * its coefficient. */
7454 break;
7455 }
7456 } else {
7457 With = &(strat->T[j]);
7458 assume(With->GetpLength()==pLength(With->p != __null ? With->p : With->t_p));
7459 cnt--;
7460 if (cnt==0)
7461 {
7462 cnt=REDTAIL_CANONICALIZE;
7463 /*poly tmp=*/Ln.CanonicalizeP();
7464 }
7465 strat->redTailChange=TRUE;
7466 /* reduction cancelling a tail term */
7467 if (ksReducePolyTail_Z(L, With, &Ln))
7468 {
7469 // reducing the tail would violate the exp bound
7470 // set a flag and hope for a retry (in bba)
7471 strat->completeReduce_retry=TRUE;
7472 if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
7473 do
7474 {
7475 pNext(h) = Ln.LmExtractAndIter();
7476 pIter(h);
7477 L->pLength++;
7478 } while (!Ln.IsNull());
7479 goto all_done;
7480 }
7481 }
7482 if (Ln.IsNull()) goto all_done;
7483 }
7484 pNext(h) = Ln.LmExtractAndIter();
7485 pIter(h);
7486 L->pLength++;
7487 }
7488
7489 all_done:
7490 Ln.Delete();
7491 if (L->p != NULL) pNext(L->p) = pNext(p);
7492
7493 if (strat->redTailChange)
7494 {
7495 L->length = 0;
7496 L->pLength = 0;
7497 }
7498
7499 kTest_L(L, strat->tailRing);
7500 return;
7501 }
7502
redtailBba_Z(LObject * L,int end_pos,kStrategy strat)7503 poly redtailBba_Z (LObject* L, int end_pos, kStrategy strat )
7504 // normalize=FALSE, withT=FALSE, coeff=Z
7505 {
7506 strat->redTailChange=FALSE;
7507 if (strat->noTailReduction) return L->GetLmCurrRing();
7508 poly h, p;
7509 p = h = L->GetLmTailRing();
7510 if ((h==NULL) || (pNext(h)==NULL))
7511 return L->GetLmCurrRing();
7512
7513 TObject* With;
7514 // placeholder in case strat->tl < 0
7515 TObject With_s(strat->tailRing);
7516
7517 LObject Ln(pNext(h), strat->tailRing);
7518 Ln.pLength = L->GetpLength() - 1;
7519
7520 pNext(h) = NULL;
7521 if (L->p != NULL) pNext(L->p) = NULL;
7522 L->pLength = 1;
7523
7524 Ln.PrepareRed(strat->use_buckets);
7525
7526 int cnt=REDTAIL_CANONICALIZE;
7527 while(!Ln.IsNull())
7528 {
7529 loop
7530 {
7531 Ln.SetShortExpVector();
7532 With = kFindDivisibleByInS_T(strat, end_pos, &Ln, &With_s);
7533 if (With == NULL) break;
7534 cnt--;
7535 if (cnt==0)
7536 {
7537 cnt=REDTAIL_CANONICALIZE;
7538 /*poly tmp=*/Ln.CanonicalizeP();
7539 }
7540 // we are in Z, do not call pNorm
7541 strat->redTailChange=TRUE;
7542 // test divisibility of coefs:
7543 poly p_Ln=Ln.GetLmCurrRing();
7544 poly p_With=With->GetLmCurrRing();
7545 number z=n_IntMod(pGetCoeff(p_Ln),pGetCoeff(p_With), currRing->cf);
7546 if (!nIsZero(z))
7547 {
7548 // subtract z*Ln, add z.Ln to L
7549 poly m=pHead(p_Ln);
7550 pSetCoeff(m,z);
7551 poly mm=pHead(m);
7552 pNext(h) = m;
7553 pIter(h);
7554 L->pLength++;
7555 mm=pNeg(mm);
7556 if (Ln.bucket!=NULL)
7557 {
7558 int dummy=1;
7559 kBucket_Add_q(Ln.bucket,mm,&dummy);
7560 }
7561 else
7562 {
7563 if ((Ln.t_p!=NULL)&&(Ln.p==NULL))
7564 Ln.GetP();
7565 if (Ln.p!=NULL)
7566 {
7567 Ln.p=pAdd(Ln.p,mm);
7568 if (Ln.t_p!=NULL)
7569 {
7570 pNext(Ln.t_p)=NULL;
7571 p_LmDelete(Ln.t_p,strat->tailRing);
7572 }
7573 }
7574 }
7575 }
7576 else
7577 nDelete(&z);
7578
7579 if (ksReducePolyTail_Z(L, With, &Ln))
7580 {
7581 // reducing the tail would violate the exp bound
7582 // set a flag and hope for a retry (in bba)
7583 strat->completeReduce_retry=TRUE;
7584 if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
7585 do
7586 {
7587 pNext(h) = Ln.LmExtractAndIter();
7588 pIter(h);
7589 L->pLength++;
7590 } while (!Ln.IsNull());
7591 goto all_done;
7592 }
7593 if (Ln.IsNull()) goto all_done;
7594 With_s.Init(currRing);
7595 }
7596 pNext(h) = Ln.LmExtractAndIter();
7597 pIter(h);
7598 pNormalize(h);
7599 L->pLength++;
7600 }
7601
7602 all_done:
7603 Ln.Delete();
7604 if (L->p != NULL) pNext(L->p) = pNext(p);
7605
7606 if (strat->redTailChange)
7607 {
7608 L->length = 0;
7609 }
7610
7611 //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
7612 //L->Normalize(); // HANNES: should have a test
7613 kTest_L(L,strat->tailRing);
7614 return L->GetLmCurrRing();
7615 }
7616
redtailBba_Ring(LObject * L,int end_pos,kStrategy strat)7617 poly redtailBba_Ring (LObject* L, int end_pos, kStrategy strat )
7618 // normalize=FALSE, withT=FALSE, coeff=Z
7619 {
7620 strat->redTailChange=FALSE;
7621 if (strat->noTailReduction) return L->GetLmCurrRing();
7622 poly h, p;
7623 p = h = L->GetLmTailRing();
7624 if ((h==NULL) || (pNext(h)==NULL))
7625 return L->GetLmCurrRing();
7626
7627 TObject* With;
7628 // placeholder in case strat->tl < 0
7629 TObject With_s(strat->tailRing);
7630
7631 LObject Ln(pNext(h), strat->tailRing);
7632 Ln.pLength = L->GetpLength() - 1;
7633
7634 pNext(h) = NULL;
7635 if (L->p != NULL) pNext(L->p) = NULL;
7636 L->pLength = 1;
7637
7638 Ln.PrepareRed(strat->use_buckets);
7639
7640 int cnt=REDTAIL_CANONICALIZE;
7641 while(!Ln.IsNull())
7642 {
7643 loop
7644 {
7645 Ln.SetShortExpVector();
7646 With_s.Init(currRing);
7647 With = kFindDivisibleByInS_T(strat, end_pos, &Ln, &With_s);
7648 if (With == NULL) break;
7649 cnt--;
7650 if (cnt==0)
7651 {
7652 cnt=REDTAIL_CANONICALIZE;
7653 /*poly tmp=*/Ln.CanonicalizeP();
7654 }
7655 // we are in a ring, do not call pNorm
7656 // test divisibility of coefs:
7657 poly p_Ln=Ln.GetLmCurrRing();
7658 poly p_With=With->GetLmCurrRing();
7659 if (n_DivBy(pGetCoeff(p_Ln),pGetCoeff(p_With), currRing->cf))
7660 {
7661 strat->redTailChange=TRUE;
7662
7663 if (ksReducePolyTail_Z(L, With, &Ln))
7664 {
7665 // reducing the tail would violate the exp bound
7666 // set a flag and hope for a retry (in bba)
7667 strat->completeReduce_retry=TRUE;
7668 if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
7669 do
7670 {
7671 pNext(h) = Ln.LmExtractAndIter();
7672 pIter(h);
7673 L->pLength++;
7674 } while (!Ln.IsNull());
7675 goto all_done;
7676 }
7677 }
7678 else break; /*proceed to next monomial*/
7679 if (Ln.IsNull()) goto all_done;
7680 }
7681 pNext(h) = Ln.LmExtractAndIter();
7682 pIter(h);
7683 pNormalize(h);
7684 L->pLength++;
7685 }
7686
7687 all_done:
7688 Ln.Delete();
7689 if (L->p != NULL) pNext(L->p) = pNext(p);
7690
7691 if (strat->redTailChange)
7692 {
7693 L->length = 0;
7694 }
7695
7696 //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
7697 //L->Normalize(); // HANNES: should have a test
7698 kTest_L(L,strat->tailRing);
7699 return L->GetLmCurrRing();
7700 }
7701 #endif
7702
7703 /*2
7704 *checks the change degree and write progress report
7705 */
message(int i,int * reduc,int * olddeg,kStrategy strat,int red_result)7706 void message (int i,int* reduc,int* olddeg,kStrategy strat, int red_result)
7707 {
7708 if (i != *olddeg)
7709 {
7710 Print("%d",i);
7711 *olddeg = i;
7712 }
7713 if (TEST_OPT_OLDSTD)
7714 {
7715 if (strat->Ll != *reduc)
7716 {
7717 if (strat->Ll != *reduc-1)
7718 Print("(%d)",strat->Ll+1);
7719 else
7720 PrintS("-");
7721 *reduc = strat->Ll;
7722 }
7723 else
7724 PrintS(".");
7725 mflush();
7726 }
7727 else
7728 {
7729 if (red_result == 0)
7730 PrintS("-");
7731 else if (red_result < 0)
7732 PrintS(".");
7733 if ((red_result > 0) || ((strat->Ll % 100)==99))
7734 {
7735 if (strat->Ll != *reduc && strat->Ll > 0)
7736 {
7737 Print("(%d)",strat->Ll+1);
7738 *reduc = strat->Ll;
7739 }
7740 }
7741 }
7742 }
7743
7744 /*2
7745 *statistics
7746 */
messageStat(int hilbcount,kStrategy strat)7747 void messageStat (int hilbcount,kStrategy strat)
7748 {
7749 //PrintS("\nUsage/Allocation of temporary storage:\n");
7750 //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
7751 //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
7752 Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
7753 if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
7754 #ifdef HAVE_SHIFTBBA
7755 /* in usual case strat->cv is 0, it gets changed only in shift routines */
7756 if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
7757 #endif
7758 }
7759
messageStatSBA(int hilbcount,kStrategy strat)7760 void messageStatSBA (int hilbcount,kStrategy strat)
7761 {
7762 //PrintS("\nUsage/Allocation of temporary storage:\n");
7763 //Print("%d/%d polynomials in standard base\n",srmax,IDELEMS(Shdl));
7764 //Print("%d/%d polynomials in set L (for lazy alg.)",lrmax+1,strat->Lmax);
7765 Print("syz criterion:%d rew criterion:%d\n",strat->nrsyzcrit,strat->nrrewcrit);
7766 //Print("product criterion:%d chain criterion:%d\n",strat->cp,strat->c3);
7767 if (hilbcount!=0) Print("hilbert series criterion:%d\n",hilbcount);
7768 #ifdef HAVE_SHIFTBBA
7769 /* in usual case strat->cv is 0, it gets changed only in shift routines */
7770 if (strat->cv!=0) Print("shift V criterion:%d\n",strat->cv);
7771 #endif
7772 }
7773
7774 #ifdef KDEBUG
7775 /*2
7776 *debugging output: all internal sets, if changed
7777 *for testing purpuse only/has to be changed for later use
7778 */
messageSets(kStrategy strat)7779 void messageSets (kStrategy strat)
7780 {
7781 int i;
7782 if (strat->news)
7783 {
7784 PrintS("set S");
7785 for (i=0; i<=strat->sl; i++)
7786 {
7787 Print("\n %d:",i);
7788 p_wrp(strat->S[i], currRing, strat->tailRing);
7789 if (strat->fromQ!=NULL && strat->fromQ[i])
7790 Print(" (from Q)");
7791 }
7792 strat->news = FALSE;
7793 }
7794 if (strat->newt)
7795 {
7796 PrintS("\nset T");
7797 for (i=0; i<=strat->tl; i++)
7798 {
7799 Print("\n %d:",i);
7800 strat->T[i].wrp();
7801 if (strat->T[i].length==0) strat->T[i].length=pLength(strat->T[i].p);
7802 Print(" o:%ld e:%d l:%d",
7803 strat->T[i].pFDeg(),strat->T[i].ecart,strat->T[i].length);
7804 }
7805 strat->newt = FALSE;
7806 }
7807 PrintS("\nset L");
7808 for (i=strat->Ll; i>=0; i--)
7809 {
7810 Print("\n%d:",i);
7811 p_wrp(strat->L[i].p1, currRing, strat->tailRing);
7812 PrintS(" ");
7813 p_wrp(strat->L[i].p2, currRing, strat->tailRing);
7814 PrintS(" lcm: ");p_wrp(strat->L[i].lcm, currRing);
7815 PrintS("\n p : ");
7816 strat->L[i].wrp();
7817 Print(" o:%ld e:%d l:%d",
7818 strat->L[i].pFDeg(),strat->L[i].ecart,strat->L[i].length);
7819 }
7820 PrintLn();
7821 }
7822
7823 #endif
7824
7825
7826 /*2
7827 *construct the set s from F
7828 */
initS(ideal F,ideal Q,kStrategy strat)7829 void initS (ideal F, ideal Q, kStrategy strat)
7830 {
7831 int i,pos;
7832
7833 if (Q!=NULL) i=((IDELEMS(F)+IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
7834 else i=((IDELEMS(F)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
7835 strat->ecartS=initec(i);
7836 strat->sevS=initsevS(i);
7837 strat->S_2_R=initS_2_R(i);
7838 strat->fromQ=NULL;
7839 strat->Shdl=idInit(i,F->rank);
7840 strat->S=strat->Shdl->m;
7841 /*- put polys into S -*/
7842 if (Q!=NULL)
7843 {
7844 strat->fromQ=initec(i);
7845 memset(strat->fromQ,0,i*sizeof(int));
7846 for (i=0; i<IDELEMS(Q); i++)
7847 {
7848 if (Q->m[i]!=NULL)
7849 {
7850 LObject h;
7851 h.p = pCopy(Q->m[i]);
7852 if (TEST_OPT_INTSTRATEGY)
7853 {
7854 h.pCleardenom(); // also does remove Content
7855 }
7856 else
7857 {
7858 h.pNorm();
7859 }
7860 if (rHasLocalOrMixedOrdering(currRing))
7861 {
7862 deleteHC(&h, strat);
7863 }
7864 if (h.p!=NULL)
7865 {
7866 strat->initEcart(&h);
7867 if (strat->sl==-1)
7868 pos =0;
7869 else
7870 {
7871 pos = posInS(strat,strat->sl,h.p,h.ecart);
7872 }
7873 h.sev = pGetShortExpVector(h.p);
7874 strat->enterS(h,pos,strat,-1);
7875 strat->fromQ[pos]=1;
7876 }
7877 }
7878 }
7879 }
7880 for (i=0; i<IDELEMS(F); i++)
7881 {
7882 if (F->m[i]!=NULL)
7883 {
7884 LObject h;
7885 h.p = pCopy(F->m[i]);
7886 if (rHasLocalOrMixedOrdering(currRing))
7887 {
7888 cancelunit(&h); /*- tries to cancel a unit -*/
7889 deleteHC(&h, strat);
7890 }
7891 if (h.p!=NULL)
7892 // do not rely on the input being a SB!
7893 {
7894 if (TEST_OPT_INTSTRATEGY)
7895 {
7896 h.pCleardenom(); // also does remove Content
7897 }
7898 else
7899 {
7900 h.pNorm();
7901 }
7902 strat->initEcart(&h);
7903 if (strat->sl==-1)
7904 pos =0;
7905 else
7906 pos = posInS(strat,strat->sl,h.p,h.ecart);
7907 h.sev = pGetShortExpVector(h.p);
7908 strat->enterS(h,pos,strat,-1);
7909 }
7910 }
7911 }
7912 /*- test, if a unit is in F -*/
7913 if ((strat->sl>=0)
7914 #ifdef HAVE_RINGS
7915 && n_IsUnit(pGetCoeff(strat->S[0]),currRing->cf)
7916 #endif
7917 && pIsConstant(strat->S[0]))
7918 {
7919 while (strat->sl>0) deleteInS(strat->sl,strat);
7920 }
7921 }
7922
initSL(ideal F,ideal Q,kStrategy strat)7923 void initSL (ideal F, ideal Q,kStrategy strat)
7924 {
7925 int i,pos;
7926
7927 if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
7928 else i=setmaxT;
7929 strat->ecartS=initec(i);
7930 strat->sevS=initsevS(i);
7931 strat->S_2_R=initS_2_R(i);
7932 strat->fromQ=NULL;
7933 strat->Shdl=idInit(i,F->rank);
7934 strat->S=strat->Shdl->m;
7935 /*- put polys into S -*/
7936 if (Q!=NULL)
7937 {
7938 strat->fromQ=initec(i);
7939 memset(strat->fromQ,0,i*sizeof(int));
7940 for (i=0; i<IDELEMS(Q); i++)
7941 {
7942 if (Q->m[i]!=NULL)
7943 {
7944 LObject h;
7945 h.p = pCopy(Q->m[i]);
7946 if (rHasLocalOrMixedOrdering(currRing))
7947 {
7948 deleteHC(&h,strat);
7949 }
7950 if (TEST_OPT_INTSTRATEGY)
7951 {
7952 h.pCleardenom(); // also does remove Content
7953 }
7954 else
7955 {
7956 h.pNorm();
7957 }
7958 if (h.p!=NULL)
7959 {
7960 strat->initEcart(&h);
7961 if (strat->sl==-1)
7962 pos =0;
7963 else
7964 {
7965 pos = posInS(strat,strat->sl,h.p,h.ecart);
7966 }
7967 h.sev = pGetShortExpVector(h.p);
7968 strat->enterS(h,pos,strat,-1);
7969 strat->fromQ[pos]=1;
7970 }
7971 }
7972 }
7973 }
7974 for (i=0; i<IDELEMS(F); i++)
7975 {
7976 if (F->m[i]!=NULL)
7977 {
7978 LObject h;
7979 h.p = pCopy(F->m[i]);
7980 if (h.p!=NULL)
7981 {
7982 if (rHasLocalOrMixedOrdering(currRing))
7983 {
7984 cancelunit(&h); /*- tries to cancel a unit -*/
7985 deleteHC(&h, strat);
7986 }
7987 if (h.p!=NULL)
7988 {
7989 if (TEST_OPT_INTSTRATEGY)
7990 {
7991 h.pCleardenom(); // also does remove Content
7992 }
7993 else
7994 {
7995 h.pNorm();
7996 }
7997 strat->initEcart(&h);
7998 if (strat->Ll==-1)
7999 pos =0;
8000 else
8001 pos = strat->posInL(strat->L,strat->Ll,&h,strat);
8002 h.sev = pGetShortExpVector(h.p);
8003 enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
8004 }
8005 }
8006 }
8007 }
8008 /*- test, if a unit is in F -*/
8009
8010 if ((strat->Ll>=0)
8011 #ifdef HAVE_RINGS
8012 && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
8013 #endif
8014 && pIsConstant(strat->L[strat->Ll].p))
8015 {
8016 while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
8017 }
8018 }
8019
initSLSba(ideal F,ideal Q,kStrategy strat)8020 void initSLSba (ideal F, ideal Q,kStrategy strat)
8021 {
8022 int i,pos;
8023 if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
8024 else i=setmaxT;
8025 strat->ecartS = initec(i);
8026 strat->sevS = initsevS(i);
8027 strat->sevSig = initsevS(i);
8028 strat->S_2_R = initS_2_R(i);
8029 strat->fromQ = NULL;
8030 strat->Shdl = idInit(i,F->rank);
8031 strat->S = strat->Shdl->m;
8032 strat->sig = (poly *)omAlloc0(i*sizeof(poly));
8033 if (strat->sbaOrder != 1)
8034 {
8035 strat->syz = (poly *)omAlloc0(i*sizeof(poly));
8036 strat->sevSyz = initsevS(i);
8037 strat->syzmax = i;
8038 strat->syzl = 0;
8039 }
8040 /*- put polys into S -*/
8041 if (Q!=NULL)
8042 {
8043 strat->fromQ=initec(i);
8044 memset(strat->fromQ,0,i*sizeof(int));
8045 for (i=0; i<IDELEMS(Q); i++)
8046 {
8047 if (Q->m[i]!=NULL)
8048 {
8049 LObject h;
8050 h.p = pCopy(Q->m[i]);
8051 if (rHasLocalOrMixedOrdering(currRing))
8052 {
8053 deleteHC(&h,strat);
8054 }
8055 if (TEST_OPT_INTSTRATEGY)
8056 {
8057 h.pCleardenom(); // also does remove Content
8058 }
8059 else
8060 {
8061 h.pNorm();
8062 }
8063 if (h.p!=NULL)
8064 {
8065 strat->initEcart(&h);
8066 if (strat->sl==-1)
8067 pos =0;
8068 else
8069 {
8070 pos = posInS(strat,strat->sl,h.p,h.ecart);
8071 }
8072 h.sev = pGetShortExpVector(h.p);
8073 strat->enterS(h,pos,strat,-1);
8074 strat->fromQ[pos]=1;
8075 }
8076 }
8077 }
8078 }
8079 for (i=0; i<IDELEMS(F); i++)
8080 {
8081 if (F->m[i]!=NULL)
8082 {
8083 LObject h;
8084 h.p = pCopy(F->m[i]);
8085 h.sig = pOne();
8086 //h.sig = pInit();
8087 //p_SetCoeff(h.sig,nInit(1),currRing);
8088 p_SetComp(h.sig,i+1,currRing);
8089 // if we are working with the Schreyer order we generate it
8090 // by multiplying the initial signatures with the leading monomial
8091 // of the corresponding initial polynomials generating the ideal
8092 // => we can keep the underlying monomial order and get a Schreyer
8093 // order without any bigger overhead
8094 if (strat->sbaOrder == 0 || strat->sbaOrder == 3)
8095 {
8096 p_ExpVectorAdd (h.sig,F->m[i],currRing);
8097 }
8098 h.sevSig = pGetShortExpVector(h.sig);
8099 #ifdef DEBUGF5
8100 pWrite(h.p);
8101 pWrite(h.sig);
8102 #endif
8103 if (h.p!=NULL)
8104 {
8105 if (rHasLocalOrMixedOrdering(currRing))
8106 {
8107 cancelunit(&h); /*- tries to cancel a unit -*/
8108 deleteHC(&h, strat);
8109 }
8110 if (h.p!=NULL)
8111 {
8112 if (TEST_OPT_INTSTRATEGY)
8113 {
8114 h.pCleardenom(); // also does remove Content
8115 }
8116 else
8117 {
8118 h.pNorm();
8119 }
8120 strat->initEcart(&h);
8121 if (strat->Ll==-1)
8122 pos =0;
8123 else
8124 pos = strat->posInLSba(strat->L,strat->Ll,&h,strat);
8125 h.sev = pGetShortExpVector(h.p);
8126 enterL(&strat->L,&strat->Ll,&strat->Lmax,h,pos);
8127 }
8128 }
8129 /*
8130 if (strat->sbaOrder != 1)
8131 {
8132 for(j=0;j<i;j++)
8133 {
8134 strat->syz[ctr] = pCopy(F->m[j]);
8135 p_SetCompP(strat->syz[ctr],i+1,currRing);
8136 // add LM(F->m[i]) to the signature to get a Schreyer order
8137 // without changing the underlying polynomial ring at all
8138 p_ExpVectorAdd (strat->syz[ctr],F->m[i],currRing);
8139 // since p_Add_q() destroys all input
8140 // data we need to recreate help
8141 // each time
8142 poly help = pCopy(F->m[i]);
8143 p_SetCompP(help,j+1,currRing);
8144 pWrite(strat->syz[ctr]);
8145 pWrite(help);
8146 printf("%d\n",pLmCmp(strat->syz[ctr],help));
8147 strat->syz[ctr] = p_Add_q(strat->syz[ctr],help,currRing);
8148 printf("%d. SYZ ",ctr);
8149 pWrite(strat->syz[ctr]);
8150 strat->sevSyz[ctr] = p_GetShortExpVector(strat->syz[ctr],currRing);
8151 ctr++;
8152 }
8153 strat->syzl = ps;
8154 }
8155 */
8156 }
8157 }
8158 /*- test, if a unit is in F -*/
8159
8160 if ((strat->Ll>=0)
8161 #ifdef HAVE_RINGS
8162 && n_IsUnit(pGetCoeff(strat->L[strat->Ll].p), currRing->cf)
8163 #endif
8164 && pIsConstant(strat->L[strat->Ll].p))
8165 {
8166 while (strat->Ll>0) deleteInL(strat->L,&strat->Ll,strat->Ll-1,strat);
8167 }
8168 }
8169
initSyzRules(kStrategy strat)8170 void initSyzRules (kStrategy strat)
8171 {
8172 if( strat->S[0] )
8173 {
8174 if( strat->S[1] && !rField_is_Ring(currRing))
8175 {
8176 omFreeSize(strat->syzIdx,(strat->syzidxmax)*sizeof(int));
8177 omFreeSize(strat->sevSyz,(strat->syzmax)*sizeof(unsigned long));
8178 omFreeSize(strat->syz,(strat->syzmax)*sizeof(poly));
8179 }
8180 int i, j, k, diff, comp, comp_old, ps=0, ctr=0;
8181 /************************************************************
8182 * computing the length of the syzygy array needed
8183 ***********************************************************/
8184 for(i=1; i<=strat->sl; i++)
8185 {
8186 if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
8187 {
8188 ps += i;
8189 }
8190 }
8191 ps += strat->sl+1;
8192 //comp = pGetComp (strat->P.sig);
8193 comp = strat->currIdx;
8194 strat->syzIdx = initec(comp);
8195 strat->sevSyz = initsevS(ps);
8196 strat->syz = (poly *)omAlloc(ps*sizeof(poly));
8197 strat->syzmax = ps;
8198 strat->syzl = 0;
8199 strat->syzidxmax = comp;
8200 #if defined(DEBUGF5) || defined(DEBUGF51)
8201 PrintS("------------- GENERATING SYZ RULES NEW ---------------\n");
8202 #endif
8203 i = 1;
8204 j = 0;
8205 /************************************************************
8206 * generating the leading terms of the principal syzygies
8207 ***********************************************************/
8208 while (i <= strat->sl)
8209 {
8210 /**********************************************************
8211 * principal syzygies start with component index 2
8212 * the array syzIdx starts with index 0
8213 * => the rules for a signature with component comp start
8214 * at strat->syz[strat->syzIdx[comp-2]] !
8215 *********************************************************/
8216 if (pGetComp(strat->sig[i-1]) != pGetComp(strat->sig[i]))
8217 {
8218 comp = pGetComp(strat->sig[i]);
8219 comp_old = pGetComp(strat->sig[i-1]);
8220 diff = comp - comp_old - 1;
8221 // diff should be zero, but sometimes also the initial generating
8222 // elements of the input ideal reduce to zero. then there is an
8223 // index-gap between the signatures. for these inbetween signatures we
8224 // can safely set syzIdx[j] = 0 as no such element will be ever computed
8225 // in the following.
8226 // doing this, we keep the relation "j = comp - 2" alive, which makes
8227 // jumps way easier when checking criteria
8228 while (diff>0)
8229 {
8230 strat->syzIdx[j] = 0;
8231 diff--;
8232 j++;
8233 }
8234 strat->syzIdx[j] = ctr;
8235 j++;
8236 LObject Q;
8237 int pos;
8238 for (k = 0; k<i; k++)
8239 {
8240 Q.sig = pOne();
8241 if(rField_is_Ring(currRing))
8242 p_SetCoeff(Q.sig,nCopy(p_GetCoeff(strat->S[k],currRing)),currRing);
8243 p_ExpVectorCopy(Q.sig,strat->S[k],currRing);
8244 p_SetCompP (Q.sig, comp, currRing);
8245 poly q = p_One(currRing);
8246 if(rField_is_Ring(currRing))
8247 p_SetCoeff(q,nCopy(p_GetCoeff(strat->S[i],currRing)),currRing);
8248 p_ExpVectorCopy(q,strat->S[i],currRing);
8249 q = p_Neg (q, currRing);
8250 p_SetCompP (q, __p_GetComp(strat->sig[k], currRing), currRing);
8251 Q.sig = p_Add_q (Q.sig, q, currRing);
8252 Q.sevSig = p_GetShortExpVector(Q.sig,currRing);
8253 pos = posInSyz(strat, Q.sig);
8254 enterSyz(Q, strat, pos);
8255 ctr++;
8256 }
8257 }
8258 i++;
8259 }
8260 /**************************************************************
8261 * add syzygies for upcoming first element of new iteration step
8262 **************************************************************/
8263 comp = strat->currIdx;
8264 comp_old = pGetComp(strat->sig[i-1]);
8265 diff = comp - comp_old - 1;
8266 // diff should be zero, but sometimes also the initial generating
8267 // elements of the input ideal reduce to zero. then there is an
8268 // index-gap between the signatures. for these inbetween signatures we
8269 // can safely set syzIdx[j] = 0 as no such element will be ever computed
8270 // in the following.
8271 // doing this, we keep the relation "j = comp - 2" alive, which makes
8272 // jumps way easier when checking criteria
8273 while (diff>0)
8274 {
8275 strat->syzIdx[j] = 0;
8276 diff--;
8277 j++;
8278 }
8279 strat->syzIdx[j] = ctr;
8280 LObject Q;
8281 int pos;
8282 for (k = 0; k<strat->sl+1; k++)
8283 {
8284 Q.sig = pOne();
8285 if(rField_is_Ring(currRing))
8286 p_SetCoeff(Q.sig,nCopy(p_GetCoeff(strat->S[k],currRing)),currRing);
8287 p_ExpVectorCopy(Q.sig,strat->S[k],currRing);
8288 p_SetCompP (Q.sig, comp, currRing);
8289 poly q = p_One(currRing);
8290 if(rField_is_Ring(currRing))
8291 p_SetCoeff(q,nCopy(p_GetCoeff(strat->L[strat->Ll].p,currRing)),currRing);
8292 p_ExpVectorCopy(q,strat->L[strat->Ll].p,currRing);
8293 q = p_Neg (q, currRing);
8294 p_SetCompP (q, __p_GetComp(strat->sig[k], currRing), currRing);
8295 Q.sig = p_Add_q (Q.sig, q, currRing);
8296 Q.sevSig = p_GetShortExpVector(Q.sig,currRing);
8297 pos = posInSyz(strat, Q.sig);
8298 enterSyz(Q, strat, pos);
8299 ctr++;
8300 }
8301 //#if 1
8302 #ifdef DEBUGF5
8303 PrintS("Principal syzygies:\n");
8304 Print("syzl %d\n",strat->syzl);
8305 Print("syzmax %d\n",strat->syzmax);
8306 Print("ps %d\n",ps);
8307 PrintS("--------------------------------\n");
8308 for(i=0;i<=strat->syzl-1;i++)
8309 {
8310 Print("%d - ",i);
8311 pWrite(strat->syz[i]);
8312 }
8313 for(i=0;i<strat->currIdx;i++)
8314 {
8315 Print("%d - %d\n",i,strat->syzIdx[i]);
8316 }
8317 PrintS("--------------------------------\n");
8318 #endif
8319 }
8320 }
8321
8322 /*2
8323 *construct the set s from F and {P}
8324 */
initSSpecial(ideal F,ideal Q,ideal P,kStrategy strat)8325 void initSSpecial (ideal F, ideal Q, ideal P,kStrategy strat)
8326 {
8327 int i,pos;
8328
8329 if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
8330 else i=setmaxT;
8331 i=((i+IDELEMS(F)+IDELEMS(P)+setmax-1)/setmax)*setmax;
8332 strat->ecartS=initec(i);
8333 strat->sevS=initsevS(i);
8334 strat->S_2_R=initS_2_R(i);
8335 strat->fromQ=NULL;
8336 strat->Shdl=idInit(i,F->rank);
8337 strat->S=strat->Shdl->m;
8338
8339 /*- put polys into S -*/
8340 if (Q!=NULL)
8341 {
8342 strat->fromQ=initec(i);
8343 memset(strat->fromQ,0,i*sizeof(int));
8344 for (i=0; i<IDELEMS(Q); i++)
8345 {
8346 if (Q->m[i]!=NULL)
8347 {
8348 LObject h;
8349 h.p = pCopy(Q->m[i]);
8350 //if (TEST_OPT_INTSTRATEGY)
8351 //{
8352 // h.pCleardenom(); // also does remove Content
8353 //}
8354 //else
8355 //{
8356 // h.pNorm();
8357 //}
8358 if (rHasLocalOrMixedOrdering(currRing))
8359 {
8360 deleteHC(&h,strat);
8361 }
8362 if (h.p!=NULL)
8363 {
8364 strat->initEcart(&h);
8365 if (strat->sl==-1)
8366 pos =0;
8367 else
8368 {
8369 pos = posInS(strat,strat->sl,h.p,h.ecart);
8370 }
8371 h.sev = pGetShortExpVector(h.p);
8372 strat->enterS(h,pos,strat, strat->tl+1);
8373 enterT(h, strat);
8374 strat->fromQ[pos]=1;
8375 }
8376 }
8377 }
8378 }
8379 /*- put polys into S -*/
8380 for (i=0; i<IDELEMS(F); i++)
8381 {
8382 if (F->m[i]!=NULL)
8383 {
8384 LObject h;
8385 h.p = pCopy(F->m[i]);
8386 if (rHasLocalOrMixedOrdering(currRing))
8387 {
8388 deleteHC(&h,strat);
8389 }
8390 else if (TEST_OPT_REDTAIL || TEST_OPT_REDSB)
8391 {
8392 h.p=redtailBba(h.p,strat->sl,strat);
8393 }
8394 if (h.p!=NULL)
8395 {
8396 strat->initEcart(&h);
8397 if (strat->sl==-1)
8398 pos =0;
8399 else
8400 pos = posInS(strat,strat->sl,h.p,h.ecart);
8401 h.sev = pGetShortExpVector(h.p);
8402 strat->enterS(h,pos,strat, strat->tl+1);
8403 enterT(h,strat);
8404 }
8405 }
8406 }
8407 for (i=0; i<IDELEMS(P); i++)
8408 {
8409 if (P->m[i]!=NULL)
8410 {
8411 LObject h;
8412 h.p=pCopy(P->m[i]);
8413 if (TEST_OPT_INTSTRATEGY)
8414 {
8415 h.pCleardenom();
8416 }
8417 else
8418 {
8419 h.pNorm();
8420 }
8421 if(strat->sl>=0)
8422 {
8423 if (rHasGlobalOrdering(currRing))
8424 {
8425 h.p=redBba(h.p,strat->sl,strat);
8426 if ((h.p!=NULL)&&(TEST_OPT_REDTAIL || TEST_OPT_REDSB))
8427 {
8428 h.p=redtailBba(h.p,strat->sl,strat);
8429 }
8430 }
8431 else
8432 {
8433 h.p=redMora(h.p,strat->sl,strat);
8434 }
8435 if(h.p!=NULL)
8436 {
8437 strat->initEcart(&h);
8438 if (TEST_OPT_INTSTRATEGY)
8439 {
8440 h.pCleardenom();
8441 }
8442 else
8443 {
8444 h.is_normalized = 0;
8445 h.pNorm();
8446 }
8447 h.sev = pGetShortExpVector(h.p);
8448 h.SetpFDeg();
8449 pos = posInS(strat,strat->sl,h.p,h.ecart);
8450 enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
8451 strat->enterS(h,pos,strat, strat->tl+1);
8452 enterT(h,strat);
8453 }
8454 }
8455 else
8456 {
8457 h.sev = pGetShortExpVector(h.p);
8458 strat->initEcart(&h);
8459 strat->enterS(h,0,strat, strat->tl+1);
8460 enterT(h,strat);
8461 }
8462 }
8463 }
8464 }
8465 /*2
8466 *construct the set s from F and {P}
8467 */
8468
initSSpecialSba(ideal F,ideal Q,ideal P,kStrategy strat)8469 void initSSpecialSba (ideal F, ideal Q, ideal P,kStrategy strat)
8470 {
8471 int i,pos;
8472
8473 if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
8474 else i=setmaxT;
8475 i=((i+IDELEMS(F)+IDELEMS(P)+setmax-1)/setmax)*setmax;
8476 strat->sevS=initsevS(i);
8477 strat->sevSig=initsevS(i);
8478 strat->S_2_R=initS_2_R(i);
8479 strat->fromQ=NULL;
8480 strat->Shdl=idInit(i,F->rank);
8481 strat->S=strat->Shdl->m;
8482 strat->sig=(poly *)omAlloc0(i*sizeof(poly));
8483 /*- put polys into S -*/
8484 if (Q!=NULL)
8485 {
8486 strat->fromQ=initec(i);
8487 memset(strat->fromQ,0,i*sizeof(int));
8488 for (i=0; i<IDELEMS(Q); i++)
8489 {
8490 if (Q->m[i]!=NULL)
8491 {
8492 LObject h;
8493 h.p = pCopy(Q->m[i]);
8494 //if (TEST_OPT_INTSTRATEGY)
8495 //{
8496 // h.pCleardenom(); // also does remove Content
8497 //}
8498 //else
8499 //{
8500 // h.pNorm();
8501 //}
8502 if (rHasLocalOrMixedOrdering(currRing))
8503 {
8504 deleteHC(&h,strat);
8505 }
8506 if (h.p!=NULL)
8507 {
8508 strat->initEcart(&h);
8509 if (strat->sl==-1)
8510 pos =0;
8511 else
8512 {
8513 pos = posInS(strat,strat->sl,h.p,h.ecart);
8514 }
8515 h.sev = pGetShortExpVector(h.p);
8516 strat->enterS(h,pos,strat, strat->tl+1);
8517 enterT(h, strat);
8518 strat->fromQ[pos]=1;
8519 }
8520 }
8521 }
8522 }
8523 /*- put polys into S -*/
8524 for (i=0; i<IDELEMS(F); i++)
8525 {
8526 if (F->m[i]!=NULL)
8527 {
8528 LObject h;
8529 h.p = pCopy(F->m[i]);
8530 if (rHasLocalOrMixedOrdering(currRing))
8531 {
8532 deleteHC(&h,strat);
8533 }
8534 else if (TEST_OPT_REDTAIL || TEST_OPT_REDSB)
8535 {
8536 h.p=redtailBba(h.p,strat->sl,strat);
8537 }
8538 if (h.p!=NULL)
8539 {
8540 strat->initEcart(&h);
8541 if (strat->sl==-1)
8542 pos =0;
8543 else
8544 pos = posInS(strat,strat->sl,h.p,h.ecart);
8545 h.sev = pGetShortExpVector(h.p);
8546 strat->enterS(h,pos,strat, strat->tl+1);
8547 enterT(h,strat);
8548 }
8549 }
8550 }
8551 for (i=0; i<IDELEMS(P); i++)
8552 {
8553 if (P->m[i]!=NULL)
8554 {
8555 LObject h;
8556 h.p=pCopy(P->m[i]);
8557 if (TEST_OPT_INTSTRATEGY)
8558 {
8559 h.pCleardenom();
8560 }
8561 else
8562 {
8563 h.pNorm();
8564 }
8565 if(strat->sl>=0)
8566 {
8567 if (rHasGlobalOrdering(currRing))
8568 {
8569 h.p=redBba(h.p,strat->sl,strat);
8570 if ((h.p!=NULL)&&(TEST_OPT_REDTAIL || TEST_OPT_REDSB))
8571 {
8572 h.p=redtailBba(h.p,strat->sl,strat);
8573 }
8574 }
8575 else
8576 {
8577 h.p=redMora(h.p,strat->sl,strat);
8578 }
8579 if(h.p!=NULL)
8580 {
8581 strat->initEcart(&h);
8582 if (TEST_OPT_INTSTRATEGY)
8583 {
8584 h.pCleardenom();
8585 }
8586 else
8587 {
8588 h.is_normalized = 0;
8589 h.pNorm();
8590 }
8591 h.sev = pGetShortExpVector(h.p);
8592 h.SetpFDeg();
8593 pos = posInS(strat,strat->sl,h.p,h.ecart);
8594 enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
8595 strat->enterS(h,pos,strat, strat->tl+1);
8596 enterT(h,strat);
8597 }
8598 }
8599 else
8600 {
8601 h.sev = pGetShortExpVector(h.p);
8602 strat->initEcart(&h);
8603 strat->enterS(h,0,strat, strat->tl+1);
8604 enterT(h,strat);
8605 }
8606 }
8607 }
8608 }
8609
8610 /*2
8611 * reduces h using the set S
8612 * procedure used in cancelunit1
8613 */
redBba1(poly h,int maxIndex,kStrategy strat)8614 static poly redBba1 (poly h,int maxIndex,kStrategy strat)
8615 {
8616 int j = 0;
8617 unsigned long not_sev = ~ pGetShortExpVector(h);
8618
8619 while (j <= maxIndex)
8620 {
8621 if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j],h, not_sev))
8622 return ksOldSpolyRedNew(strat->S[j],h,strat->kNoetherTail());
8623 else j++;
8624 }
8625 return h;
8626 }
8627
8628 /*2
8629 *tests if p.p=monomial*unit and cancels the unit
8630 */
cancelunit1(LObject * p,int * suc,int index,kStrategy strat)8631 void cancelunit1 (LObject* p,int *suc, int index,kStrategy strat )
8632 {
8633 int k;
8634 poly r,h,h1,q;
8635
8636 if (!pIsVector((*p).p) && ((*p).ecart != 0))
8637 {
8638 #ifdef HAVE_RINGS
8639 // Leading coef have to be a unit: no
8640 // example 2x+4x2 should be simplified to 2x*(1+2x)
8641 // and 2 is not a unit in Z
8642 //if ( !(n_IsUnit(pGetCoeff((*p).p), currRing->cf)) ) return;
8643 #endif
8644 k = 0;
8645 h1 = r = pCopy((*p).p);
8646 h =pNext(r);
8647 loop
8648 {
8649 if (h==NULL)
8650 {
8651 pDelete(&r);
8652 pDelete(&(pNext((*p).p)));
8653 (*p).ecart = 0;
8654 (*p).length = 1;
8655 (*p).pLength = 1;
8656 (*suc)=0;
8657 return;
8658 }
8659 if (!pDivisibleBy(r,h))
8660 {
8661 q=redBba1(h,index ,strat);
8662 if (q != h)
8663 {
8664 k++;
8665 pDelete(&h);
8666 pNext(h1) = h = q;
8667 }
8668 else
8669 {
8670 pDelete(&r);
8671 return;
8672 }
8673 }
8674 else
8675 {
8676 h1 = h;
8677 pIter(h);
8678 }
8679 if (k > 10)
8680 {
8681 pDelete(&r);
8682 return;
8683 }
8684 }
8685 }
8686 }
8687
8688 #if 0
8689 /*2
8690 * reduces h using the elements from Q in the set S
8691 * procedure used in updateS
8692 * must not be used for elements of Q or elements of an ideal !
8693 */
redQ(poly h,int j,kStrategy strat)8694 static poly redQ (poly h, int j, kStrategy strat)
8695 {
8696 int start;
8697 unsigned long not_sev = ~ pGetShortExpVector(h);
8698 while ((j <= strat->sl) && (pGetComp(strat->S[j])!=0)) j++;
8699 start=j;
8700 while (j<=strat->sl)
8701 {
8702 if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
8703 {
8704 h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
8705 if (h==NULL) return NULL;
8706 j = start;
8707 not_sev = ~ pGetShortExpVector(h);
8708 }
8709 else j++;
8710 }
8711 return h;
8712 }
8713 #endif
8714
8715 /*2
8716 * reduces h using the set S
8717 * procedure used in updateS
8718 */
redBba(poly h,int maxIndex,kStrategy strat)8719 static poly redBba (poly h,int maxIndex,kStrategy strat)
8720 {
8721 int j = 0;
8722 unsigned long not_sev = ~ pGetShortExpVector(h);
8723
8724 while (j <= maxIndex)
8725 {
8726 if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev))
8727 {
8728 h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
8729 if (h==NULL) return NULL;
8730 j = 0;
8731 not_sev = ~ pGetShortExpVector(h);
8732 }
8733 else j++;
8734 }
8735 return h;
8736 }
8737
8738 /*2
8739 * reduces h using the set S
8740 *e is the ecart of h
8741 *procedure used in updateS
8742 */
redMora(poly h,int maxIndex,kStrategy strat)8743 static poly redMora (poly h,int maxIndex,kStrategy strat)
8744 {
8745 int j=0;
8746 int e,l;
8747 unsigned long not_sev = ~ pGetShortExpVector(h);
8748
8749 if (maxIndex >= 0)
8750 {
8751 e = currRing->pLDeg(h,&l,currRing)-p_FDeg(h,currRing);
8752 do
8753 {
8754 if (pLmShortDivisibleBy(strat->S[j],strat->sevS[j], h, not_sev)
8755 && ((e >= strat->ecartS[j]) || strat->kHEdgeFound))
8756 {
8757 #ifdef KDEBUG
8758 if (TEST_OPT_DEBUG)
8759 {
8760 PrintS("reduce ");wrp(h);Print(" with S[%d] (",j);wrp(strat->S[j]);
8761 }
8762 #endif
8763 h = ksOldSpolyRed(strat->S[j],h,strat->kNoetherTail());
8764 #ifdef KDEBUG
8765 if(TEST_OPT_DEBUG)
8766 {
8767 PrintS(")\nto "); wrp(h); PrintLn();
8768 }
8769 #endif
8770 // pDelete(&h);
8771 if (h == NULL) return NULL;
8772 e = currRing->pLDeg(h,&l,currRing)-p_FDeg(h,currRing);
8773 j = 0;
8774 not_sev = ~ pGetShortExpVector(h);
8775 }
8776 else j++;
8777 }
8778 while (j <= maxIndex);
8779 }
8780 return h;
8781 }
8782
8783 /*2
8784 *updates S:
8785 *the result is a set of polynomials which are in
8786 *normalform with respect to S
8787 */
updateS(BOOLEAN toT,kStrategy strat)8788 void updateS(BOOLEAN toT,kStrategy strat)
8789 {
8790 LObject h;
8791 int i, suc=0;
8792 poly redSi=NULL;
8793 BOOLEAN change,any_change;
8794 // Print("nach initS: updateS start mit sl=%d\n",(strat->sl));
8795 // for (i=0; i<=(strat->sl); i++)
8796 // {
8797 // Print("s%d:",i);
8798 // if (strat->fromQ!=NULL) Print("(Q:%d) ",strat->fromQ[i]);
8799 // pWrite(strat->S[i]);
8800 // }
8801 // Print("currRing->OrdSgn=%d\n", currRing->OrdSgn);
8802 any_change=FALSE;
8803 if (rHasGlobalOrdering(currRing))
8804 {
8805 while (suc != -1)
8806 {
8807 i=suc+1;
8808 while (i<=strat->sl)
8809 {
8810 change=FALSE;
8811 if(rField_is_Ring(currRing))
8812 any_change = FALSE;
8813 if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
8814 {
8815 redSi = pHead(strat->S[i]);
8816 strat->S[i] = redBba(strat->S[i],i-1,strat);
8817 //if ((strat->ak!=0)&&(strat->S[i]!=NULL))
8818 // strat->S[i]=redQ(strat->S[i],i+1,strat); /*reduce S[i] mod Q*/
8819 if (pCmp(redSi,strat->S[i])!=0)
8820 {
8821 change=TRUE;
8822 any_change=TRUE;
8823 #ifdef KDEBUG
8824 if (TEST_OPT_DEBUG)
8825 {
8826 PrintS("reduce:");
8827 wrp(redSi);PrintS(" to ");p_wrp(strat->S[i], currRing, strat->tailRing);PrintLn();
8828 }
8829 #endif
8830 if (TEST_OPT_PROT)
8831 {
8832 if (strat->S[i]==NULL)
8833 PrintS("V");
8834 else
8835 PrintS("v");
8836 mflush();
8837 }
8838 }
8839 pLmDelete(&redSi);
8840 if (strat->S[i]==NULL)
8841 {
8842 deleteInS(i,strat);
8843 i--;
8844 }
8845 else if (change)
8846 {
8847 if (TEST_OPT_INTSTRATEGY)
8848 {
8849 if (TEST_OPT_CONTENTSB)
8850 {
8851 number n;
8852 p_Cleardenom_n(strat->S[i], currRing, n);// also does remove Content
8853 if (!nIsOne(n))
8854 {
8855 denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
8856 denom->n=nInvers(n);
8857 denom->next=DENOMINATOR_LIST;
8858 DENOMINATOR_LIST=denom;
8859 }
8860 nDelete(&n);
8861 }
8862 else
8863 {
8864 strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does remove Content
8865 }
8866 }
8867 else
8868 {
8869 pNorm(strat->S[i]);
8870 }
8871 strat->sevS[i] = pGetShortExpVector(strat->S[i]);
8872 }
8873 }
8874 i++;
8875 }
8876 if (any_change) reorderS(&suc,strat);
8877 else break;
8878 }
8879 if (toT)
8880 {
8881 for (i=0; i<=strat->sl; i++)
8882 {
8883 if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
8884 {
8885 h.p = redtailBba(strat->S[i],i-1,strat);
8886 if (TEST_OPT_INTSTRATEGY)
8887 {
8888 h.pCleardenom();// also does remove Content
8889 }
8890 }
8891 else
8892 {
8893 h.p = strat->S[i];
8894 }
8895 strat->initEcart(&h);
8896 if (strat->honey)
8897 {
8898 strat->ecartS[i] = h.ecart;
8899 }
8900 if (strat->sevS[i] == 0) {strat->sevS[i] = pGetShortExpVector(h.p);}
8901 else assume(strat->sevS[i] == pGetShortExpVector(h.p));
8902 h.sev = strat->sevS[i];
8903 /*puts the elements of S also to T*/
8904 strat->initEcart(&h);
8905 /*if (toT) - already checked*/ enterT(h,strat);
8906 strat->S_2_R[i] = strat->tl;
8907 #ifdef HAVE_SHIFTBBA
8908 if (/*(toT) && */(currRing->isLPring))
8909 enterTShift(h, strat);
8910 #endif
8911 }
8912 }
8913 }
8914 else
8915 {
8916 while (suc != -1)
8917 {
8918 i=suc;
8919 while (i<=strat->sl)
8920 {
8921 change=FALSE;
8922 if (((strat->fromQ==NULL) || (strat->fromQ[i]==0)) && (i>0))
8923 {
8924 redSi=pHead((strat->S)[i]);
8925 (strat->S)[i] = redMora((strat->S)[i],i-1,strat);
8926 if ((strat->S)[i]==NULL)
8927 {
8928 deleteInS(i,strat);
8929 i--;
8930 }
8931 else if (pCmp((strat->S)[i],redSi)!=0)
8932 {
8933 any_change=TRUE;
8934 h.p = strat->S[i];
8935 strat->initEcart(&h);
8936 strat->ecartS[i] = h.ecart;
8937 if (TEST_OPT_INTSTRATEGY)
8938 {
8939 if (TEST_OPT_CONTENTSB)
8940 {
8941 number n;
8942 p_Cleardenom_n(strat->S[i], currRing, n);// also does remove Content
8943 if (!nIsOne(n))
8944 {
8945 denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
8946 denom->n=nInvers(n);
8947 denom->next=DENOMINATOR_LIST;
8948 DENOMINATOR_LIST=denom;
8949 }
8950 nDelete(&n);
8951 }
8952 else
8953 {
8954 strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does remove Content
8955 }
8956 }
8957 else
8958 {
8959 pNorm(strat->S[i]); // == h.p
8960 }
8961 h.sev = pGetShortExpVector(h.p);
8962 strat->sevS[i] = h.sev;
8963 }
8964 pLmDelete(&redSi);
8965 kTest(strat);
8966 }
8967 i++;
8968 }
8969 #ifdef KDEBUG
8970 kTest(strat);
8971 #endif
8972 if (any_change) reorderS(&suc,strat);
8973 else { suc=-1; break; }
8974 if (h.p!=NULL)
8975 {
8976 if (!strat->kHEdgeFound)
8977 {
8978 /*strat->kHEdgeFound =*/ HEckeTest(h.p,strat);
8979 }
8980 if (strat->kHEdgeFound)
8981 newHEdge(strat);
8982 }
8983 }
8984 for (i=0; i<=strat->sl; i++)
8985 {
8986 if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
8987 {
8988 strat->S[i] = h.p = redtail(strat->S[i],strat->sl,strat);
8989 strat->initEcart(&h);
8990 strat->ecartS[i] = h.ecart;
8991 h.sev = pGetShortExpVector(h.p);
8992 strat->sevS[i] = h.sev;
8993 }
8994 else
8995 {
8996 h.p = strat->S[i];
8997 h.ecart=strat->ecartS[i];
8998 h.sev = strat->sevS[i];
8999 h.length = h.pLength = pLength(h.p);
9000 }
9001 if ((strat->fromQ==NULL) || (strat->fromQ[i]==0))
9002 cancelunit1(&h,&suc,strat->sl,strat);
9003 h.SetpFDeg();
9004 /*puts the elements of S also to T*/
9005 enterT(h,strat);
9006 strat->S_2_R[i] = strat->tl;
9007 #ifdef HAVE_SHIFTBBA
9008 if (currRing->isLPring)
9009 enterTShift(h, strat);
9010 #endif
9011 }
9012 if (suc!= -1) updateS(toT,strat);
9013 }
9014 #ifdef KDEBUG
9015 kTest(strat);
9016 #endif
9017 }
9018
9019 /*2
9020 * -puts p to the standardbasis s at position at
9021 * -saves the result in S
9022 */
enterSBba(LObject & p,int atS,kStrategy strat,int atR)9023 void enterSBba (LObject &p,int atS,kStrategy strat, int atR)
9024 {
9025 strat->news = TRUE;
9026 /*- puts p to the standardbasis s at position at -*/
9027 if (strat->sl == IDELEMS(strat->Shdl)-1)
9028 {
9029 strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
9030 IDELEMS(strat->Shdl)*sizeof(unsigned long),
9031 (IDELEMS(strat->Shdl)+setmaxTinc)
9032 *sizeof(unsigned long));
9033 strat->ecartS = (intset)omReallocSize(strat->ecartS,
9034 IDELEMS(strat->Shdl)*sizeof(int),
9035 (IDELEMS(strat->Shdl)+setmaxTinc)
9036 *sizeof(int));
9037 strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
9038 IDELEMS(strat->Shdl)*sizeof(int),
9039 (IDELEMS(strat->Shdl)+setmaxTinc)
9040 *sizeof(int));
9041 if (strat->lenS!=NULL)
9042 strat->lenS=(int*)omRealloc0Size(strat->lenS,
9043 IDELEMS(strat->Shdl)*sizeof(int),
9044 (IDELEMS(strat->Shdl)+setmaxTinc)
9045 *sizeof(int));
9046 if (strat->lenSw!=NULL)
9047 strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
9048 IDELEMS(strat->Shdl)*sizeof(wlen_type),
9049 (IDELEMS(strat->Shdl)+setmaxTinc)
9050 *sizeof(wlen_type));
9051 if (strat->fromQ!=NULL)
9052 {
9053 strat->fromQ = (intset)omReallocSize(strat->fromQ,
9054 IDELEMS(strat->Shdl)*sizeof(int),
9055 (IDELEMS(strat->Shdl)+setmaxTinc)*sizeof(int));
9056 }
9057 pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmaxTinc);
9058 IDELEMS(strat->Shdl)+=setmaxTinc;
9059 strat->Shdl->m=strat->S;
9060 }
9061 if (atS <= strat->sl)
9062 {
9063 #ifdef ENTER_USE_MEMMOVE
9064 memmove(&(strat->S[atS+1]), &(strat->S[atS]),
9065 (strat->sl - atS + 1)*sizeof(poly));
9066 memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
9067 (strat->sl - atS + 1)*sizeof(int));
9068 memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
9069 (strat->sl - atS + 1)*sizeof(unsigned long));
9070 memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
9071 (strat->sl - atS + 1)*sizeof(int));
9072 if (strat->lenS!=NULL)
9073 memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
9074 (strat->sl - atS + 1)*sizeof(int));
9075 if (strat->lenSw!=NULL)
9076 memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
9077 (strat->sl - atS + 1)*sizeof(wlen_type));
9078 #else
9079 for (i=strat->sl+1; i>=atS+1; i--)
9080 {
9081 strat->S[i] = strat->S[i-1];
9082 strat->ecartS[i] = strat->ecartS[i-1];
9083 strat->sevS[i] = strat->sevS[i-1];
9084 strat->S_2_R[i] = strat->S_2_R[i-1];
9085 }
9086 if (strat->lenS!=NULL)
9087 for (i=strat->sl+1; i>=atS+1; i--)
9088 strat->lenS[i] = strat->lenS[i-1];
9089 if (strat->lenSw!=NULL)
9090 for (i=strat->sl+1; i>=atS+1; i--)
9091 strat->lenSw[i] = strat->lenSw[i-1];
9092 #endif
9093 }
9094 if (strat->fromQ!=NULL)
9095 {
9096 #ifdef ENTER_USE_MEMMOVE
9097 memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
9098 (strat->sl - atS + 1)*sizeof(int));
9099 #else
9100 for (i=strat->sl+1; i>=atS+1; i--)
9101 {
9102 strat->fromQ[i] = strat->fromQ[i-1];
9103 }
9104 #endif
9105 strat->fromQ[atS]=0;
9106 }
9107
9108 /*- save result -*/
9109 poly pp=p.p;
9110 strat->S[atS] = pp;
9111 if (strat->honey) strat->ecartS[atS] = p.ecart;
9112 if (p.sev == 0)
9113 p.sev = pGetShortExpVector(pp);
9114 else
9115 assume(p.sev == pGetShortExpVector(pp));
9116 strat->sevS[atS] = p.sev;
9117 strat->ecartS[atS] = p.ecart;
9118 strat->S_2_R[atS] = atR;
9119 strat->sl++;
9120 }
9121
9122 #ifdef HAVE_SHIFTBBA
enterSBbaShift(LObject & p,int atS,kStrategy strat,int atR)9123 void enterSBbaShift (LObject &p,int atS,kStrategy strat, int atR)
9124 {
9125 enterSBba(p, atS, strat, atR);
9126
9127 int maxPossibleShift = p_mLPmaxPossibleShift(p.p, strat->tailRing);
9128 for (int i = maxPossibleShift; i > 0; i--)
9129 {
9130 // NOTE: don't use "shared tails" here. In rare cases it can cause problems
9131 // in `kNF2` because of lazy poly normalizations.
9132 LObject qq(p_Copy(p.p, strat->tailRing));
9133 p_mLPshift(qq.p, i, strat->tailRing);
9134 qq.shift = i;
9135 strat->initEcart(&qq); // initEcartBBA sets length, pLength, FDeg and ecart
9136 int atS = posInS(strat, strat->sl, qq.p, qq.ecart); // S needs to stay sorted because this is for example assumed when searching S later
9137 enterSBba(qq, atS, strat, -1);
9138 }
9139 }
9140 #endif
9141
9142 /*2
9143 * -puts p to the standardbasis s at position at
9144 * -saves the result in S
9145 */
enterSSba(LObject & p,int atS,kStrategy strat,int atR)9146 void enterSSba (LObject &p,int atS,kStrategy strat, int atR)
9147 {
9148 strat->news = TRUE;
9149 /*- puts p to the standardbasis s at position at -*/
9150 if (strat->sl == IDELEMS(strat->Shdl)-1)
9151 {
9152 strat->sevS = (unsigned long*) omRealloc0Size(strat->sevS,
9153 IDELEMS(strat->Shdl)*sizeof(unsigned long),
9154 (IDELEMS(strat->Shdl)+setmax)
9155 *sizeof(unsigned long));
9156 strat->sevSig = (unsigned long*) omRealloc0Size(strat->sevSig,
9157 IDELEMS(strat->Shdl)*sizeof(unsigned long),
9158 (IDELEMS(strat->Shdl)+setmax)
9159 *sizeof(unsigned long));
9160 strat->ecartS = (intset)omReallocSize(strat->ecartS,
9161 IDELEMS(strat->Shdl)*sizeof(int),
9162 (IDELEMS(strat->Shdl)+setmax)
9163 *sizeof(int));
9164 strat->S_2_R = (int*) omRealloc0Size(strat->S_2_R,
9165 IDELEMS(strat->Shdl)*sizeof(int),
9166 (IDELEMS(strat->Shdl)+setmax)
9167 *sizeof(int));
9168 if (strat->lenS!=NULL)
9169 strat->lenS=(int*)omRealloc0Size(strat->lenS,
9170 IDELEMS(strat->Shdl)*sizeof(int),
9171 (IDELEMS(strat->Shdl)+setmax)
9172 *sizeof(int));
9173 if (strat->lenSw!=NULL)
9174 strat->lenSw=(wlen_type*)omRealloc0Size(strat->lenSw,
9175 IDELEMS(strat->Shdl)*sizeof(wlen_type),
9176 (IDELEMS(strat->Shdl)+setmax)
9177 *sizeof(wlen_type));
9178 if (strat->fromQ!=NULL)
9179 {
9180 strat->fromQ = (intset)omReallocSize(strat->fromQ,
9181 IDELEMS(strat->Shdl)*sizeof(int),
9182 (IDELEMS(strat->Shdl)+setmax)*sizeof(int));
9183 }
9184 pEnlargeSet(&strat->S,IDELEMS(strat->Shdl),setmax);
9185 pEnlargeSet(&strat->sig,IDELEMS(strat->Shdl),setmax);
9186 IDELEMS(strat->Shdl)+=setmax;
9187 strat->Shdl->m=strat->S;
9188 }
9189 // in a signature-based algorithm the following situation will never
9190 // appear due to the fact that the critical pairs are already sorted
9191 // by increasing signature.
9192 // True. However, in the case of integers we need to put the element
9193 // that caused the signature drop on the first position
9194 if (atS <= strat->sl)
9195 {
9196 #ifdef ENTER_USE_MEMMOVE
9197 memmove(&(strat->S[atS+1]), &(strat->S[atS]),
9198 (strat->sl - atS + 1)*sizeof(poly));
9199 memmove(&(strat->sig[atS+1]), &(strat->sig[atS]),
9200 (strat->sl - atS + 1)*sizeof(poly));
9201 memmove(&(strat->sevSig[atS+1]), &(strat->sevSig[atS]),
9202 (strat->sl - atS + 1)*sizeof(unsigned long));
9203 memmove(&(strat->ecartS[atS+1]), &(strat->ecartS[atS]),
9204 (strat->sl - atS + 1)*sizeof(int));
9205 memmove(&(strat->sevS[atS+1]), &(strat->sevS[atS]),
9206 (strat->sl - atS + 1)*sizeof(unsigned long));
9207 memmove(&(strat->S_2_R[atS+1]), &(strat->S_2_R[atS]),
9208 (strat->sl - atS + 1)*sizeof(int));
9209 if (strat->lenS!=NULL)
9210 memmove(&(strat->lenS[atS+1]), &(strat->lenS[atS]),
9211 (strat->sl - atS + 1)*sizeof(int));
9212 if (strat->lenSw!=NULL)
9213 memmove(&(strat->lenSw[atS+1]), &(strat->lenSw[atS]),
9214 (strat->sl - atS + 1)*sizeof(wlen_type));
9215 #else
9216 for (i=strat->sl+1; i>=atS+1; i--)
9217 {
9218 strat->S[i] = strat->S[i-1];
9219 strat->ecartS[i] = strat->ecartS[i-1];
9220 strat->sevS[i] = strat->sevS[i-1];
9221 strat->S_2_R[i] = strat->S_2_R[i-1];
9222 strat->sig[i] = strat->sig[i-1];
9223 strat->sevSig[i] = strat->sevSig[i-1];
9224 }
9225 if (strat->lenS!=NULL)
9226 for (i=strat->sl+1; i>=atS+1; i--)
9227 strat->lenS[i] = strat->lenS[i-1];
9228 if (strat->lenSw!=NULL)
9229 for (i=strat->sl+1; i>=atS+1; i--)
9230 strat->lenSw[i] = strat->lenSw[i-1];
9231 #endif
9232 }
9233 if (strat->fromQ!=NULL)
9234 {
9235 #ifdef ENTER_USE_MEMMOVE
9236 memmove(&(strat->fromQ[atS+1]), &(strat->fromQ[atS]),
9237 (strat->sl - atS + 1)*sizeof(int));
9238 #else
9239 for (i=strat->sl+1; i>=atS+1; i--)
9240 {
9241 strat->fromQ[i] = strat->fromQ[i-1];
9242 }
9243 #endif
9244 strat->fromQ[atS]=0;
9245 }
9246
9247 /*- save result -*/
9248 strat->S[atS] = p.p;
9249 strat->sig[atS] = p.sig; // TODO: get ths correct signature in here!
9250 if (strat->honey) strat->ecartS[atS] = p.ecart;
9251 if (p.sev == 0)
9252 p.sev = pGetShortExpVector(p.p);
9253 else
9254 assume(p.sev == pGetShortExpVector(p.p));
9255 strat->sevS[atS] = p.sev;
9256 // during the interreduction process of a signature-based algorithm we do not
9257 // compute the signature at this point, but when the whole interreduction
9258 // process finishes, i.e. f5c terminates!
9259 if (p.sig != NULL)
9260 {
9261 if (p.sevSig == 0)
9262 p.sevSig = pGetShortExpVector(p.sig);
9263 else
9264 assume(p.sevSig == pGetShortExpVector(p.sig));
9265 strat->sevSig[atS] = p.sevSig; // TODO: get the correct signature in here!
9266 }
9267 strat->ecartS[atS] = p.ecart;
9268 strat->S_2_R[atS] = atR;
9269 strat->sl++;
9270 #ifdef DEBUGF5
9271 int k;
9272 Print("--- LIST S: %d ---\n",strat->sl);
9273 for(k=0;k<=strat->sl;k++)
9274 {
9275 pWrite(strat->sig[k]);
9276 }
9277 PrintS("--- LIST S END ---\n");
9278 #endif
9279 }
9280
replaceInLAndSAndT(LObject & p,int tj,kStrategy strat)9281 void replaceInLAndSAndT(LObject &p, int tj, kStrategy strat)
9282 {
9283 p.GetP(strat->lmBin);
9284 if (strat->homog) strat->initEcart(&p);
9285 strat->redTailChange=FALSE;
9286 if ((TEST_OPT_INTSTRATEGY) || (rField_is_Ring(currRing)))
9287 {
9288 p.pCleardenom();
9289 if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
9290 {
9291 #ifdef HAVE_SHIFTBBA
9292 if (rIsLPRing(currRing))
9293 p.p = redtailBba(&p,strat->tl,strat, TRUE,!TEST_OPT_CONTENTSB);
9294 else
9295 #endif
9296 {
9297 p.p = redtailBba(&p,strat->sl,strat, FALSE,!TEST_OPT_CONTENTSB);
9298 }
9299 p.pCleardenom();
9300 if (strat->redTailChange)
9301 p.t_p=NULL;
9302 if (strat->P.p!=NULL) strat->P.sev=p_GetShortExpVector(strat->P.p,currRing);
9303 else strat->P.sev=0;
9304 }
9305 }
9306
9307 assume(strat->tailRing == p.tailRing);
9308 assume(p.pLength == 0 || pLength(p.p) == p.pLength || rIsSyzIndexRing(currRing)); // modulo syzring
9309
9310 int i, j, pos;
9311 poly tp = strat->T[tj].p;
9312
9313 /* enter p to T set */
9314 enterT(p, strat);
9315
9316 for (j = 0; j <= strat->sl; ++j)
9317 {
9318 if (pLtCmp(tp, strat->S[j]) == 0)
9319 {
9320 break;
9321 }
9322 }
9323 /* it may be that the exchanged element
9324 * is until now only in T and not in S */
9325 if (j <= strat->sl)
9326 {
9327 deleteInS(j, strat);
9328 }
9329
9330 pos = posInS(strat, strat->sl, p.p, p.ecart);
9331
9332 pp_Test(p.p, currRing, p.tailRing);
9333 assume(p.FDeg == p.pFDeg());
9334
9335 /* remove useless pairs from L set */
9336 for (i = 0; i <= strat->Ll; ++i)
9337 {
9338 if (strat->L[i].p1 != NULL && pLtCmp(tp, strat->L[i].p1) == 0)
9339 {
9340 deleteInL(strat->L, &(strat->Ll), i, strat);
9341 i--;
9342 continue;
9343 }
9344 if (strat->L[i].p2 != NULL && pLtCmp(tp, strat->L[i].p2) == 0)
9345 {
9346 deleteInL(strat->L, &(strat->Ll), i, strat);
9347 i--;
9348 }
9349 }
9350 #ifdef HAVE_SHIFTBBA
9351 if (rIsLPRing(currRing))
9352 enterpairsShift(p.p, strat->sl, p.ecart, pos, strat, strat->tl); // TODO LP
9353 else
9354 #endif
9355 {
9356 /* generate new pairs with p, probably removing older, now useless pairs */
9357 superenterpairs(p.p, strat->sl, p.ecart, pos, strat, strat->tl);
9358 }
9359 /* enter p to S set */
9360 strat->enterS(p, pos, strat, strat->tl);
9361
9362 #ifdef HAVE_SHIFTBBA
9363 /* do this after enterS so that the index in R (which is strat->tl) is correct */
9364 if (rIsLPRing(currRing) && !strat->rightGB)
9365 enterTShift(p,strat);
9366 #endif
9367 }
9368
9369 /*2
9370 * puts p to the set T at position atT
9371 */
enterT(LObject & p,kStrategy strat,int atT)9372 void enterT(LObject &p, kStrategy strat, int atT)
9373 {
9374 int i;
9375
9376 #ifdef PDEBUG
9377 #ifdef HAVE_SHIFTBBA
9378 if (currRing->isLPring && p.shift > 0)
9379 {
9380 // in this case, the order is not correct. test LM and tail separately
9381 p_LmTest(p.p, currRing);
9382 p_Test(pNext(p.p), currRing);
9383 }
9384 else
9385 #endif
9386 {
9387 pp_Test(p.p, currRing, p.tailRing);
9388 }
9389 #endif
9390 assume(strat->tailRing == p.tailRing);
9391 // redMoraNF complains about this -- but, we don't really
9392 // neeed this so far
9393 assume(p.pLength == 0 || pLength(p.p) == p.pLength || rIsSyzIndexRing(currRing)); // modulo syzring
9394 assume(p.FDeg == p.pFDeg());
9395 assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
9396
9397 #ifdef KDEBUG
9398 // do not put an LObject twice into T:
9399 for(i=strat->tl;i>=0;i--)
9400 {
9401 if (p.p==strat->T[i].p)
9402 {
9403 printf("already in T at pos %d of %d, atT=%d\n",i,strat->tl,atT);
9404 return;
9405 }
9406 }
9407 #endif
9408
9409 #ifdef HAVE_TAIL_RING
9410 if (currRing!=strat->tailRing)
9411 {
9412 p.t_p=p.GetLmTailRing();
9413 }
9414 #endif
9415 strat->newt = TRUE;
9416 if (atT < 0)
9417 atT = strat->posInT(strat->T, strat->tl, p);
9418 if (strat->tl == strat->tmax-1)
9419 enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
9420 if (atT <= strat->tl)
9421 {
9422 #ifdef ENTER_USE_MEMMOVE
9423 memmove(&(strat->T[atT+1]), &(strat->T[atT]),
9424 (strat->tl-atT+1)*sizeof(TObject));
9425 memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
9426 (strat->tl-atT+1)*sizeof(unsigned long));
9427 #endif
9428 for (i=strat->tl+1; i>=atT+1; i--)
9429 {
9430 #ifndef ENTER_USE_MEMMOVE
9431 strat->T[i] = strat->T[i-1];
9432 strat->sevT[i] = strat->sevT[i-1];
9433 #endif
9434 strat->R[strat->T[i].i_r] = &(strat->T[i]);
9435 }
9436 }
9437
9438 if ((strat->tailBin != NULL) && (pNext(p.p) != NULL))
9439 {
9440 #ifdef HAVE_SHIFTBBA
9441 // letterplace: if p.shift > 0 then pNext(p.p) is already in the tailBin
9442 if (!(currRing->isLPring && p.shift > 0))
9443 #endif
9444 {
9445 pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
9446 (strat->tailRing != NULL ?
9447 strat->tailRing : currRing),
9448 strat->tailBin);
9449 if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
9450 }
9451 }
9452 strat->T[atT] = (TObject) p;
9453 //printf("\nenterT: add new: length = %i, ecart = %i\n",p.length,p.ecart);
9454
9455 if (pNext(p.p) != NULL)
9456 strat->T[atT].max_exp = p_GetMaxExpP(pNext(p.p), strat->tailRing);
9457 else
9458 strat->T[atT].max_exp = NULL;
9459
9460 strat->tl++;
9461 strat->R[strat->tl] = &(strat->T[atT]);
9462 strat->T[atT].i_r = strat->tl;
9463 assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
9464 strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
9465 kTest_T(&(strat->T[atT]));
9466 }
9467
9468 /*2
9469 * puts p to the set T at position atT
9470 */
9471 #ifdef HAVE_RINGS
enterT_strong(LObject & p,kStrategy strat,int atT)9472 void enterT_strong(LObject &p, kStrategy strat, int atT)
9473 {
9474 assume(rField_is_Ring(currRing));
9475 int i;
9476
9477 pp_Test(p.p, currRing, p.tailRing);
9478 assume(strat->tailRing == p.tailRing);
9479 // redMoraNF complains about this -- but, we don't really
9480 // neeed this so far
9481 assume(p.pLength == 0 || pLength(p.p) == p.pLength || rIsSyzIndexRing(currRing)); // modulo syzring
9482 assume(p.FDeg == p.pFDeg());
9483 assume(!p.is_normalized || nIsOne(pGetCoeff(p.p)));
9484
9485 #ifdef KDEBUG
9486 // do not put an LObject twice into T:
9487 for(i=strat->tl;i>=0;i--)
9488 {
9489 if (p.p==strat->T[i].p)
9490 {
9491 printf("already in T at pos %d of %d, atT=%d\n",i,strat->tl,atT);
9492 return;
9493 }
9494 }
9495 #endif
9496
9497 #ifdef HAVE_TAIL_RING
9498 if (currRing!=strat->tailRing)
9499 {
9500 p.t_p=p.GetLmTailRing();
9501 }
9502 #endif
9503 strat->newt = TRUE;
9504 if (atT < 0)
9505 atT = strat->posInT(strat->T, strat->tl, p);
9506 if (strat->tl == strat->tmax-1)
9507 enlargeT(strat->T,strat->R,strat->sevT,strat->tmax,setmaxTinc);
9508 if (atT <= strat->tl)
9509 {
9510 #ifdef ENTER_USE_MEMMOVE
9511 memmove(&(strat->T[atT+1]), &(strat->T[atT]),
9512 (strat->tl-atT+1)*sizeof(TObject));
9513 memmove(&(strat->sevT[atT+1]), &(strat->sevT[atT]),
9514 (strat->tl-atT+1)*sizeof(unsigned long));
9515 #endif
9516 for (i=strat->tl+1; i>=atT+1; i--)
9517 {
9518 #ifndef ENTER_USE_MEMMOVE
9519 strat->T[i] = strat->T[i-1];
9520 strat->sevT[i] = strat->sevT[i-1];
9521 #endif
9522 strat->R[strat->T[i].i_r] = &(strat->T[i]);
9523 }
9524 }
9525
9526 if ((strat->tailBin != NULL) && (pNext(p.p) != NULL))
9527 {
9528 pNext(p.p)=p_ShallowCopyDelete(pNext(p.p),
9529 (strat->tailRing != NULL ?
9530 strat->tailRing : currRing),
9531 strat->tailBin);
9532 if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
9533 }
9534 strat->T[atT] = (TObject) p;
9535 //printf("\nenterT_strong: add new: length = %i, ecart = %i\n",p.length,p.ecart);
9536
9537 if (pNext(p.p) != NULL)
9538 strat->T[atT].max_exp = p_GetMaxExpP(pNext(p.p), strat->tailRing);
9539 else
9540 strat->T[atT].max_exp = NULL;
9541
9542 strat->tl++;
9543 strat->R[strat->tl] = &(strat->T[atT]);
9544 strat->T[atT].i_r = strat->tl;
9545 assume(p.sev == 0 || pGetShortExpVector(p.p) == p.sev);
9546 strat->sevT[atT] = (p.sev == 0 ? pGetShortExpVector(p.p) : p.sev);
9547 #if 1
9548 if(rHasLocalOrMixedOrdering(currRing)
9549 && !n_IsUnit(p.p->coef, currRing->cf))
9550 {
9551 for(i=strat->tl;i>=0;i--)
9552 {
9553 if(strat->T[i].ecart <= p.ecart && pLmDivisibleBy(strat->T[i].p,p.p))
9554 {
9555 enterOneStrongPoly(i,p.p,p.ecart,0,strat,0 , TRUE);
9556 }
9557 }
9558 }
9559 /*
9560 printf("\nThis is T:\n");
9561 for(i=strat->tl;i>=0;i--)
9562 {
9563 pWrite(strat->T[i].p);
9564 }
9565 //getchar();*/
9566 #endif
9567 kTest_T(&(strat->T[atT]));
9568 }
9569 #endif
9570
9571 /*2
9572 * puts signature p.sig to the set syz
9573 */
enterSyz(LObject & p,kStrategy strat,int atT)9574 void enterSyz(LObject &p, kStrategy strat, int atT)
9575 {
9576 int i;
9577 strat->newt = TRUE;
9578 if (strat->syzl == strat->syzmax-1)
9579 {
9580 pEnlargeSet(&strat->syz,strat->syzmax,setmax);
9581 strat->sevSyz = (unsigned long*) omRealloc0Size(strat->sevSyz,
9582 (strat->syzmax)*sizeof(unsigned long),
9583 ((strat->syzmax)+setmax)
9584 *sizeof(unsigned long));
9585 strat->syzmax += setmax;
9586 }
9587 if (atT < strat->syzl)
9588 {
9589 #ifdef ENTER_USE_MEMMOVE
9590 memmove(&(strat->syz[atT+1]), &(strat->syz[atT]),
9591 (strat->syzl-atT+1)*sizeof(poly));
9592 memmove(&(strat->sevSyz[atT+1]), &(strat->sevSyz[atT]),
9593 (strat->syzl-atT+1)*sizeof(unsigned long));
9594 #endif
9595 for (i=strat->syzl; i>=atT+1; i--)
9596 {
9597 #ifndef ENTER_USE_MEMMOVE
9598 strat->syz[i] = strat->syz[i-1];
9599 strat->sevSyz[i] = strat->sevSyz[i-1];
9600 #endif
9601 }
9602 }
9603 //i = strat->syzl;
9604 i = atT;
9605 //Makes sure the syz saves just the signature
9606 #ifdef HAVE_RINGS
9607 if(rField_is_Ring(currRing))
9608 pNext(p.sig) = NULL;
9609 #endif
9610 strat->syz[atT] = p.sig;
9611 strat->sevSyz[atT] = p.sevSig;
9612 strat->syzl++;
9613 #if F5DEBUG
9614 Print("element in strat->syz: %d--%d ",atT+1,strat->syzmax);
9615 pWrite(strat->syz[atT]);
9616 #endif
9617 // recheck pairs in strat->L with new rule and delete correspondingly
9618 int cc = strat->Ll;
9619 while (cc>-1)
9620 {
9621 //printf("\nCheck if syz is div by L\n");pWrite(strat->syz[atT]);pWrite(strat->L[cc].sig);
9622 //printf("\npLmShDivBy(syz,L) = %i\nn_DivBy(L,syz) = %i\n pLtCmp(L,syz) = %i",p_LmShortDivisibleBy( strat->syz[atT], strat->sevSyz[atT],strat->L[cc].sig, ~strat->L[cc].sevSig, currRing), n_DivBy(pGetCoeff(strat->L[cc].sig),pGetCoeff(strat->syz[atT]),currRing), pLtCmp(strat->L[cc].sig,strat->syz[atT])==1);
9623 if (p_LmShortDivisibleBy( strat->syz[atT], strat->sevSyz[atT],
9624 strat->L[cc].sig, ~strat->L[cc].sevSig, currRing)
9625 #ifdef HAVE_RINGS
9626 &&((!rField_is_Ring(currRing))
9627 || (n_DivBy(pGetCoeff(strat->L[cc].sig),pGetCoeff(strat->syz[atT]),currRing->cf) && (pLtCmp(strat->L[cc].sig,strat->syz[atT])==1)))
9628 #endif
9629 )
9630 {
9631 //printf("\nYES!\n");
9632 deleteInL(strat->L,&strat->Ll,cc,strat);
9633 }
9634 cc--;
9635 }
9636 //#if 1
9637 #ifdef DEBUGF5
9638 PrintS("--- Syzygies ---\n");
9639 Print("syzl %d\n",strat->syzl);
9640 Print("syzmax %d\n",strat->syzmax);
9641 PrintS("--------------------------------\n");
9642 for(i=0;i<=strat->syzl-1;i++)
9643 {
9644 Print("%d - ",i);
9645 pWrite(strat->syz[i]);
9646 }
9647 PrintS("--------------------------------\n");
9648 #endif
9649 }
9650
9651
initHilbCrit(ideal,ideal,intvec ** hilb,kStrategy strat)9652 void initHilbCrit(ideal/*F*/, ideal /*Q*/, intvec **hilb,kStrategy strat)
9653 {
9654
9655 //if the ordering is local, then hilb criterion
9656 //can be used also if the ideal is not homogenous
9657 if((rHasLocalOrMixedOrdering(currRing)) && (rHasMixedOrdering(currRing)==FALSE))
9658 {
9659 if(rField_is_Ring(currRing))
9660 *hilb=NULL;
9661 else
9662 return;
9663 }
9664 if (strat->homog!=isHomog)
9665 {
9666 *hilb=NULL;
9667 }
9668 }
9669
initBuchMoraCrit(kStrategy strat)9670 void initBuchMoraCrit(kStrategy strat)
9671 {
9672 strat->enterOnePair=enterOnePairNormal;
9673 strat->chainCrit=chainCritNormal;
9674 if (TEST_OPT_SB_1)
9675 strat->chainCrit=chainCritOpt_1;
9676 #ifdef HAVE_RINGS
9677 if (rField_is_Ring(currRing))
9678 {
9679 strat->enterOnePair=enterOnePairRing;
9680 strat->chainCrit=chainCritRing;
9681 }
9682 #endif
9683 #ifdef HAVE_RATGRING
9684 if (rIsRatGRing(currRing))
9685 {
9686 strat->chainCrit=chainCritPart;
9687 /* enterOnePairNormal get rational part in it */
9688 }
9689 #endif
9690 if (TEST_OPT_IDLIFT
9691 && (strat->syzComp==1)
9692 && (!rIsPluralRing(currRing)))
9693 strat->enterOnePair=enterOnePairLift;
9694
9695 strat->sugarCrit = TEST_OPT_SUGARCRIT;
9696 strat->Gebauer = strat->homog || strat->sugarCrit;
9697 strat->honey = !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
9698 if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
9699 strat->pairtest = NULL;
9700 /* alway use tailreduction, except:
9701 * - in local rings, - in lex order case, -in ring over extensions */
9702 strat->noTailReduction = !TEST_OPT_REDTAIL;
9703 //if(rHasMixedOrdering(currRing)==2)
9704 //{
9705 // strat->noTailReduction =TRUE;
9706 //}
9707
9708 #ifdef HAVE_PLURAL
9709 // and r is plural_ring
9710 // hence this holds for r a rational_plural_ring
9711 if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
9712 { //or it has non-quasi-comm type... later
9713 strat->sugarCrit = FALSE;
9714 strat->Gebauer = FALSE;
9715 strat->honey = FALSE;
9716 }
9717 #endif
9718
9719 // Coefficient ring?
9720 if (rField_is_Ring(currRing))
9721 {
9722 strat->sugarCrit = FALSE;
9723 strat->Gebauer = FALSE ;
9724 strat->honey = FALSE;
9725 }
9726 #ifdef KDEBUG
9727 if (TEST_OPT_DEBUG)
9728 {
9729 if (strat->homog) PrintS("ideal/module is homogeneous\n");
9730 else PrintS("ideal/module is not homogeneous\n");
9731 }
9732 #endif
9733 }
9734
initSbaCrit(kStrategy strat)9735 void initSbaCrit(kStrategy strat)
9736 {
9737 //strat->enterOnePair=enterOnePairNormal;
9738 strat->enterOnePair = enterOnePairNormal;
9739 //strat->chainCrit=chainCritNormal;
9740 strat->chainCrit = chainCritSig;
9741 /******************************************
9742 * rewCrit1 and rewCrit2 are already set in
9743 * kSba() in kstd1.cc
9744 *****************************************/
9745 //strat->rewCrit1 = faugereRewCriterion;
9746 if (strat->sbaOrder == 1)
9747 {
9748 strat->syzCrit = syzCriterionInc;
9749 }
9750 else
9751 {
9752 strat->syzCrit = syzCriterion;
9753 }
9754 #ifdef HAVE_RINGS
9755 if (rField_is_Ring(currRing))
9756 {
9757 strat->enterOnePair=enterOnePairRing;
9758 strat->chainCrit=chainCritRing;
9759 }
9760 #endif
9761 #ifdef HAVE_RATGRING
9762 if (rIsRatGRing(currRing))
9763 {
9764 strat->chainCrit=chainCritPart;
9765 /* enterOnePairNormal get rational part in it */
9766 }
9767 #endif
9768
9769 strat->sugarCrit = TEST_OPT_SUGARCRIT;
9770 strat->Gebauer = strat->homog || strat->sugarCrit;
9771 strat->honey = !strat->homog || strat->sugarCrit || TEST_OPT_WEIGHTM;
9772 if (TEST_OPT_NOT_SUGAR) strat->honey = FALSE;
9773 strat->pairtest = NULL;
9774 /* alway use tailreduction, except:
9775 * - in local rings, - in lex order case, -in ring over extensions */
9776 strat->noTailReduction = !TEST_OPT_REDTAIL;
9777 if(rHasMixedOrdering(currRing)) strat->noTailReduction =TRUE;
9778
9779 #ifdef HAVE_PLURAL
9780 // and r is plural_ring
9781 // hence this holds for r a rational_plural_ring
9782 if( rIsPluralRing(currRing) || (rIsSCA(currRing) && !strat->z2homog) )
9783 { //or it has non-quasi-comm type... later
9784 strat->sugarCrit = FALSE;
9785 strat->Gebauer = FALSE;
9786 strat->honey = FALSE;
9787 }
9788 #endif
9789
9790 // Coefficient ring?
9791 if (rField_is_Ring(currRing))
9792 {
9793 strat->sugarCrit = FALSE;
9794 strat->Gebauer = FALSE ;
9795 strat->honey = FALSE;
9796 }
9797 #ifdef KDEBUG
9798 if (TEST_OPT_DEBUG)
9799 {
9800 if (strat->homog) PrintS("ideal/module is homogeneous\n");
9801 else PrintS("ideal/module is not homogeneous\n");
9802 }
9803 #endif
9804 }
9805
kPosInLDependsOnLength(int (* pos_in_l)(const LSet set,const int length,LObject * L,const kStrategy strat))9806 BOOLEAN kPosInLDependsOnLength(int (*pos_in_l)
9807 (const LSet set, const int length,
9808 LObject* L,const kStrategy strat))
9809 {
9810 if (pos_in_l == posInL110
9811 || pos_in_l == posInL10
9812 #ifdef HAVE_RINGS
9813 || pos_in_l == posInL110Ring
9814 || pos_in_l == posInLRing
9815 #endif
9816 )
9817 return TRUE;
9818
9819 return FALSE;
9820 }
9821
initBuchMoraPos(kStrategy strat)9822 void initBuchMoraPos (kStrategy strat)
9823 {
9824 if (rHasGlobalOrdering(currRing))
9825 {
9826 if (strat->honey)
9827 {
9828 strat->posInL = posInL15;
9829 // ok -- here is the deal: from my experiments for Singular-2-0
9830 // I conclude that that posInT_EcartpLength is the best of
9831 // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
9832 // see the table at the end of this file
9833 if (TEST_OPT_OLDSTD)
9834 strat->posInT = posInT15;
9835 else
9836 strat->posInT = posInT_EcartpLength;
9837 }
9838 else if (currRing->pLexOrder && !TEST_OPT_INTSTRATEGY)
9839 {
9840 strat->posInL = posInL11;
9841 strat->posInT = posInT11;
9842 }
9843 else if (TEST_OPT_INTSTRATEGY)
9844 {
9845 strat->posInL = posInL11;
9846 strat->posInT = posInT11;
9847 }
9848 else
9849 {
9850 strat->posInL = posInL0;
9851 strat->posInT = posInT0;
9852 }
9853 //if (strat->minim>0) strat->posInL =posInLSpecial;
9854 if (strat->homog)
9855 {
9856 strat->posInL = posInL110;
9857 strat->posInT = posInT110;
9858 }
9859 }
9860 else
9861 {
9862 if (strat->homog)
9863 {
9864 strat->posInL = posInL11;
9865 strat->posInT = posInT11;
9866 }
9867 else
9868 {
9869 if ((currRing->order[0]==ringorder_c)
9870 ||(currRing->order[0]==ringorder_C))
9871 {
9872 strat->posInL = posInL17_c;
9873 strat->posInT = posInT17_c;
9874 }
9875 else
9876 {
9877 strat->posInL = posInL17;
9878 strat->posInT = posInT17;
9879 }
9880 }
9881 }
9882 if (strat->minim>0) strat->posInL =posInLSpecial;
9883 // for further tests only
9884 if ((BTEST1(11)) || (BTEST1(12)))
9885 strat->posInL = posInL11;
9886 else if ((BTEST1(13)) || (BTEST1(14)))
9887 strat->posInL = posInL13;
9888 else if ((BTEST1(15)) || (BTEST1(16)))
9889 strat->posInL = posInL15;
9890 else if ((BTEST1(17)) || (BTEST1(18)))
9891 strat->posInL = posInL17;
9892 if (BTEST1(11))
9893 strat->posInT = posInT11;
9894 else if (BTEST1(13))
9895 strat->posInT = posInT13;
9896 else if (BTEST1(15))
9897 strat->posInT = posInT15;
9898 else if ((BTEST1(17)))
9899 strat->posInT = posInT17;
9900 else if ((BTEST1(19)))
9901 strat->posInT = posInT19;
9902 else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
9903 strat->posInT = posInT1;
9904 strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
9905 }
9906
9907 #ifdef HAVE_RINGS
initBuchMoraPosRing(kStrategy strat)9908 void initBuchMoraPosRing (kStrategy strat)
9909 {
9910 if (rHasGlobalOrdering(currRing))
9911 {
9912 if (strat->honey)
9913 {
9914 strat->posInL = posInL15Ring;
9915 // ok -- here is the deal: from my experiments for Singular-2-0
9916 // I conclude that that posInT_EcartpLength is the best of
9917 // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
9918 // see the table at the end of this file
9919 if (TEST_OPT_OLDSTD)
9920 strat->posInT = posInT15Ring;
9921 else
9922 strat->posInT = posInT_EcartpLength;
9923 }
9924 else if (currRing->pLexOrder && !TEST_OPT_INTSTRATEGY)
9925 {
9926 strat->posInL = posInL11Ring;
9927 strat->posInT = posInT11;
9928 }
9929 else if (TEST_OPT_INTSTRATEGY)
9930 {
9931 strat->posInL = posInL11Ring;
9932 strat->posInT = posInT11;
9933 }
9934 else
9935 {
9936 strat->posInL = posInL0Ring;
9937 strat->posInT = posInT0;
9938 }
9939 //if (strat->minim>0) strat->posInL =posInLSpecial;
9940 if (strat->homog)
9941 {
9942 strat->posInL = posInL110Ring;
9943 strat->posInT = posInT110Ring;
9944 }
9945 }
9946 else
9947 {
9948 if (strat->homog)
9949 {
9950 //printf("\nHere 3\n");
9951 strat->posInL = posInL11Ring;
9952 strat->posInT = posInT11Ring;
9953 }
9954 else
9955 {
9956 if ((currRing->order[0]==ringorder_c)
9957 ||(currRing->order[0]==ringorder_C))
9958 {
9959 strat->posInL = posInL17_cRing;
9960 strat->posInT = posInT17_cRing;
9961 }
9962 else
9963 {
9964 strat->posInL = posInL11Ringls;
9965 strat->posInT = posInT17Ring;
9966 }
9967 }
9968 }
9969 if (strat->minim>0) strat->posInL =posInLSpecial;
9970 // for further tests only
9971 if ((BTEST1(11)) || (BTEST1(12)))
9972 strat->posInL = posInL11Ring;
9973 else if ((BTEST1(13)) || (BTEST1(14)))
9974 strat->posInL = posInL13;
9975 else if ((BTEST1(15)) || (BTEST1(16)))
9976 strat->posInL = posInL15Ring;
9977 else if ((BTEST1(17)) || (BTEST1(18)))
9978 strat->posInL = posInL17Ring;
9979 if (BTEST1(11))
9980 strat->posInT = posInT11Ring;
9981 else if (BTEST1(13))
9982 strat->posInT = posInT13;
9983 else if (BTEST1(15))
9984 strat->posInT = posInT15Ring;
9985 else if ((BTEST1(17)))
9986 strat->posInT = posInT17Ring;
9987 else if ((BTEST1(19)))
9988 strat->posInT = posInT19;
9989 else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
9990 strat->posInT = posInT1;
9991 strat->posInLDependsOnLength = kPosInLDependsOnLength(strat->posInL);
9992 }
9993 #endif
9994
initBuchMora(ideal F,ideal Q,kStrategy strat)9995 void initBuchMora (ideal F,ideal Q,kStrategy strat)
9996 {
9997 strat->interpt = BTEST1(OPT_INTERRUPT);
9998 strat->kHEdge=NULL;
9999 if (rHasGlobalOrdering(currRing)) strat->kHEdgeFound=FALSE;
10000 /*- creating temp data structures------------------- -*/
10001 strat->cp = 0;
10002 strat->c3 = 0;
10003 #ifdef HAVE_SHIFTBBA
10004 strat->cv = 0;
10005 #endif
10006 strat->tail = pInit();
10007 /*- set s -*/
10008 strat->sl = -1;
10009 /*- set L -*/
10010 strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
10011 strat->Ll = -1;
10012 strat->L = initL(strat->Lmax);
10013 /*- set B -*/
10014 strat->Bmax = setmaxL;
10015 strat->Bl = -1;
10016 strat->B = initL();
10017 /*- set T -*/
10018 strat->tl = -1;
10019 strat->tmax = setmaxT;
10020 strat->T = initT();
10021 strat->R = initR();
10022 strat->sevT = initsevT();
10023 /*- init local data struct.---------------------------------------- -*/
10024 strat->P.ecart=0;
10025 strat->P.length=0;
10026 strat->P.pLength=0;
10027 if (rHasLocalOrMixedOrdering(currRing))
10028 {
10029 if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
10030 if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
10031 }
10032 if(rField_is_Ring(currRing))
10033 {
10034 /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
10035 }
10036 else
10037 {
10038 if(TEST_OPT_SB_1)
10039 {
10040 int i;
10041 ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
10042 for (i=strat->newIdeal;i<IDELEMS(F);i++)
10043 {
10044 P->m[i-strat->newIdeal] = F->m[i];
10045 F->m[i] = NULL;
10046 }
10047 initSSpecial(F,Q,P,strat);
10048 for (i=strat->newIdeal;i<IDELEMS(F);i++)
10049 {
10050 F->m[i] = P->m[i-strat->newIdeal];
10051 P->m[i-strat->newIdeal] = NULL;
10052 }
10053 idDelete(&P);
10054 }
10055 else
10056 {
10057 /*Shdl=*/initSL(F, Q,strat); /*sets also S, ecartS, fromQ */
10058 // /*Shdl=*/initS(F, Q,strat); /*sets also S, ecartS, fromQ */
10059 }
10060 }
10061 strat->fromT = FALSE;
10062 strat->noTailReduction = !TEST_OPT_REDTAIL;
10063 if ((!TEST_OPT_SB_1)
10064 || (rField_is_Ring(currRing))
10065 )
10066 {
10067 updateS(TRUE,strat);
10068 }
10069 #ifdef HAVE_SHIFTBBA
10070 if (!(rIsLPRing(currRing) && strat->rightGB)) // for right GB, we need to check later whether a poly is from Q
10071 #endif
10072 {
10073 if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
10074 strat->fromQ=NULL;
10075 }
10076 assume(kTest_TS(strat));
10077 }
10078
exitBuchMora(kStrategy strat)10079 void exitBuchMora (kStrategy strat)
10080 {
10081 /*- release temp data -*/
10082 cleanT(strat);
10083 omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
10084 omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
10085 omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
10086 omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
10087 omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
10088 omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
10089 /*- set L: should be empty -*/
10090 omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
10091 /*- set B: should be empty -*/
10092 omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
10093 pLmFree(&strat->tail);
10094 strat->syzComp=0;
10095
10096 #ifdef HAVE_SHIFTBBA
10097 if (rIsLPRing(currRing) && strat->rightGB)
10098 {
10099 if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
10100 strat->fromQ=NULL;
10101 }
10102 #endif
10103 }
10104
initSbaPos(kStrategy strat)10105 void initSbaPos (kStrategy strat)
10106 {
10107 if (rHasGlobalOrdering(currRing))
10108 {
10109 if (strat->honey)
10110 {
10111 strat->posInL = posInL15;
10112 // ok -- here is the deal: from my experiments for Singular-2-0
10113 // I conclude that that posInT_EcartpLength is the best of
10114 // posInT15, posInT_EcartFDegpLength, posInT_FDegLength, posInT_pLength
10115 // see the table at the end of this file
10116 if (TEST_OPT_OLDSTD)
10117 strat->posInT = posInT15;
10118 else
10119 strat->posInT = posInT_EcartpLength;
10120 }
10121 else if (currRing->pLexOrder && !TEST_OPT_INTSTRATEGY)
10122 {
10123 strat->posInL = posInL11;
10124 strat->posInT = posInT11;
10125 }
10126 else if (TEST_OPT_INTSTRATEGY)
10127 {
10128 strat->posInL = posInL11;
10129 strat->posInT = posInT11;
10130 }
10131 else
10132 {
10133 strat->posInL = posInL0;
10134 strat->posInT = posInT0;
10135 }
10136 //if (strat->minim>0) strat->posInL =posInLSpecial;
10137 if (strat->homog)
10138 {
10139 strat->posInL = posInL110;
10140 strat->posInT = posInT110;
10141 }
10142 }
10143 else
10144 {
10145 if (strat->homog)
10146 {
10147 strat->posInL = posInL11;
10148 strat->posInT = posInT11;
10149 }
10150 else
10151 {
10152 if ((currRing->order[0]==ringorder_c)
10153 ||(currRing->order[0]==ringorder_C))
10154 {
10155 strat->posInL = posInL17_c;
10156 strat->posInT = posInT17_c;
10157 }
10158 else
10159 {
10160 strat->posInL = posInL17;
10161 strat->posInT = posInT17;
10162 }
10163 }
10164 }
10165 if (strat->minim>0) strat->posInL =posInLSpecial;
10166 // for further tests only
10167 if ((BTEST1(11)) || (BTEST1(12)))
10168 strat->posInL = posInL11;
10169 else if ((BTEST1(13)) || (BTEST1(14)))
10170 strat->posInL = posInL13;
10171 else if ((BTEST1(15)) || (BTEST1(16)))
10172 strat->posInL = posInL15;
10173 else if ((BTEST1(17)) || (BTEST1(18)))
10174 strat->posInL = posInL17;
10175 if (BTEST1(11))
10176 strat->posInT = posInT11;
10177 else if (BTEST1(13))
10178 strat->posInT = posInT13;
10179 else if (BTEST1(15))
10180 strat->posInT = posInT15;
10181 else if ((BTEST1(17)))
10182 strat->posInT = posInT17;
10183 else if ((BTEST1(19)))
10184 strat->posInT = posInT19;
10185 else if (BTEST1(12) || BTEST1(14) || BTEST1(16) || BTEST1(18))
10186 strat->posInT = posInT1;
10187 if (rField_is_Ring(currRing))
10188 {
10189 strat->posInL = posInL11Ring;
10190 if(rHasLocalOrMixedOrdering(currRing) && currRing->pLexOrder == TRUE)
10191 strat->posInL = posInL11Ringls;
10192 strat->posInT = posInT11;
10193 }
10194 strat->posInLDependsOnLength = FALSE;
10195 strat->posInLSba = posInLSig;
10196 //strat->posInL = posInLSig;
10197 strat->posInL = posInLF5C;
10198 /*
10199 if (rField_is_Ring(currRing))
10200 {
10201 strat->posInLSba = posInLSigRing;
10202 strat->posInL = posInL11Ring;
10203 }*/
10204 //strat->posInT = posInTSig;
10205 }
10206
initSbaBuchMora(ideal F,ideal Q,kStrategy strat)10207 void initSbaBuchMora (ideal F,ideal Q,kStrategy strat)
10208 {
10209 strat->interpt = BTEST1(OPT_INTERRUPT);
10210 strat->kHEdge=NULL;
10211 if (rHasGlobalOrdering(currRing)) strat->kHEdgeFound=FALSE;
10212 /*- creating temp data structures------------------- -*/
10213 strat->cp = 0;
10214 strat->c3 = 0;
10215 strat->tail = pInit();
10216 /*- set s -*/
10217 strat->sl = -1;
10218 /*- set ps -*/
10219 strat->syzl = -1;
10220 /*- set L -*/
10221 strat->Lmax = ((IDELEMS(F)+setmaxLinc-1)/setmaxLinc)*setmaxLinc;
10222 strat->Ll = -1;
10223 strat->L = initL(strat->Lmax);
10224 /*- set B -*/
10225 strat->Bmax = setmaxL;
10226 strat->Bl = -1;
10227 strat->B = initL();
10228 /*- set T -*/
10229 strat->tl = -1;
10230 strat->tmax = setmaxT;
10231 strat->T = initT();
10232 strat->R = initR();
10233 strat->sevT = initsevT();
10234 /*- init local data struct.---------------------------------------- -*/
10235 strat->P.ecart=0;
10236 strat->P.length=0;
10237 if (rHasLocalOrMixedOrdering(currRing))
10238 {
10239 if (strat->kHEdge!=NULL) pSetComp(strat->kHEdge, strat->ak);
10240 if (strat->kNoether!=NULL) pSetComp(strat->kNoetherTail(), strat->ak);
10241 }
10242 if(rField_is_Ring(currRing))
10243 {
10244 /*Shdl=*/initSLSba(F, Q,strat); /*sets also S, ecartS, fromQ */
10245 }
10246 else
10247 {
10248 if(TEST_OPT_SB_1)
10249 {
10250 int i;
10251 ideal P=idInit(IDELEMS(F)-strat->newIdeal,F->rank);
10252 for (i=strat->newIdeal;i<IDELEMS(F);i++)
10253 {
10254 P->m[i-strat->newIdeal] = F->m[i];
10255 F->m[i] = NULL;
10256 }
10257 initSSpecialSba(F,Q,P,strat);
10258 for (i=strat->newIdeal;i<IDELEMS(F);i++)
10259 {
10260 F->m[i] = P->m[i-strat->newIdeal];
10261 P->m[i-strat->newIdeal] = NULL;
10262 }
10263 idDelete(&P);
10264 }
10265 else
10266 {
10267 initSLSba(F, Q,strat); /*sets also S, ecartS, fromQ */
10268 }
10269 }
10270 strat->fromT = FALSE;
10271 if (!TEST_OPT_SB_1)
10272 {
10273 if(!rField_is_Ring(currRing)) updateS(TRUE,strat);
10274 }
10275 //if (strat->fromQ!=NULL) omFreeSize(strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
10276 //strat->fromQ=NULL;
10277 assume(kTest_TS(strat));
10278 }
10279
exitSba(kStrategy strat)10280 void exitSba (kStrategy strat)
10281 {
10282 /*- release temp data -*/
10283 if(rField_is_Ring(currRing))
10284 cleanTSbaRing(strat);
10285 else
10286 cleanT(strat);
10287 omFreeSize(strat->T,(strat->tmax)*sizeof(TObject));
10288 omFreeSize(strat->R,(strat->tmax)*sizeof(TObject*));
10289 omFreeSize(strat->sevT, (strat->tmax)*sizeof(unsigned long));
10290 omFreeSize(strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
10291 omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
10292 omFreeSize((ADDRESS)strat->sevSig,IDELEMS(strat->Shdl)*sizeof(unsigned long));
10293 if(strat->syzmax>0)
10294 {
10295 omFreeSize((ADDRESS)strat->syz,(strat->syzmax)*sizeof(poly));
10296 omFreeSize((ADDRESS)strat->sevSyz,(strat->syzmax)*sizeof(unsigned long));
10297 if (strat->sbaOrder == 1)
10298 {
10299 omFreeSize(strat->syzIdx,(strat->syzidxmax)*sizeof(int));
10300 }
10301 }
10302 omFreeSize(strat->S_2_R,IDELEMS(strat->Shdl)*sizeof(int));
10303 /*- set L: should be empty -*/
10304 omFreeSize(strat->L,(strat->Lmax)*sizeof(LObject));
10305 /*- set B: should be empty -*/
10306 omFreeSize(strat->B,(strat->Bmax)*sizeof(LObject));
10307 /*- set sig: no need for the signatures anymore -*/
10308 omFreeSize(strat->sig,IDELEMS(strat->Shdl)*sizeof(poly));
10309 pLmDelete(&strat->tail);
10310 strat->syzComp=0;
10311 }
10312
10313 /*2
10314 * in the case of a standardbase of a module over a qring:
10315 * replace polynomials in i by ak vectors,
10316 * (the polynomial * unit vectors gen(1)..gen(ak)
10317 * in every case (also for ideals:)
10318 * deletes divisible vectors/polynomials
10319 */
updateResult(ideal r,ideal Q,kStrategy strat)10320 void updateResult(ideal r,ideal Q, kStrategy strat)
10321 {
10322 int l;
10323 if (strat->ak>0)
10324 {
10325 for (l=IDELEMS(r)-1;l>=0;l--)
10326 {
10327 if ((r->m[l]!=NULL) && (pGetComp(r->m[l])==0))
10328 {
10329 pDelete(&r->m[l]); // and set it to NULL
10330 }
10331 }
10332 int q;
10333 poly p;
10334 if(!rField_is_Ring(currRing))
10335 {
10336 for (l=IDELEMS(r)-1;l>=0;l--)
10337 {
10338 if ((r->m[l]!=NULL)
10339 //&& (strat->syzComp>0)
10340 //&& (pGetComp(r->m[l])<=strat->syzComp)
10341 )
10342 {
10343 for(q=IDELEMS(Q)-1; q>=0;q--)
10344 {
10345 if ((Q->m[q]!=NULL)
10346 &&(pLmDivisibleBy(Q->m[q],r->m[l])))
10347 {
10348 if (TEST_OPT_REDSB)
10349 {
10350 p=r->m[l];
10351 r->m[l]=kNF(Q,NULL,p);
10352 pDelete(&p);
10353 }
10354 else
10355 {
10356 pDelete(&r->m[l]); // and set it to NULL
10357 }
10358 break;
10359 }
10360 }
10361 }
10362 }
10363 }
10364 #ifdef HAVE_RINGS
10365 else
10366 {
10367 for (l=IDELEMS(r)-1;l>=0;l--)
10368 {
10369 if ((r->m[l]!=NULL)
10370 //&& (strat->syzComp>0)
10371 //&& (pGetComp(r->m[l])<=strat->syzComp)
10372 )
10373 {
10374 for(q=IDELEMS(Q)-1; q>=0;q--)
10375 {
10376 if ((Q->m[q]!=NULL)
10377 &&(pLmDivisibleBy(Q->m[q],r->m[l])))
10378 {
10379 if(n_DivBy(r->m[l]->coef, Q->m[q]->coef, currRing->cf))
10380 {
10381 if (TEST_OPT_REDSB)
10382 {
10383 p=r->m[l];
10384 r->m[l]=kNF(Q,NULL,p);
10385 pDelete(&p);
10386 }
10387 else
10388 {
10389 pDelete(&r->m[l]); // and set it to NULL
10390 }
10391 break;
10392 }
10393 }
10394 }
10395 }
10396 }
10397 }
10398 #endif
10399 }
10400 else
10401 {
10402 int q;
10403 poly p;
10404 BOOLEAN reduction_found=FALSE;
10405 if (!rField_is_Ring(currRing))
10406 {
10407 for (l=IDELEMS(r)-1;l>=0;l--)
10408 {
10409 if (r->m[l]!=NULL)
10410 {
10411 for(q=IDELEMS(Q)-1; q>=0;q--)
10412 {
10413 if ((Q->m[q]!=NULL)&&(pLmEqual(Q->m[q],r->m[l])))
10414 {
10415 if (TEST_OPT_REDSB)
10416 {
10417 p=r->m[l];
10418 r->m[l]=kNF(Q,NULL,p);
10419 pDelete(&p);
10420 reduction_found=TRUE;
10421 }
10422 else
10423 {
10424 pDelete(&r->m[l]); // and set it to NULL
10425 }
10426 break;
10427 }
10428 }
10429 }
10430 }
10431 }
10432 #ifdef HAVE_RINGS
10433 //Also need divisibility of the leading coefficients
10434 else
10435 {
10436 for (l=IDELEMS(r)-1;l>=0;l--)
10437 {
10438 if (r->m[l]!=NULL)
10439 {
10440 for(q=IDELEMS(Q)-1; q>=0;q--)
10441 {
10442 if(n_DivBy(r->m[l]->coef, Q->m[q]->coef, currRing->cf))
10443 {
10444 if ((Q->m[q]!=NULL)&&(pLmEqual(Q->m[q],r->m[l])) && pDivisibleBy(Q->m[q],r->m[l]))
10445 {
10446 if (TEST_OPT_REDSB)
10447 {
10448 p=r->m[l];
10449 r->m[l]=kNF(Q,NULL,p);
10450 pDelete(&p);
10451 reduction_found=TRUE;
10452 }
10453 else
10454 {
10455 pDelete(&r->m[l]); // and set it to NULL
10456 }
10457 break;
10458 }
10459 }
10460 }
10461 }
10462 }
10463 }
10464 #endif
10465 if (/*TEST_OPT_REDSB &&*/ reduction_found)
10466 {
10467 #ifdef HAVE_RINGS
10468 if(rField_is_Ring(currRing))
10469 {
10470 for (l=IDELEMS(r)-1;l>=0;l--)
10471 {
10472 if (r->m[l]!=NULL)
10473 {
10474 for(q=IDELEMS(r)-1;q>=0;q--)
10475 {
10476 if ((l!=q)
10477 && (r->m[q]!=NULL)
10478 &&(pLmDivisibleBy(r->m[l],r->m[q]))
10479 &&(n_DivBy(r->m[q]->coef, r->m[l]->coef, currRing->cf))
10480 )
10481 {
10482 //If they are equal then take the one with the smallest length
10483 if(pLmDivisibleBy(r->m[q],r->m[l])
10484 && n_DivBy(r->m[q]->coef, r->m[l]->coef, currRing->cf)
10485 && (pLength(r->m[q]) < pLength(r->m[l]) ||
10486 (pLength(r->m[q]) == pLength(r->m[l]) && nGreaterZero(r->m[q]->coef))))
10487 {
10488 pDelete(&r->m[l]);
10489 break;
10490 }
10491 else
10492 pDelete(&r->m[q]);
10493 }
10494 }
10495 }
10496 }
10497 }
10498 else
10499 #endif
10500 {
10501 for (l=IDELEMS(r)-1;l>=0;l--)
10502 {
10503 if (r->m[l]!=NULL)
10504 {
10505 for(q=IDELEMS(r)-1;q>=0;q--)
10506 {
10507 if ((l!=q)
10508 && (r->m[q]!=NULL)
10509 &&(pLmDivisibleBy(r->m[l],r->m[q]))
10510 )
10511 {
10512 //If they are equal then take the one with the smallest length
10513 if(pLmDivisibleBy(r->m[q],r->m[l])
10514 &&(pLength(r->m[q]) < pLength(r->m[l]) ||
10515 (pLength(r->m[q]) == pLength(r->m[l]) && nGreaterZero(r->m[q]->coef))))
10516 {
10517 pDelete(&r->m[l]);
10518 break;
10519 }
10520 else
10521 pDelete(&r->m[q]);
10522 }
10523 }
10524 }
10525 }
10526 }
10527 }
10528 }
10529 idSkipZeroes(r);
10530 }
10531
completeReduce(kStrategy strat,BOOLEAN withT)10532 void completeReduce (kStrategy strat, BOOLEAN withT)
10533 {
10534 int i;
10535 int low = (((rHasGlobalOrdering(currRing)) && (strat->ak==0)) ? 1 : 0);
10536 LObject L;
10537
10538 #ifdef KDEBUG
10539 // need to set this: during tailreductions of T[i], T[i].max is out of
10540 // sync
10541 sloppy_max = TRUE;
10542 #endif
10543
10544 strat->noTailReduction = FALSE;
10545 //if(rHasMixedOrdering(currRing)) strat->noTailReduction = TRUE;
10546 if (TEST_OPT_PROT)
10547 {
10548 PrintLn();
10549 // if (timerv) writeTime("standard base computed:");
10550 }
10551 if (TEST_OPT_PROT)
10552 {
10553 Print("(S:%d)",strat->sl);mflush();
10554 }
10555 for (i=strat->sl; i>=low; i--)
10556 {
10557 int end_pos=strat->sl;
10558 if ((strat->fromQ!=NULL) && (strat->fromQ[i])) continue; // do not reduce Q_i
10559 if (strat->ak==0) end_pos=i-1;
10560 TObject* T_j = strat->s_2_t(i);
10561 if ((T_j != NULL)&&(T_j->p==strat->S[i]))
10562 {
10563 L = *T_j;
10564 #ifdef KDEBUG
10565 if (TEST_OPT_DEBUG)
10566 {
10567 Print("test S[%d]:",i);
10568 p_wrp(L.p,currRing,strat->tailRing);
10569 PrintLn();
10570 }
10571 #endif
10572 if (rHasGlobalOrdering(currRing))
10573 strat->S[i] = redtailBba(&L, end_pos, strat, withT);
10574 else
10575 strat->S[i] = redtail(&L, strat->sl, strat);
10576 #ifdef KDEBUG
10577 if (TEST_OPT_DEBUG)
10578 {
10579 Print("to (tailR) S[%d]:",i);
10580 p_wrp(strat->S[i],currRing,strat->tailRing);
10581 PrintLn();
10582 }
10583 #endif
10584
10585 if (strat->redTailChange)
10586 {
10587 if (T_j->max_exp != NULL) p_LmFree(T_j->max_exp, strat->tailRing);
10588 if (pNext(T_j->p) != NULL)
10589 T_j->max_exp = p_GetMaxExpP(pNext(T_j->p), strat->tailRing);
10590 else
10591 T_j->max_exp = NULL;
10592 }
10593 if (TEST_OPT_INTSTRATEGY)
10594 T_j->pCleardenom();
10595 }
10596 else
10597 {
10598 assume(currRing == strat->tailRing);
10599 #ifdef KDEBUG
10600 if (TEST_OPT_DEBUG)
10601 {
10602 Print("test S[%d]:",i);
10603 p_wrp(strat->S[i],currRing,strat->tailRing);
10604 PrintLn();
10605 }
10606 #endif
10607 if (rHasGlobalOrdering(currRing))
10608 strat->S[i] = redtailBba(strat->S[i], end_pos, strat, withT);
10609 else
10610 strat->S[i] = redtail(strat->S[i], strat->sl, strat);
10611 if (TEST_OPT_INTSTRATEGY)
10612 {
10613 if (TEST_OPT_CONTENTSB)
10614 {
10615 number n;
10616 p_Cleardenom_n(strat->S[i], currRing, n);// also does remove Content
10617 if (!nIsOne(n))
10618 {
10619 denominator_list denom=(denominator_list)omAlloc(sizeof(denominator_list_s));
10620 denom->n=nInvers(n);
10621 denom->next=DENOMINATOR_LIST;
10622 DENOMINATOR_LIST=denom;
10623 }
10624 nDelete(&n);
10625 }
10626 else
10627 {
10628 strat->S[i]=p_Cleardenom(strat->S[i], currRing);// also does remove Content
10629 }
10630 }
10631 #ifdef KDEBUG
10632 if (TEST_OPT_DEBUG)
10633 {
10634 Print("to (-tailR) S[%d]:",i);
10635 p_wrp(strat->S[i],currRing,strat->tailRing);
10636 PrintLn();
10637 }
10638 #endif
10639 }
10640 if (TEST_OPT_PROT)
10641 PrintS("-");
10642 }
10643 if (TEST_OPT_PROT) PrintLn();
10644 #ifdef KDEBUG
10645 sloppy_max = FALSE;
10646 #endif
10647 }
10648
10649
10650 /*2
10651 * computes the new strat->kHEdge and the new pNoether,
10652 * returns TRUE, if pNoether has changed
10653 */
newHEdge(kStrategy strat)10654 BOOLEAN newHEdge(kStrategy strat)
10655 {
10656 if (currRing->pLexOrder || rHasMixedOrdering(currRing))
10657 return FALSE;
10658 int i,j;
10659 poly newNoether;
10660
10661 #if 0
10662 if (currRing->weight_all_1)
10663 scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
10664 else
10665 scComputeHCw(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
10666 #else
10667 scComputeHC(strat->Shdl,NULL,strat->ak,strat->kHEdge, strat->tailRing);
10668 #endif
10669 if (strat->kHEdge==NULL) return FALSE;
10670 if (strat->t_kHEdge != NULL) p_LmFree(strat->t_kHEdge, strat->tailRing);
10671 if (strat->tailRing != currRing)
10672 strat->t_kHEdge = k_LmInit_currRing_2_tailRing(strat->kHEdge, strat->tailRing);
10673 /* compare old and new noether*/
10674 newNoether = pLmInit(strat->kHEdge);
10675 pSetCoeff0(newNoether,nInit(1));
10676 j = p_FDeg(newNoether,currRing);
10677 for (i=1; i<=(currRing->N); i++)
10678 {
10679 if (pGetExp(newNoether, i) > 0) pDecrExp(newNoether,i);
10680 }
10681 pSetm(newNoether);
10682 if (j < strat->HCord) /*- statistics -*/
10683 {
10684 if (TEST_OPT_PROT)
10685 {
10686 Print("H(%d)",j);
10687 mflush();
10688 }
10689 strat->HCord=j;
10690 #ifdef KDEBUG
10691 if (TEST_OPT_DEBUG)
10692 {
10693 Print("H(%d):",j);
10694 wrp(strat->kHEdge);
10695 PrintLn();
10696 }
10697 #endif
10698 }
10699 if (pCmp(strat->kNoether,newNoether)!=1)
10700 {
10701 if (strat->kNoether!=NULL) pLmDelete(&strat->kNoether);
10702 strat->kNoether=newNoether;
10703 if (strat->t_kNoether != NULL) p_LmFree(strat->t_kNoether, strat->tailRing);
10704 if (strat->tailRing != currRing)
10705 strat->t_kNoether = k_LmInit_currRing_2_tailRing(strat->kNoether, strat->tailRing);
10706
10707 return TRUE;
10708 }
10709 pLmDelete(newNoether);
10710 return FALSE;
10711 }
10712
10713 /***************************************************************
10714 *
10715 * Routines related for ring changes during std computations
10716 *
10717 ***************************************************************/
kCheckSpolyCreation(LObject * L,kStrategy strat,poly & m1,poly & m2)10718 BOOLEAN kCheckSpolyCreation(LObject *L, kStrategy strat, poly &m1, poly &m2)
10719 {
10720 if (strat->overflow) return FALSE;
10721 assume(L->p1 != NULL && L->p2 != NULL);
10722 // shift changes: from 0 to -1
10723 assume(L->i_r1 >= -1 && L->i_r1 <= strat->tl);
10724 assume(L->i_r2 >= -1 && L->i_r2 <= strat->tl);
10725
10726 if (! k_GetLeadTerms(L->p1, L->p2, currRing, m1, m2, strat->tailRing))
10727 return FALSE;
10728 // shift changes: extra case inserted
10729 if ((L->i_r1 == -1) || (L->i_r2 == -1) )
10730 {
10731 return TRUE;
10732 }
10733 poly p1_max=NULL;
10734 if ((L->i_r1>=0)&&(strat->R[L->i_r1]!=NULL)) p1_max = (strat->R[L->i_r1])->max_exp;
10735 poly p2_max=NULL;
10736 if ((L->i_r2>=0)&&(strat->R[L->i_r2]!=NULL)) p2_max = (strat->R[L->i_r2])->max_exp;
10737
10738 if (((p1_max != NULL) && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
10739 ((p2_max != NULL) && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
10740 {
10741 p_LmFree(m1, strat->tailRing);
10742 p_LmFree(m2, strat->tailRing);
10743 m1 = NULL;
10744 m2 = NULL;
10745 return FALSE;
10746 }
10747 return TRUE;
10748 }
10749
10750 #ifdef HAVE_RINGS
10751 /***************************************************************
10752 *
10753 * Checks, if we can compute the gcd poly / strong pair
10754 * gcd-poly = m1 * R[atR] + m2 * S[atS]
10755 *
10756 ***************************************************************/
kCheckStrongCreation(int atR,poly m1,int atS,poly m2,kStrategy strat)10757 BOOLEAN kCheckStrongCreation(int atR, poly m1, int atS, poly m2, kStrategy strat)
10758 {
10759 assume(strat->S_2_R[atS] >= -1 && strat->S_2_R[atS] <= strat->tl);
10760 //assume(strat->tailRing != currRing);
10761
10762 poly p1_max = (strat->R[atR])->max_exp;
10763 poly p2_max = (strat->R[strat->S_2_R[atS]])->max_exp;
10764
10765 if (((p1_max != NULL) && !p_LmExpVectorAddIsOk(m1, p1_max, strat->tailRing)) ||
10766 ((p2_max != NULL) && !p_LmExpVectorAddIsOk(m2, p2_max, strat->tailRing)))
10767 {
10768 return FALSE;
10769 }
10770 return TRUE;
10771 }
10772 #endif
10773
10774 #ifdef HAVE_RINGS
10775 /*!
10776 used for GB over ZZ: look for constant and monomial elements in the ideal
10777 background: any known constant element of ideal suppresses
10778 intermediate coefficient swell
10779 */
preIntegerCheck(const ideal Forig,const ideal Q)10780 poly preIntegerCheck(const ideal Forig, const ideal Q)
10781 {
10782 if(!nCoeff_is_Z(currRing->cf))
10783 return NULL;
10784 ideal F = idCopy(Forig);
10785 idSkipZeroes(F);
10786 poly pmon;
10787 ring origR = currRing;
10788 ideal monred = idInit(1,1);
10789 for(int i=0; i<idElem(F); i++)
10790 {
10791 if(pNext(F->m[i]) == NULL)
10792 idInsertPoly(monred, pCopy(F->m[i]));
10793 }
10794 int posconst = idPosConstant(F);
10795 if((posconst != -1) && (!nIsZero(F->m[posconst]->coef)))
10796 {
10797 idDelete(&F);
10798 idDelete(&monred);
10799 return NULL;
10800 }
10801 int idelemQ = 0;
10802 if(Q!=NULL)
10803 {
10804 idelemQ = IDELEMS(Q);
10805 for(int i=0; i<idelemQ; i++)
10806 {
10807 if(pNext(Q->m[i]) == NULL)
10808 idInsertPoly(monred, pCopy(Q->m[i]));
10809 }
10810 idSkipZeroes(monred);
10811 posconst = idPosConstant(monred);
10812 //the constant, if found, will be from Q
10813 if((posconst != -1) && (!nIsZero(monred->m[posconst]->coef)))
10814 {
10815 pmon = pCopy(monred->m[posconst]);
10816 idDelete(&F);
10817 idDelete(&monred);
10818 return pmon;
10819 }
10820 }
10821 ring QQ_ring = rCopy0(currRing,FALSE);
10822 nKillChar(QQ_ring->cf);
10823 QQ_ring->cf = nInitChar(n_Q, NULL);
10824 rComplete(QQ_ring,1);
10825 QQ_ring = rAssure_c_dp(QQ_ring);
10826 rChangeCurrRing(QQ_ring);
10827 nMapFunc nMap = n_SetMap(origR->cf, QQ_ring->cf);
10828 ideal II = idInit(IDELEMS(F)+idelemQ+2,id_RankFreeModule(F, origR));
10829 for(int i = 0, j = 0; i<IDELEMS(F); i++)
10830 II->m[j++] = prMapR(F->m[i], nMap, origR, QQ_ring);
10831 for(int i = 0, j = IDELEMS(F); i<idelemQ; i++)
10832 II->m[j++] = prMapR(Q->m[i], nMap, origR, QQ_ring);
10833 ideal one = kStd(II, NULL, isNotHomog, NULL);
10834 idSkipZeroes(one);
10835 if(idIsConstant(one))
10836 {
10837 //one should be <1>
10838 for(int i = IDELEMS(II)-1; i>=0; i--)
10839 if(II->m[i] != NULL)
10840 II->m[i+1] = II->m[i];
10841 II->m[0] = pOne();
10842 ideal syz = idSyzygies(II, isNotHomog, NULL);
10843 poly integer = NULL;
10844 for(int i = IDELEMS(syz)-1;i>=0; i--)
10845 {
10846 if(pGetComp(syz->m[i]) == 1)
10847 {
10848 pSetComp(syz->m[i],0);
10849 if(pIsConstant(pHead(syz->m[i])))
10850 {
10851 integer = pHead(syz->m[i]);
10852 break;
10853 }
10854 }
10855 }
10856 rChangeCurrRing(origR);
10857 nMapFunc nMap2 = n_SetMap(QQ_ring->cf, origR->cf);
10858 pmon = prMapR(integer, nMap2, QQ_ring, origR);
10859 idDelete(&monred);
10860 idDelete(&F);
10861 id_Delete(&II,QQ_ring);
10862 id_Delete(&one,QQ_ring);
10863 id_Delete(&syz,QQ_ring);
10864 p_Delete(&integer,QQ_ring);
10865 rDelete(QQ_ring);
10866 return pmon;
10867 }
10868 else
10869 {
10870 if(idIs0(monred))
10871 {
10872 poly mindegmon = NULL;
10873 for(int i = 0; i<IDELEMS(one); i++)
10874 {
10875 if(pNext(one->m[i]) == NULL)
10876 {
10877 if(mindegmon == NULL)
10878 mindegmon = pCopy(one->m[i]);
10879 else
10880 {
10881 if(p_Deg(one->m[i], QQ_ring) < p_Deg(mindegmon, QQ_ring))
10882 mindegmon = pCopy(one->m[i]);
10883 }
10884 }
10885 }
10886 if(mindegmon != NULL)
10887 {
10888 for(int i = IDELEMS(II)-1; i>=0; i--)
10889 if(II->m[i] != NULL)
10890 II->m[i+1] = II->m[i];
10891 II->m[0] = pCopy(mindegmon);
10892 ideal syz = idSyzygies(II, isNotHomog, NULL);
10893 bool found = FALSE;
10894 for(int i = IDELEMS(syz)-1;i>=0; i--)
10895 {
10896 if(pGetComp(syz->m[i]) == 1)
10897 {
10898 pSetComp(syz->m[i],0);
10899 if(pIsConstant(pHead(syz->m[i])))
10900 {
10901 pSetCoeff(mindegmon, nCopy(syz->m[i]->coef));
10902 found = TRUE;
10903 break;
10904 }
10905 }
10906 }
10907 id_Delete(&syz,QQ_ring);
10908 if (found == FALSE)
10909 {
10910 rChangeCurrRing(origR);
10911 idDelete(&monred);
10912 idDelete(&F);
10913 id_Delete(&II,QQ_ring);
10914 id_Delete(&one,QQ_ring);
10915 rDelete(QQ_ring);
10916 return NULL;
10917 }
10918 rChangeCurrRing(origR);
10919 nMapFunc nMap2 = n_SetMap(QQ_ring->cf, origR->cf);
10920 pmon = prMapR(mindegmon, nMap2, QQ_ring, origR);
10921 idDelete(&monred);
10922 idDelete(&F);
10923 id_Delete(&II,QQ_ring);
10924 id_Delete(&one,QQ_ring);
10925 id_Delete(&syz,QQ_ring);
10926 rDelete(QQ_ring);
10927 return pmon;
10928 }
10929 }
10930 }
10931 rChangeCurrRing(origR);
10932 idDelete(&monred);
10933 idDelete(&F);
10934 id_Delete(&II,QQ_ring);
10935 id_Delete(&one,QQ_ring);
10936 rDelete(QQ_ring);
10937 return NULL;
10938 }
10939 #endif
10940
10941 #ifdef HAVE_RINGS
10942 /*!
10943 used for GB over ZZ: intermediate reduction by monomial elements
10944 background: any known constant element of ideal suppresses
10945 intermediate coefficient swell
10946 */
postReduceByMon(LObject * h,kStrategy strat)10947 void postReduceByMon(LObject* h, kStrategy strat)
10948 {
10949 if(!nCoeff_is_Z(currRing->cf))
10950 return;
10951 poly pH = h->GetP();
10952 poly p,pp;
10953 p = pH;
10954 bool deleted = FALSE, ok = FALSE;
10955 for(int i = 0; i<=strat->sl; i++)
10956 {
10957 p = pH;
10958 if(pNext(strat->S[i]) == NULL)
10959 {
10960 //pWrite(p);
10961 //pWrite(strat->S[i]);
10962 while(ok == FALSE && p != NULL)
10963 {
10964 if(pLmDivisibleBy(strat->S[i], p)
10965 #ifdef HAVE_SHIFTBBA
10966 || (rIsLPRing(currRing) && pLPLmDivisibleBy(strat->S[i], p))
10967 #endif
10968 )
10969 {
10970 number dummy = n_IntMod(p->coef, strat->S[i]->coef, currRing->cf);
10971 p_SetCoeff(p,dummy,currRing);
10972 }
10973 if(nIsZero(p->coef))
10974 {
10975 pLmDelete(&p);
10976 h->p = p;
10977 deleted = TRUE;
10978 }
10979 else
10980 {
10981 ok = TRUE;
10982 }
10983 }
10984 if (p!=NULL)
10985 {
10986 pp = pNext(p);
10987 while(pp != NULL)
10988 {
10989 if(pLmDivisibleBy(strat->S[i], pp)
10990 #ifdef HAVE_SHIFTBBA
10991 || (rIsLPRing(currRing) && pLPLmDivisibleBy(strat->S[i], pp))
10992 #endif
10993 )
10994 {
10995 number dummy = n_IntMod(pp->coef, strat->S[i]->coef, currRing->cf);
10996 p_SetCoeff(pp,dummy,currRing);
10997 if(nIsZero(pp->coef))
10998 {
10999 pLmDelete(&pNext(p));
11000 pp = pNext(p);
11001 deleted = TRUE;
11002 }
11003 else
11004 {
11005 p = pp;
11006 pp = pNext(p);
11007 }
11008 }
11009 else
11010 {
11011 p = pp;
11012 pp = pNext(p);
11013 }
11014 }
11015 }
11016 }
11017 }
11018 h->SetLmCurrRing();
11019 if((deleted)&&(h->p!=NULL))
11020 strat->initEcart(h);
11021 }
11022
postReduceByMonSig(LObject * h,kStrategy strat)11023 void postReduceByMonSig(LObject* h, kStrategy strat)
11024 {
11025 if(!nCoeff_is_Z(currRing->cf))
11026 return;
11027 poly hSig = h->sig;
11028 poly pH = h->GetP();
11029 poly p,pp;
11030 p = pH;
11031 bool deleted = FALSE, ok = FALSE;
11032 for(int i = 0; i<=strat->sl; i++)
11033 {
11034 p = pH;
11035 if(pNext(strat->S[i]) == NULL)
11036 {
11037 while(ok == FALSE && p!=NULL)
11038 {
11039 if(pLmDivisibleBy(strat->S[i], p))
11040 {
11041 poly sigMult = pDivideM(pHead(p),pHead(strat->S[i]));
11042 sigMult = ppMult_mm(sigMult,pCopy(strat->sig[i]));
11043 if(sigMult!= NULL && pLtCmp(hSig,sigMult) == 1)
11044 {
11045 number dummy = n_IntMod(p->coef, strat->S[i]->coef, currRing->cf);
11046 p_SetCoeff(p,dummy,currRing);
11047 }
11048 pDelete(&sigMult);
11049 }
11050 if(nIsZero(p->coef))
11051 {
11052 pLmDelete(&p);
11053 h->p = p;
11054 deleted = TRUE;
11055 }
11056 else
11057 {
11058 ok = TRUE;
11059 }
11060 }
11061 if(p == NULL)
11062 return;
11063 pp = pNext(p);
11064 while(pp != NULL)
11065 {
11066 if(pLmDivisibleBy(strat->S[i], pp))
11067 {
11068 poly sigMult = pDivideM(pHead(p),pHead(strat->S[i]));
11069 sigMult = ppMult_mm(sigMult,pCopy(strat->sig[i]));
11070 if(sigMult!= NULL && pLtCmp(hSig,sigMult) == 1)
11071 {
11072 number dummy = n_IntMod(pp->coef, strat->S[i]->coef, currRing->cf);
11073 p_SetCoeff(pp,dummy,currRing);
11074 if(nIsZero(pp->coef))
11075 {
11076 pLmDelete(&pNext(p));
11077 pp = pNext(p);
11078 deleted = TRUE;
11079 }
11080 else
11081 {
11082 p = pp;
11083 pp = pNext(p);
11084 }
11085 }
11086 else
11087 {
11088 p = pp;
11089 pp = pNext(p);
11090 }
11091 pDelete(&sigMult);
11092 }
11093 else
11094 {
11095 p = pp;
11096 pp = pNext(p);
11097 }
11098 }
11099 }
11100 }
11101 h->SetLmCurrRing();
11102 if(deleted)
11103 strat->initEcart(h);
11104
11105 }
11106
11107 /*!
11108 used for GB over ZZ: final reduction by constant elements
11109 background: any known constant element of ideal suppresses
11110 intermediate coefficient swell and beautifies output
11111 */
finalReduceByMon(kStrategy strat)11112 void finalReduceByMon(kStrategy strat)
11113 {
11114 assume(strat->tl<0); /* can only be called with no elements in T:
11115 i.e. after exitBuchMora */
11116 /* do not use strat->S, strat->sl as they may be out of sync*/
11117 if(!nCoeff_is_Z(currRing->cf))
11118 return;
11119 poly p,pp;
11120 for(int j = 0; j<IDELEMS(strat->Shdl); j++)
11121 {
11122 if((strat->Shdl->m[j]!=NULL)&&(pNext(strat->Shdl->m[j]) == NULL))
11123 {
11124 for(int i = 0; i<IDELEMS(strat->Shdl); i++)
11125 {
11126 if((i != j) && (strat->Shdl->m[i] != NULL))
11127 {
11128 p = strat->Shdl->m[i];
11129 while((p!=NULL) && (pLmDivisibleBy(strat->Shdl->m[j], p)
11130 #if HAVE_SHIFTBBA
11131 || (rIsLPRing(currRing) && pLPLmDivisibleBy(strat->Shdl->m[j], p))
11132 #endif
11133 ))
11134 {
11135 number dummy = n_IntMod(p->coef, strat->Shdl->m[j]->coef, currRing->cf);
11136 if (!nEqual(dummy,p->coef))
11137 {
11138 if (nIsZero(dummy))
11139 {
11140 nDelete(&dummy);
11141 pLmDelete(&strat->Shdl->m[i]);
11142 p=strat->Shdl->m[i];
11143 }
11144 else
11145 {
11146 p_SetCoeff(p,dummy,currRing);
11147 break;
11148 }
11149 }
11150 else
11151 {
11152 nDelete(&dummy);
11153 break;
11154 }
11155 }
11156 if (p!=NULL)
11157 {
11158 pp = pNext(p);
11159 while(pp != NULL)
11160 {
11161 if(pLmDivisibleBy(strat->Shdl->m[j], pp)
11162 #if HAVE_SHIFTBBA
11163 || (rIsLPRing(currRing) && pLPLmDivisibleBy(strat->Shdl->m[j], pp))
11164 #endif
11165 )
11166 {
11167 number dummy = n_IntMod(pp->coef, strat->Shdl->m[j]->coef, currRing->cf);
11168 if (!nEqual(dummy,pp->coef))
11169 {
11170 p_SetCoeff(pp,dummy,currRing);
11171 if(nIsZero(pp->coef))
11172 {
11173 pLmDelete(&pNext(p));
11174 pp = pNext(p);
11175 }
11176 else
11177 {
11178 p = pp;
11179 pp = pNext(p);
11180 }
11181 }
11182 else
11183 {
11184 nDelete(&dummy);
11185 p = pp;
11186 pp = pNext(p);
11187 }
11188 }
11189 else
11190 {
11191 p = pp;
11192 pp = pNext(p);
11193 }
11194 }
11195 }
11196 }
11197 }
11198 //idPrint(strat->Shdl);
11199 }
11200 }
11201 idSkipZeroes(strat->Shdl);
11202 }
11203 #endif
11204
kStratChangeTailRing(kStrategy strat,LObject * L,TObject * T,unsigned long expbound)11205 BOOLEAN kStratChangeTailRing(kStrategy strat, LObject *L, TObject* T, unsigned long expbound)
11206 {
11207 assume((strat->tailRing == currRing) || (strat->tailRing->bitmask <= currRing->bitmask));
11208 /* initial setup or extending */
11209
11210 if (rIsLPRing(currRing)) return TRUE;
11211 if (expbound == 0) expbound = strat->tailRing->bitmask << 1;
11212 if (expbound >= currRing->bitmask) return FALSE;
11213 strat->overflow=FALSE;
11214 ring new_tailRing = rModifyRing(currRing,
11215 // Hmmm .. the condition pFDeg == p_Deg
11216 // might be too strong
11217 (strat->homog && currRing->pFDeg == p_Deg && !(rField_is_Ring(currRing))), // omit degree
11218 (strat->ak==0), // omit_comp if the input is an ideal
11219 expbound); // exp_limit
11220
11221 if (new_tailRing == currRing) return TRUE;
11222
11223 strat->pOrigFDeg_TailRing = new_tailRing->pFDeg;
11224 strat->pOrigLDeg_TailRing = new_tailRing->pLDeg;
11225
11226 if (currRing->pFDeg != currRing->pFDegOrig)
11227 {
11228 new_tailRing->pFDeg = currRing->pFDeg;
11229 new_tailRing->pLDeg = currRing->pLDeg;
11230 }
11231
11232 if (TEST_OPT_PROT)
11233 Print("[%lu:%d", (unsigned long) new_tailRing->bitmask, new_tailRing->ExpL_Size);
11234 kTest_TS(strat);
11235 assume(new_tailRing != strat->tailRing);
11236 pShallowCopyDeleteProc p_shallow_copy_delete
11237 = pGetShallowCopyDeleteProc(strat->tailRing, new_tailRing);
11238
11239 omBin new_tailBin = omGetStickyBinOfBin(new_tailRing->PolyBin);
11240
11241 int i;
11242 for (i=0; i<=strat->tl; i++)
11243 {
11244 strat->T[i].ShallowCopyDelete(new_tailRing, new_tailBin,
11245 p_shallow_copy_delete);
11246 }
11247 for (i=0; i<=strat->Ll; i++)
11248 {
11249 assume(strat->L[i].p != NULL);
11250 if (pNext(strat->L[i].p) != strat->tail)
11251 strat->L[i].ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
11252 }
11253 if ((strat->P.t_p != NULL) ||
11254 ((strat->P.p != NULL) && pNext(strat->P.p) != strat->tail))
11255 strat->P.ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
11256
11257 if ((L != NULL) && (L->tailRing != new_tailRing))
11258 {
11259 if (L->i_r < 0)
11260 L->ShallowCopyDelete(new_tailRing, p_shallow_copy_delete);
11261 else
11262 {
11263 assume(L->i_r <= strat->tl);
11264 TObject* t_l = strat->R[L->i_r];
11265 assume(t_l != NULL);
11266 L->tailRing = new_tailRing;
11267 L->p = t_l->p;
11268 L->t_p = t_l->t_p;
11269 L->max_exp = t_l->max_exp;
11270 }
11271 }
11272
11273 if ((T != NULL) && (T->tailRing != new_tailRing && T->i_r < 0))
11274 T->ShallowCopyDelete(new_tailRing, new_tailBin, p_shallow_copy_delete);
11275
11276 omMergeStickyBinIntoBin(strat->tailBin, strat->tailRing->PolyBin);
11277 if (strat->tailRing != currRing)
11278 rKillModifiedRing(strat->tailRing);
11279
11280 strat->tailRing = new_tailRing;
11281 strat->tailBin = new_tailBin;
11282 strat->p_shallow_copy_delete
11283 = pGetShallowCopyDeleteProc(currRing, new_tailRing);
11284
11285 if (strat->kHEdge != NULL)
11286 {
11287 if (strat->t_kHEdge != NULL)
11288 p_LmFree(strat->t_kHEdge, strat->tailRing);
11289 strat->t_kHEdge=k_LmInit_currRing_2_tailRing(strat->kHEdge, new_tailRing);
11290 }
11291
11292 if (strat->kNoether != NULL)
11293 {
11294 if (strat->t_kNoether != NULL)
11295 p_LmFree(strat->t_kNoether, strat->tailRing);
11296 strat->t_kNoether=k_LmInit_currRing_2_tailRing(strat->kNoether,
11297 new_tailRing);
11298 }
11299 kTest_TS(strat);
11300 if (TEST_OPT_PROT)
11301 PrintS("]");
11302 return TRUE;
11303 }
11304
kStratInitChangeTailRing(kStrategy strat)11305 void kStratInitChangeTailRing(kStrategy strat)
11306 {
11307 unsigned long l = 0;
11308 int i;
11309 long e;
11310
11311 assume(strat->tailRing == currRing);
11312
11313 for (i=0; i<= strat->Ll; i++)
11314 {
11315 l = p_GetMaxExpL(strat->L[i].p, currRing, l);
11316 }
11317 for (i=0; i<=strat->tl; i++)
11318 {
11319 // Hmm ... this we could do in one Step
11320 l = p_GetMaxExpL(strat->T[i].p, currRing, l);
11321 }
11322 if (rField_is_Ring(currRing))
11323 {
11324 l *= 2;
11325 }
11326 e = p_GetMaxExp(l, currRing);
11327 if (e <= 1) e = 2;
11328 if (rIsLPRing(currRing)) e = 1;
11329
11330 kStratChangeTailRing(strat, NULL, NULL, e);
11331 }
11332
sbaRing(kStrategy strat,const ring r,BOOLEAN,int)11333 ring sbaRing (kStrategy strat, const ring r, BOOLEAN /*complete*/, int /*sgn*/)
11334 {
11335 int n = rBlocks(r); // Including trailing zero!
11336 // if sbaOrder == 1 => use (C,monomial order from r)
11337 if (strat->sbaOrder == 1)
11338 {
11339 if (r->order[0] == ringorder_C || r->order[0] == ringorder_c)
11340 {
11341 return r;
11342 }
11343 ring res = rCopy0(r, TRUE, FALSE);
11344 res->order = (rRingOrder_t *)omAlloc0((n+1)*sizeof(rRingOrder_t));
11345 res->block0 = (int *)omAlloc0((n+1)*sizeof(int));
11346 res->block1 = (int *)omAlloc0((n+1)*sizeof(int));
11347 int **wvhdl = (int **)omAlloc0((n+1)*sizeof(int*));
11348 res->wvhdl = wvhdl;
11349 for (int i=1; i<n; i++)
11350 {
11351 res->order[i] = r->order[i-1];
11352 res->block0[i] = r->block0[i-1];
11353 res->block1[i] = r->block1[i-1];
11354 res->wvhdl[i] = r->wvhdl[i-1];
11355 }
11356
11357 // new 1st block
11358 res->order[0] = ringorder_C; // Prefix
11359 // removes useless secondary component order if defined in old ring
11360 for (int i=rBlocks(res); i>0; --i)
11361 {
11362 if (res->order[i] == ringorder_C || res->order[i] == ringorder_c)
11363 {
11364 res->order[i] = (rRingOrder_t)0;
11365 }
11366 }
11367 rComplete(res, 1);
11368 #ifdef HAVE_PLURAL
11369 if (rIsPluralRing(r))
11370 {
11371 if ( nc_rComplete(r, res, false) ) // no qideal!
11372 {
11373 #ifndef SING_NDEBUG
11374 WarnS("error in nc_rComplete");
11375 #endif
11376 // cleanup?
11377
11378 // rDelete(res);
11379 // return r;
11380
11381 // just go on..
11382 }
11383 }
11384 #endif
11385 strat->tailRing = res;
11386 return (res);
11387 }
11388 // if sbaOrder == 3 => degree - position - ring order
11389 if (strat->sbaOrder == 3)
11390 {
11391 ring res = rCopy0(r, TRUE, FALSE);
11392 res->order = (rRingOrder_t*)omAlloc0((n+2)*sizeof(rRingOrder_t));
11393 res->block0 = (int *)omAlloc0((n+2)*sizeof(int));
11394 res->block1 = (int *)omAlloc0((n+2)*sizeof(int));
11395 int **wvhdl = (int **)omAlloc0((n+2)*sizeof(int*));
11396 res->wvhdl = wvhdl;
11397 for (int i=2; i<n+2; i++)
11398 {
11399 res->order[i] = r->order[i-2];
11400 res->block0[i] = r->block0[i-2];
11401 res->block1[i] = r->block1[i-2];
11402 res->wvhdl[i] = r->wvhdl[i-2];
11403 }
11404
11405 // new 1st block
11406 res->order[0] = ringorder_a; // Prefix
11407 res->block0[0] = 1;
11408 res->wvhdl[0] = (int *)omAlloc(res->N*sizeof(int));
11409 for (int i=0; i<res->N; ++i)
11410 res->wvhdl[0][i] = 1;
11411 res->block1[0] = si_min(res->N, rVar(res));
11412 // new 2nd block
11413 res->order[1] = ringorder_C; // Prefix
11414 res->wvhdl[1] = NULL;
11415 // removes useless secondary component order if defined in old ring
11416 for (int i=rBlocks(res); i>1; --i)
11417 {
11418 if (res->order[i] == ringorder_C || res->order[i] == ringorder_c)
11419 {
11420 res->order[i] = (rRingOrder_t)0;
11421 }
11422 }
11423 rComplete(res, 1);
11424 #ifdef HAVE_PLURAL
11425 if (rIsPluralRing(r))
11426 {
11427 if ( nc_rComplete(r, res, false) ) // no qideal!
11428 {
11429 #ifndef SING_NDEBUG
11430 WarnS("error in nc_rComplete");
11431 #endif
11432 // cleanup?
11433
11434 // rDelete(res);
11435 // return r;
11436
11437 // just go on..
11438 }
11439 }
11440 #endif
11441 strat->tailRing = res;
11442 return (res);
11443 }
11444
11445 // not sbaOrder == 1 => use Schreyer order
11446 // this is done by a trick when initializing the signatures
11447 // in initSLSba():
11448 // Instead of using the signature 1e_i for F->m[i], we start
11449 // with the signature LM(F->m[i])e_i for F->m[i]. Doing this we get a
11450 // Schreyer order w.r.t. the underlying monomial order.
11451 // => we do not need to change the underlying polynomial ring at all!
11452
11453 // UPDATE/NOTE/TODO: use induced Schreyer ordering 'IS'!!!!????
11454
11455 /*
11456 else
11457 {
11458 ring res = rCopy0(r, FALSE, FALSE);
11459 // Create 2 more blocks for prefix/suffix:
11460 res->order=(int *)omAlloc0((n+2)*sizeof(int)); // 0 .. n+1
11461 res->block0=(int *)omAlloc0((n+2)*sizeof(int));
11462 res->block1=(int *)omAlloc0((n+2)*sizeof(int));
11463 int ** wvhdl =(int **)omAlloc0((n+2)*sizeof(int**));
11464
11465 // Encapsulate all existing blocks between induced Schreyer ordering markers: prefix and suffix!
11466 // Note that prefix and suffix have the same ringorder marker and only differ in block[] parameters!
11467
11468 // new 1st block
11469 int j = 0;
11470 res->order[j] = ringorder_IS; // Prefix
11471 res->block0[j] = res->block1[j] = 0;
11472 // wvhdl[j] = NULL;
11473 j++;
11474
11475 for(int i = 0; (i < n) && (r->order[i] != 0); i++, j++) // i = [0 .. n-1] <- non-zero old blocks
11476 {
11477 res->order [j] = r->order [i];
11478 res->block0[j] = r->block0[i];
11479 res->block1[j] = r->block1[i];
11480
11481 if (r->wvhdl[i] != NULL)
11482 {
11483 wvhdl[j] = (int*) omMemDup(r->wvhdl[i]);
11484 } // else wvhdl[j] = NULL;
11485 }
11486
11487 // new last block
11488 res->order [j] = ringorder_IS; // Suffix
11489 res->block0[j] = res->block1[j] = sgn; // Sign of v[o]: 1 for C, -1 for c
11490 // wvhdl[j] = NULL;
11491 j++;
11492
11493 // res->order [j] = 0; // The End!
11494 res->wvhdl = wvhdl;
11495
11496 // j == the last zero block now!
11497 assume(j == (n+1));
11498 assume(res->order[0]==ringorder_IS);
11499 assume(res->order[j-1]==ringorder_IS);
11500 assume(res->order[j]==0);
11501
11502 if (complete)
11503 {
11504 rComplete(res, 1);
11505
11506 #ifdef HAVE_PLURAL
11507 if (rIsPluralRing(r))
11508 {
11509 if ( nc_rComplete(r, res, false) ) // no qideal!
11510 {
11511 }
11512 }
11513 assume(rIsPluralRing(r) == rIsPluralRing(res));
11514 #endif
11515
11516
11517 #ifdef HAVE_PLURAL
11518 ring old_ring = r;
11519
11520 #endif
11521
11522 if (r->qideal!=NULL)
11523 {
11524 res->qideal= idrCopyR_NoSort(r->qideal, r, res);
11525
11526 assume(idRankFreeModule(res->qideal, res) == 0);
11527
11528 #ifdef HAVE_PLURAL
11529 if( rIsPluralRing(res) )
11530 if( nc_SetupQuotient(res, r, true) )
11531 {
11532 // WarnS("error in nc_SetupQuotient"); // cleanup? rDelete(res); return r; // just go on...?
11533 }
11534
11535 #endif
11536 assume(idRankFreeModule(res->qideal, res) == 0);
11537 }
11538
11539 #ifdef HAVE_PLURAL
11540 assume((res->qideal==NULL) == (old_ring->qideal==NULL));
11541 assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
11542 assume(rIsSCA(res) == rIsSCA(old_ring));
11543 assume(ncRingType(res) == ncRingType(old_ring));
11544 #endif
11545 }
11546 strat->tailRing = res;
11547 return res;
11548 }
11549 */
11550
11551 assume(FALSE);
11552 return(NULL);
11553 }
11554
skStrategy()11555 skStrategy::skStrategy()
11556 {
11557 memset(this, 0, sizeof(skStrategy));
11558 strat_nr++;
11559 nr=strat_nr;
11560 tailRing = currRing;
11561 P.tailRing = currRing;
11562 tl = -1;
11563 sl = -1;
11564 #ifdef HAVE_LM_BIN
11565 lmBin = omGetStickyBinOfBin(currRing->PolyBin);
11566 #endif
11567 #ifdef HAVE_TAIL_BIN
11568 tailBin = omGetStickyBinOfBin(currRing->PolyBin);
11569 #endif
11570 pOrigFDeg = currRing->pFDeg;
11571 pOrigLDeg = currRing->pLDeg;
11572 }
11573
11574
~skStrategy()11575 skStrategy::~skStrategy()
11576 {
11577 if (lmBin != NULL)
11578 omMergeStickyBinIntoBin(lmBin, currRing->PolyBin);
11579 if (tailBin != NULL)// && !rField_is_Ring(currRing))
11580 omMergeStickyBinIntoBin(tailBin,
11581 ((tailRing != NULL) ? tailRing->PolyBin:
11582 currRing->PolyBin));
11583 if (t_kHEdge != NULL)
11584 p_LmFree(t_kHEdge, tailRing);
11585 if (t_kNoether != NULL)
11586 p_LmFree(t_kNoether, tailRing);
11587
11588 if (currRing != tailRing)
11589 rKillModifiedRing(tailRing);
11590 pRestoreDegProcs(currRing,pOrigFDeg, pOrigLDeg);
11591 }
11592
11593 #if 0
11594 Timings for the different possibilities of posInT:
11595 T15 EDL DL EL L 1-2-3
11596 Gonnet 43.26 42.30 38.34 41.98 38.40 100.04
11597 Hairer_2_1 1.11 1.15 1.04 1.22 1.08 4.7
11598 Twomat3 1.62 1.69 1.70 1.65 1.54 11.32
11599 ahml 4.48 4.03 4.03 4.38 4.96 26.50
11600 c7 15.02 13.98 15.16 13.24 17.31 47.89
11601 c8 505.09 407.46 852.76 413.21 499.19 n/a
11602 f855 12.65 9.27 14.97 8.78 14.23 33.12
11603 gametwo6 11.47 11.35 14.57 11.20 12.02 35.07
11604 gerhard_3 2.73 2.83 2.93 2.64 3.12 6.24
11605 ilias13 22.89 22.46 24.62 20.60 23.34 53.86
11606 noon8 40.68 37.02 37.99 36.82 35.59 877.16
11607 rcyclic_19 48.22 42.29 43.99 45.35 51.51 204.29
11608 rkat9 82.37 79.46 77.20 77.63 82.54 267.92
11609 schwarz_11 16.46 16.81 16.76 16.81 16.72 35.56
11610 test016 16.39 14.17 14.40 13.50 14.26 34.07
11611 test017 34.70 36.01 33.16 35.48 32.75 71.45
11612 test042 10.76 10.99 10.27 11.57 10.45 23.04
11613 test058 6.78 6.75 6.51 6.95 6.22 9.47
11614 test066 10.71 10.94 10.76 10.61 10.56 19.06
11615 test073 10.75 11.11 10.17 10.79 8.63 58.10
11616 test086 12.23 11.81 12.88 12.24 13.37 66.68
11617 test103 5.05 4.80 5.47 4.64 4.89 11.90
11618 test154 12.96 11.64 13.51 12.46 14.61 36.35
11619 test162 65.27 64.01 67.35 59.79 67.54 196.46
11620 test164 7.50 6.50 7.68 6.70 7.96 17.13
11621 virasoro 3.39 3.50 3.35 3.47 3.70 7.66
11622 #endif
11623
11624
11625 //#ifdef HAVE_MORE_POS_IN_T
11626 #if 1
11627 // determines the position based on: 1.) Ecart 2.) FDeg 3.) pLength
11628 int posInT_EcartFDegpLength(const TSet set,const int length,LObject &p)
11629 {
11630
11631 if (length==-1) return 0;
11632
11633 int o = p.ecart;
11634 int op=p.GetpFDeg();
11635 int ol = p.GetpLength();
11636
11637 if (set[length].ecart < o)
11638 return length+1;
11639 if (set[length].ecart == o)
11640 {
11641 int oo=set[length].GetpFDeg();
11642 if ((oo < op) || ((oo==op) && (set[length].length < ol)))
11643 return length+1;
11644 }
11645
11646 int i;
11647 int an = 0;
11648 int en= length;
11649 loop
11650 {
11651 if (an >= en-1)
11652 {
11653 if (set[an].ecart > o)
11654 return an;
11655 if (set[an].ecart == o)
11656 {
11657 int oo=set[an].GetpFDeg();
11658 if((oo > op)
11659 || ((oo==op) && (set[an].pLength > ol)))
11660 return an;
11661 }
11662 return en;
11663 }
11664 i=(an+en) / 2;
11665 if (set[i].ecart > o)
11666 en=i;
11667 else if (set[i].ecart == o)
11668 {
11669 int oo=set[i].GetpFDeg();
11670 if ((oo > op)
11671 || ((oo == op) && (set[i].pLength > ol)))
11672 en=i;
11673 else
11674 an=i;
11675 }
11676 else
11677 an=i;
11678 }
11679 }
11680
11681 // determines the position based on: 1.) FDeg 2.) pLength
posInT_FDegpLength(const TSet set,const int length,LObject & p)11682 int posInT_FDegpLength(const TSet set,const int length,LObject &p)
11683 {
11684
11685 if (length==-1) return 0;
11686
11687 int op=p.GetpFDeg();
11688 int ol = p.GetpLength();
11689
11690 int oo=set[length].GetpFDeg();
11691 if ((oo < op) || ((oo==op) && (set[length].length < ol)))
11692 return length+1;
11693
11694 int i;
11695 int an = 0;
11696 int en= length;
11697 loop
11698 {
11699 if (an >= en-1)
11700 {
11701 int oo=set[an].GetpFDeg();
11702 if((oo > op)
11703 || ((oo==op) && (set[an].pLength > ol)))
11704 return an;
11705 return en;
11706 }
11707 i=(an+en) / 2;
11708 int oo=set[i].GetpFDeg();
11709 if ((oo > op)
11710 || ((oo == op) && (set[i].pLength > ol)))
11711 en=i;
11712 else
11713 an=i;
11714 }
11715 }
11716
11717
11718 // determines the position based on: 1.) pLength
posInT_pLength(const TSet set,const int length,LObject & p)11719 int posInT_pLength(const TSet set,const int length,LObject &p)
11720 {
11721 int ol = p.GetpLength();
11722 if (length==-1)
11723 return 0;
11724 if (set[length].length<p.length)
11725 return length+1;
11726
11727 int i;
11728 int an = 0;
11729 int en= length;
11730
11731 loop
11732 {
11733 if (an >= en-1)
11734 {
11735 if (set[an].pLength>ol) return an;
11736 return en;
11737 }
11738 i=(an+en) / 2;
11739 if (set[i].pLength>ol) en=i;
11740 else an=i;
11741 }
11742 }
11743 #endif
11744
11745 // kstd1.cc:
11746 int redFirst (LObject* h,kStrategy strat);
11747 int redEcart (LObject* h,kStrategy strat);
11748 void enterSMora (LObject &p,int atS,kStrategy strat, int atR=-1);
11749 void enterSMoraNF (LObject &p,int atS,kStrategy strat, int atR=-1);
11750 // ../Singular/misc.cc:
11751 extern char * showOption();
11752
kDebugPrint(kStrategy strat)11753 void kDebugPrint(kStrategy strat)
11754 {
11755 PrintS("red: ");
11756 if (strat->red==redFirst) PrintS("redFirst\n");
11757 else if (strat->red==redHoney) PrintS("redHoney\n");
11758 else if (strat->red==redEcart) PrintS("redEcart\n");
11759 else if (strat->red==redHomog) PrintS("redHomog\n");
11760 else if (strat->red==redLazy) PrintS("redLazy\n");
11761 else if (strat->red==redLiftstd) PrintS("redLiftstd\n");
11762 else Print("%p\n",(void*)strat->red);
11763 PrintS("posInT: ");
11764 if (strat->posInT==posInT0) PrintS("posInT0\n");
11765 else if (strat->posInT==posInT1) PrintS("posInT1\n");
11766 else if (strat->posInT==posInT11) PrintS("posInT11\n");
11767 else if (strat->posInT==posInT110) PrintS("posInT110\n");
11768 else if (strat->posInT==posInT13) PrintS("posInT13\n");
11769 else if (strat->posInT==posInT15) PrintS("posInT15\n");
11770 else if (strat->posInT==posInT17) PrintS("posInT17\n");
11771 else if (strat->posInT==posInT17_c) PrintS("posInT17_c\n");
11772 else if (strat->posInT==posInT19) PrintS("posInT19\n");
11773 else if (strat->posInT==posInT2) PrintS("posInT2\n");
11774 #ifdef HAVE_RINGS
11775 else if (strat->posInT==posInT11Ring) PrintS("posInT11Ring\n");
11776 else if (strat->posInT==posInT110Ring) PrintS("posInT110Ring\n");
11777 else if (strat->posInT==posInT15Ring) PrintS("posInT15Ring\n");
11778 else if (strat->posInT==posInT17Ring) PrintS("posInT17Ring\n");
11779 else if (strat->posInT==posInT17_cRing) PrintS("posInT17_cRing\n");
11780 #endif
11781 #ifdef HAVE_MORE_POS_IN_T
11782 else if (strat->posInT==posInT_EcartFDegpLength) PrintS("posInT_EcartFDegpLength\n");
11783 else if (strat->posInT==posInT_FDegpLength) PrintS("posInT_FDegpLength\n");
11784 else if (strat->posInT==posInT_pLength) PrintS("posInT_pLength\n");
11785 #endif
11786 else if (strat->posInT==posInT_EcartpLength) PrintS("posInT_EcartpLength\n");
11787 else if (strat->posInT==posInTrg0) PrintS("posInTrg0\n");
11788 else Print("%p\n",(void*)strat->posInT);
11789 PrintS("posInL: ");
11790 if (strat->posInL==posInL0) PrintS("posInL0\n");
11791 else if (strat->posInL==posInL10) PrintS("posInL10\n");
11792 else if (strat->posInL==posInL11) PrintS("posInL11\n");
11793 else if (strat->posInL==posInL110) PrintS("posInL110\n");
11794 else if (strat->posInL==posInL13) PrintS("posInL13\n");
11795 else if (strat->posInL==posInL15) PrintS("posInL15\n");
11796 else if (strat->posInL==posInL17) PrintS("posInL17\n");
11797 else if (strat->posInL==posInL17_c) PrintS("posInL17_c\n");
11798 #ifdef HAVE_RINGS
11799 else if (strat->posInL==posInL0) PrintS("posInL0Ring\n");
11800 else if (strat->posInL==posInL11Ring) PrintS("posInL11Ring\n");
11801 else if (strat->posInL==posInL11Ringls) PrintS("posInL11Ringls\n");
11802 else if (strat->posInL==posInL110Ring) PrintS("posInL110Ring\n");
11803 else if (strat->posInL==posInL15Ring) PrintS("posInL15Ring\n");
11804 else if (strat->posInL==posInL17Ring) PrintS("posInL17Ring\n");
11805 else if (strat->posInL==posInL17_cRing) PrintS("posInL17_cRing\n");
11806 #endif
11807 else if (strat->posInL==posInLSpecial) PrintS("posInLSpecial\n");
11808 else if (strat->posInL==posInLrg0) PrintS("posInLrg0\n");
11809 else Print("%p\n",(void*)strat->posInL);
11810 PrintS("enterS: ");
11811 if (strat->enterS==enterSBba) PrintS("enterSBba\n");
11812 else if (strat->enterS==enterSMora) PrintS("enterSMora\n");
11813 else if (strat->enterS==enterSMoraNF) PrintS("enterSMoraNF\n");
11814 else Print("%p\n",(void*)strat->enterS);
11815 PrintS("initEcart: ");
11816 if (strat->initEcart==initEcartBBA) PrintS("initEcartBBA\n");
11817 else if (strat->initEcart==initEcartNormal) PrintS("initEcartNormal\n");
11818 else Print("%p\n",(void*)strat->initEcart);
11819 PrintS("initEcartPair: ");
11820 if (strat->initEcartPair==initEcartPairBba) PrintS("initEcartPairBba\n");
11821 else if (strat->initEcartPair==initEcartPairMora) PrintS("initEcartPairMora\n");
11822 else Print("%p\n",(void*)strat->initEcartPair);
11823 Print("homog=%d, LazyDegree=%d, LazyPass=%d, ak=%d,\n",
11824 strat->homog, strat->LazyDegree,strat->LazyPass, strat->ak);
11825 Print("honey=%d, sugarCrit=%d, Gebauer=%d, noTailReduction=%d, use_buckets=%d\n",
11826 strat->honey,strat->sugarCrit,strat->Gebauer,strat->noTailReduction,strat->use_buckets);
11827 PrintS("chainCrit: ");
11828 if (strat->chainCrit==chainCritNormal) PrintS("chainCritNormal\n");
11829 else if (strat->chainCrit==chainCritOpt_1) PrintS("chainCritOpt_1\n");
11830 else Print("%p\n",(void*)strat->chainCrit);
11831 Print("posInLDependsOnLength=%d\n",
11832 strat->posInLDependsOnLength);
11833 PrintS(showOption());PrintLn();
11834 PrintS("LDeg: ");
11835 if (currRing->pLDeg==pLDeg0) PrintS("pLDeg0");
11836 else if (currRing->pLDeg==pLDeg0c) PrintS("pLDeg0c");
11837 else if (currRing->pLDeg==pLDegb) PrintS("pLDegb");
11838 else if (currRing->pLDeg==pLDeg1) PrintS("pLDeg1");
11839 else if (currRing->pLDeg==pLDeg1c) PrintS("pLDeg1c");
11840 else if (currRing->pLDeg==pLDeg1_Deg) PrintS("pLDeg1_Deg");
11841 else if (currRing->pLDeg==pLDeg1c_Deg) PrintS("pLDeg1c_Deg");
11842 else if (currRing->pLDeg==pLDeg1_Totaldegree) PrintS("pLDeg1_Totaldegree");
11843 else if (currRing->pLDeg==pLDeg1c_Totaldegree) PrintS("pLDeg1c_Totaldegree");
11844 else if (currRing->pLDeg==pLDeg1_WFirstTotalDegree) PrintS("pLDeg1_WFirstTotalDegree");
11845 else if (currRing->pLDeg==pLDeg1c_WFirstTotalDegree) PrintS("pLDeg1c_WFirstTotalDegree");
11846 else if (currRing->pLDeg==maxdegreeWecart) PrintS("maxdegreeWecart");
11847 else Print("? (%lx)", (long)currRing->pLDeg);
11848 PrintS(" / ");
11849 if (strat->tailRing->pLDeg==pLDeg0) PrintS("pLDeg0");
11850 else if (strat->tailRing->pLDeg==pLDeg0c) PrintS("pLDeg0c");
11851 else if (strat->tailRing->pLDeg==pLDegb) PrintS("pLDegb");
11852 else if (strat->tailRing->pLDeg==pLDeg1) PrintS("pLDeg1");
11853 else if (strat->tailRing->pLDeg==pLDeg1c) PrintS("pLDeg1c");
11854 else if (strat->tailRing->pLDeg==pLDeg1_Deg) PrintS("pLDeg1_Deg");
11855 else if (strat->tailRing->pLDeg==pLDeg1c_Deg) PrintS("pLDeg1c_Deg");
11856 else if (strat->tailRing->pLDeg==pLDeg1_Totaldegree) PrintS("pLDeg1_Totaldegree");
11857 else if (strat->tailRing->pLDeg==pLDeg1c_Totaldegree) PrintS("pLDeg1c_Totaldegree");
11858 else if (strat->tailRing->pLDeg==pLDeg1_WFirstTotalDegree) PrintS("pLDeg1_WFirstTotalDegree");
11859 else if (strat->tailRing->pLDeg==pLDeg1c_WFirstTotalDegree) PrintS("pLDeg1c_WFirstTotalDegree");
11860 else if (strat->tailRing->pLDeg==maxdegreeWecart) PrintS("maxdegreeWecart");
11861 else Print("? (%lx)", (long)strat->tailRing->pLDeg);
11862 PrintLn();
11863 PrintS("currRing->pFDeg: ");
11864 if (currRing->pFDeg==p_Totaldegree) PrintS("p_Totaldegree");
11865 else if (currRing->pFDeg==p_WFirstTotalDegree) PrintS("pWFirstTotalDegree");
11866 else if (currRing->pFDeg==p_Deg) PrintS("p_Deg");
11867 else if (currRing->pFDeg==kHomModDeg) PrintS("kHomModDeg");
11868 else if (currRing->pFDeg==totaldegreeWecart) PrintS("totaldegreeWecart");
11869 else if (currRing->pFDeg==p_WTotaldegree) PrintS("p_WTotaldegree");
11870 else Print("? (%lx)", (long)currRing->pFDeg);
11871 PrintLn();
11872 Print(" syzring:%d, syzComp(strat):%d limit:%d\n",rIsSyzIndexRing(currRing),strat->syzComp,rGetCurrSyzLimit(currRing));
11873 if(TEST_OPT_DEGBOUND)
11874 Print(" degBound: %d\n", Kstd1_deg);
11875
11876 if( ecartWeights != NULL )
11877 {
11878 PrintS("ecartWeights: ");
11879 for (int i = rVar(currRing); i > 0; i--)
11880 Print("%hd ", ecartWeights[i]);
11881 PrintLn();
11882 assume( TEST_OPT_WEIGHTM );
11883 }
11884
11885 #ifndef SING_NDEBUG
11886 rDebugPrint(currRing);
11887 #endif
11888 }
11889
11890 #ifdef HAVE_SHIFTBBA
pMove2CurrTail(poly p,kStrategy strat)11891 poly pMove2CurrTail(poly p, kStrategy strat)
11892 {
11893 /* assume: p is completely in currRing */
11894 /* produces an object with LM in curring
11895 and TAIL in tailring */
11896 if (pNext(p)!=NULL)
11897 {
11898 pNext(p) = prMoveR(pNext(p), /* src */ currRing, /* dest */ strat->tailRing);
11899 }
11900 return(p);
11901 }
11902 #endif
11903
11904 #ifdef HAVE_SHIFTBBA
pMoveCurrTail2poly(poly p,kStrategy strat)11905 poly pMoveCurrTail2poly(poly p, kStrategy strat)
11906 {
11907 /* assume: p has LM in curring and TAIL in tailring */
11908 /* convert it to complete currRing */
11909
11910 /* check that LM is in currRing */
11911 assume(p_LmCheckIsFromRing(p, currRing));
11912
11913 if (pNext(p)!=NULL)
11914 {
11915 pNext(p) = prMoveR(pNext(p), /* src */ strat->tailRing, /* dest */currRing);
11916 }
11917 return(p);
11918 }
11919 #endif
11920
11921 #ifdef HAVE_SHIFTBBA
pCopyL2p(LObject H,kStrategy strat)11922 poly pCopyL2p(LObject H, kStrategy strat)
11923 {
11924 /* restores a poly in currRing from LObject */
11925 LObject h = H;
11926 h.Copy();
11927 poly p;
11928 if (h.p == NULL)
11929 {
11930 if (h.t_p != NULL)
11931 {
11932 p = prMoveR(h.t_p, /* source ring: */ strat->tailRing, /* dest. ring: */ currRing);
11933 return(p);
11934 }
11935 else
11936 {
11937 /* h.tp == NULL -> the object is NULL */
11938 return(NULL);
11939 }
11940 }
11941 /* we're here if h.p != NULL */
11942 if (h.t_p == NULL)
11943 {
11944 /* then h.p is the whole poly in currRing */
11945 p = h.p;
11946 return(p);
11947 }
11948 /* we're here if h.p != NULL and h.t_p != NULL */
11949 // clean h.p, get poly from t_p
11950 pNext(h.p)=NULL;
11951 pLmDelete(&h.p);
11952 p = prMoveR(h.t_p, /* source ring: */ strat->tailRing,
11953 /* dest. ring: */ currRing);
11954 // no need to clean h: we re-used the polys
11955 return(p);
11956 }
11957 #endif
11958
11959 //LObject pCopyp2L(poly p, kStrategy strat)
11960 //{
11961 /* creates LObject from the poly in currRing */
11962 /* actually put p into L.p and make L.t_p=NULL : does not work */
11963
11964 //}
11965
11966 // poly pCopyL2p(LObject H, kStrategy strat)
11967 // {
11968 // /* restores a poly in currRing from LObject */
11969 // LObject h = H;
11970 // h.Copy();
11971 // poly p;
11972 // if (h.p == NULL)
11973 // {
11974 // if (h.t_p != NULL)
11975 // {
11976 // p = p_ShallowCopyDelete(h.t_p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
11977 // return(p);
11978 // }
11979 // else
11980 // {
11981 // /* h.tp == NULL -> the object is NULL */
11982 // return(NULL);
11983 // }
11984 // }
11985 // /* we're here if h.p != NULL */
11986
11987 // if (h.t_p == NULL)
11988 // {
11989 // /* then h.p is the whole poly in tailRing */
11990 // if (strat->tailBin != NULL && (pNext(h.p) != NULL))
11991 // {
11992 // p = p_ShallowCopyDelete(h.p, (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
11993 // }
11994 // return(p);
11995 // }
11996 // /* we're here if h.p != NULL and h.t_p != NULL */
11997 // p = pCopy(pHead(h.p)); // in currRing
11998 // if (strat->tailBin != NULL && (pNext(h.p) != NULL))
11999 // {
12000 // // pNext(p) = p_ShallowCopyDelete(pNext(h.t_p), (strat->tailRing != NULL ? strat->tailRing : currRing), strat->tailBin);
12001 // poly pp = p_Copy(pNext(h.p), strat->tailRing);
12002 // // poly p3 = p_Copy(pNext(h.p), currRing); // error
12003 // // p_ShallowCopyDelete(pNext(h.p), currRing, strat->tailBin); // the same as pp
12004 // poly p5 = p_ShallowCopyDelete(pNext(h.p), strat->tailRing, strat->tailBin);
12005 // pNext(p) = p_ShallowCopyDelete(h.t_p, strat->tailRing, strat->tailBin);
12006 // poly p4 = p_Copy(h.t_p, strat->tailRing);
12007 // // if (p.t_p != NULL) pNext(p.t_p) = pNext(p.p);
12008 // }
12009 // // pTest(p);
12010 // return(p);
12011 // }
12012
12013 /*2
12014 * put the lcm(q,p) into the set B, q is the shift of some s[i]
12015 */
12016 #ifdef HAVE_SHIFTBBA
enterOneStrongPolyShift(poly q,poly p,int,int,kStrategy strat,int atR,int,int qisFromQ,int shiftcount,int ifromS)12017 static BOOLEAN enterOneStrongPolyShift (poly q, poly p, int /*ecart*/, int /*isFromQ*/, kStrategy strat, int atR, int /*ecartq*/, int qisFromQ, int shiftcount, int ifromS)
12018 {
12019 number d, s, t;
12020 /* assume(atR >= 0); */
12021 assume(ifromS <= strat->sl);
12022 assume(rField_is_Ring(currRing));
12023 poly m1, m2, gcd;
12024 //printf("\n--------------------------------\n");
12025 //pWrite(p);pWrite(si);
12026 d = n_ExtGcd(pGetCoeff(p), pGetCoeff(q), &s, &t, currRing->cf);
12027
12028 if (nIsZero(s) || nIsZero(t)) // evtl. durch divBy tests ersetzen
12029 {
12030 nDelete(&d);
12031 nDelete(&s);
12032 nDelete(&t);
12033 return FALSE;
12034 }
12035
12036 assume(pIsInV(p));
12037
12038 k_GetStrongLeadTerms(p, q, currRing, m1, m2, gcd, strat->tailRing);
12039
12040 /* the V criterion */
12041 if (!pmIsInV(gcd))
12042 {
12043 strat->cv++;
12044 nDelete(&d);
12045 nDelete(&s);
12046 nDelete(&t);
12047 pLmFree(gcd);
12048 return FALSE;
12049 }
12050
12051 // disabled for Letterplace because it is not so easy to check
12052 /* if (!rHasLocalOrMixedOrdering(currRing)) { */
12053 /* unsigned long sev = pGetShortExpVector(gcd); */
12054
12055 /* for (int j = 0; j < strat->sl; j++) { */
12056 /* if (j == i) */
12057 /* continue; */
12058
12059 /* if (n_DivBy(d, pGetCoeff(strat->S[j]), currRing->cf) && */
12060 /* !(strat->sevS[j] & ~sev) && */
12061 /* p_LmDivisibleBy(strat->S[j], gcd, currRing)) { */
12062 /* nDelete(&d); */
12063 /* nDelete(&s); */
12064 /* nDelete(&t); */
12065 /* return FALSE; */
12066 /* } */
12067 /* } */
12068 /* } */
12069
12070 poly m12, m22;
12071 assume(p_mFirstVblock(p, currRing) <= 1 || p_mFirstVblock(q, currRing) <= 1);
12072 k_SplitFrame(m1, m12, si_max(p_mFirstVblock(p, currRing), 1), currRing);
12073 k_SplitFrame(m2, m22, si_max(p_mFirstVblock(q, currRing), 1), currRing);
12074 // manually free the coeffs, because pSetCoeff0 is used in the next step
12075 n_Delete(&(m1->coef), currRing->cf);
12076 n_Delete(&(m2->coef), currRing->cf);
12077
12078 //p_Test(m1,strat->tailRing);
12079 //p_Test(m2,strat->tailRing);
12080 /*if(!enterTstrong)
12081 {
12082 while (! kCheckStrongCreation(atR, m1, i, m2, strat) )
12083 {
12084 memset(&(strat->P), 0, sizeof(strat->P));
12085 kStratChangeTailRing(strat);
12086 strat->P = *(strat->R[atR]);
12087 p_LmFree(m1, strat->tailRing);
12088 p_LmFree(m2, strat->tailRing);
12089 p_LmFree(gcd, currRing);
12090 k_GetStrongLeadTerms(p, si, currRing, m1, m2, gcd, strat->tailRing);
12091 }
12092 }*/
12093 pSetCoeff0(m1, s);
12094 pSetCoeff0(m2, t);
12095 pSetCoeff0(gcd, d);
12096 p_Test(m1,strat->tailRing);
12097 p_Test(m2,strat->tailRing);
12098 p_Test(m12,strat->tailRing);
12099 p_Test(m22,strat->tailRing);
12100 assume(pmIsInV(m1));
12101 assume(pmIsInV(m2));
12102 assume(pmIsInV(m12));
12103 assume(pmIsInV(m22));
12104 //printf("\n===================================\n");
12105 //pWrite(m1);pWrite(m2);pWrite(gcd);
12106 #ifdef KDEBUG
12107 if (TEST_OPT_DEBUG)
12108 {
12109 // Print("t = %d; s = %d; d = %d\n", nInt(t), nInt(s), nInt(d));
12110 PrintS("m1 = ");
12111 p_wrp(m1, strat->tailRing);
12112 PrintS("m12 = ");
12113 p_wrp(m12, strat->tailRing);
12114 PrintS(" ; m2 = ");
12115 p_wrp(m2, strat->tailRing);
12116 PrintS(" ; m22 = ");
12117 p_wrp(m22, strat->tailRing);
12118 PrintS(" ; gcd = ");
12119 wrp(gcd);
12120 PrintS("\n--- create strong gcd poly: ");
12121 PrintS("\n p: ");
12122 wrp(p);
12123 Print("\n q (strat->S[%d]): ", ifromS);
12124 wrp(q);
12125 PrintS(" ---> ");
12126 }
12127 #endif
12128
12129 pNext(gcd) = p_Add_q(pp_Mult_mm(pp_mm_Mult(pNext(p), m1, strat->tailRing), m12, strat->tailRing), pp_Mult_mm(pp_mm_Mult(pNext(q), m2, strat->tailRing), m22, strat->tailRing), strat->tailRing);
12130 p_LmDelete(m1, strat->tailRing);
12131 p_LmDelete(m2, strat->tailRing);
12132 p_LmDelete(m12, strat->tailRing);
12133 p_LmDelete(m22, strat->tailRing);
12134
12135 assume(pIsInV(gcd));
12136
12137 #ifdef KDEBUG
12138 if (TEST_OPT_DEBUG)
12139 {
12140 wrp(gcd);
12141 PrintLn();
12142 }
12143 #endif
12144
12145 LObject h;
12146 h.p = gcd;
12147 h.tailRing = strat->tailRing;
12148 int posx;
12149 h.pCleardenom();
12150 strat->initEcart(&h);
12151 h.sev = pGetShortExpVector(h.p);
12152 h.i_r1 = -1;h.i_r2 = -1;
12153 if (currRing!=strat->tailRing)
12154 h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
12155 #if 1
12156 h.p1 = p;
12157 h.p2 = q;
12158 #endif
12159 if (atR >= 0 && shiftcount == 0 && ifromS >= 0)
12160 {
12161 h.i_r2 = kFindInT(h.p1, strat);
12162 h.i_r1 = atR;
12163 }
12164 else
12165 {
12166 h.i_r1 = -1;
12167 h.i_r2 = -1;
12168 }
12169 if (strat->Ll==-1)
12170 posx =0;
12171 else
12172 posx = strat->posInL(strat->L,strat->Ll,&h,strat);
12173
12174 assume(pIsInV(h.p));
12175 assume(pIsInV(h.p1));
12176
12177 enterL(&strat->L,&strat->Ll,&strat->Lmax,h,posx);
12178 return TRUE;
12179 }
12180 #endif
12181
12182
12183 /*2
12184 * put the pair (q,p) into the set B, ecart=ecart(p), q is the shift of some s[i] (ring case)
12185 */
12186 #ifdef HAVE_SHIFTBBA
enterOnePairRingShift(poly q,poly p,int,int isFromQ,kStrategy strat,int atR,int,int qisFromQ,int shiftcount,int ifromS)12187 static void enterOnePairRingShift (poly q, poly p, int /*ecart*/, int isFromQ, kStrategy strat, int atR, int /*ecartq*/, int qisFromQ, int shiftcount, int ifromS)
12188 {
12189 /* assume(atR >= 0); */
12190 /* assume(i<=strat->sl); */
12191 assume(p!=NULL);
12192 assume(rField_is_Ring(currRing));
12193 assume(pIsInV(p));
12194 #if ALL_VS_JUST
12195 //Over rings, if we construct the strong pair, do not add the spair
12196 if(rField_is_Ring(currRing))
12197 {
12198 number s,t,d;
12199 d = n_ExtGcd(pGetCoeff(p), pGetCoeff(q, &s, &t, currRing->cf);
12200
12201 if (!nIsZero(s) && !nIsZero(t)) // evtl. durch divBy tests ersetzen
12202 {
12203 nDelete(&d);
12204 nDelete(&s);
12205 nDelete(&t);
12206 return;
12207 }
12208 nDelete(&d);
12209 nDelete(&s);
12210 nDelete(&t);
12211 }
12212 #endif
12213 int j,compare,compareCoeff;
12214 LObject h;
12215
12216 #ifdef KDEBUG
12217 h.ecart=0; h.length=0;
12218 #endif
12219 /*- computes the lcm(s[i],p) -*/
12220 if(pHasNotCFRing(p,q))
12221 {
12222 strat->cp++;
12223 return;
12224 }
12225 h.lcm = p_Lcm(p,q,currRing);
12226 pSetCoeff0(h.lcm, n_Lcm(pGetCoeff(p), pGetCoeff(q), currRing->cf));
12227 if (nIsZero(pGetCoeff(h.lcm)))
12228 {
12229 strat->cp++;
12230 pLmDelete(h.lcm);
12231 return;
12232 }
12233
12234 /* the V criterion */
12235 if (!pmIsInV(h.lcm))
12236 {
12237 strat->cv++;
12238 pLmDelete(h.lcm);
12239 return;
12240 }
12241 // basic chain criterion
12242 /*
12243 *the set B collects the pairs of type (S[j],p)
12244 *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p) != lcm(r,p)
12245 *if the leading term of s divides lcm(r,p) then (r,p) will be canceled
12246 *if the leading term of r divides lcm(s,p) then (s,p) will not enter B
12247 */
12248
12249 for(j = strat->Bl;j>=0;j--)
12250 {
12251 compare=pDivCompRing(strat->B[j].lcm,h.lcm);
12252 compareCoeff = n_DivComp(pGetCoeff(strat->B[j].lcm), pGetCoeff(h.lcm), currRing->cf);
12253 if(compare == pDivComp_EQUAL)
12254 {
12255 //They have the same LM
12256 if(compareCoeff == pDivComp_LESS)
12257 {
12258 if ((strat->fromQ==NULL) || (isFromQ==0) || (qisFromQ==0))
12259 {
12260 strat->c3++;
12261 pLmDelete(h.lcm);
12262 return;
12263 }
12264 break;
12265 }
12266 if(compareCoeff == pDivComp_GREATER)
12267 {
12268 deleteInL(strat->B,&strat->Bl,j,strat);
12269 strat->c3++;
12270 }
12271 if(compareCoeff == pDivComp_EQUAL)
12272 {
12273 if ((strat->fromQ==NULL) || (isFromQ==0) || (qisFromQ==0))
12274 {
12275 strat->c3++;
12276 pLmDelete(h.lcm);
12277 return;
12278 }
12279 break;
12280 }
12281 }
12282 if(compareCoeff == compare || compareCoeff == pDivComp_EQUAL)
12283 {
12284 if(compare == pDivComp_LESS)
12285 {
12286 if ((strat->fromQ==NULL) || (isFromQ==0) || (qisFromQ==0))
12287 {
12288 strat->c3++;
12289 pLmDelete(h.lcm);
12290 return;
12291 }
12292 break;
12293 }
12294 if(compare == pDivComp_GREATER)
12295 {
12296 deleteInL(strat->B,&strat->Bl,j,strat);
12297 strat->c3++;
12298 }
12299 }
12300 }
12301 number s, t;
12302 poly m1, m2, gcd = NULL;
12303 s = pGetCoeff(q);
12304 t = pGetCoeff(p);
12305 k_GetLeadTerms(p,q,currRing,m1,m2,currRing);
12306
12307 poly m12, m22;
12308 assume(p_mFirstVblock(p, currRing) <= 1 || p_mFirstVblock(q, currRing) <= 1);
12309 k_SplitFrame(m1, m12, si_max(p_mFirstVblock(p, currRing), 1), currRing);
12310 k_SplitFrame(m2, m22, si_max(p_mFirstVblock(q, currRing), 1), currRing);
12311 // manually free the coeffs, because pSetCoeff0 is used in the next step
12312 n_Delete(&(m1->coef), currRing->cf);
12313 n_Delete(&(m2->coef), currRing->cf);
12314
12315 ksCheckCoeff(&s, &t, currRing->cf);
12316 pSetCoeff0(m1, s);
12317 pSetCoeff0(m2, t);
12318 m2 = pNeg(m2);
12319 p_Test(m1,strat->tailRing);
12320 p_Test(m2,strat->tailRing);
12321 p_Test(m12,strat->tailRing);
12322 p_Test(m22,strat->tailRing);
12323 assume(pmIsInV(m1));
12324 assume(pmIsInV(m2));
12325 assume(pmIsInV(m12));
12326 assume(pmIsInV(m22));
12327 poly pm1 = pp_Mult_mm(pp_mm_Mult(pNext(p), m1, strat->tailRing), m12, strat->tailRing);
12328 poly sim2 = pp_Mult_mm(pp_mm_Mult(pNext(q), m2, strat->tailRing), m22, strat->tailRing);
12329 assume(pIsInV(pm1));
12330 assume(pIsInV(sim2));
12331 p_LmDelete(m1, currRing);
12332 p_LmDelete(m2, currRing);
12333 p_LmDelete(m12, currRing);
12334 p_LmDelete(m22, currRing);
12335 if(sim2 == NULL)
12336 {
12337 if(pm1 == NULL)
12338 {
12339 if(h.lcm != NULL)
12340 {
12341 pLmDelete(h.lcm);
12342 h.lcm=NULL;
12343 }
12344 h.Clear();
12345 /* TEMPORARILY DISABLED FOR SHIFTS because there is no i*/
12346 /* if (strat->pairtest==NULL) initPairtest(strat); */
12347 /* strat->pairtest[i] = TRUE; */
12348 /* strat->pairtest[strat->sl+1] = TRUE; */
12349 return;
12350 }
12351 else
12352 {
12353 gcd = pm1;
12354 pm1 = NULL;
12355 }
12356 }
12357 else
12358 {
12359 if((pGetComp(q) == 0) && (0 != pGetComp(p)))
12360 {
12361 p_SetCompP(sim2, pGetComp(p), strat->tailRing);
12362 pSetmComp(sim2);
12363 }
12364 //p_Write(pm1,strat->tailRing);p_Write(sim2,strat->tailRing);
12365 gcd = p_Add_q(pm1, sim2, strat->tailRing);
12366 }
12367 p_Test(gcd, strat->tailRing);
12368 assume(pIsInV(gcd));
12369 #ifdef KDEBUG
12370 if (TEST_OPT_DEBUG)
12371 {
12372 wrp(gcd);
12373 PrintLn();
12374 }
12375 #endif
12376 h.p = gcd;
12377 h.i_r = -1;
12378 if(h.p == NULL)
12379 {
12380 /* TEMPORARILY DISABLED FOR SHIFTS because there is no i*/
12381 /* if (strat->pairtest==NULL) initPairtest(strat); */
12382 /* strat->pairtest[i] = TRUE; */
12383 /* strat->pairtest[strat->sl+1] = TRUE; */
12384 return;
12385 }
12386 h.tailRing = strat->tailRing;
12387 int posx;
12388 //h.pCleardenom();
12389 //pSetm(h.p);
12390 h.i_r1 = -1;h.i_r2 = -1;
12391 strat->initEcart(&h);
12392 #if 1
12393 h.p1 = p;
12394 h.p2 = q;
12395 #endif
12396 #if 1
12397 /* TEMPORARILY DISABLED FOR SHIFTS because there's no i*/
12398 /* at the beginning we DO NOT set atR = -1 ANYMORE*/
12399 if (atR >= 0 && shiftcount == 0 && ifromS >= 0)
12400 {
12401 h.i_r2 = kFindInT(h.p1, strat); //strat->S_2_R[i];
12402 h.i_r1 = atR;
12403 }
12404 else
12405 {
12406 /* END _ TEMPORARILY DISABLED FOR SHIFTS */
12407 h.i_r1 = -1;
12408 h.i_r2 = -1;
12409 }
12410 #endif
12411 if (strat->Bl==-1)
12412 posx =0;
12413 else
12414 posx = strat->posInL(strat->B,strat->Bl,&h,strat);
12415 h.sev = pGetShortExpVector(h.p);
12416 if (currRing!=strat->tailRing)
12417 h.t_p = k_LmInit_currRing_2_tailRing(h.p, strat->tailRing);
12418
12419 assume(pIsInV(h.p));
12420 assume(pIsInV(h.p1));
12421 assume(h.lcm != NULL);
12422 assume(pIsInV(h.lcm));
12423
12424 enterL(&strat->B,&strat->Bl,&strat->Bmax,h,posx);
12425 kTest_TS(strat);
12426 }
12427 #endif
12428
12429 #ifdef HAVE_SHIFTBBA
12430 // adds the strong pair and the normal pair for rings (aka gpoly and spoly)
12431 static void enterOneStrongPolyAndEnterOnePairRingShift(poly q, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int ecartq, int qisFromQ, int shiftcount, int ifromS)
12432 {
12433 enterOneStrongPolyShift(q, p, ecart, isFromQ, strat, atR, ecartq, qisFromQ, shiftcount, ifromS); // "gpoly"
12434 enterOnePairRingShift(q, p, ecart, isFromQ, strat, atR, ecartq, qisFromQ, shiftcount, ifromS); // "spoly"
12435 }
12436 #endif
12437
12438 #ifdef HAVE_SHIFTBBA
12439 // creates if possible (q,p), (shifts(q),p)
12440 static void enterOnePairWithShifts (int q_inS /*also i*/, poly q, poly p, int ecartp, int p_isFromQ, kStrategy strat, int atR, int p_lastVblock, int q_lastVblock)
12441 {
12442 // note: ecart and isFromQ is for p
12443 assume(q_inS < 0 || strat->S[q_inS] == q); // if q is from S, q_inS should be the index of q in S
12444 assume(pmFirstVblock(p) == 1);
12445 assume(pmFirstVblock(q) == 1);
12446 assume(p_lastVblock == pmLastVblock(p));
12447 assume(q_lastVblock == pmLastVblock(q));
12448
12449 // TODO: is ecartq = 0 still ok?
12450 int ecartq = 0; //Hans says it's ok; we're in the homog case, no ecart
12451
12452 int q_isFromQ = 0;
12453 if (strat->fromQ != NULL && q_inS >= 0)
12454 q_isFromQ = strat->fromQ[q_inS];
12455
12456 void (*enterPair)(poly, poly, int, int, kStrategy, int, int, int, int, int);
12457 #ifdef HAVE_RINGS
12458 if (rField_is_Ring(currRing))
12459 enterPair = enterOneStrongPolyAndEnterOnePairRingShift;
12460 else
12461 #endif
12462 enterPair = enterOnePairShift;
12463
12464 int degbound = currRing->N/currRing->isLPring;
12465 int neededShift = p_lastVblock - ((pGetComp(p) > 0 || pGetComp(q) > 0) ? 0 : 1); // in the module case, product criterion does not hold
12466 int maxPossibleShift = degbound - q_lastVblock;
12467 int maxShift = si_min(neededShift, maxPossibleShift);
12468 int firstShift = (q == p ? 1 : 0); // do not add (q,p) if q=p
12469 for (int j = firstShift; j <= maxShift; j++)
12470 {
12471 poly qq = pLPCopyAndShiftLM(q, j);
12472 enterPair(qq, p, ecartp, p_isFromQ, strat, -1, ecartq, q_isFromQ, j, q_inS);
12473 }
12474
12475 #ifdef HAVE_RINGS
12476 if (rField_is_Ring(currRing) && p_lastVblock >= firstShift && p_lastVblock <= maxPossibleShift)
12477 {
12478 // add pairs (m*shifts(q), p) where m is a monomial and the pair has no overlap
12479 for (int j = p_lastVblock; j <= maxPossibleShift; j++)
12480 {
12481 ideal fillers = id_MaxIdeal(j - p_lastVblock, currRing);
12482 for (int k = 0; k < IDELEMS(fillers); k++)
12483 {
12484 poly qq = pLPCopyAndShiftLM(pp_mm_Mult(q, fillers->m[k], currRing), p_lastVblock);
12485 enterPair(qq, p, ecartp, p_isFromQ, strat, -1, ecartq, q_isFromQ, p_lastVblock, q_inS);
12486 }
12487 idDelete(&fillers);
12488 }
12489 }
12490 #endif
12491 }
12492 #endif
12493
12494 #ifdef HAVE_SHIFTBBA
12495 // creates (q,p), use it when q is already shifted
12496 static void enterOnePairWithoutShifts (int p_inS /*also i*/, poly q, poly p, int ecartq, int q_isFromQ, kStrategy strat, int atR, int p_lastVblock, int q_shift)
12497 {
12498 // note: ecart and isFromQ is for p
12499 assume(p_inS < 0 || strat->S[p_inS] == p); // if p is from S, p_inS should be the index of p in S
12500 assume(pmFirstVblock(p) == 1);
12501 assume(p_lastVblock == pmLastVblock(p));
12502 assume(q_shift == pmFirstVblock(q) - 1);
12503
12504 // TODO: is ecartp = 0 still ok?
12505 int ecartp = 0; //Hans says it's ok; we're in the homog e:, no ecart
12506
12507 int p_isFromQ = 0;
12508 if (strat->fromQ != NULL && p_inS >= 0)
12509 p_isFromQ = strat->fromQ[p_inS];
12510
12511 #ifdef HAVE_RINGS
12512 if (rField_is_Ring(currRing))
12513 {
12514 assume(q_shift <= p_lastVblock); // we allow the special case where there is no overlap
12515 enterOneStrongPolyAndEnterOnePairRingShift(q, p, ecartp, p_isFromQ, strat, -1, ecartq, q_isFromQ, q_shift, -1);
12516 }
12517 else
12518 #endif
12519 {
12520 assume(q_shift <= p_lastVblock - ((pGetComp(q) > 0 || pGetComp(p) > 0) ? 0 : 1)); // there should be an overlap (in the module case epsilon overlap is also allowed)
12521 enterOnePairShift(q, p, ecartp, p_isFromQ, strat, -1, ecartq, q_isFromQ, q_shift, -1);
12522 }
12523 }
12524 #endif
12525
12526
12527 #ifdef KDEBUG
12528 // enable to print which pairs are considered or discarded and why
12529 /* #define CRITERION_DEBUG */
12530 #endif
12531 /*2
12532 * put the pair (q,p) into the set B, ecart=ecart(p), q is the shift of some s[i]
12533 */
12534 #ifdef HAVE_SHIFTBBA
12535 void enterOnePairShift (poly q, poly p, int ecart, int isFromQ, kStrategy strat, int atR, int ecartq, int qisFromQ, int shiftcount, int ifromS)
12536 {
12537 #ifdef CRITERION_DEBUG
12538 if (TEST_OPT_DEBUG)
12539 {
12540 PrintS("Consider pair ("); wrp(q); PrintS(", "); wrp(p); PrintS(")"); PrintLn();
12541 // also write the LMs in separate lines:
12542 poly lmq = pHead(q);
12543 poly lmp = pHead(p);
12544 pSetCoeff(lmq, n_Init(1, currRing->cf));
12545 pSetCoeff(lmp, n_Init(1, currRing->cf));
12546 Print(" %s\n", pString(lmq));
12547 Print(" %s\n", pString(lmp));
12548 pLmDelete(lmq);
12549 pLmDelete(lmp);
12550 }
12551 #endif
12552
12553 /* Format: q and p are like strat->P.p, so lm in CR, tail in TR */
12554
12555 /* check this Formats: */
12556 assume(p_LmCheckIsFromRing(q,currRing));
12557 assume(p_CheckIsFromRing(pNext(q),strat->tailRing));
12558 assume(p_LmCheckIsFromRing(p,currRing));
12559 assume(p_CheckIsFromRing(pNext(p),strat->tailRing));
12560
12561 /* poly q stays for s[i], ecartq = ecart(q), qisFromQ = applies to q */
12562
12563 int qfromQ = qisFromQ;
12564
12565 /* need additionally: int up_to_degree, poly V0 with the variables in (0) or just the number lV = the length of the first block */
12566
12567 int l,j,compare;
12568 LObject Lp;
12569 Lp.i_r = -1;
12570
12571 #ifdef KDEBUG
12572 Lp.ecart=0; Lp.length=0;
12573 #endif
12574 /*- computes the lcm(s[i],p) -*/
12575 Lp.lcm = p_Lcm(p,q, currRing); // q is what was strat->S[i], so a poly in LM/TR presentation
12576
12577 /* the V criterion */
12578 if (!pmIsInV(Lp.lcm))
12579 {
12580 strat->cv++; // counter for applying the V criterion
12581 pLmFree(Lp.lcm);
12582 #ifdef CRITERION_DEBUG
12583 if (TEST_OPT_DEBUG) PrintS("--- V crit\n");
12584 #endif
12585 return;
12586 }
12587
12588 if (strat->sugarCrit && ALLOW_PROD_CRIT(strat))
12589 {
12590 if((!((ecartq>0)&&(ecart>0)))
12591 && pHasNotCF(p,q))
12592 {
12593 /*
12594 *the product criterion has applied for (s,p),
12595 *i.e. lcm(s,p)=product of the leading terms of s and p.
12596 *Suppose (s,r) is in L and the leading term
12597 *of p divides lcm(s,r)
12598 *(==> the leading term of p divides the leading term of r)
12599 *but the leading term of s does not divide the leading term of r
12600 *(notice that this condition is automatically satisfied if r is still
12601 *in S), then (s,r) can be cancelled.
12602 *This should be done here because the
12603 *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
12604 *
12605 *Moreover, skipping (s,r) holds also for the noncommutative case.
12606 */
12607 strat->cp++;
12608 pLmFree(Lp.lcm);
12609 #ifdef CRITERION_DEBUG
12610 if (TEST_OPT_DEBUG) PrintS("--- prod crit\n");
12611 #endif
12612 return;
12613 }
12614 else
12615 Lp.ecart = si_max(ecart,ecartq);
12616 if (strat->fromT && (ecartq>ecart))
12617 {
12618 pLmFree(Lp.lcm);
12619 #ifdef CRITERION_DEBUG
12620 if (TEST_OPT_DEBUG) PrintS("--- ecartq > ecart\n");
12621 #endif
12622 return;
12623 /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
12624 }
12625 /*
12626 *the set B collects the pairs of type (S[j],p)
12627 *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
12628 *if the leading term of s divides lcm(r,p) then (r,p) will be canceled
12629 *if the leading term of r divides lcm(s,p) then (s,p) will not enter B
12630 */
12631 {
12632 j = strat->Bl;
12633 loop
12634 {
12635 if (j < 0) break;
12636 compare=pLPDivComp(strat->B[j].lcm,Lp.lcm);
12637 if ((compare==1)
12638 &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
12639 {
12640 strat->c3++;
12641 if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
12642 {
12643 pLmFree(Lp.lcm);
12644 #ifdef CRITERION_DEBUG
12645 if (TEST_OPT_DEBUG)
12646 {
12647 Print("--- chain crit using B[%d].lcm=%s\n", j, pString(strat->B[j].lcm));
12648 }
12649 #endif
12650 return;
12651 }
12652 break;
12653 }
12654 else
12655 if ((compare ==-1)
12656 && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
12657 {
12658 #ifdef CRITERION_DEBUG
12659 if (TEST_OPT_DEBUG)
12660 {
12661 Print("--- chain crit using pair to remove B[%d].lcm=%s\n", j, pString(strat->B[j].lcm));
12662 }
12663 #endif
12664 deleteInL(strat->B,&strat->Bl,j,strat);
12665 strat->c3++;
12666 }
12667 j--;
12668 }
12669 }
12670 }
12671 else /*sugarcrit*/
12672 {
12673 if (ALLOW_PROD_CRIT(strat))
12674 {
12675 // if currRing->nc_type!=quasi (or skew)
12676 // TODO: enable productCrit for super commutative algebras...
12677 if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
12678 pHasNotCF(p,q))
12679 {
12680 /*
12681 *the product criterion has applied for (s,p),
12682 *i.e. lcm(s,p)=product of the leading terms of s and p.
12683 *Suppose (s,r) is in L and the leading term
12684 *of p divides lcm(s,r)
12685 *(==> the leading term of p divides the leading term of r)
12686 *but the leading term of s does not divide the leading term of r
12687 *(notice that tis condition is automatically satisfied if r is still
12688 *in S), then (s,r) can be canceled.
12689 *This should be done here because the
12690 *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
12691 */
12692 strat->cp++;
12693 pLmFree(Lp.lcm);
12694 #ifdef CRITERION_DEBUG
12695 if (TEST_OPT_DEBUG) PrintS("--- prod crit\n");
12696 #endif
12697 return;
12698 }
12699 if (strat->fromT && (ecartq>ecart))
12700 {
12701 pLmFree(Lp.lcm);
12702 #ifdef CRITERION_DEBUG
12703 if (TEST_OPT_DEBUG) PrintS("--- ecartq > ecart\n");
12704 #endif
12705 return;
12706 /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
12707 }
12708 /*
12709 *the set B collects the pairs of type (S[j],p)
12710 *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
12711 *if the leading term of s divides lcm(r,p) then (r,p) will be canceled
12712 *if the leading term of r divides lcm(s,p) then (s,p) will not enter B
12713 */
12714 for(j = strat->Bl;j>=0;j--)
12715 {
12716 compare=pLPDivComp(strat->B[j].lcm,Lp.lcm);
12717 if (compare==1)
12718 {
12719 strat->c3++;
12720 if ((strat->fromQ==NULL) || (isFromQ==0) || (qfromQ==0))
12721 {
12722 pLmFree(Lp.lcm);
12723 #ifdef CRITERION_DEBUG
12724 if (TEST_OPT_DEBUG)
12725 {
12726 Print("--- chain crit using B[%d].lcm=%s\n", j, pString(strat->B[j].lcm));
12727 }
12728 #endif
12729 return;
12730 }
12731 break;
12732 }
12733 else
12734 if (compare ==-1)
12735 {
12736 #ifdef CRITERION_DEBUG
12737 if (TEST_OPT_DEBUG)
12738 {
12739 Print("--- chain crit using pair to remove B[%d].lcm=%s\n", j, pString(strat->B[j].lcm));
12740 }
12741 #endif
12742 deleteInL(strat->B,&strat->Bl,j,strat);
12743 strat->c3++;
12744 }
12745 }
12746 }
12747 }
12748 /*
12749 *the pair (S[i],p) enters B if the spoly != 0
12750 */
12751 /*- compute the short s-polynomial -*/
12752 if (strat->fromT && !TEST_OPT_INTSTRATEGY)
12753 pNorm(p);
12754 if ((q==NULL) || (p==NULL))
12755 {
12756 #ifdef CRITERION_DEBUG
12757 if (TEST_OPT_DEBUG) PrintS("--- q == NULL || p == NULL\n");
12758 #endif
12759 return;
12760 }
12761 if ((strat->fromQ!=NULL) && (isFromQ!=0) && (qfromQ!=0))
12762 {
12763 Lp.p=NULL;
12764 #ifdef CRITERION_DEBUG
12765 if (TEST_OPT_DEBUG) PrintS("--- pair is from Q\n");
12766 #endif
12767 }
12768 else
12769 {
12770 // if ( rIsPluralRing(currRing) )
12771 // {
12772 // if(pHasNotCF(p, q))
12773 // {
12774 // if(ncRingType(currRing) == nc_lie)
12775 // {
12776 // // generalized prod-crit for lie-type
12777 // strat->cp++;
12778 // Lp.p = nc_p_Bracket_qq(pCopy(p),q, currRing);
12779 // }
12780 // else
12781 // if( ALLOW_PROD_CRIT(strat) )
12782 // {
12783 // // product criterion for homogeneous case in SCA
12784 // strat->cp++;
12785 // Lp.p = NULL;
12786 // }
12787 // else
12788 // Lp.p = nc_CreateSpoly(q,p,currRing); // ?
12789 // }
12790 // else Lp.p = nc_CreateSpoly(q,p,currRing);
12791 // }
12792 // else
12793 // {
12794
12795 /* ksCreateShortSpoly needs two Lobject-kind presentations */
12796 /* p is already in this form, so convert q */
12797 // q = pMove2CurrTail(q, strat);
12798 Lp.p = ksCreateShortSpoly(q, p, strat->tailRing);
12799 // }
12800 }
12801 if (Lp.p == NULL)
12802 {
12803 /*- the case that the s-poly is 0 -*/
12804 // TODO: currently ifromS is only > 0 if called from enterOnePairWithShifts
12805 if (ifromS > 0)
12806 {
12807 if (strat->pairtest==NULL) initPairtest(strat);
12808 strat->pairtest[ifromS] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
12809 strat->pairtest[strat->sl+1] = TRUE;
12810 }
12811 //if (TEST_OPT_DEBUG){Print("!");} // option teach
12812 /* END _ TEMPORARILY DISABLED FOR SHIFTS */
12813 /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
12814 /*
12815 *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
12816 *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
12817 *divide lcm(r,p)). In the last case (s,r) can be canceled if the leading
12818 *term of p divides the lcm(s,r)
12819 *(this canceling should be done here because
12820 *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
12821 *the first case is handeled in chainCrit
12822 */
12823 if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
12824 #ifdef CRITERION_DEBUG
12825 if (TEST_OPT_DEBUG) PrintS("--- S-poly = 0\n");
12826 #endif
12827 }
12828 else
12829 {
12830 /*- the pair (S[i],p) enters B -*/
12831 /* both of them should have their LM in currRing and TAIL in tailring */
12832 Lp.p1 = q; // already in the needed form
12833 Lp.p2 = p; // already in the needed form
12834
12835 if ( !rIsPluralRing(currRing) )
12836 pNext(Lp.p) = strat->tail;
12837
12838 /* TEMPORARILY DISABLED FOR SHIFTS because there's no i*/
12839 /* at the beginning we DO NOT set atR = -1 ANYMORE*/
12840 if ( (atR >= 0) && (shiftcount==0) && (ifromS >=0) )
12841 {
12842 Lp.i_r1 = kFindInT(Lp.p1,strat); //strat->S_2_R[ifromS];
12843 Lp.i_r2 = atR;
12844 }
12845 else
12846 {
12847 /* END _ TEMPORARILY DISABLED FOR SHIFTS */
12848 Lp.i_r1 = -1;
12849 Lp.i_r2 = -1;
12850 }
12851 strat->initEcartPair(&Lp,q,p,ecartq,ecart);
12852
12853 if (TEST_OPT_INTSTRATEGY)
12854 {
12855 if (!rIsPluralRing(currRing)
12856 && !rField_is_Ring(currRing)
12857 && (Lp.p->coef!=NULL))
12858 nDelete(&(Lp.p->coef));
12859 }
12860
12861 l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
12862 enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
12863 #ifdef CRITERION_DEBUG
12864 if (TEST_OPT_DEBUG) PrintS("+++ Entered pair\n");
12865 #endif
12866 }
12867 }
12868 #endif
12869
12870 /*3
12871 *(s[0], s \dot h),...,(s[k],s \dot h) will be put to the pairset L
12872 * also the pairs (h, s\dot s[0]), ..., (h, s\dot s[k]) enter L
12873 * additionally we put the pairs (h, s \sdot h) for s>=1 to L
12874 */
12875 #ifdef HAVE_SHIFTBBA
12876 void initenterpairsShift (poly h,int k,int ecart,int isFromQ, kStrategy strat, int atR)
12877 {
12878 int h_lastVblock = pmLastVblock(h);
12879 assume(h_lastVblock != 0 || pLmIsConstantComp(h));
12880 // TODO: is it allowed to skip pairs with constants? also with constants from other components?
12881 if (h_lastVblock == 0) return;
12882 assume(pmFirstVblock(h) == 1);
12883 /* h comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
12884 // atR = -1;
12885 if ((strat->syzComp==0)
12886 || (pGetComp(h)<=strat->syzComp))
12887 {
12888 int i,j;
12889 BOOLEAN new_pair=FALSE;
12890
12891 int degbound = currRing->N/currRing->isLPring;
12892 int maxShift = degbound - h_lastVblock;
12893
12894 if (pGetComp(h)==0)
12895 {
12896 if (strat->rightGB)
12897 {
12898 if (isFromQ)
12899 {
12900 // pairs (shifts(h),s[1..k]), (h, s[1..k])
12901 for (i=0; i<=maxShift; i++)
12902 {
12903 poly hh = pLPCopyAndShiftLM(h, i);
12904 for (j=0; j<=k; j++)
12905 {
12906 if (strat->fromQ == NULL || !strat->fromQ[j])
12907 {
12908 new_pair=TRUE;
12909 poly s = strat->S[j];
12910 enterOnePairWithoutShifts(j, hh, s, ecart, isFromQ, strat, atR, pmLastVblock(s), i);
12911 }
12912 }
12913 }
12914 }
12915 else
12916 {
12917 new_pair=TRUE;
12918 for (j=0; j<=k; j++)
12919 {
12920 poly s = strat->S[j];
12921 if (strat->fromQ != NULL && strat->fromQ[j])
12922 {
12923 // pairs (shifts(s[j]),h), (s[j],h)
12924 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
12925 }
12926 else
12927 {
12928 // pair (h, s[j])
12929 enterOnePairWithoutShifts(j, h, s, ecart, isFromQ, strat, atR, pmLastVblock(s), 0);
12930 }
12931 }
12932 }
12933 }
12934 /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
12935 else if ((isFromQ)&&(strat->fromQ!=NULL))
12936 {
12937 // pairs (shifts(s[1..k]),h), (s[1..k],h)
12938 for (j=0; j<=k; j++)
12939 {
12940 if (!strat->fromQ[j])
12941 {
12942 new_pair=TRUE;
12943 poly s = strat->S[j];
12944 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
12945 }
12946 }
12947 // pairs (shifts(h),s[1..k])
12948 if (new_pair)
12949 {
12950 for (i=1; i<=maxShift; i++)
12951 {
12952 poly hh = pLPCopyAndShiftLM(h, i);
12953 for (j=0; j<=k; j++)
12954 {
12955 if (!strat->fromQ[j])
12956 {
12957 poly s = strat->S[j];
12958 int s_lastVblock = pmLastVblock(s);
12959 if (i < s_lastVblock || (pGetComp(s) > 0 && i == s_lastVblock)) // in the module case, product criterion does not hold (note: comp h is always zero here)
12960 enterOnePairWithoutShifts(j, hh, s, ecart, isFromQ, strat, atR, s_lastVblock, i);
12961 #ifdef HAVE_RINGS
12962 else if (rField_is_Ring(currRing))
12963 {
12964 assume(i >= s_lastVblock); // this is always the case, but just to be very sure
12965 ideal fillers = id_MaxIdeal(i - s_lastVblock, currRing);
12966 for (int k = 0; k < IDELEMS(fillers); k++)
12967 {
12968 poly hhh = pLPCopyAndShiftLM(pp_mm_Mult(h, fillers->m[k], currRing), s_lastVblock);
12969 enterOnePairWithoutShifts(j, hhh, s, ecart, isFromQ, strat, atR, s_lastVblock, s_lastVblock);
12970 }
12971 idDelete(&fillers);
12972 }
12973 #endif
12974 }
12975 }
12976 }
12977 }
12978 }
12979 else
12980 {
12981 new_pair=TRUE;
12982 // pairs (shifts(s[1..k]),h), (s[1..k],h)
12983 for (j=0; j<=k; j++)
12984 {
12985 poly s = strat->S[j];
12986 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
12987 }
12988 // pairs (shifts(h),s[1..k]), (shifts(h), h)
12989 for (i=1; i<=maxShift; i++)
12990 {
12991 poly hh = pLPCopyAndShiftLM(h, i);
12992 for (j=0; j<=k; j++)
12993 {
12994 poly s = strat->S[j];
12995 int s_lastVblock = pmLastVblock(s);
12996 if (i < s_lastVblock || (pGetComp(s) > 0 && i == s_lastVblock)) // in the module case, product criterion does not hold (note: comp h is always zero here)
12997 enterOnePairWithoutShifts(j, hh, s, ecart, isFromQ, strat, atR, s_lastVblock, i);
12998 #ifdef HAVE_RINGS
12999 else if (rField_is_Ring(currRing))
13000 {
13001 assume(i >= s_lastVblock); // this is always the case, but just to be very sure
13002 ideal fillers = id_MaxIdeal(i - s_lastVblock, currRing);
13003 for (int k = 0; k < IDELEMS(fillers); k++)
13004 {
13005 poly hhh = pLPCopyAndShiftLM(pp_mm_Mult(h, fillers->m[k], currRing), s_lastVblock);
13006 enterOnePairWithoutShifts(j, hhh, s, ecart, isFromQ, strat, atR, s_lastVblock, s_lastVblock);
13007 }
13008 idDelete(&fillers);
13009 }
13010 #endif
13011 }
13012 if (i < h_lastVblock) // in the module case, product criterion does not hold (note: comp h is always zero here)
13013 enterOnePairWithoutShifts(-1, hh, h, ecart, isFromQ, strat, atR, h_lastVblock, i);
13014 #ifdef HAVE_RINGS
13015 else if (rField_is_Ring(currRing))
13016 {
13017 assume(i >= h_lastVblock); // this is always the case, but just to be very sure
13018 ideal fillers = id_MaxIdeal(i - h_lastVblock, currRing);
13019 for (int k = 0; k < IDELEMS(fillers); k++)
13020 {
13021 poly hhh = pLPCopyAndShiftLM(pp_mm_Mult(h, fillers->m[k], currRing), h_lastVblock);
13022 enterOnePairWithoutShifts(-1, hhh, h, ecart, isFromQ, strat, atR, h_lastVblock, h_lastVblock);
13023 }
13024 idDelete(&fillers);
13025 }
13026 #endif
13027 }
13028 }
13029 }
13030 else
13031 {
13032 assume(isFromQ == 0); // an element from Q should always has 0 component
13033 new_pair=TRUE;
13034 if (strat->rightGB)
13035 {
13036 for (j=0; j<=k; j++)
13037 {
13038 if ((pGetComp(h)==pGetComp(strat->S[j]))
13039 || (pGetComp(strat->S[j])==0))
13040 {
13041 poly s = strat->S[j];
13042 if (strat->fromQ != NULL && strat->fromQ[j])
13043 {
13044 // pairs (shifts(s[j]),h), (s[j],h)
13045 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
13046 }
13047 else
13048 {
13049 // pair (h, s[j])
13050 enterOnePairWithoutShifts(j, h, s, ecart, isFromQ, strat, atR, pmLastVblock(s), 0);
13051 }
13052 }
13053 }
13054 }
13055 else
13056 {
13057 // pairs (shifts(s[1..k]),h), (s[1..k],h)
13058 for (j=0; j<=k; j++)
13059 {
13060 if ((pGetComp(h)==pGetComp(strat->S[j]))
13061 || (pGetComp(strat->S[j])==0))
13062 {
13063 poly s = strat->S[j];
13064 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
13065 }
13066 }
13067 // pairs (shifts(h),s[1..k]), (shifts(h), h)
13068 for (i=1; i<=maxShift; i++)
13069 {
13070 poly hh = pLPCopyAndShiftLM(h, i);
13071 for (j=0; j<=k; j++)
13072 {
13073 if ((pGetComp(h)==pGetComp(strat->S[j]))
13074 || (pGetComp(strat->S[j])==0))
13075 {
13076 poly s = strat->S[j];
13077 int s_lastVblock = pmLastVblock(s);
13078 if (i <= s_lastVblock) // in the module case, product criterion does not hold
13079 enterOnePairWithoutShifts(j, hh, s, ecart, isFromQ, strat, atR, s_lastVblock, i);
13080 #ifdef HAVE_RINGS
13081 else if (rField_is_Ring(currRing))
13082 {
13083 assume(i >= s_lastVblock); // this is always the case, but just to be very sure
13084 ideal fillers = id_MaxIdeal(i - s_lastVblock, currRing);
13085 for (int k = 0; k < IDELEMS(fillers); k++)
13086 {
13087 poly hhh = pLPCopyAndShiftLM(pp_mm_Mult(h, fillers->m[k], currRing), s_lastVblock);
13088 enterOnePairWithoutShifts(j, hhh, s, ecart, isFromQ, strat, atR, s_lastVblock, s_lastVblock);
13089 }
13090 idDelete(&fillers);
13091 }
13092 #endif
13093 }
13094 }
13095 if (i <= h_lastVblock) // in the module case, product criterion does not hold
13096 enterOnePairWithoutShifts(-1, hh, h, ecart, isFromQ, strat, atR, h_lastVblock, i);
13097 #ifdef HAVE_RINGS
13098 else if (rField_is_Ring(currRing))
13099 {
13100 assume(i >= h_lastVblock); // this is always the case, but just to be very sure
13101 ideal fillers = id_MaxIdeal(i - h_lastVblock, currRing);
13102 for (int k = 0; k < IDELEMS(fillers); k++)
13103 {
13104 poly hhh = pLPCopyAndShiftLM(pp_mm_Mult(h, fillers->m[k], currRing), h_lastVblock);
13105 enterOnePairWithoutShifts(-1, hhh, h, ecart, isFromQ, strat, atR, h_lastVblock, h_lastVblock);
13106 }
13107 idDelete(&fillers);
13108 }
13109 #endif
13110 }
13111 }
13112 }
13113
13114 if (new_pair)
13115 {
13116 strat->chainCrit(h,ecart,strat);
13117 }
13118 kMergeBintoL(strat);
13119 }
13120 }
13121 #endif
13122
13123 /*3
13124 *(s[0], s \dot h),...,(s[k],s \dot h) will be put to the pairset L
13125 * also the pairs (h, s\dot s[0]), ..., (h, s\dot s[k]) enter L
13126 * additionally we put the pairs (h, s \sdot h) for s>=1 to L
13127 */
13128 #ifdef HAVE_SHIFTBBA
13129 void initenterstrongPairsShift (poly h,int k,int ecart,int isFromQ, kStrategy strat, int atR)
13130 {
13131 int h_lastVblock = pmLastVblock(h);
13132 assume(h_lastVblock != 0 || pLmIsConstantComp(h));
13133 // TODO: is it allowed to skip pairs with constants? also with constants from other components?
13134 if (h_lastVblock == 0) return;
13135 assume(pmFirstVblock(h) == 1);
13136 /* h comes from strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
13137 // atR = -1;
13138 if ((strat->syzComp==0)
13139 || (pGetComp(h)<=strat->syzComp))
13140 {
13141 int i,j;
13142 BOOLEAN new_pair=FALSE;
13143
13144 int degbound = currRing->N/currRing->isLPring;
13145 int maxShift = degbound - h_lastVblock;
13146
13147 if (pGetComp(h)==0)
13148 {
13149 if (strat->rightGB)
13150 {
13151 if (isFromQ)
13152 {
13153 // pairs (shifts(h),s[1..k]), (h, s[1..k])
13154 for (i=0; i<=maxShift; i++)
13155 {
13156 poly hh = pLPCopyAndShiftLM(h, i);
13157 for (j=0; j<=k; j++)
13158 {
13159 if (strat->fromQ == NULL || !strat->fromQ[j])
13160 {
13161 new_pair=TRUE;
13162 poly s = strat->S[j];
13163 enterOnePairWithoutShifts(j, hh, s, ecart, isFromQ, strat, atR, pmLastVblock(s), i);
13164 }
13165 }
13166 }
13167 }
13168 else
13169 {
13170 new_pair=TRUE;
13171 for (j=0; j<=k; j++)
13172 {
13173 poly s = strat->S[j];
13174 if (strat->fromQ != NULL && strat->fromQ[j])
13175 {
13176 // pairs (shifts(s[j]),h), (s[j],h)
13177 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
13178 }
13179 else
13180 {
13181 // pair (h, s[j])
13182 enterOnePairWithoutShifts(j, h, s, ecart, isFromQ, strat, atR, pmLastVblock(s), 0);
13183 }
13184 }
13185 }
13186 }
13187 /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
13188 else if ((isFromQ)&&(strat->fromQ!=NULL))
13189 {
13190 // pairs (shifts(s[1..k]),h), (s[1..k],h)
13191 for (j=0; j<=k; j++)
13192 {
13193 if (!strat->fromQ[j])
13194 {
13195 new_pair=TRUE;
13196 poly s = strat->S[j];
13197 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
13198 }
13199 }
13200 // pairs (shifts(h),s[1..k])
13201 if (new_pair)
13202 {
13203 for (i=1; i<=maxShift; i++)
13204 {
13205 poly hh = pLPCopyAndShiftLM(h, i);
13206 for (j=0; j<=k; j++)
13207 {
13208 if (!strat->fromQ[j])
13209 {
13210 poly s = strat->S[j];
13211 enterOnePairWithoutShifts(j, hh, s, ecart, isFromQ, strat, atR, pmLastVblock(s), i);
13212 }
13213 }
13214 }
13215 }
13216 }
13217 else
13218 {
13219 new_pair=TRUE;
13220 // pairs (shifts(s[1..k]),h), (s[1..k],h)
13221 for (j=0; j<=k; j++)
13222 {
13223 poly s = strat->S[j];
13224 // TODO: cache lastVblock of s[1..k] for later use
13225 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
13226 }
13227 // pairs (shifts(h),s[1..k]), (shifts(h), h)
13228 for (i=1; i<=maxShift; i++)
13229 {
13230 poly hh = pLPCopyAndShiftLM(h, i);
13231 for (j=0; j<=k; j++)
13232 {
13233 poly s = strat->S[j];
13234 enterOnePairWithoutShifts(j, hh, s, ecart, isFromQ, strat, atR, pmLastVblock(s), i);
13235 }
13236 enterOnePairWithoutShifts(-1, hh, h, ecart, isFromQ, strat, atR, h_lastVblock, i);
13237 }
13238 }
13239 }
13240 else
13241 {
13242 new_pair=TRUE;
13243 if (strat->rightGB)
13244 {
13245 for (j=0; j<=k; j++)
13246 {
13247 if ((pGetComp(h)==pGetComp(strat->S[j]))
13248 || (pGetComp(strat->S[j])==0))
13249 {
13250 assume(isFromQ == 0); // this case is not handeled here and should also never happen
13251 poly s = strat->S[j];
13252 if (strat->fromQ != NULL && strat->fromQ[j])
13253 {
13254 // pairs (shifts(s[j]),h), (s[j],h)
13255 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
13256 }
13257 else
13258 {
13259 // pair (h, s[j])
13260 enterOnePairWithoutShifts(j, h, s, ecart, isFromQ, strat, atR, pmLastVblock(s), 0);
13261 }
13262 }
13263 }
13264 }
13265 else
13266 {
13267 // pairs (shifts(s[1..k]),h), (s[1..k],h)
13268 for (j=0; j<=k; j++)
13269 {
13270 if ((pGetComp(h)==pGetComp(strat->S[j]))
13271 || (pGetComp(strat->S[j])==0))
13272 {
13273 poly s = strat->S[j];
13274 enterOnePairWithShifts(j, s, h, ecart, isFromQ, strat, atR, h_lastVblock, pmLastVblock(s));
13275 }
13276 }
13277 // pairs (shifts(h),s[1..k]), (shifts(h), h)
13278 for (i=1; i<=maxShift; i++)
13279 {
13280 poly hh = pLPCopyAndShiftLM(h, i);
13281 for (j=0; j<=k; j++)
13282 {
13283 if ((pGetComp(h)==pGetComp(strat->S[j]))
13284 || (pGetComp(strat->S[j])==0))
13285 {
13286 poly s = strat->S[j];
13287 enterOnePairWithoutShifts(j, hh, s, ecart, isFromQ, strat, atR, pmLastVblock(s), i);
13288 }
13289 }
13290 enterOnePairWithoutShifts(-1, hh, h, ecart, isFromQ, strat, atR, h_lastVblock, i);
13291 }
13292 }
13293 }
13294
13295 if (new_pair)
13296 {
13297 strat->chainCrit(h,ecart,strat);
13298 }
13299 kMergeBintoL(strat);
13300 }
13301 }
13302 #endif
13303
13304 /*2
13305 *(s[0],h),...,(s[k],h) will be put to the pairset L(via initenterpairs)
13306 *superfluous elements in S will be deleted
13307 */
13308 #ifdef HAVE_SHIFTBBA
13309 void enterpairsShift (poly h,int k,int ecart,int pos,kStrategy strat, int atR)
13310 {
13311 /* h is strat->P.p, that is LObject with LM in currRing and Tail in tailRing */
13312 /* Q: what is exactly the strat->fromT ? A: a local case trick; don't need it yet*/
13313 int j=pos;
13314
13315 /* if (!(rField_is_Domain(currRing))) enterExtendedSpoly(h, strat); */ // TODO: enterExtendedSpoly not for LP yet
13316 initenterpairsShift(h,k,ecart,0,strat, atR);
13317 if ( (!strat->fromT)
13318 && ((strat->syzComp==0)
13319 ||(pGetComp(h)<=strat->syzComp)))
13320 {
13321 unsigned long h_sev = pGetShortExpVector(h);
13322 loop
13323 {
13324 if (j > k) break;
13325 // TODO this currently doesn't clear all possible elements because of commutative division
13326 if (!(strat->rightGB && strat->fromQ != NULL && strat->fromQ[j]))
13327 clearS(h,h_sev, &j,&k,strat);
13328 j++;
13329 }
13330 }
13331 }
13332 #endif
13333
13334 /*2
13335 * enteres all admissible shifts of p into T
13336 * assumes that p is already in T!
13337 */
13338 #ifdef HAVE_SHIFTBBA
13339 void enterTShift(LObject p, kStrategy strat, int atT)
13340 {
13341 /* determine how many elements we have to insert */
13342 /* x(0)y(1)z(2) : lastVblock-1=2, to add until lastVblock=uptodeg-1 */
13343 /* hence, a total number of elt's to add is: */
13344 /* int toInsert = 1 + (uptodeg-1) - (pLastVblock(p.p, lV) -1); */
13345 pAssume(p.p != NULL);
13346
13347 int maxPossibleShift = p_mLPmaxPossibleShift(p.p, strat->tailRing);
13348
13349 for (int i = 1; i <= maxPossibleShift; i++)
13350 {
13351 LObject qq;
13352 qq.p = pLPCopyAndShiftLM(p.p, i); // don't use Set() because it'll test the poly order
13353 qq.shift = i;
13354 strat->initEcart(&qq); // initEcartBBA sets length, pLength, FDeg and ecart
13355
13356 enterT(qq, strat, atT); // enterT is modified, so it doesn't copy and delete the tail of shifted polys
13357 }
13358 }
13359 #endif
13360
13361 #ifdef HAVE_SHIFTBBA
13362 poly redtailBbaShift (LObject* L, int pos, kStrategy strat, BOOLEAN withT, BOOLEAN normalize)
13363 {
13364 /* for the shift case need to run it with withT = TRUE */
13365 strat->redTailChange=FALSE;
13366 if (strat->noTailReduction) return L->GetLmCurrRing();
13367 poly h, p;
13368 p = h = L->GetLmTailRing();
13369 if ((h==NULL) || (pNext(h)==NULL))
13370 return L->GetLmCurrRing();
13371
13372 TObject* With;
13373 // placeholder in case strat->tl < 0
13374 TObject With_s(strat->tailRing);
13375
13376 LObject Ln(pNext(h), strat->tailRing);
13377 Ln.pLength = L->GetpLength() - 1;
13378
13379 pNext(h) = NULL;
13380 if (L->p != NULL) pNext(L->p) = NULL;
13381 L->pLength = 1;
13382
13383 Ln.PrepareRed(strat->use_buckets);
13384
13385 while(!Ln.IsNull())
13386 {
13387 loop
13388 {
13389 Ln.SetShortExpVector();
13390 if (withT)
13391 {
13392 int j;
13393 j = kFindDivisibleByInT(strat, &Ln);
13394 if (j < 0) break;
13395 With = &(strat->T[j]);
13396 }
13397 else
13398 {
13399 With = kFindDivisibleByInS_T(strat, pos, &Ln, &With_s);
13400 if (With == NULL) break;
13401 }
13402 if (normalize && (!TEST_OPT_INTSTRATEGY) && (!nIsOne(pGetCoeff(With->p))))
13403 {
13404 With->pNorm();
13405 //if (TEST_OPT_PROT) { PrintS("n"); mflush(); }
13406 }
13407 strat->redTailChange=TRUE;
13408 if (ksReducePolyTail(L, With, &Ln))
13409 {
13410 // reducing the tail would violate the exp bound
13411 // set a flag and hope for a retry (in bba)
13412 strat->completeReduce_retry=TRUE;
13413 if ((Ln.p != NULL) && (Ln.t_p != NULL)) Ln.p=NULL;
13414 do
13415 {
13416 pNext(h) = Ln.LmExtractAndIter();
13417 pIter(h);
13418 L->pLength++;
13419 } while (!Ln.IsNull());
13420 goto all_done;
13421 }
13422 if (Ln.IsNull()) goto all_done;
13423 if (! withT) With_s.Init(currRing);
13424 }
13425 pNext(h) = Ln.LmExtractAndIter();
13426 pIter(h);
13427 L->pLength++;
13428 }
13429
13430 all_done:
13431 Ln.Delete();
13432 if (L->p != NULL) pNext(L->p) = pNext(p);
13433
13434 if (strat->redTailChange)
13435 {
13436 L->length = 0;
13437 }
13438 L->Normalize(); // HANNES: should have a test
13439 kTest_L(L,strat->tailRing);
13440 return L->GetLmCurrRing();
13441 }
13442 #endif
13443