source: git/kernel/kstdfac.cc @ fbc7cb

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