source: git/Singular/kstdfac.cc @ 2c694a2

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