source: git/kernel/kstdfac.cc @ ca371d

spielwiese
Last change on this file since ca371d was c0e2c36, checked in by Hans Schönemann <hannes@…>, 15 years ago
*hannes: pCleardenom changes git-svn-id: file:///usr/local/Singular/svn/trunk@11482 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 25.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kstdfac.cc,v 1.18 2009-02-26 15:55:23 Singular Exp $ */
5/*
6*  ABSTRACT -  Kernel: factorizing alg. of Buchberger
7*/
8
9#include "mod2.h"
10#include "structs.h"
11#include "omalloc.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 "ideals.h"
26#include "timer.h"
27#include "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_PLURAL
244  s->no_prod_crit=o->no_prod_crit,
245#endif
246  kTest_TS(s);
247  return s;
248}
249
250BOOLEAN k_factorize(poly p,ideal &rfac, ideal &fac_copy)
251{
252  int facdeg=pFDeg(p,currRing);
253  ideal fac=singclap_factorize(pCopy(p),NULL,1);
254  int fac_elems;
255#ifndef HAVE_LIBFAC_P
256  if (fac==NULL)
257  {
258    fac=idInit(1,1);
259    fac->m[0]=pCopy(p);
260    fac_elems=1;
261  }
262  else
263#endif
264    fac_elems=IDELEMS(fac);
265  rfac=fac;
266  fac_copy=idInit(fac_elems,1);
267
268  if ((fac_elems!=1)||(facdeg!=pFDeg(fac->m[0],currRing)))
269  {
270    if (TEST_OPT_DEBUG)
271    {
272      Print("-> %d factors\n",fac_elems);
273      if (fac_elems!=1)
274      {
275        pWrite(p); PrintS(" ->\n");
276        int ii=fac_elems;
277        while(ii>0) { ii--;pWrite(fac->m[ii]); }
278      }
279    }
280    else if (TEST_OPT_PROT)
281    {
282      int ii=fac_elems;
283      if (ii>1)
284      {
285        while(ii>0) { PrintS("F"); ii--; }
286      }
287    }
288#ifndef NDEBUG
289    else if (strat_fac_debug)
290    {
291      pWrite(p);
292      Print("-> %d factors\n",fac_elems);
293      if (fac_elems!=1)
294      {
295        int ii=fac_elems;
296        while(ii>0) { ii--;pWrite(fac->m[ii]); }
297      }
298    }
299#endif
300    return TRUE;
301  }
302  else
303  {
304    pDelete(&(fac->m[0]));
305    fac->m[0]=pCopy(p);
306  }
307  return FALSE;
308}
309
310static void completeReduceFac (kStrategy strat, ideal_list FL)
311{
312  int si;
313
314  strat->noTailReduction = FALSE;
315  if (TEST_OPT_PROT)
316  {
317    PrintLn();
318    if (timerv) writeTime("standard base computed:");
319  }
320  if (TEST_OPT_PROT)
321  {
322    Print("(S:%d)",strat->sl);mflush();
323  }
324  for (si=strat->sl; si>0; si--)
325  {
326    //if (strat->interpt) test_int_std(strat->kIdeal);
327    strat->S[si] = redtailBba(strat->S[si],si-1,strat);
328    if (TEST_OPT_INTSTRATEGY)
329    {
330      strat->S[si]=pCleardenom(strat->S[si]);
331    }
332    if (TEST_OPT_PROT)
333    {
334      PrintS("-");mflush();
335    }
336    ideal fac;
337    ideal fac_copy;
338
339    if (!k_factorize(strat->S[si],fac,fac_copy))
340    {
341      idDelete(&fac);
342      idDelete(&fac_copy);
343      continue;
344    }
345
346    deleteInS(si,strat);
347
348    int i;
349    for(i=IDELEMS(fac)-1;i>=0;i--)
350    {
351      kStrategy n=strat;
352      if (i>=1)
353      {
354        n=kStratCopy(strat); // includes: memset(&n->P,0,sizeof(n->P));
355        n->next=strat->next;
356        strat->next=n;
357      }
358      else
359      {
360        n->P.Init(strat->tailRing);
361      }
362
363      n->P.p=fac->m[i];
364      n->P.pLength=0;
365      n->initEcart(&n->P);
366      /* enter P.p into s and L */
367      int pos;
368      if (n->sl==-1) pos=0;
369      else pos=posInS(n,n->sl,n->P.p,n->P.ecart);
370      if (TEST_OPT_INTSTRATEGY)
371      {
372        n->P.p = redtailBba(n->P.p,pos-1,n);
373        n->P.pCleardenom();
374      }
375      else
376      {
377        pNorm(n->P.p);
378        n->P.p = redtailBba(n->P.p,pos-1,n);
379      }
380      n->P.pLength=0;
381      if (TEST_OPT_DEBUG)
382      {
383        PrintS("new s:");
384        wrp(n->P.p);
385        PrintLn();
386      }
387      enterpairs(n->P.p,n->sl,n->P.ecart,pos,n);
388      enterT(n->P,n);
389      n->enterS(n->P,pos,n, n->tl);
390
391      /* construct D */
392      if (IDELEMS(fac)>1)
393      {
394        if (n->D==NULL)
395        {
396          n->D=idCopy(fac_copy);
397          idSkipZeroes(n->D);
398        }
399        else
400        {
401          idTest(n->D);
402          ideal r=idAdd(n->D,fac_copy);
403          idDelete(&n->D);
404          n->D=r;
405        }
406        if (TEST_OPT_DEBUG)
407        {
408          PrintS("new D:\n");
409          iiWriteMatrix((matrix)n->D,"D",1,0);
410          PrintLn();
411        }
412      }
413#ifndef NDEBUG
414      if(strat_fac_debug)
415      {
416        int ii;
417        Print("---------------------------------------------------------------\ns(%d), set S\n",n->nr);
418        for(ii=0;ii<n->sl;ii++)
419        { Print("s(%d->S[%d]= ",n->nr,ii);pWrite(n->S[ii]);}
420        Print("s(%d), set D\n",n->nr);
421        if (n->D!=NULL)
422        {
423          for(ii=0;ii<IDELEMS(n->D);ii++)
424          { Print("s(%d->D[%d]= ",n->nr,ii);pWrite(n->D->m[ii]);}
425        }
426        else PrintS(" empty\n");
427      }
428#endif
429
430      fac_copy->m[i]=pCopy(fac->m[i]);
431      fac->m[i]=NULL;
432
433      /* check for empty sets */
434      if (n->D!=NULL)
435      {
436        int j=IDELEMS(n->D)-1;
437        while(j>=0)
438        {
439          if (n->D->m[j]!=NULL)
440          {
441            poly r=kNF(n->Shdl,NULL,n->D->m[j],0,KSTD_NF_LAZY | KSTD_NF_NONORM);
442            if (r==NULL)
443            {
444#ifndef NDEBUG
445              if(strat_fac_debug)
446              {
447                Print("empty set s(%d) because: D[%d] -> 0\n",
448                       n->nr, j);
449                Print("s(%d)->D[%d]= ",n->nr,j);pWrite(n->D->m[j]);
450              }
451#endif
452              if (TEST_OPT_DEBUG)
453              {
454                PrintS("empty set because:");
455                wrp(n->D->m[j]);
456                PrintLn();
457                messageSets(n);
458              }
459              while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
460              while (n->tl >= 0)
461              {
462                int i=n->sl;
463                while (i>=0)
464                {
465                  if (n->S[i]==n->T[n->tl].p)
466                  {
467                    n->T[n->tl].p=NULL; n->S[i]=NULL;
468                    break;
469                  }
470                  i--;
471                }
472                pDelete(&n->T[n->tl].p);
473                n->tl--;
474              }
475              memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
476              n->sl=-1;
477              if (strat==n) si=-1;
478              break;
479            }
480            else
481            {
482              pDelete(&r);
483            }
484          }
485          j--;
486        }
487      }
488      /* check for empty sets */
489      {
490        ideal_list Lj=FL;
491        while (Lj!=NULL)
492        {
493          if ((n->sl>=0)&&(n->S[0]!=NULL))
494          {
495            ideal r=kNF(n->Shdl,NULL,Lj->d,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
496#ifndef NDEBUG
497              if(strat_fac_debug)
498              {
499                Print("empty set s(%d) because:L[%d]\n",n->nr,Lj->nr);
500                PrintS("L:\n");
501                iiWriteMatrix((matrix)Lj->d,"L",1,0);
502              }
503#endif
504            if (idIs0(r))
505            {
506              if (TEST_OPT_DEBUG)
507              {
508                Print("empty set because:L[%x]\n",Lj);
509              }
510              while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
511              while (n->tl >= 0)
512              {
513                int i=n->sl;
514                while (i>=0)
515                {
516                  if (n->S[i]==n->T[n->tl].p)
517                  {
518                    n->T[n->tl].p=NULL; n->S[i]=NULL;
519                    break;
520                  }
521                  i--;
522                }
523                pDelete(&n->T[n->tl].p);
524                n->tl--;
525              }
526              memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
527              n->sl=-1;
528              if (strat==n) si=-1;
529              idDelete(&r);
530              break;
531            }
532            idDelete(&r);
533          }
534          Lj=Lj->next;
535        }
536      }
537    } /* for */
538    for(i=0;i<IDELEMS(fac);i++) fac->m[i]=NULL;
539    idDelete(&fac);
540    idDelete(&fac_copy);
541    if ((strat->Ll>=0) && (strat->sl>=0)) break;
542    else si=strat->sl+1;
543  }
544}
545
546ideal bbafac (ideal F, ideal Q,intvec *w,kStrategy strat, ideal_list FL)
547{
548  int   srmax,lrmax;
549  int   olddeg,reduc=0;
550  int red_result = 1;
551  srmax = strat->sl;
552  reduc = olddeg = lrmax = 0;
553  /* compute------------------------------------------------------- */
554  if ((strat->Ll==-1) && (strat->sl>=0))
555  {
556    if (TEST_OPT_REDSB) completeReduceFac(strat,FL);
557  }
558  kTest_TS(strat);
559  while (strat->Ll >= 0)
560  {
561    if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
562    if (TEST_OPT_DEBUG) messageSets(strat);
563    //test_int_std(strat->kIdeal);
564    if (strat->Ll== 0) strat->interpt=TRUE;
565    if (TEST_OPT_DEGBOUND
566    && ((strat->honey
567        && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
568      || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
569    {
570      /*
571      *stops computation if
572      * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
573      *a predefined number Kstd1_deg
574      */
575      while (strat->Ll >= 0) deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
576      break;
577    }
578    /* picks the last element from the lazyset L */
579    strat->P = strat->L[strat->Ll];
580    strat->Ll--;
581    if (pNext(strat->P.p) == strat->tail)
582    {
583      /* deletes the short spoly and computes */
584      pLmFree(strat->P.p);
585      /* the real one */
586      strat->P.p = ksOldCreateSpoly(strat->P.p1,
587                                    strat->P.p2,
588                                    strat->kNoether);
589    }
590    if (strat->honey)
591    {
592      if (TEST_OPT_PROT)
593        message(strat->P.ecart+pFDeg(strat->P.p,currRing),&olddeg,&reduc,strat, red_result);
594    }
595    else
596    {
597      if (TEST_OPT_PROT)
598        message(pFDeg(strat->P.p,currRing),&olddeg,&reduc,strat, red_result);
599    }
600    /* reduction of the element choosen from L */
601    kTest_TS(strat);
602    red_result = strat->red(&strat->P,strat);
603    if (strat->P.p != NULL)
604    {
605      /* statistic */
606      if (TEST_OPT_PROT) PrintS("s");
607      ideal fac;
608      ideal fac_copy;
609
610      if (!k_factorize(strat->P.p,fac,fac_copy))
611      {
612        if (TEST_OPT_INTSTRATEGY)
613        {
614          strat->P.p = redtailBba(strat->P.p,strat->sl,strat);
615          if (strat->redTailChange) strat->P.pCleardenom();
616        }
617        else
618        {
619          pNorm(strat->P.p);
620          strat->P.p = redtailBba(strat->P.p,strat->sl,strat);
621        }
622        if (strat->redTailChange)
623        {
624          idDelete(&fac);
625          idDelete(&fac_copy);
626          if (!k_factorize(strat->P.p,fac,fac_copy))
627          {
628            pDelete(&(fac->m[0]));
629            fac->m[0]=strat->P.p;
630            strat->P.p=NULL;
631          }
632          else
633          {
634            pDelete(&strat->P.p);
635          }
636        }
637      }
638      if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
639      int i;
640
641      for(i=IDELEMS(fac)-1;i>=0;i--)
642      {
643        int ii;
644        kStrategy n=strat;
645        if (i>=1)
646        {
647          n=kStratCopy(strat); // includes memset(&n->P,0,sizeof(n->P));
648          kTest_TS(n);
649          n->next=strat->next;
650          strat->next=n;
651        }
652        else
653        {
654          n->P.Init(strat->tailRing);
655        }
656
657        n->P.p=fac->m[i];
658        n->initEcart(&n->P);
659        kTest_TS(n);
660
661        /* enter P.p into s and L */
662        int pos;
663        if (n->sl==-1) pos=0;
664        else pos=posInS(n,n->sl,n->P.p,n->P.ecart);
665
666        // we have already reduced all elements from fac....
667        if (TEST_OPT_INTSTRATEGY)
668        {
669          n->P.p = redtailBba(n->P.p,pos-1,n);
670          if (n->redTailChange)
671          {
672            n->P.pCleardenom();
673            n->P.pLength=0;
674          }
675        }
676        else
677        {
678          pNorm(n->P.p);
679          n->P.p = redtailBba(n->P.p,pos-1,n);
680          if (n->redTailChange)
681          {
682            n->P.pLength=0;
683          }
684        }
685        kTest_TS(n);
686
687        if (TEST_OPT_DEBUG)
688        {
689          PrintS("new s:");
690          wrp(n->P.p);
691          PrintLn();
692        }
693        enterpairs(n->P.p,n->sl,n->P.ecart,pos,n);
694        enterT(n->P,n);
695        n->enterS(n->P,pos,n, n->tl);
696        {
697          int i=n->Ll;
698          for(;i>=0;i--)
699          {
700            n->L[i].i_r1= -1;
701            for(ii=0; ii<=n->tl; ii++)
702            {
703              if (n->R[ii]->p==n->L[i].p1)  { n->L[i].i_r1=ii;break; }
704            }
705            n->L[i].i_r2= -1;
706            for(ii=0; ii<=n->tl; ii++)
707            {
708              if (n->R[ii]->p==n->L[i].p2)  { n->L[i].i_r2=ii;break; }
709            }
710          }
711        }
712        kTest_TS(n);
713        if (n->sl>srmax) srmax = n->sl;
714
715        /* construct D */
716        if (IDELEMS(fac)>1)
717        {
718          if (n->D==NULL)
719          {
720            n->D=idCopy(fac_copy);
721            idSkipZeroes(n->D);
722          }
723          else
724          {
725            idTest(n->D);
726            ideal r=idAdd(n->D,fac_copy);
727            idDelete(&n->D);
728            n->D=r;
729          }
730          if (TEST_OPT_DEBUG)
731          {
732            PrintS("new D:\n");
733            iiWriteMatrix((matrix)n->D,"D",1,0);
734            PrintLn();
735          }
736        }
737#ifndef NDEBUG
738        if(strat_fac_debug)
739        {
740          int ii;
741          Print("-------------------------------------------------------------\ns(%d), set S\n",n->nr);
742          for(ii=0;ii<n->sl;ii++)
743          { Print("s(%d->S[%d]= ",n->nr,ii);pWrite(n->S[ii]);}
744          Print("s(%d), set D\n",n->nr);
745          if (n->D!=NULL)
746          {
747            for(ii=0;ii<IDELEMS(n->D);ii++)
748            { Print("s(%d->D[%d]= ",n->nr,ii);pWrite(n->D->m[ii]);}
749          }
750          else PrintS(" empty\n");
751        }
752#endif
753
754        fac_copy->m[i]=pCopy(fac->m[i]);
755        fac->m[i]=NULL;
756
757        /* check for empty sets */
758        if (n->D!=NULL)
759        {
760          int j=IDELEMS(n->D)-1;
761          while(j>=0)
762          {
763            if (n->D->m[j]!=NULL)
764            {
765              poly r=kNF(n->Shdl,NULL,n->D->m[j],0,KSTD_NF_LAZY | KSTD_NF_NONORM);
766              if (r==NULL)
767              {
768#ifndef NDEBUG
769                if(strat_fac_debug)
770                {
771                  Print("empty set s(%d) because: D[%d] -> 0\n",
772                       n->nr, j);
773                  Print("s(%d)->D[%d]= ",n->nr,j);pWrite(n->D->m[j]);
774                }
775#endif
776                if (TEST_OPT_DEBUG)
777                {
778                  PrintS("empty set because:");
779                  wrp(n->D->m[j]);
780                  PrintLn();
781                  messageSets(n);
782                }
783                //if (n->Ll >=0) Print("Ll:%d|",n->Ll);
784                while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
785                //if (n->tl >=0) Print("tl:%d|",n->tl);
786                while (n->tl >= 0)
787                {
788                  int i=n->sl;
789                  while (i>=0)
790                  {
791                    if (n->S[i]==n->T[n->tl].p)
792                    {
793                      n->T[n->tl].p=NULL; n->S[i]=NULL;
794                      break;
795                    }
796                    i--;
797                  }
798                  pDelete(&n->T[n->tl].p);
799                  n->tl--;
800                }
801                memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
802                n->sl=-1;
803                break;
804              }
805              else
806              {
807                pDelete(&r);
808              }
809            }
810            j--;
811          }
812        }
813
814        /* check for empty sets */
815        {
816          ideal_list Lj=FL;
817          while (Lj!=NULL)
818          {
819            if ((n->sl>=0)&&(n->S[0]!=NULL))
820            {
821              ideal r=kNF(n->Shdl,NULL,Lj->d,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
822              if (idIs0(r))
823              {
824#ifndef NDEBUG
825                if(strat_fac_debug)
826                {
827                  Print("empty set s(%d) because:L[%d]\n",n->nr,Lj->nr);
828                  PrintS("L:\n");
829                  iiWriteMatrix((matrix)Lj->d,"L",1,0);
830                }
831#endif
832                if (TEST_OPT_DEBUG)
833                {
834                  Print("empty set because:L[%x]\n",Lj);
835                }
836                while (n->Ll >= 0) deleteInL(n->L,&n->Ll,n->Ll,n);
837                while (n->tl >= 0)
838                {
839                  int i=n->sl;
840                  while (i>=0)
841                  {
842                    if (n->S[i]==n->T[n->tl].p)
843                    {
844                      n->T[n->tl].p=NULL; n->S[i]=NULL;
845                      break;
846                    }
847                    i--;
848                  }
849                  pDelete(&n->T[n->tl].p);
850                  n->tl--;
851                }
852                memset(n->Shdl->m,0,IDELEMS(n->Shdl)*sizeof(poly));
853                n->sl=-1;
854                idDelete(&r);
855                break;
856              }
857              idDelete(&r);
858            }
859            Lj=Lj->next;
860          }
861        }
862      } /* for */
863      for(i=0;i<IDELEMS(fac);i++) fac->m[i]=NULL;
864      idDelete(&fac);
865      idDelete(&fac_copy);
866    }
867#ifdef KDEBUG
868    strat->P.lcm=NULL;
869#endif
870    kTest_TS(strat);
871    if ((strat->Ll==-1) && (strat->sl>=0))
872    {
873      if (TEST_OPT_REDSB) completeReduceFac(strat,FL);
874    }
875    kTest_TS(strat);
876  }
877  if (TEST_OPT_DEBUG) messageSets(strat);
878  /* complete reduction of the standard basis--------- */
879  /* release temp data-------------------------------- */
880  exitBuchMora(strat);
881  if (TEST_OPT_WEIGHTM)
882  {
883    pRestoreDegProcs(pFDegOld, pLDegOld);
884    if (ecartWeights)
885    {
886      omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
887      ecartWeights=NULL;
888    }
889  }
890  if (TEST_OPT_PROT) { PrintLn(); messageStat(srmax,lrmax,0,strat); }
891  if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
892  return (strat->Shdl);
893}
894#endif
895
896ideal_list kStdfac(ideal F, ideal Q, tHomog h,intvec ** w,ideal D)
897{
898#ifdef HAVE_FACTORY
899  ideal r;
900  BOOLEAN b=pLexOrder,toReset=FALSE;
901  BOOLEAN delete_w=(w==NULL);
902  kStrategy strat=new skStrategy;
903  kStrategy orgstrat=strat;
904  ideal_list L=NULL;
905
906  if (rField_has_simple_inverse())
907    strat->LazyPass=20;
908  else
909    strat->LazyPass=2;
910  strat->LazyDegree = 1;
911  strat->ak = idRankFreeModule(F);
912  if ((h==testHomog))
913  {
914    if (strat->ak==0)
915    {
916      h = (tHomog)idHomIdeal(F,Q);
917      w=NULL;
918    }
919    else
920      h = (tHomog)idHomModule(F,Q,w);
921  }
922  if (h==isHomog)
923  {
924    if ((w!=NULL) && (*w!=NULL))
925    {
926      kModW = *w;
927      strat->kModW = *w;
928      pFDegOld = pFDeg;
929      pLDegOld = pLDeg;
930      pSetDegProcs(kModDeg);
931      toReset = TRUE;
932    }
933    pLexOrder = TRUE;
934    strat->LazyPass*=2;
935  }
936  strat->homog=h;
937  initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
938  initBuchMoraPos(strat);
939  initBba(F,strat);
940  initBuchMora(F, Q,strat);
941  if (D!=NULL)
942  {
943    strat->D=idCopy(D);
944  }
945// Ende der Initalisierung
946  while (strat!=NULL)
947  {
948    if (TEST_OPT_DEBUG)
949      PrintS("====================================\n");
950    if (w!=NULL)
951      r=bbafac(F,Q,*w,strat,L);
952    else
953      r=bbafac(F,Q,NULL,strat,L);
954#ifdef KDEBUG
955    int i;
956    for (i=0; i<IDELEMS(r); i++) pTest(r->m[i]);
957#endif
958    idSkipZeroes(r);
959    // Testausgabe:
960    //if (!idIs0(r))
961    //{
962    //  PrintS("===================================================\n");
963    //  iiWriteMatrix((matrix)r,"S",1,0);
964    //  PrintS("\n===================================================\n");
965    //}
966    //else
967    //{
968    //  PrintS("=========empty============================\n");
969    //}
970    if(!idIs0(r))
971    {
972      ideal_list LL=(ideal_list)omAlloc(sizeof(*LL));
973      LL->d=r;
974#ifndef NDEBUG
975      LL->nr=strat->nr;
976#endif
977      LL->next=L;
978      L=LL;
979    }
980    strat=strat->next;
981  }
982  /* check for empty sets */
983  if (L!=NULL)
984  {
985    ideal_list Lj=L->next;
986    ideal_list Lj_prev=L;
987    while (Lj!=NULL)
988    {
989      ideal_list Li=L;
990      while(Li!=Lj)
991      {
992        ideal r=kNF(Lj->d,NULL,Li->d,0,KSTD_NF_LAZY | KSTD_NF_NONORM);
993        if (idIs0(r))
994        {
995#ifndef NDEBUG
996          if(strat_fac_debug)
997          {
998            Print("empty set L(%d) because:L(%d)\n",Lj->nr,Li->nr);
999          }
1000#endif
1001          if (TEST_OPT_DEBUG)
1002          {
1003            Print("empty set L[%x] because:L[%x]\n",Lj,Li);
1004          }
1005          // delete L[j],
1006          Li=L; 
1007          if (Lj_prev!=NULL)
1008          {
1009            Lj=Lj_prev;
1010            if (Lj==L) Lj_prev=NULL;
1011            else
1012            {
1013              Lj_prev=L;
1014              while(Lj_prev->next!=Lj) Lj_prev=Lj_prev->next;
1015            }
1016          }
1017          else Lj=NULL;
1018        }
1019        else
1020        {
1021          Li=Li->next;
1022        }
1023        idDelete (&r);
1024      }
1025      if (Lj!=NULL) Lj=Lj->next;
1026    }
1027  }
1028// Ende: aufraeumen
1029  if (toReset)
1030  {
1031    pRestoreDegProcs(pFDegOld, pLDegOld);
1032    kModW = NULL;
1033  }
1034  pLexOrder = b;
1035  delete(strat);
1036  strat=orgstrat;
1037  while (strat!=NULL)
1038  {
1039    orgstrat=strat->next;
1040    delete(strat);
1041    strat=orgstrat;
1042  }
1043  if ((delete_w)&&(w!=NULL)&&(*w!=NULL)) delete *w;
1044  return L;
1045#else
1046  return NULL;
1047#endif
1048}
Note: See TracBrowser for help on using the repository browser.