source: git/Singular/kstdfac.cc @ 24d587

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