source: git/kernel/kstdfac.cc @ 599326

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