source: git/Singular/kstd2.cc @ f003a9

spielwiese
Last change on this file since f003a9 was f003a9, checked in by Olaf Bachmann <obachman@…>, 26 years ago
* polys-impl.cc, polys.cc: No COMP_FAST any more * Makefile.in: Introduced variable PERL, set by configure * kstdfac.cc (kStratCopy): kModW iv is not copied, but just the pointer is set 1998-03-18 Olaf Bachmann <obachman@mathematik.uni-kl.de> * Makefile.in: added Singularb target for bprof * polys-impl.h, polys-comp.h: Cleaned up COMP_FAST and related #defines 1998-03-16 Olaf Bachmann <obachman@mathematik.uni-kl.de> * polys-impl.h: no #define COMP_FAST * configure.in,Makefile.in: check for flex -P; increased version number to 1.1.7 git-svn-id: file:///usr/local/Singular/svn/trunk@1268 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 40.8 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstd2.cc,v 1.14 1998-03-23 22:50:59 obachman Exp $ */
5/*
6*  ABSTRACT -  Kernel: alg. of Buchberger
7*/
8
9#include "mod2.h"
10#include "tok.h"
11#include "mmemory.h"
12#include "polys.h"
13#include "ideals.h"
14#include "febase.h"
15#include "kutil.h"
16#include "kstd1.h"
17#include "kstd2.h"
18#include "khstd.h"
19#include "spolys.h"
20#include "cntrlc.h"
21#include "weight.h"
22#include "ipid.h"
23#include "ipshell.h"
24#include "intvec.h"
25#ifdef STDTRACE
26#include "comm.h"
27#include "lists.h"
28#endif
29#include "spSpolyLoop.h"
30
31// #include "timer.h"
32
33/*2
34* consider the part above syzComp:
35* (assume the polynomial comes from a syz computation)
36* - it is a constant term: return a copy of it
37* - else: return NULL
38*/
39static poly kFromInput(poly p,kStrategy strat)
40{
41  poly q=p;
42
43  if (pGetComp(q)>strat->syzComp) return NULL;
44  while ((q!=NULL) && (pGetComp(q)<=strat->syzComp)) pIter(q);
45  if (pIsConstantComp(q))
46    return pHead(q);
47  return NULL;
48}
49
50/*2
51*  reduction procedure for the syz
52*  and TEST_OPT_MINRES: special minimizing during computations
53*  assumes homogeneous case and degree-ordering
54*/
55static void redSyz (LObject* h,kStrategy strat)
56{
57  int j = 0,i=0,pos;
58  BOOLEAN exchanged=pDivisibleBy((*h).p2,(*h).p1);
59  poly p,q;
60
61  if (exchanged)
62  {
63    q = kFromInput((*h).p1,strat);
64    if (q==NULL)
65    {
66      exchanged = FALSE;
67    }
68    else
69    {
70      while (i<=strat->Ll)
71      {
72        if ((strat->L[i].p1==strat->P.p1) || (strat->L[i].p2==strat->P.p1))
73        {
74//PrintS("#");
75          deleteInL(strat->L,&strat->Ll,i,strat);
76        }
77        else
78          i++;
79      }
80      i = 0;
81    }
82  }
83#ifdef KDEBUG
84  if (TEST_OPT_DEBUG)
85  {
86    PrintS("red:");
87    wrp(h->p);
88    PrintS(" ");
89  }
90#endif
91  loop
92  {
93#ifdef KDEBUG
94    if (TEST_OPT_DEBUG) Print("%d",j);
95#endif
96    if (pDivisibleBy(strat->S[j],(*h).p))
97    {
98#ifdef KDEBUG
99      if (TEST_OPT_DEBUG)
100      {
101        PrintS("+\nwith ");
102        wrp(strat->S[j]);
103      }
104#endif
105      if ((!exchanged) && (pEqual((*h).p,strat->S[j])))
106      {
107//PrintS("@");
108        q = kFromInput(strat->S[j],strat);
109        if (q!=NULL)
110        {
111//Print("%d*",pGetComp(q));
112          exchanged = TRUE;
113          p = strat->S[j];
114          if (!TEST_OPT_INTSTRATEGY)
115            pNorm((*h).p);
116          else
117          {
118            //pContent((*h).p);
119            pCleardenom((*h).p);// also does a pContent
120          }
121          strat->S[j] = (*h).p;
122          (*h).p = p;
123          while ((i<=strat->tl) && (strat->T[i].p!=p)) i++;
124          if (i<=strat->tl) strat->T[i].p = strat->S[j];
125          for (i=0;i<=strat->Ll;i++)
126          {
127            if (strat->L[i].p1==p) strat->L[i].p1=strat->S[j];
128            if (strat->L[i].p2==p) strat->L[i].p2=strat->S[j];
129          }
130        }
131      }
132      //if (strat->interpt) test_int_std(strat->kIdeal);
133      /*- compute the s-polynomial -*/
134      (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether,
135                          strat->spSpolyLoop);
136      if ((*h).p == NULL)
137      {
138#ifdef KDEBUG
139        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
140#endif
141        if (h->lcm!=NULL) pFree1((*h).lcm);
142#ifdef KDEBUG
143        (*h).lcm=NULL;
144#endif
145        return;
146      }
147/*- try to reduce the s-polynomial -*/
148      j = 0;
149    }
150    else
151    {
152      if (j >= strat->sl)
153      {
154        if (exchanged)
155        {
156          if (pGetComp((*h).p) > strat->syzComp)
157          {
158//PrintS("syz");
159            pDelete(&((*h).p));
160            return;
161          }
162          else
163          {
164            if (!TEST_OPT_INTSTRATEGY)
165            {
166//PrintS("r");
167              pos = posInS(strat->S,strat->sl,(*h).p);
168              pNorm((*h).p);
169              (*h).p = redtailSyz((*h).p,pos-1,strat);
170            }
171            p = (*h).p;
172            while ((pNext(p)!=NULL) && (pGetComp(pNext(p))<=strat->syzComp))
173               pIter(p);
174            pDelete(&pNext(p));
175            pNext(p) = q;
176          }
177        }
178        else if (!TEST_OPT_INTSTRATEGY)
179        {
180          pos = posInS(strat->S,strat->sl,(*h).p);
181          pNorm((*h).p);
182          (*h).p = redtailSyz((*h).p,pos-1,strat);
183        }
184        enterTBba((*h),strat->tl+1,strat);
185        return;
186      }
187      j++;
188    }
189  }
190}
191
192/*2
193*  reduction procedure for the homogeneous case
194*  and the case of a degree-ordering
195*/
196static void redHomog (LObject* h,kStrategy strat)
197{
198  if (strat->tl<0)
199  {
200    enterTBba((*h),0,strat);
201    return;
202  }
203
204  int j = 0;
205
206#ifdef KDEBUG
207  if (TEST_OPT_DEBUG)
208  {
209    PrintS("red:");
210    wrp(h->p);
211    PrintS(" ");
212  }
213#endif
214  if (strat->ak!=0)
215  {
216    loop
217      {
218#ifdef KDEBUG
219        if (TEST_OPT_DEBUG) Print("%d",j);
220#endif
221        if (pDivisibleBy1(strat->S[j],(*h).p))
222        {
223#ifdef KDEBUG
224          if (TEST_OPT_DEBUG)
225          {
226            PrintS("+\nwith ");
227            wrp(strat->S[j]);
228          }
229#endif
230          //if (strat->interpt) test_int_std(strat->kIdeal);
231          /*- compute the s-polynomial -*/
232          (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether,
233                              strat->spSpolyLoop);
234          if ((*h).p == NULL)
235          {
236#ifdef KDEBUG
237            if (TEST_OPT_DEBUG) PrintS(" to 0\n");
238#endif
239            if (h->lcm!=NULL) pFree1((*h).lcm);
240#ifdef KDEBUG
241            (*h).lcm=NULL;
242#endif
243            return;
244          }
245          j = 0;
246        }
247        else
248        {
249          if (j >= strat->sl)
250          {
251            enterTBba((*h),strat->tl+1,strat);
252            return;
253          }
254          j++;
255        }
256      }
257  }
258  else
259  {
260    // no module component
261    loop
262      {
263#ifdef KDEBUG
264        if (TEST_OPT_DEBUG) Print("%d",j);
265#endif
266        if (pDivisibleBy2(strat->S[j],(*h).p))
267        {
268#ifdef KDEBUG
269          if (TEST_OPT_DEBUG)
270          {
271            PrintS("+\nwith ");
272            wrp(strat->S[j]);
273          }
274#endif
275          //if (strat->interpt) test_int_std(strat->kIdeal);
276          /*- compute the s-polynomial -*/
277          (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether,
278                              strat->spSpolyLoop);
279          if ((*h).p == NULL)
280          {
281#ifdef KDEBUG
282            if (TEST_OPT_DEBUG) PrintS(" to 0\n");
283#endif
284            if (h->lcm!=NULL) pFree1((*h).lcm);
285#ifdef KDEBUG
286            (*h).lcm=NULL;
287#endif
288            return;
289          }
290          j = 0;
291        }
292        else
293        {
294          if (j >= strat->sl)
295          {
296            enterTBba((*h),strat->tl+1,strat);
297            return;
298          }
299          j++;
300        }
301      }
302  }
303}
304
305/*2
306*  reduction procedure for the homogeneous case
307*  and the case of a degree-ordering
308*/
309static void redHomog0 (LObject* h,kStrategy strat)
310{
311  if (strat->tl<0)
312  {
313    enterTBba((*h),0,strat);
314    return;
315  }
316
317  int j = 0;
318  int k = 0;
319
320#ifdef KDEBUG
321  if (TEST_OPT_DEBUG)
322  {
323    PrintS("red:");
324    wrp(h->p);
325    PrintS(" ");
326  }
327#endif
328  if (strat->ak)
329  {
330    loop
331      {
332#ifdef KDEBUG
333        if (TEST_OPT_DEBUG) Print("%d",j);
334#endif
335        if (pDivisibleBy1(strat->T[j].p,(*h).p))
336        {
337          //if (strat->interpt) test_int_std(strat->kIdeal);
338#ifdef KDEBUG
339          if (TEST_OPT_DEBUG)
340          {
341            PrintS("+\nwith ");
342            wrp(strat->S[j]);
343          }
344#endif
345          /*- compute the s-polynomial -*/
346          (*h).p = spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether,
347                              strat->spSpolyLoop);
348          if ((*h).p == NULL)
349          {
350#ifdef KDEBUG
351            if (TEST_OPT_DEBUG) PrintS(" to 0\n");
352#endif
353            if (h->lcm!=NULL) pFree1((*h).lcm);
354#ifdef KDEBUG
355            (*h).lcm=NULL;
356#endif
357            return;
358          }
359          j = 0;
360        }
361        else
362        {
363          if (j >= strat->tl)
364          {
365            //pContent((*h).p);
366            pCleardenom((*h).p);// also does a pContent
367/*
368 *       (*h).length=pLength0((*h).p);
369 */
370            k=strat->posInT(strat->T,strat->tl,(*h));
371            enterTBba((*h),k,strat);
372            return;
373          }
374          j++;
375        }
376      }
377  }
378  else
379  {
380    loop
381      {
382
383        // no module component
384#ifdef KDEBUG
385        if (TEST_OPT_DEBUG) Print("%d",j);
386#endif
387        if (pDivisibleBy2(strat->T[j].p,(*h).p))
388        {
389          //if (strat->interpt) test_int_std(strat->kIdeal);
390#ifdef KDEBUG
391          if (TEST_OPT_DEBUG)
392          {
393            PrintS("+\nwith ");
394            wrp(strat->S[j]);
395          }
396#endif
397          /*- compute the s-polynomial -*/
398          (*h).p = spSpolyRed(strat->T[j].p,(*h).p,strat->kNoether,
399                              strat->spSpolyLoop);
400          if ((*h).p == NULL)
401          {
402#ifdef KDEBUG
403            if (TEST_OPT_DEBUG) PrintS(" to 0\n");
404#endif
405            if (h->lcm!=NULL) pFree1((*h).lcm);
406#ifdef KDEBUG
407            (*h).lcm=NULL;
408#endif
409            return;
410          }
411          j = 0;
412        }
413        else
414        {
415          if (j >= strat->tl)
416          {
417            //pContent((*h).p);
418            pCleardenom((*h).p);// also does a pContent
419/*
420 *       (*h).length=pLength0((*h).p);
421 */
422            k=strat->posInT(strat->T,strat->tl,(*h));
423            enterTBba((*h),k,strat);
424            return;
425          }
426          j++;
427        }
428      }
429  }
430}
431
432
433/*2
434*  reduction procedure for the inhomogeneous case
435*  and not a degree-ordering
436*/
437static void redLazy (LObject* h,kStrategy strat)
438{
439  if (strat->tl<0)
440  {
441    enterTBba((*h),0,strat);
442    return;
443  }
444
445  int at,d,i;
446  int j = 0;
447  int pass = 0;
448  int reddeg = pFDeg((*h).p);
449
450#ifdef KDEBUG
451  if (TEST_OPT_DEBUG)
452  {
453    PrintS("red:");
454    wrp(h->p);
455    PrintS(" ");
456  }
457#endif
458  loop
459  {
460    if (pDivisibleBy1(strat->S[j],(*h).p))
461    {
462      //if (strat->interpt) test_int_std(strat->kIdeal);
463#ifdef KDEBUG
464      if (TEST_OPT_DEBUG)
465      {
466        Print("\nwith S[%d] ",j);
467        wrp(strat->S[j]);
468      }
469#endif
470      /*- compute the s-polynomial -*/
471      (*h).p = spSpolyRed(strat->S[j],(*h).p,strat->kNoether
472                          , strat->spSpolyLoop);
473      if ((*h).p == NULL)
474      {
475#ifdef KDEBUG
476        if (TEST_OPT_DEBUG) PrintS(" to 0\n");
477#endif
478        if (h->lcm!=NULL) pFree1((*h).lcm);
479#ifdef KDEBUG
480        (*h).lcm=NULL;
481#endif
482        return;
483      }
484#ifdef KDEBUG
485      else if (TEST_OPT_DEBUG)
486      {
487        PrintS("to:");
488        wrp((*h).p);
489        PrintLn();
490      }
491#endif
492      /*- try to reduce the s-polynomial -*/
493      pass++;
494      d = pFDeg((*h).p);
495      if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
496      {
497        at = posInL11(strat->L,strat->Ll,*h,strat);
498        if (at <= strat->Ll)
499        {
500          i=strat->sl+1;
501          do
502          {
503            i--;
504            if (i<0)
505            {
506              enterTBba((*h),strat->tl+1,strat);
507              return;
508            }
509          }
510          while (!pDivisibleBy1(strat->S[i],(*h).p));
511#ifdef KDEBUG
512          if (TEST_OPT_DEBUG) Print(" ->L[%d]\n",at);
513#endif
514          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
515          (*h).p = NULL;
516          return;
517        }
518      }
519      else if ((TEST_OPT_PROT) && (strat->Ll < 0) && (d != reddeg))
520      {
521        Print(".%d",d);mflush();
522        reddeg = d;
523      }
524      j = 0;
525    }
526    else
527    {
528      if (j >= strat->sl)
529      {
530#ifdef KDEBUG
531        if (TEST_OPT_DEBUG) PrintLn();
532#endif
533        if (TEST_OPT_INTSTRATEGY)
534        {
535          //pContent(h->p);
536          pCleardenom(h->p);// also does a pContent
537        }
538        enterTBba((*h),strat->tl+1,strat);
539        return;
540      }
541      j++;
542    }
543  }
544}
545
546/*2
547*  reduction procedure for the sugar-strategy (honey)
548* reduces h with elements from T choosing first possible
549* element in T with respect to the given ecart
550*/
551static void redHoney (LObject*  h,kStrategy strat)
552{
553  if (strat->tl<0)
554  {
555    enterTBba((*h),0,strat);
556    return;
557  }
558
559  poly pi;
560  int i,j,at,reddeg,d,pass,ei;
561
562  pass = j = 0;
563  d = reddeg = pFDeg((*h).p)+(*h).ecart;
564#ifdef KDEBUG
565  if (TEST_OPT_DEBUG)
566  {
567    PrintS("red:");
568    wrp((*h).p);
569  }
570#endif
571  loop
572  {
573    if (pDivisibleBy1(strat->T[j].p,(*h).p))
574    {
575#ifdef KDEBUG
576      if (TEST_OPT_DEBUG) Print(" T[%d]",j);
577#endif
578      pi = strat->T[j].p;
579      ei = strat->T[j].ecart;
580      /*
581      * the polynomial to reduce with (up to the moment) is;
582      * pi with ecart ei
583      */
584      i = j;
585      loop
586      {
587        /*- takes the first possible with respect to ecart -*/
588        i++;
589        if (i > strat->tl)
590          break;
591        if ((!BTEST1(20)) && (ei <= (*h).ecart))
592          break;
593        if ((strat->T[i].ecart < ei) && pDivisibleBy1(strat->T[i].p,(*h).p))
594        {
595#ifdef KDEBUG
596          if (TEST_OPT_DEBUG) Print(" T[%d]",i);
597#endif
598          /*
599          * the polynomial to reduce with is now;
600          */
601          pi = strat->T[i].p;
602          ei = strat->T[i].ecart;
603        }
604      }
605
606      /*
607      * end of search: have to reduce with pi
608      */
609      if (ei > (*h).ecart)
610      {
611        /*
612        * It is not possible to reduce h with smaller ecart;
613        * if possible h goes to the lazy-set L,i.e
614        * if its position in L would be not the last one
615        */
616        if (strat->Ll >= 0) /* L is not empty */
617        {
618          at = strat->posInL(strat->L,strat->Ll,*h,strat);
619          if(at <= strat->Ll)
620          /*- h will not become the next element to reduce -*/
621          {
622            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
623#ifdef KDEBUG
624            if (TEST_OPT_DEBUG) Print(" ecart too big: -> L%d\n",at);
625#endif
626            (*h).p = NULL;
627            return;
628          }
629        }
630        if (TEST_OPT_MOREPAIRS)
631        {
632        /*put the polynomial also in the pair set*/
633          strat->fromT = TRUE;
634          if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
635          enterpairs((*h).p,strat->sl,(*h).ecart,0,strat);
636        }
637      }
638#ifdef KDEBUG
639      if (TEST_OPT_DEBUG)
640      {
641        PrintS("\nwith ");
642        wrp(pi);
643      }
644#endif
645      if (strat->fromT)
646      {
647        strat->fromT=FALSE;
648        (*h).p = spSpolyRedNew(pi,(*h).p,strat->kNoether,
649                               strat->spSpolyLoop);
650      }
651      else
652        (*h).p = spSpolyRed(pi,(*h).p,strat->kNoether, strat->spSpolyLoop);
653#ifdef KDEBUG
654      if (TEST_OPT_DEBUG)
655      {
656        PrintS(" to ");
657        wrp((*h).p);
658        PrintLn();
659      }
660#endif
661      if ((*h).p == NULL)
662      {
663        if (h->lcm!=NULL) pFree1((*h).lcm);
664#ifdef KDEBUG
665        (*h).lcm=NULL;
666#endif
667        return;
668      }
669      /* compute the ecart */
670      if (ei <= (*h).ecart)
671        (*h).ecart = d-pFDeg((*h).p);
672      else
673        (*h).ecart = d-pFDeg((*h).p)+ei-(*h).ecart;
674//      if (strat->syzComp)
675//      {
676//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
677//        {
678#ifdef KDEBUG
679//          if (TEST_OPT_DEBUG)
680#endif
681//            PrintS("  >syzComp\n");
682//          if (TEST_OPT_INTSTRATEGY) pContent(h->p);
683//          at=strat->posInT(strat->T,strat->tl,(*h));
684//          enterTBba((*h),at,strat);
685//          return;
686//        }
687//      }
688      /*
689      * try to reduce the s-polynomial h
690      *test first whether h should go to the lazyset L
691      *-if the degree jumps
692      *-if the number of pre-defined reductions jumps
693      */
694      pass++;
695      d = pFDeg((*h).p)+(*h).ecart;
696      if ((strat->Ll >= 0) && ((d > reddeg) || (pass > strat->LazyPass)))
697      {
698        at = strat->posInL(strat->L,strat->Ll,*h,strat);
699        if (at <= strat->Ll)
700        {
701          /*test if h is already standardbasis element*/
702          i=strat->sl+1;
703          do
704          {
705            i--;
706            if (i<0)
707            {
708              at=strat->posInT(strat->T,strat->tl,(*h));
709              enterTBba((*h),at,strat);
710              return;
711            }
712          } while (!pDivisibleBy1(strat->S[i],(*h).p));
713          enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
714#ifdef KDEBUG
715          if (TEST_OPT_DEBUG)
716            Print(" degree jumped: -> L%d\n",at);
717#endif
718          (*h).p = NULL;
719          return;
720        }
721      }
722      else if (TEST_OPT_PROT && (strat->Ll < 0) && (d > reddeg))
723      {
724        reddeg = d;
725        Print(".%d",d); mflush();
726      }
727      j = 0;
728    }
729    else
730    {
731      if (j >= strat->tl)
732      {
733#ifdef KDEBUG
734        if (TEST_OPT_DEBUG) PrintLn();
735#endif
736        if (TEST_OPT_INTSTRATEGY)
737        {
738          //pContent(h->p);
739          pCleardenom(h->p);// also does a pContent
740        }
741        at=strat->posInT(strat->T,strat->tl,(*h));
742        enterTBba((*h),at,strat);
743        return;
744      }
745      j++;
746    }
747  }
748}
749
750/*2
751*  reduction procedure for tests only
752*  reduces with elements from T and chooses the best possible
753*/
754static void redBest (LObject*  h,kStrategy strat)
755{
756  if (strat->tl<0)
757  {
758    enterTBba((*h),0,strat);
759    return;
760  }
761
762  int j,jbest,at,reddeg,d,pass;
763  poly     p,ph;
764  pass = j = 0;
765
766  if (strat->honey)
767    reddeg = pFDeg((*h).p)+(*h).ecart;
768  else
769    reddeg = pFDeg((*h).p);
770  loop
771  {
772    if (pDivisibleBy(strat->T[j].p,(*h).p))
773    {
774      //if (strat->interpt) test_int_std(strat->kIdeal);
775      /* compute the s-polynomial */
776      if (!TEST_OPT_INTSTRATEGY) pNorm((*h).p);
777#ifdef SDRING
778      // spSpolyShortBba will not work in the SRING case
779      if (pSDRING)
780      {
781        p=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
782        if (p!=NULL) pDelete(&pNext(p));
783      }
784      else
785#endif
786      p = spSpolyShortBba(strat->T[j].p,(*h).p);
787      /* computes only the first monomial of the spoly  */
788      if (p)
789      {
790        jbest = j;
791        /* looking for the best possible reduction */
792        if ((strat->syzComp==0) || (pMinComp(p) <= strat->syzComp))
793        {
794          loop
795          {
796            j++;
797            if (j > strat->tl)
798              break;
799            if (pDivisibleBy(strat->T[j].p,(*h).p))
800            {
801#ifdef SDRING
802              // spSpolyShortBba will not work in the SRING case
803              if (pSDRING)
804              {
805                ph=spSpolyCreate(strat->T[j].p,(*h).p,strat->kNoether);
806                if (ph!=NULL) pDelete(&pNext(ph));
807              }
808              else
809#endif
810              ph = spSpolyShortBba(strat->T[j].p,(*h).p);
811              if (ph==NULL)
812              {
813                pFree1(p);
814                pDelete(&((*h).p));
815                if (h->lcm!=NULL) pFree1((*h).lcm);
816#ifdef KDEBUG
817                (*h).lcm=NULL;
818#endif
819                return;
820              }
821              else if (pComp0(ph,p) == -1)
822              {
823                pFree1(p);
824                p = ph;
825                jbest = j;
826              }
827              else
828              {
829                pFree1(ph);
830              }
831            }
832          }
833        }
834        pFree1(p);
835        (*h).p = spSpolyRed(strat->T[jbest].p,(*h).p,strat->kNoether,
836                            strat->spSpolyLoop);
837      }
838      else
839      {
840        if (h->lcm!=NULL) pFree1((*h).lcm);
841#ifdef KDEBUG
842        (*h).lcm=NULL;
843#endif
844        (*h).p = NULL;
845        return;
846      }
847      if (strat->honey && pLexOrder)
848        strat->initEcart(h);
849      /* h.length:=l; */
850      /* try to reduce the s-polynomial */
851//      if (strat->syzComp)
852//      {
853//        if ((strat->syzComp>0) && (pMinComp((*h).p) > strat->syzComp))
854//        {
855#ifdef KDEBUG
856//          if (TEST_OPT_DEBUG)
857#endif
858//            PrintS(" >syzComp\n");
859//          if (TEST_OPT_INTSTRATEGY) pContent(h->p);
860//          at=strat->posInT(strat->T,strat->tl,(*h));
861//          enterTBba((*h),at,strat);
862//          return;
863//        }
864//      }
865      if (strat->honey || pLexOrder)
866      {
867        pass++;
868        d = pFDeg((*h).p);
869        if (strat->honey)
870          d += (*h).ecart;
871        if ((strat->Ll >= 0) && ((pass > strat->LazyPass) || (d > reddeg)))
872        {
873          at = strat->posInL(strat->L,strat->Ll,*h,strat);
874          if (at <= strat->Ll)
875          {
876            enterL(&strat->L,&strat->Ll,&strat->Lmax,*h,at);
877            (*h).p = NULL;
878            return;
879          }
880        }
881        else if (TEST_OPT_PROT && (strat->Ll < 0) && (d != reddeg))
882        {
883          reddeg = d;
884          Print("%d.");
885          mflush();
886        }
887      }
888      j = 0;
889    }
890    else
891    {
892      if (j >= strat->tl)
893      {
894        if (TEST_OPT_INTSTRATEGY)
895        {
896          //pContent(h->p);
897          pCleardenom(h->p);// also does a pContent
898        }
899        at=strat->posInT(strat->T,strat->tl,(*h));
900        enterTBba((*h),at,strat);
901        return;
902      }
903      j++;
904    }
905  }
906}
907
908/*2
909*  reduction procedure for the normal form
910*/
911
912static poly redNF (poly h,kStrategy strat)
913{
914  int j = 0;
915  int z = 3;
916
917#ifdef KDEBUG
918 if (TEST_OPT_DEBUG)
919 {
920   PrintS("red:");wrp(h);
921 }
922#endif
923  if (0 > strat->tl)
924  {
925#ifdef KDEBUG
926    if (TEST_OPT_DEBUG) PrintLn();
927#endif
928    return h;
929  }
930  loop
931  {
932    if (pDivisibleBy1(strat->S[j],h))
933    {
934      //if (strat->interpt) test_int_std(strat->kIdeal);
935      /*- compute the s-polynomial -*/
936#ifdef KDEBUG
937      if (TEST_OPT_DEBUG)
938      {
939        Print("\nwith S[%d]:",j);wrp(strat->S[j]);
940      }
941#endif
942      h = spSpolyRed(strat->S[j],h,strat->kNoether, strat->spSpolyLoop);
943#ifdef KDEBUG
944      if (TEST_OPT_DEBUG)
945      {
946        PrintS("\nto:");
947        wrp(h);
948        if (h==NULL) PrintLn();
949      }
950#endif
951      if (h == NULL) return NULL;
952      z++;
953      if (z>=10)
954      {
955        z=0;
956        pNormalize(h);
957      }
958      /*- try to reduce the s-polynomial -*/
959      j = 0;
960    }
961    else
962    {
963      if (j >= strat->sl) return h;
964      j++;
965    }
966  }
967}
968
969void initBba(ideal F,kStrategy strat)
970{
971  int i;
972  idhdl h;
973 /* setting global variables ------------------- */
974  strat->enterS = enterSBba;
975  if ((BTEST1(20)) && (!strat->honey))
976    strat->red = redBest;
977  else if (strat->honey)
978    strat->red = redHoney;
979  else if (pLexOrder && !strat->homog)
980    strat->red = redLazy;
981  else if (TEST_OPT_INTSTRATEGY && strat->homog)
982    strat->red = redHomog0;
983  else
984    strat->red = redHomog;
985  if (TEST_OPT_MINRES && strat->homog && (strat->syzComp >0))
986    strat->red = redSyz;
987
988  if (pLexOrder && strat->honey)
989    strat->initEcart = initEcartNormal;
990  else
991    strat->initEcart = initEcartBBA;
992  if (strat->honey)
993    strat->initEcartPair = initEcartPairMora;
994  else
995    strat->initEcartPair = initEcartPairBba;
996  strat->kIdeal = NULL;
997  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
998  //else              strat->kIdeal->rtyp=MODUL_CMD;
999  //strat->kIdeal->data=(void *)strat->Shdl;
1000  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
1001  {
1002    //interred  machen   Aenderung
1003    pFDegOld=pFDeg;
1004    pLDegOld=pLDeg;
1005    h=ggetid("ecart");
1006    if ((h!=NULL) && (IDTYP(h)==INTVEC_CMD))
1007    {
1008      ecartWeights=iv2array(IDINTVEC(h));
1009    }
1010    else
1011    {
1012      ecartWeights=(short *)Alloc((pVariables+1)*sizeof(short));
1013      /*uses automatic computation of the ecartWeights to set them*/
1014      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
1015    }
1016    pFDeg=totaldegreeWecart;
1017    pLDeg=maxdegreeWecart;
1018    for(i=1; i<=pVariables; i++)
1019      Print(" %d",ecartWeights[i]);
1020    PrintLn();
1021    mflush();
1022  }
1023}
1024
1025#ifdef STDTRACE
1026lists bbaLink (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat, stdLink stdTrace)
1027{
1028  int oldLl;
1029  int srmax,lrmax;
1030  int olddeg,reduc;
1031  int anzTupel=0, anzNew = 0, anzSkipped=0;
1032#ifdef SDRING
1033  polyset aug=(polyset)Alloc(setmax*sizeof(poly));
1034  int augmax=setmax, augl=-1;
1035  poly oldLcm=NULL;
1036#endif
1037  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1038
1039  if(stdTrace!=NULL) stdTrace->Start(strat);
1040
1041  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1042  initHilbCrit(F,Q,&hilb,strat);
1043  initBba(F,strat);
1044  initBuchMoraPos(strat);
1045  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1046  /*Shdl=*/initBuchMora(F, Q,strat);
1047  if (strat->minim>0)
1048  {
1049    strat->M=idInit(IDELEMS(F),F->rank);
1050  }
1051  srmax = strat->sl;
1052  reduc = olddeg = lrmax = 0;
1053  /* compute------------------------------------------------------- */
1054  while ((stdTrace!=NULL && !stdTrace->CheckEnd(strat)) || (stdTrace == NULL && strat->Ll>=0))
1055    {
1056//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1057      if(stdTrace!=NULL && stdTrace->Receive)
1058        {
1059          stdTrace->ReceiveMsg();
1060          stdTrace->ParseMessage(strat);
1061        }
1062//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1063      if((stdTrace!=NULL && stdTrace->Verwaltung) || (stdTrace == NULL))
1064        {
1065          if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1066#ifdef KDEBUG
1067          if (TEST_OPT_DEBUG) messageSets(strat);
1068#endif
1069          //test_int_std(strat->kIdeal);
1070          if (strat->Ll== 0) strat->interpt=TRUE;
1071          if (TEST_OPT_DEGBOUND
1072              && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))
1073                  || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))))
1074            {
1075              /*
1076               *stops computation if
1077               * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1078               *a predefined number Kstd1_deg
1079               */
1080              while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1081              break;
1082            }
1083        }
1084//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1085      if((stdTrace!=NULL && stdTrace->TupelL) || (stdTrace == NULL ))
1086        {
1087          /* picks the last element from the lazyset L */
1088          strat->P = strat->L[strat->Ll];
1089          anzTupel++;
1090          strat->Ll--;
1091          if(stdTrace!=NULL && stdTrace->TupelStore)
1092            {
1093              if (TEST_OPT_PROT) PrintS(":");
1094              stdTrace->Store(strat->P);
1095              strat->P.p=NULL;
1096              anzSkipped++;
1097            }
1098        }
1099//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1100      if((stdTrace!=NULL && stdTrace->SPoly) || (stdTrace == NULL))
1101        {
1102          kTest(strat);
1103          if (pNext(strat->P.p) == strat->tail)
1104            {
1105              /* deletes the short spoly and computes */
1106              pFree1(strat->P.p);
1107              /* the real one */
1108              strat->P.p = spSpolyCreate(strat->P.p1,strat->P.p2,strat->kNoether);
1109            }
1110          if((strat->P.p1==NULL) && (strat->minim>0))
1111            strat->P.p2=pCopy(strat->P.p);
1112        }
1113//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1114      if((stdTrace!=NULL && stdTrace->Reduzieren) || (stdTrace == NULL))
1115        {
1116#ifdef SDRING
1117          if (strat->P.p != NULL)
1118#endif
1119            {
1120              if (strat->honey)
1121                {
1122                  if (TEST_OPT_PROT) message(strat->P.ecart+pFDeg(strat->P.p),&olddeg,&reduc,strat);
1123                }
1124              else
1125                {
1126                  if (TEST_OPT_PROT) message(pFDeg(strat->P.p),&olddeg,&reduc,strat);
1127                }
1128              /* reduction of the element choosen from L */
1129              oldLl=strat->Ll;
1130              strat->red(&strat->P,strat);
1131              if(stdTrace!=NULL && stdTrace->TupelPosition)
1132                stdTrace->CheckPosition(strat,oldLl);
1133              if((stdTrace!=NULL && stdTrace->TupelMelden))
1134                stdTrace->SendTupel(strat);
1135              if(stdTrace!=NULL && strat->P.p!=NULL && stdTrace->Modus==ModCheck)
1136                anzNew++;
1137            }
1138          if (strat->P.p != NULL)
1139            {
1140#ifdef SDRING
1141              aug[0]=strat->P.p;
1142              augl=0;
1143              if (pSDRING)
1144          {
1145            oldLcm=strat->P.lcm;
1146#ifdef SRING
1147            if (pSRING) psAug(pCopy(strat->P.p),pOne(),&aug,&augl,&augmax);
1148#endif
1149#ifdef DRING
1150            if (pDRING) pdAug(pCopy(strat->P.p),&aug,&augl,&augmax);
1151#endif
1152#ifdef KDEBUG
1153            if (TEST_OPT_DEBUG)
1154            {
1155              PrintS(" aug of ");
1156              wrp(aug[0]);
1157              PrintLn();
1158              int iiaug=augl;
1159              while (iiaug>=0)
1160              {
1161                Print(" to %d:",iiaug);
1162                wrp(aug[iiaug]);
1163                PrintLn();
1164                iiaug--;
1165              }
1166            }
1167#endif
1168          }
1169              for (augl++;augl != 0;)
1170                {
1171                  strat->P.p=aug[--augl];
1172                  aug[augl]=NULL;
1173                  if (pSDRING)
1174                    {
1175                      if (oldLcm==NULL) strat->P.lcm=NULL;
1176                      else  strat->P.lcm=pCopy1(oldLcm);
1177                    }
1178                  if ((augl!=0)&&(strat->P.p!=NULL))
1179                    strat->red(&strat->P,strat);
1180                  if (strat->P.p != NULL)
1181                    {
1182#endif
1183                      /* statistic */
1184                      if (TEST_OPT_PROT) PrintS("s");
1185                      /* enter P.p into s and L */
1186                      {
1187                        int pos=posInS(strat->S,strat->sl,strat->P.p);
1188#ifdef SDRING
1189                        if ((pSDRING) && (pos<=strat->sl)&& (pComparePolys(strat->P.p,strat->S[pos])))
1190                          {
1191                            if (TEST_OPT_PROT)
1192                              PrintS("d");
1193                          }
1194                        else
1195#endif
1196                          {
1197                            if (TEST_OPT_INTSTRATEGY)
1198                              {
1199                                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
1200                                  {
1201                                    strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1202                                    pCleardenom(strat->P.p);
1203                                  }
1204                              }
1205                            else
1206                              {
1207                                pNorm(strat->P.p);
1208                                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
1209                                  {
1210                                    strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1211                                  }
1212                              }
1213#ifdef KDEBUG
1214                            if (TEST_OPT_DEBUG)
1215                              {
1216                                PrintS("new s:");
1217                                wrp(strat->P.p);
1218                                PrintLn();
1219                              }
1220#endif
1221                            if((strat->P.p1==NULL) && (strat->minim>0))
1222                              {
1223                                if (strat->minim==1)
1224                                  {
1225                                    strat->M->m[minimcnt]=pCopy(strat->P.p);
1226                                    pDelete(&strat->P.p2);
1227                                  }
1228                                else
1229                                  {
1230                                    strat->M->m[minimcnt]=strat->P.p2;
1231                                    strat->P.p2=NULL;
1232                                  }
1233                                minimcnt++;
1234                              }
1235                            enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat);
1236                            if (strat->sl==-1) pos=0;
1237                            else pos=posInS(strat->S,strat->sl,strat->P.p);
1238                            strat->enterS(strat->P,pos,strat);
1239                          }
1240                        if (hilb!=NULL)
1241                          {  // xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
1242                            oldLl=strat->Ll;
1243                            khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1244                            if(stdTrace!=NULL)
1245                              stdTrace->CheckHilb(strat,oldLl);
1246                          }
1247                      }
1248                      if (strat->P.lcm!=NULL) pFree1(strat->P.lcm);
1249#ifdef SDRING
1250                    }
1251                }
1252              /* delete the old pair */
1253              if (pSDRING &&(oldLcm!=NULL)) pFree1(oldLcm);
1254#endif
1255              if (strat->sl>srmax) srmax = strat->sl;
1256            }
1257          if(stdTrace!=NULL && stdTrace->TupelTesten)
1258            stdTrace->TupelDifferent(strat);
1259        }
1260#ifdef KDEBUG
1261      strat->P.lcm=NULL;
1262#endif
1263      kTest(strat);
1264    }
1265  if(stdTrace !=NULL)
1266    if(TEST_OPT_PROT)
1267      {
1268        Print("\n(Tupel  Skipped  New) = (%i  %i  %i)\n",anzTupel, anzSkipped, anzNew);
1269      }
1270  if((stdTrace!=NULL && stdTrace->ResultSend) || (stdTrace == NULL))
1271    {
1272#ifdef KDEBUG
1273      if (TEST_OPT_DEBUG) messageSets(strat);
1274#endif
1275      /* complete reduction of the standard basis--------- */
1276      if (TEST_OPT_REDSB) completeReduce(strat);
1277      /* release temp data-------------------------------- */
1278      exitBuchMora(strat);
1279      if (TEST_OPT_WEIGHTM)
1280        {
1281          pFDeg=pFDegOld;
1282          pLDeg=pLDegOld;
1283          if (ecartWeights)
1284            {
1285              Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1286              ecartWeights=NULL;
1287            }
1288        }
1289#ifdef SDRING
1290      Free((ADDRESS)aug,augmax*sizeof(poly));
1291#endif
1292      if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1293      if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1294    }
1295  if(stdTrace!=NULL)
1296    stdTrace->End(strat);
1297  lists l=(lists)Alloc(sizeof(slists));
1298  l->Init(2);
1299  l->m[0].rtyp = IDEAL_CMD;
1300  l->m[0].data = (void *) strat->Shdl;
1301   if(stdTrace!=NULL )
1302     {
1303       l->m[1].rtyp = LIST_CMD;
1304       l->m[1].data = (void *)stdTrace->RestTupel();
1305     }
1306  return (l);
1307}
1308
1309#else
1310
1311ideal bba (ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
1312{
1313  int   srmax,lrmax;
1314  int   olddeg,reduc;
1315#ifdef SDRING
1316  polyset aug=(polyset)Alloc(setmax*sizeof(poly));
1317  int augmax=setmax, augl=-1;
1318  poly oldLcm=NULL;
1319#endif
1320  int hilbeledeg=1,hilbcount=0,minimcnt=0;
1321
1322  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1323  initHilbCrit(F,Q,&hilb,strat);
1324  initBba(F,strat);
1325  initBuchMoraPos(strat);
1326  /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
1327  /*Shdl=*/initBuchMora(F, Q,strat);
1328  if (strat->minim>0)
1329  {
1330    strat->M=idInit(IDELEMS(F),F->rank);
1331  }
1332  srmax = strat->sl;
1333  reduc = olddeg = lrmax = 0;
1334  /* compute------------------------------------------------------- */
1335  while (strat->Ll >= 0)
1336  {
1337    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
1338#ifdef KDEBUG
1339    if (TEST_OPT_DEBUG) messageSets(strat);
1340#endif
1341    //test_int_std(strat->kIdeal);
1342    if (strat->Ll== 0) strat->interpt=TRUE;
1343    if (TEST_OPT_DEGBOUND
1344    && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))
1345       || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p)>Kstd1_deg))))
1346    {
1347      /*
1348      *stops computation if
1349      * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
1350      *a predefined number Kstd1_deg
1351      */
1352      while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
1353      break;
1354    }
1355    /* picks the last element from the lazyset L */
1356    strat->P = strat->L[strat->Ll];
1357    strat->Ll--;
1358    kTest(strat);
1359    if (pNext(strat->P.p) == strat->tail)
1360    {
1361      /* deletes the short spoly and computes */
1362      pFree1(strat->P.p);
1363      /* the real one */
1364      strat->P.p = spSpolyCreate(strat->P.p1,strat->P.p2,strat->kNoether);
1365    }
1366    kTest(strat);
1367    if((strat->P.p1==NULL) && (strat->minim>0))
1368      strat->P.p2=pCopy(strat->P.p);
1369#ifdef SDRING
1370    if (strat->P.p != NULL)
1371#endif
1372    {
1373      if (strat->honey)
1374      {
1375        if (TEST_OPT_PROT) message(strat->P.ecart+pFDeg(strat->P.p),&olddeg,&reduc,strat);
1376      }
1377      else
1378      {
1379        if (TEST_OPT_PROT) message(pFDeg(strat->P.p),&olddeg,&reduc,strat);
1380      }
1381      kTest(strat);
1382      /* reduction of the element choosen from L */
1383      strat->red(&strat->P,strat);
1384      pTest(strat->P.p);
1385    }
1386    kTest(strat);
1387    if (strat->P.p != NULL)
1388    {
1389#ifdef SDRING
1390      aug[0]=strat->P.p;
1391      augl=0;
1392      if (pSDRING)
1393      {
1394        oldLcm=strat->P.lcm;
1395#ifdef SRING
1396        if (pSRING) psAug(pCopy(strat->P.p),pOne(),&aug,&augl,&augmax);
1397#endif
1398#ifdef DRING
1399        if (pDRING) pdAug(pCopy(strat->P.p),&aug,&augl,&augmax);
1400#endif
1401#ifdef KDEBUG
1402        if (TEST_OPT_DEBUG)
1403        {
1404          PrintS(" aug of ");
1405          wrp(aug[0]);
1406          PrintLn();
1407          int iiaug=augl;
1408          while (iiaug>=0)
1409          {
1410            Print(" to %d:",iiaug);
1411            wrp(aug[iiaug]);
1412            PrintLn();
1413            iiaug--;
1414          }
1415        }
1416#endif
1417      }
1418      for (augl++;augl != 0;)
1419      {
1420        strat->P.p=aug[--augl];
1421        aug[augl]=NULL;
1422        if (pSDRING)
1423        {
1424          if (oldLcm==NULL) strat->P.lcm=NULL;
1425          else  strat->P.lcm=pCopy1(oldLcm);
1426        }
1427        if ((augl!=0)&&(strat->P.p!=NULL))
1428          strat->red(&strat->P,strat);
1429        if (strat->P.p != NULL)
1430        {
1431#endif
1432          /* statistic */
1433          if (TEST_OPT_PROT) PrintS("s");
1434          /* enter P.p into s and L */
1435          {
1436            int pos=posInS(strat->S,strat->sl,strat->P.p);
1437#ifdef SDRING
1438            if ((pSDRING) && (pos<=strat->sl)&& (pComparePolys(strat->P.p,strat->S[pos])))
1439            {
1440              if (TEST_OPT_PROT)
1441                PrintS("d");
1442            }
1443            else
1444#endif
1445            {
1446              if (TEST_OPT_INTSTRATEGY)
1447              {
1448                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
1449                {
1450                  strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1451                  pCleardenom(strat->P.p);
1452                }
1453              }
1454              else
1455              {
1456                pNorm(strat->P.p);
1457                if ((!TEST_OPT_MINRES)||(strat->syzComp==0)||(!strat->homog))
1458                {
1459                  strat->P.p = redtailBba(strat->P.p,pos-1,strat);
1460                }
1461              }
1462#ifdef KDEBUG
1463              if (TEST_OPT_DEBUG)
1464              {
1465                PrintS("new s:");
1466                wrp(strat->P.p);
1467                PrintLn();
1468              }
1469#endif
1470              if((strat->P.p1==NULL) && (strat->minim>0))
1471              {
1472                if (strat->minim==1)
1473                {
1474                  strat->M->m[minimcnt]=pCopy(strat->P.p);
1475                  pDelete(&strat->P.p2);
1476                }
1477                else
1478                {
1479                  strat->M->m[minimcnt]=strat->P.p2;
1480                  strat->P.p2=NULL;
1481                }
1482                minimcnt++;
1483              }
1484              enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat);
1485              if (strat->sl==-1) pos=0;
1486              else pos=posInS(strat->S,strat->sl,strat->P.p);
1487              strat->enterS(strat->P,pos,strat);
1488            }
1489            if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
1490          }
1491          if (strat->P.lcm!=NULL) pFree1(strat->P.lcm);
1492#ifdef SDRING
1493        }
1494      }
1495      /* delete the old pair */
1496      if (pSDRING &&(oldLcm!=NULL)) pFree1(oldLcm);
1497#endif
1498      if (strat->sl>srmax) srmax = strat->sl;
1499    }
1500#ifdef KDEBUG
1501    strat->P.lcm=NULL;
1502#endif
1503    kTest(strat);
1504  }
1505#ifdef KDEBUG
1506  if (TEST_OPT_DEBUG) messageSets(strat);
1507#endif
1508  /* complete reduction of the standard basis--------- */
1509  if (TEST_OPT_REDSB) completeReduce(strat);
1510  /* release temp data-------------------------------- */
1511  exitBuchMora(strat);
1512  if (TEST_OPT_WEIGHTM)
1513  {
1514    pFDeg=pFDegOld;
1515    pLDeg=pLDegOld;
1516    if (ecartWeights)
1517    {
1518      Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1519      ecartWeights=NULL;
1520    }
1521  }
1522#ifdef SDRING
1523  Free((ADDRESS)aug,augmax*sizeof(poly));
1524#endif
1525  if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
1526  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1527  return (strat->Shdl);
1528}
1529#endif
1530
1531poly kNF2 (ideal F,ideal Q,poly q,kStrategy strat, int lazyReduce)
1532{
1533  poly   p;
1534  int   i;
1535
1536  if ((idIs0(F))&&(Q==NULL))
1537    return pCopy(q); /*F=0*/
1538  strat->ak = idRankFreeModule(F);
1539  /*- creating temp data structures------------------- -*/
1540  BITSET save_test=test;
1541  test|=Sy_bit(OPT_REDTAIL);
1542  initBuchMoraCrit(strat);
1543  strat->initEcart = initEcartBBA;
1544  strat->enterS = enterSBba;
1545  /*- set S -*/
1546  strat->sl = -1;
1547  strat->spSpolyLoop = spGetSpolyLoop(currRing, MAX(strat->ak, pMaxComp(q)),
1548                                      strat->syzComp, FALSE);
1549  /*- init local data struct.---------------------------------------- -*/
1550  /*Shdl=*/initS(F,Q,strat);
1551  /*- compute------------------------------------------------------- -*/
1552  if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1553  {
1554    for (i=strat->sl;i>=0;i--)
1555      pNorm(strat->S[i]);
1556  }
1557  kTest(strat);
1558  p = redNF(pCopy(q),strat);
1559  kTest(strat);
1560  if ((p!=NULL)&&(lazyReduce==0))
1561  {
1562    p = redtailBba(p,strat->sl,strat);
1563  }
1564  kTest(strat);
1565  /*- release temp data------------------------------- -*/
1566  Free((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1567  idDelete(&strat->Shdl);
1568  test=save_test;
1569  return p;
1570}
1571
1572ideal kNF2 (ideal F,ideal Q,ideal q,kStrategy strat, int lazyReduce)
1573{
1574  poly   p;
1575  int   i;
1576  ideal res;
1577
1578  if (idIs0(q))
1579    return idInit(1,q->rank);
1580  if ((idIs0(F))&&(Q==NULL))
1581    return idCopy(q); /*F=0*/
1582  strat->ak = idRankFreeModule(F);
1583  /*- creating temp data structures------------------- -*/
1584  BITSET save_test=test;
1585  test|=Sy_bit(OPT_REDTAIL);
1586  initBuchMoraCrit(strat);
1587  strat->initEcart = initEcartBBA;
1588  strat->enterS = enterSBba;
1589  /*- set S -*/
1590  strat->sl = -1;
1591  strat->spSpolyLoop =  spGetSpolyLoop(currRing, 
1592                                       MAX(strat->ak, idRankFreeModule(q)),
1593                                       strat->syzComp, FALSE);
1594  /*- init local data struct.---------------------------------------- -*/
1595  /*Shdl=*/initS(F,Q,strat);
1596  /*- compute------------------------------------------------------- -*/
1597  res=idInit(IDELEMS(q),q->rank);
1598  if ((TEST_OPT_INTSTRATEGY)&&(lazyReduce==0))
1599  {
1600    for (i=strat->sl;i>=0;i--)
1601      pNorm(strat->S[i]);
1602  }
1603  for (i=IDELEMS(q)-1; i>=0; i--)
1604  {
1605    if (q->m[i]!=NULL)
1606    {
1607      p = redNF(pCopy(q->m[i]),strat);
1608      if ((p!=NULL)&&(lazyReduce==0))
1609      {
1610        p = redtailBba(p,strat->sl,strat);
1611      }
1612      res->m[i]=p;
1613    }
1614    //else
1615    //  res->m[i]=NULL;
1616    if (TEST_OPT_PROT)
1617    {
1618      PrintS("-");mflush();
1619    }
1620  }
1621  /*- release temp data------------------------------- -*/
1622  Free((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
1623  idDelete(&strat->Shdl);
1624  test=save_test;
1625  return res;
1626}
1627
1628static ideal bbared (ideal F, ideal Q,kStrategy strat)
1629{
1630
1631  /* complete reduction of the standard basis--------- */
1632  completeReduce(strat);
1633  /* release temp data-------------------------------- */
1634  exitBuchMora(strat);
1635  if (TEST_OPT_WEIGHTM)
1636  {
1637    pFDeg=pFDegOld;
1638    pLDeg=pLDegOld;
1639    if (ecartWeights)
1640    {
1641      Free((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
1642      ecartWeights=NULL;
1643    }
1644  }
1645  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
1646  return (strat->Shdl);
1647}
1648
1649ideal stdred(ideal F, ideal Q, tHomog h,intvec ** w)
1650{
1651  ideal r;
1652  BOOLEAN b=pLexOrder,toReset=FALSE;
1653  BOOLEAN delete_w=(w==NULL);
1654  kStrategy strat=(kStrategy)Alloc0(sizeof(skStrategy));
1655
1656  if (currRing->ch==0) strat->LazyPass=2;
1657  else                 strat->LazyPass=20;
1658  strat->LazyDegree = 1;
1659  if ((h==testHomog))
1660  {
1661    strat->ak = idRankFreeModule(F);
1662    if (strat->ak==0)
1663    {
1664      h = (tHomog)idHomIdeal(F,Q);
1665      w=NULL;
1666    }
1667    else
1668      h = (tHomog)idHomModule(F,Q,w);
1669  }
1670  if (h==isHomog)
1671  {
1672    if ((w!=NULL) && (*w!=NULL))
1673    {
1674      kModW = *w;
1675      strat->kModW = *w;
1676      pOldFDeg = pFDeg;
1677      pFDeg = kModDeg;
1678      toReset = TRUE;
1679    }
1680    pLexOrder = TRUE;
1681    strat->LazyPass*=2;
1682  }
1683  strat->homog=h;
1684  spSet(currRing);
1685  strat->spSpolyLoop = spGetSpolyLoop(currRing, strat);
1686  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
1687  initBuchMoraPos(strat);
1688  if (pOrdSgn==1)
1689    initBba(F,strat);
1690  else
1691    initMora(F,strat);
1692  initBuchMora(F, Q,strat);
1693  //initS(F,Q,strat);
1694// Ende der Initalisierung
1695  r=bbared(F,Q,strat);
1696#ifdef KDEBUG
1697  int i;
1698  for (i=0; i<IDELEMS(r); i++) pTest(r->m[i]);
1699#endif
1700// Ende: aufraeumen
1701  if (toReset)
1702  {
1703    kModW = NULL;
1704    pFDeg = pOldFDeg;
1705  }
1706  pLexOrder = b;
1707  Free((ADDRESS)strat,sizeof(skStrategy));
1708  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
1709  idSkipZeroes(r);
1710  return r;
1711}
Note: See TracBrowser for help on using the repository browser.