source: git/kernel/GBEngine/kstdfac.cc

spielwiese
Last change on this file was 2398d9, checked in by Hans Schoenemann <hannes@…>, 3 years ago
mora: removed strta->HCord, always call HEckeTest
  • Property mode set to 100644
File size: 22.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5*  ABSTRACT -  Kernel: factorizing alg. of Buchberger
6*/
7
8#include "kernel/mod2.h"
9#include "misc/options.h"
10#include "kernel/polys.h"
11#include "kernel/ideals.h"
12#include "kernel/GBEngine/kutil.h"
13#include "kernel/GBEngine/kstd1.h"
14#include "kernel/GBEngine/khstd.h"
15#include "polys/weight.h"
16#include "misc/intvec.h"
17#include "polys/clapsing.h"
18#include "kernel/ideals.h"
19#include "kernel/GBEngine/kstdfac.h"
20
21VAR int strat_nr=0;
22/*3
23* copy o->T to n->T, assumes that n->S is already copied
24*/
25static void copyT (kStrategy o,kStrategy n)
26{
27  int i,j;
28  poly  p;
29  TSet t=(TSet)omAlloc0(o->tmax*sizeof(TObject));
30  TObject** r = (TObject**)omAlloc0(o->tmax*sizeof(TObject*));
31
32  for (j=0; j<=o->tl; j++)
33  {
34    t[j] = o->T[j];
35    r[t[j].i_r] = &t[j];
36    p = o->T[j].p;
37    i = -1;
38    loop
39    {
40      i++;
41      if (i>o->sl)
42      {
43        t[j].p=pCopy(p);
44        break;
45      }
46      if (p == o->S[i])
47      {
48        t[j].p=n->S[i];
49        break;
50      }
51    }
52    t[j].t_p = NULL; // ?? or t[j].p ??
53    t[j].max_exp = NULL; // ?? or p_GetMaxExpP(t[j].t_p,o->tailRing); ??
54    t[j].pLength =  pLength(p);
55  }
56  n->T=t;
57  n->R=r;
58}
59
60/*3
61* copy o->L to n->L, assumes that n->T,n->tail is already copied
62*/
63static void copyL (kStrategy o,kStrategy n)
64{
65  int i,j;
66  poly  p;
67  LSet l=(LSet)omAlloc(o->Lmax*sizeof(LObject));
68
69  for (j=0; j<=o->Ll; j++)
70  {
71    l[j] = o->L[j];
72    // copy .p ----------------------------------------------
73    if (pNext(o->L[j].p)!=o->tail)
74      l[j].p=pCopy(o->L[j].p);
75    else
76    {
77      l[j].p=p_LmInit(o->L[j].p,currRing);
78      if (pGetCoeff(o->L[j].p)!=NULL) pSetCoeff0(l[j].p,nCopy(pGetCoeff(o->L[j].p)));
79      pNext(l[j].p)=n->tail;
80    }
81    // copy .lcm ----------------------------------------------
82    if (o->L[j].lcm!=NULL)
83      l[j].lcm=pLmInit(o->L[j].lcm);
84    else
85      l[j].lcm=NULL;
86    l[j].p1=NULL;
87    l[j].p2=NULL;
88    l[j].t_p = NULL;
89
90    // copy .p1 , i_r1----------------------------------------------
91    p = o->L[j].p1;
92    i = -1;
93    loop
94    {
95      if(p==NULL) break;
96      i++;
97      if(i>o->tl)
98      {
99        WarnS("poly p1 not found in T:");wrp(p);PrintLn();
100        l[j].p1=pCopy(p);
101        l[j].i_r1=-1;
102        break;
103      }
104      if (p == o->T[i].p)
105      {
106        l[j].p1=n->T[i].p;
107        l[j].i_r1=n->T[i].i_r;
108        break;
109      }
110    }
111
112    // copy .p2 , i_r2----------------------------------------------
113    p = o->L[j].p2;
114    i = -1;
115    loop
116    {
117      if(p==NULL) break;
118      i++;
119      if(i>o->tl)
120      {
121        WarnS("poly p2 not found in T:");wrp(p);PrintLn();
122        l[j].p2=pCopy(p);
123        l[j].i_r2=-1;
124        break;
125      }
126      if (p == o->T[i].p)
127      {
128        l[j].p2=n->T[i].p;
129        l[j].i_r2=n->T[i].i_r;
130        break;
131      }
132    }
133
134    // copy .ecart ---------------------------------------------
135    l[j].ecart=o->L[j].ecart;
136    // copy .length --------------------------------------------
137    l[j].length=o->L[j].length;
138    // copy .pLength -------------------------------------------
139    l[j].pLength=o->L[j].pLength;
140    // copy .sev -----------------------------------------------
141    l[j].sev=o->L[j].sev;
142    l[j].i_r = o->L[j].i_r;
143    //l[j].i_r1 = o->L[j].i_r1;
144    //l[j].i_r2 = o->L[j].i_r2;
145  }
146  n->L=l;
147}
148
149kStrategy kStratCopy(kStrategy o)
150{
151  // int i;
152  kTest_TS(o);
153  kStrategy s=new skStrategy;
154  s->next=NULL;
155  s->red=o->red;
156  s->initEcart=o->initEcart;
157  s->posInT=o->posInT;
158  s->posInL=o->posInL;
159  s->enterS=o->enterS;
160  s->initEcartPair=o->initEcartPair;
161  s->posInLOld=o->posInLOld;
162  s->enterOnePair=o->enterOnePair;
163  s->chainCrit=o->chainCrit;
164  s->Shdl=idCopy(o->Shdl);
165  s->S=s->Shdl->m;
166  s->tailRing = o->tailRing;
167  if (o->D!=NULL) s->D=idCopy(o->D);
168  else            s->D=NULL;
169  s->ecartS=(int *)omAlloc(IDELEMS(o->Shdl)*sizeof(int));
170  memcpy(s->ecartS,o->ecartS,IDELEMS(o->Shdl)*sizeof(int));
171  s->sevS=(unsigned long *)omAlloc(IDELEMS(o->Shdl)*sizeof(unsigned long));
172  memcpy(s->sevS,o->sevS,IDELEMS(o->Shdl)*sizeof(unsigned long));
173  s->S_2_R=(int*)omAlloc(IDELEMS(o->Shdl)*sizeof(int));
174  memcpy(s->S_2_R,o->S_2_R,IDELEMS(o->Shdl)*sizeof(int));
175  s->sevT=(unsigned long *)omAlloc(o->tmax*sizeof(unsigned long));
176  memcpy(s->sevT,o->sevT,o->tmax*sizeof(unsigned long));
177  if(o->fromQ!=NULL)
178  {
179    s->fromQ=(int *)omAlloc(IDELEMS(o->Shdl)*sizeof(int));
180    memcpy(s->fromQ,o->fromQ,IDELEMS(o->Shdl)*sizeof(int));
181  }
182  else
183    s->fromQ=NULL;
184  copyT(o,s);//s->T=...
185  s->tail = pInit();
186  copyL(o,s);//s->L=...
187  s->B=initL();
188  s->kNoether=pCopy(o->kNoether);
189  if (o->NotUsedAxis!=NULL)
190  {
191    s->NotUsedAxis=(BOOLEAN *)omAlloc(currRing->N*sizeof(BOOLEAN));
192    memcpy(s->NotUsedAxis,o->NotUsedAxis,currRing->N*sizeof(BOOLEAN));
193  }
194  //s->P=s->L[s->Ll+1];
195  s->P.Init(o->tailRing);
196  s->update=o->update;
197  s->posInLOldFlag=o->posInLOldFlag;
198  s->kModW = o->kModW;
199//   if (o->kModW!=NULL)
200//     s->kModW=ivCopy(o->kModW);
201//   else
202//     s->kModW=NULL;
203  s->pairtest=NULL;
204  s->sl=o->sl;
205  s->mu=o->mu;
206  s->tl=o->tl;
207  s->tmax=o->tmax;
208  s->Ll=o->Ll;
209  s->Lmax=o->Lmax;
210  s->Bl=-1;
211  s->Bmax=setmaxL;
212  s->ak=o->ak;
213  s->syzComp=o->syzComp;
214  s->LazyPass=o->LazyPass;
215  s->LazyDegree=o->LazyDegree;
216  s->lastAxis=o->lastAxis;
217  s->interpt=o->interpt;
218  s->homog=o->homog;
219  s->news=o->news;
220  s->newt=o->newt;
221  s->kAllAxis=o->kAllAxis;
222  s->honey=o->honey;
223  s->sugarCrit=o->sugarCrit;
224  s->Gebauer=o->Gebauer;
225  s->noTailReduction=o->noTailReduction;
226  s->fromT=o->fromT;
227  s->noetherSet=o->noetherSet;
228#ifdef HAVE_PLURAL
229  s->no_prod_crit=o->no_prod_crit;
230#endif
231  kTest_TS(s);
232  return s;
233}
234
235BOOLEAN k_factorize(poly p,ideal &rfac, ideal &fac_copy)
236{
237  int facdeg=currRing->pFDeg(p,currRing);
238  ideal fac=singclap_factorize(pCopy(p),NULL,1,currRing);
239  int fac_elems;
240  fac_elems=IDELEMS(fac);
241  rfac=fac;
242  fac_copy=idInit(fac_elems,1);
243
244  if ((fac_elems!=1)||(facdeg!=currRing->pFDeg(fac->m[0],currRing)))
245  {
246    if (TEST_OPT_DEBUG)
247    {
248      Print("%d factors:\n",fac_elems);
249      pWrite(p); PrintS(" ->\n");
250      int ii=fac_elems;
251      while(ii>0) { ii--;pWrite(fac->m[ii]); }
252    }
253    else if (TEST_OPT_PROT)
254    {
255      int ii=fac_elems;
256      if (ii>1)
257      {
258        while(ii>0) { PrintS("F"); ii--; }
259      }
260    }
261    return TRUE;
262  }
263  else
264  {
265    pDelete(&(fac->m[0]));
266    fac->m[0]=pCopy(p);
267  }
268  return FALSE;
269}
270
271static void completeReduceFac (kStrategy strat, ideal_list FL)
272{
273  int si;
274
275  strat->noTailReduction = FALSE;
276  if (TEST_OPT_PROT)
277  {
278    PrintLn();
279//    if (timerv) writeTime("standard base computed:");
280  }
281  if (TEST_OPT_PROT)
282  {
283    Print("(S:%d)",strat->sl);mflush();
284  }
285  for (si=strat->sl; si>0; si--)
286  {
287    strat->S[si] = redtailBba(strat->S[si],si-1,strat);
288    if (TEST_OPT_INTSTRATEGY)
289    {
290      strat->S[si]=p_Cleardenom(strat->S[si], currRing);
291    }
292    if (TEST_OPT_PROT)
293    {
294      PrintS("-");mflush();
295    }
296    int i;
297    if (strat->redTailChange)
298    {
299      for(i=strat->tl;i>=0;i--)
300      {
301        strat->initEcart(&strat->T[i]);
302      }
303    }
304    ideal fac;
305    ideal fac_copy;
306
307    if (!k_factorize(strat->S[si],fac,fac_copy))
308    {
309      idDelete(&fac);
310      idDelete(&fac_copy);
311      continue;
312    }
313
314    deleteInS(si,strat);
315
316    for(i=IDELEMS(fac)-1;i>=0;i--)
317    {
318      kStrategy n=strat;
319      if (i>=1)
320      {
321        n=kStratCopy(strat); // includes: memset(&n->P,0,sizeof(n->P));
322        n->next=strat->next;
323        strat->next=n;
324      }
325      else
326      {
327        n->P.Init(strat->tailRing);
328      }
329
330      n->P.p=fac->m[i];
331      //n->P.pLength=pLength(n->P.p); // by initEcart
332      n->initEcart(&n->P);
333      /* enter P.p into s and L */
334      int pos;
335      if (n->sl==-1) pos=0;
336      else pos=posInS(n,n->sl,n->P.p,n->P.ecart);
337      if (TEST_OPT_INTSTRATEGY)
338      {
339        n->P.p = redtailBba(n->P.p,pos-1,n);
340        n->P.pCleardenom();
341      }
342      else
343      {
344        pNorm(n->P.p);
345        n->P.p = redtailBba(n->P.p,pos-1,n);
346      }
347      n->P.pLength=pLength(n->P.p);
348      if (TEST_OPT_DEBUG)
349      {
350        Print("new s(%d)->S:",n->nr);
351        pWrite(n->P.p);
352      }
353      enterpairs(n->P.p,n->sl,n->P.ecart,pos,n);
354      enterT(n->P,n);
355      n->enterS(n->P,pos,n, n->tl);
356
357      /* construct D */
358      if (IDELEMS(fac)>1)
359      {
360        if (n->D==NULL)
361        {
362          n->D=idCopy(fac_copy);
363          idSkipZeroes(n->D);
364        }
365        else
366        {
367          idTest(n->D);
368          ideal r=idAdd(n->D,fac_copy);
369          idDelete(&n->D);
370          n->D=r;
371        }
372        if (TEST_OPT_DEBUG)
373        {
374          Print("new s(%d)->D:\n",n->nr);
375          iiWriteMatrix((matrix)n->D,"D",1,currRing,0);
376          PrintLn();
377        }
378      }
379
380      fac_copy->m[i]=pCopy(fac->m[i]);
381      fac->m[i]=NULL;
382
383      /* check for empty sets */
384      if (n->D!=NULL)
385      {
386        int j=IDELEMS(n->D)-1;
387        while(j>=0)
388        {
389          if (n->D->m[j]!=NULL)
390          {
391            poly r=kNF(n->Shdl,NULL,n->D->m[j],0,KSTD_NF_LAZY | KSTD_NF_NONORM);
392            if (r==NULL)
393            {
394              if (TEST_OPT_DEBUG)
395              {
396                Print("empty set s(%d) because D[%d]:",n->nr,j);
397                pWrite(n->D->m[j]);
398                messageSets(n);
399              }
400              while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
401              while (n->tl >= 0)
402              {
403                int i=n->sl;
404                while (i>=0)
405                {
406                  if (n->S[i]==n->T[n->tl].p)
407                  {
408                    n->T[n->tl].p=NULL; n->S[i]=NULL;
409                    break;
410                  }
411                  i--;
412                }
413                pDelete(&n->T[n->tl].p);
414                n->tl--;
415              }
416              memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
417              n->sl=-1;
418              if (strat==n) si=-1;
419              break;
420            }
421            else
422            {
423              pDelete(&r);
424            }
425          }
426          j--;
427        }
428      }
429      /* check for empty sets */
430      {
431        ideal_list Lj=FL;
432        while (Lj!=NULL)
433        {
434          if ((n->sl>=0)&&(n->S[0]!=NULL))
435          {
436            ideal r=kNF(n->Shdl,NULL,Lj->d,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
437            if (idIs0(r))
438            {
439              if (TEST_OPT_DEBUG)
440              {
441                Print("empty set because:L[%p]\n",(void *)Lj);
442                iiWriteMatrix((matrix)Lj->d,"L",1,currRing,0);
443              }
444              while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
445              while (n->tl >= 0)
446              {
447                int i=n->sl;
448                while (i>=0)
449                {
450                  if (n->S[i]==n->T[n->tl].p)
451                  {
452                    n->T[n->tl].p=NULL; n->S[i]=NULL;
453                    break;
454                  }
455                  i--;
456                }
457                pDelete(&n->T[n->tl].p);
458                n->tl--;
459              }
460              memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
461              n->sl=-1;
462              if (strat==n) si=-1;
463              idDelete(&r);
464              break;
465            }
466            idDelete(&r);
467          }
468          Lj=Lj->next;
469        }
470      }
471    } /* for */
472    for(i=0;i<IDELEMS(fac);i++) fac->m[i]=NULL;
473    idDelete(&fac);
474    idDelete(&fac_copy);
475    if ((strat->Ll>=0) && (strat->sl>=0)) break;
476    else si=strat->sl+1;
477  }
478}
479
480ideal bbafac (ideal /*F*/, ideal Q,intvec */*w*/,kStrategy strat, ideal_list FL)
481{
482  int   olddeg,reduc=0;
483  int red_result = 1;
484  reduc = olddeg = 0;
485  /* compute------------------------------------------------------- */
486  if ((strat->Ll==-1) && (strat->sl>=0))
487  {
488    if (TEST_OPT_REDSB) completeReduceFac(strat,FL);
489  }
490  kTest_TS(strat);
491  while (strat->Ll >= 0)
492  {
493    if (TEST_OPT_DEBUG) messageSets(strat);
494    if (strat->Ll== 0) strat->interpt=TRUE;
495    if (TEST_OPT_DEGBOUND
496    && ((strat->honey
497        && (strat->L[strat->Ll].ecart+currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
498      || ((!strat->honey) && (currRing->pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
499    {
500      /*
501      *stops computation if
502      * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
503      *a predefined number Kstd1_deg
504      */
505      while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
506      break;
507    }
508    /* picks the last element from the lazyset L */
509    strat->P = strat->L[strat->Ll];
510    strat->Ll--;
511    if (pNext(strat->P.p) == strat->tail)
512    {
513      /* deletes the short spoly and computes */
514      pLmFree(strat->P.p);
515      /* the real one */
516      strat->P.p = ksOldCreateSpoly(strat->P.p1,
517                                    strat->P.p2,
518                                    strat->kNoether);
519    }
520    if (strat->honey)
521    {
522      if (TEST_OPT_PROT)
523        message(strat->P.ecart+currRing->pFDeg(strat->P.p,currRing),&olddeg,&reduc,strat, red_result);
524    }
525    else
526    {
527      if (TEST_OPT_PROT)
528        message(currRing->pFDeg(strat->P.p,currRing),&olddeg,&reduc,strat, red_result);
529    }
530    /* reduction of the element chosen from L */
531    kTest_TS(strat);
532    red_result = strat->red(&strat->P,strat);
533    if (strat->P.p != NULL)
534    {
535      /* statistic */
536      if (TEST_OPT_PROT) PrintS("s");
537      ideal fac;
538      ideal fac_copy;
539
540      if (!k_factorize(strat->P.p,fac,fac_copy))
541      {
542        if (TEST_OPT_INTSTRATEGY)
543        {
544          strat->P.p = redtailBba(strat->P.p,strat->sl,strat);
545          if (strat->redTailChange) strat->P.pCleardenom();
546        }
547        else
548        {
549          pNorm(strat->P.p);
550          strat->P.p = redtailBba(strat->P.p,strat->sl,strat);
551        }
552        if (strat->redTailChange)
553        {
554          idDelete(&fac);
555          idDelete(&fac_copy);
556          if (!k_factorize(strat->P.p,fac,fac_copy))
557          {
558            pDelete(&(fac->m[0]));
559            fac->m[0]=strat->P.p;
560            strat->P.p=NULL;
561          }
562          else
563          {
564            pDelete(&strat->P.p);
565          }
566        }
567      }
568      kDeleteLcm(&strat->P);
569      int i;
570
571      for(i=IDELEMS(fac)-1;i>=0;i--)
572      {
573        int ii;
574        kStrategy n=strat;
575        if (i>=1)
576        {
577          n=kStratCopy(strat); // includes memset(&n->P,0,sizeof(n->P));
578          kTest_TS(n);
579          n->next=strat->next;
580          strat->next=n;
581        }
582        else
583        {
584          n->P.Init(strat->tailRing);
585        }
586
587        n->P.p=fac->m[i];
588        //n->P.pLength=pLength(n->P.p); // by initEcart
589        n->initEcart(&n->P);
590        kTest_TS(n);
591
592        /* enter P.p into s and L */
593        int pos;
594        if (n->sl==-1) pos=0;
595        else pos=posInS(n,n->sl,n->P.p,n->P.ecart);
596
597        // we have already reduced all elements from fac....
598        if (TEST_OPT_INTSTRATEGY)
599        {
600          n->P.p = redtailBba(n->P.p,pos-1,n);
601          if (n->redTailChange)
602          {
603            n->P.pCleardenom();
604            n->P.pLength=pLength(n->P.p);
605          }
606        }
607        else
608        {
609          pNorm(n->P.p);
610          n->P.p = redtailBba(n->P.p,pos-1,n);
611          if (n->redTailChange)
612          {
613            n->P.pLength=pLength(n->P.p);
614          }
615        }
616        kTest_TS(n);
617
618        if (TEST_OPT_DEBUG)
619        {
620          PrintS("new s:");
621          wrp(n->P.p);
622          PrintLn();
623        }
624        enterpairs(n->P.p,n->sl,n->P.ecart,pos,n);
625        enterT(n->P,n);
626        n->enterS(n->P,pos,n, n->tl);
627        {
628          int i=n->Ll;
629          for(;i>=0;i--)
630          {
631            n->L[i].i_r1= -1;
632            for(ii=0; ii<=n->tl; ii++)
633            {
634              if (n->R[ii]->p==n->L[i].p1)  { n->L[i].i_r1=ii;break; }
635            }
636            n->L[i].i_r2= -1;
637            for(ii=0; ii<=n->tl; ii++)
638            {
639              if (n->R[ii]->p==n->L[i].p2)  { n->L[i].i_r2=ii;break; }
640            }
641          }
642        }
643        kTest_TS(n);
644        /* construct D */
645        if (IDELEMS(fac)>1)
646        {
647          if (n->D==NULL)
648          {
649            n->D=idCopy(fac_copy);
650            idSkipZeroes(n->D);
651          }
652          else
653          {
654            idTest(n->D);
655            ideal r=idAdd(n->D,fac_copy);
656            idDelete(&n->D);
657            n->D=r;
658          }
659          if (TEST_OPT_DEBUG)
660          {
661            PrintS("new D:\n");
662            iiWriteMatrix((matrix)n->D,"D",1,currRing,0);
663            PrintLn();
664          }
665        }
666
667        fac_copy->m[i]=pCopy(fac->m[i]);
668        fac->m[i]=NULL;
669
670        /* check for empty sets */
671        if (n->D!=NULL)
672        {
673          int j=IDELEMS(n->D)-1;
674          while(j>=0)
675          {
676            if (n->D->m[j]!=NULL)
677            {
678              poly r=kNF(n->Shdl,NULL,n->D->m[j],0,KSTD_NF_LAZY | KSTD_NF_NONORM);
679              if (r==NULL)
680              {
681                if (TEST_OPT_DEBUG)
682                {
683                  Print("empty set s(%d) because: D[%d]:", n->nr,j);
684                  pWrite(n->D->m[j]);
685                  messageSets(n);
686                }
687                //if (n->Ll >=0) Print("Ll:%d|",n->Ll);
688                while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
689                //if (n->tl >=0) Print("tl:%d|",n->tl);
690                while (n->tl >= 0)
691                {
692                  int i=n->sl;
693                  while (i>=0)
694                  {
695                    if (n->S[i]==n->T[n->tl].p)
696                    {
697                      n->T[n->tl].p=NULL; n->S[i]=NULL;
698                      break;
699                    }
700                    i--;
701                  }
702                  pDelete(&n->T[n->tl].p);
703                  n->tl--;
704                }
705                memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
706                n->sl=-1;
707                break;
708              }
709              else
710              {
711                pDelete(&r);
712              }
713            }
714            j--;
715          }
716        }
717
718        /* check for empty sets */
719        {
720          ideal_list Lj=FL;
721          while (Lj!=NULL)
722          {
723            if ((n->sl>=0)&&(n->S[0]!=NULL))
724            {
725              ideal r=kNF(n->Shdl,NULL,Lj->d,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
726              if (idIs0(r))
727              {
728                if (TEST_OPT_DEBUG)
729                {
730                  #ifdef KDEBUG
731                  Print("empty set s(%d) because:L[%d]\n",n->nr,Lj->nr);
732                  #else
733                  Print("empty set s(%d) because:\n",n->nr);
734                  #endif
735                  iiWriteMatrix((matrix)Lj->d,"L",1,currRing,0);
736                }
737                while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
738                while (n->tl >= 0)
739                {
740                  int i=n->sl;
741                  while (i>=0)
742                  {
743                    if (n->S[i]==n->T[n->tl].p)
744                    {
745                      n->T[n->tl].p=NULL; n->S[i]=NULL;
746                      break;
747                    }
748                    i--;
749                  }
750                  pDelete(&n->T[n->tl].p);
751                  n->tl--;
752                }
753                memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
754                n->sl=-1;
755                idDelete(&r);
756                break;
757              }
758              idDelete(&r);
759            }
760            Lj=Lj->next;
761          }
762        }
763      } /* for */
764      for(i=0;i<IDELEMS(fac);i++) fac->m[i]=NULL;
765      idDelete(&fac);
766      idDelete(&fac_copy);
767    }
768#ifdef KDEBUG
769    strat->P.lcm=NULL;
770#endif
771    kTest_TS(strat);
772    if ((strat->Ll==-1) && (strat->sl>=0))
773    {
774      if (TEST_OPT_REDSB) completeReduceFac(strat,FL);
775    }
776    kTest_TS(strat);
777  }
778#ifdef KDEBUG
779  if (TEST_OPT_DEBUG) messageSets(strat);
780#endif
781  /* complete reduction of the standard basis--------- */
782  /* release temp data-------------------------------- */
783  if (TEST_OPT_WEIGHTM)
784  {
785    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
786    if (ecartWeights)
787    {
788      omFreeSize((ADDRESS)ecartWeights,((currRing->N)+1)*sizeof(short));
789      ecartWeights=NULL;
790    }
791  }
792  exitBuchMora(strat);
793  if (TEST_OPT_PROT) { PrintLn(); messageStat(0,strat); }
794  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
795  return (strat->Shdl);
796}
797
798ideal_list kStdfac(ideal F, ideal Q, tHomog h,intvec ** w,ideal D)
799{
800  ideal r;
801  BOOLEAN b=currRing->pLexOrder,toReset=FALSE;
802  BOOLEAN delete_w=(w==NULL);
803  kStrategy strat=new skStrategy;
804  kStrategy orgstrat=strat;
805  ideal_list L=NULL;
806
807  if (rField_has_simple_inverse(currRing))
808    strat->LazyPass=20;
809  else
810    strat->LazyPass=2;
811  strat->LazyDegree = 1;
812  strat->ak = id_RankFreeModule(F,currRing);
813  if (h==testHomog)
814  {
815    if (strat->ak==0)
816    {
817      h = (tHomog)idHomIdeal(F,Q);
818      w=NULL;
819    }
820    else
821      h = (tHomog)idHomModule(F,Q,w);
822  }
823  if (h==isHomog)
824  {
825    if ((w!=NULL) && (*w!=NULL))
826    {
827      kModW = *w;
828      strat->kModW = *w;
829      strat->pOrigFDeg = currRing->pFDeg;
830      strat->pOrigLDeg = currRing->pLDeg;
831      pSetDegProcs(currRing,kModDeg);
832      toReset = TRUE;
833    }
834    currRing->pLexOrder = TRUE;
835    strat->LazyPass*=2;
836  }
837  strat->homog=h;
838  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
839  initBuchMoraPos(strat);
840  initBba(strat);
841  initBuchMora(F, Q,strat);
842  if (D!=NULL)
843  {
844    strat->D=idCopy(D);
845  }
846// Ende der Initalisierung
847  while (strat!=NULL)
848  {
849    if (TEST_OPT_DEBUG)
850      PrintS("====================================\n");
851    if (w!=NULL)
852      r=bbafac(F,Q,*w,strat,L);
853    else
854      r=bbafac(F,Q,NULL,strat,L);
855#ifdef KDEBUG
856    int i;
857    for (i=0; i<IDELEMS(r); i++) pTest(r->m[i]);
858#endif
859    idSkipZeroes(r);
860    // Testausgabe:
861    //if (!idIs0(r))
862    //{
863    //  PrintS("===================================================\n");
864    //  iiWriteMatrix((matrix)r,"S",1,currRing,0);
865    //  PrintS("\n===================================================\n");
866    //}
867    //else
868    //{
869    //  PrintS("=========empty============================\n");
870    //}
871    if(!idIs0(r))
872    {
873      ideal_list LL=(ideal_list)omAlloc(sizeof(*LL));
874      LL->d=r;
875#ifndef SING_NDEBUG
876      LL->nr=strat->nr;
877#endif
878      LL->next=L;
879      L=LL;
880    }
881    strat=strat->next;
882  }
883  /* check for empty sets */
884  if (L!=NULL)
885  {
886    ideal_list Lj=L->next;
887    ideal_list Lj_prev=L;
888    while (Lj!=NULL)
889    {
890      ideal_list Li=L;
891      while(Li!=Lj)
892      {
893        ideal r=kNF(Lj->d,NULL,Li->d,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
894        if (idIs0(r))
895        {
896#ifdef KDEBUG
897          if (TEST_OPT_DEBUG)
898          {
899            Print("empty set L[%p] because:L[%p]\n",(void*)Lj,(void*)Li);
900          }
901#endif
902          // delete L[j],
903          Li=L;
904          if (Lj_prev!=NULL)
905          {
906            Lj=Lj_prev;
907            if (Lj==L) Lj_prev=NULL;
908            else
909            {
910              Lj_prev=L;
911              while(Lj_prev->next!=Lj) Lj_prev=Lj_prev->next;
912            }
913          }
914          else Lj=NULL;
915        }
916        else
917        {
918          Li=Li->next;
919        }
920        idDelete (&r);
921      }
922      if (Lj!=NULL) Lj=Lj->next;
923    }
924  }
925// Ende: aufraeumen
926  if (toReset)
927  {
928    pRestoreDegProcs(currRing,strat->pOrigFDeg, strat->pOrigLDeg);
929    kModW = NULL;
930  }
931  currRing->pLexOrder = b;
932  delete(strat);
933  strat=orgstrat;
934  while (strat!=NULL)
935  {
936    orgstrat=strat->next;
937    delete(strat);
938    strat=orgstrat;
939  }
940  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
941  return L;
942}
Note: See TracBrowser for help on using the repository browser.