source: git/Singular/syz0.cc @ 18dd47

spielwiese
Last change on this file since 18dd47 was ef304d, checked in by Hans Schönemann <hannes@…>, 27 years ago
* hannes: changed output of reservedName() -> now 3 names in a row fixed error message in ring definition: mismatch of # of vars changed use of LaScala: not for (0), not for qring git-svn-id: file:///usr/local/Singular/svn/trunk@172 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 21.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: syz0.cc,v 1.9 1997-04-17 17:52:22 Singular Exp $ */
5/*
6* ABSTRACT: resolutions
7*/
8
9
10#include "mod2.h"
11#include "mmemory.h"
12#include "polys.h"
13#include "febase.h"
14#include "kstd1.h"
15#include "kutil.h"
16#include "spolys.h"
17#include "stairc.h"
18#include "ipid.h"
19#include "cntrlc.h"
20#include "ipid.h"
21#include "intvec.h"
22#include "ipshell.h"
23#include "tok.h"
24#include "numbers.h"
25#include "ideals.h"
26#include "intvec.h"
27#include "ring.h"
28#include "syz.h"
29
30static polyset syInitSort(polyset oldF,int rkF,int Fmax,
31         int syComponentOrder,intvec **modcomp)
32{
33  int i,j,k,kk,kkk,jj;
34  polyset F;
35  int Fl=Fmax;
36
37  while ((Fl!=0) && (oldF[Fl-1]==NULL)) Fl--;
38  if (*modcomp!=NULL) delete modcomp;
39  *modcomp = new intvec(rkF+2);
40  F=(polyset)Alloc0(Fmax*sizeof(poly));
41  j=0;
42  for(i=0;i<=rkF;i++)
43  {
44    k=0;
45    jj = j;
46    (**modcomp)[i] = j;
47    while (k<Fl)
48    {
49      while ((k<Fl) && (pGetComp(oldF[k]) != i)) k++;
50      if (k<Fl)
51      {
52        kk=jj;
53        while ((kk<Fl) && (F[kk]) && (pComp0(oldF[k],F[kk])!=syComponentOrder))
54        {
55            kk++;
56        }
57        for (kkk=j;kkk>kk;kkk--)
58        {
59          F[kkk] = F[kkk-1];
60        }
61        F[kk] = oldF[k];
62//Print("Element %d: ",kk);pWrite(F[kk]);
63        j++;
64        k++;
65      }
66    }
67  }
68  (**modcomp)[rkF+1] = Fl;
69  return F;
70}
71
72static void syCreatePairs(polyset F,int lini,int wend,int k,int j,int i,
73           polyset pairs,int regularPairs=0,ideal mW=NULL)
74{
75  int l,ii=0,jj;
76  poly p,q;
77
78  while (((k<wend) && (pGetComp(F[k]) == i)) ||
79         ((currQuotient!=NULL) && (k<regularPairs+IDELEMS(currQuotient))))
80  {
81    p = pOne();
82    if ((k<wend) && (pGetComp(F[k]) == i) && (k!=j))
83      pLcm(F[j],F[k],p);
84    else if (ii<IDELEMS(currQuotient))
85    {
86      q = pHead(F[j]);
87      if (mW!=NULL)
88      {
89        for(jj=1;jj<=pVariables;jj++)
90          pSetExp(q,jj,pGetExp(q,jj) -pGetExp(mW->m[pGetComp(q)-1],jj));
91        pSetm(q);
92      }
93      pLcm(q,currQuotient->m[ii],p);
94      if (mW!=NULL)
95      {
96        for(jj=1;jj<=pVariables;jj++)
97          pSetExp(p,jj,pGetExp(p,jj) +pGetExp(mW->m[pGetComp(p)-1],jj));
98        pSetm(p);
99      }
100      pDelete(&q);
101      k = regularPairs+ii;
102      ii++;
103    }
104    l=lini;
105    while ((l<k) && ((pairs[l]==NULL) || (!pDivisibleBy(pairs[l],p))))
106    {
107      if ((pairs[l]!=NULL) && (pDivisibleBy(p,pairs[l])))
108        pDelete(&(pairs[l]));
109      l++;
110    }
111    if (l==k)
112    {
113      pSetm(p);
114      pairs[l] = p;
115    }
116    else
117      pDelete(&p);
118    k++;
119  }
120}
121
122inline BOOLEAN syDivisibleBy2(poly a, poly b)
123{
124  //if (a->exp[0]==b->exp[0])
125  {
126    int i=pVariables-1;
127    short *e1=&(a->exp[1]);
128    short *e2=&(b->exp[1]);
129    if ((*e1) > (*e2)) return FALSE;
130    do
131    {
132      i--;
133      e1++;
134      e2++;
135      if ((*e1) > (*e2)) return FALSE;
136    } while (i>0);
137    return TRUE;
138  }
139  //else
140  //{
141    //Print("Fehler");
142    //return FALSE;
143  //}
144}
145
146static poly syRedtail2(poly p, polyset redWith, intvec *modcomp)
147{
148  poly h, hn;
149  int hncomp,nxt;
150  int j;
151
152  h = p;
153  hn = pNext(h);
154  while(hn != NULL)
155  {
156    hncomp = pGetComp(hn);
157    j = (*modcomp)[hncomp];
158    nxt = (*modcomp)[hncomp+1];
159    while (j < nxt)
160    {
161      if (syDivisibleBy2(redWith[j], hn))
162      {
163        //if (TEST_OPT_PROT) Print("r");
164        hn = spSpolyRed(redWith[j],hn,NULL);
165        if (hn == NULL)
166        {
167          pNext(h) = NULL;
168          return p;
169        }
170        hncomp = pGetComp(hn);
171        j = (*modcomp)[hncomp];
172        nxt = (*modcomp)[hncomp+1];
173      }
174      else
175      {
176        j++;
177      }
178    }
179    h = pNext(h) = hn;
180    hn = pNext(h);
181  }
182  return p;
183}
184
185/*2
186* computes the Schreyer syzygies in the local case
187* input: F, Fmax,  noSort: F is already ordered by: Schreyer-order
188*              (only allocated: Shdl, Smax)
189* output: Shdl, Smax
190*/
191void sySchreyersSyzygiesFM(polyset F,int Fmax,polyset* Shdl,int* Smax,
192  BOOLEAN noSort)
193{
194  int Fl=Fmax;
195  while ((Fl!=0) && (F[Fl-1]==NULL)) Fl--;
196  if (Fl==0) return;
197
198  int i,j,l,k,totalToRed,ecartToRed,kk,bestEcart,totalmax,rkF,
199    Sl=0,smax,tmax,tl;
200  int *ecartS, *ecartT, *totalS,
201    *totalT=NULL, *temp=NULL;
202  intvec * modcomp=NULL;
203  polyset pairs,S,T,ST,oldF;
204  poly p,q,toRed;
205  BOOLEAN notFound = FALSE;
206
207/*-------------initializing the sets--------------------*/
208  ideal idF=(ideal)Alloc(sizeof(ip_sideal));
209  ST=(polyset)Alloc0(Fl*sizeof(poly));
210  S=(polyset)Alloc0(Fl*sizeof(poly));
211  ecartS=(int*)Alloc(Fl*sizeof(int));
212  totalS=(int*)Alloc(Fl*sizeof(int));
213  T=(polyset)Alloc0(2*Fl*sizeof(poly));
214  ecartT=(int*)Alloc(2*Fl*sizeof(int));
215  totalT=(int*)Alloc(2*Fl*sizeof(int));
216  pairs=(polyset)Alloc0(Fl*sizeof(poly));
217
218  smax = Fl;
219  tmax = 2*Fl;
220  idF->m=F;IDELEMS(idF)=Fmax;
221  rkF=idRankFreeModule(idF);
222  Free((ADDRESS)idF,sizeof(ip_sideal));
223  spSet(currRing);
224/*-------------sorting of F for index handling------------*/
225  if (noSort)
226  {
227    oldF = F;
228    F=syInitSort(F,rkF,Fmax,1,&modcomp);
229  }
230/*----------------construction of the new ordering----------*/
231  pSetSchreyerOrdM(F,Fl,rkF);
232/*----------------creating S--------------------------------*/
233  for(j=0;j<Fl;j++)
234  {
235    S[j] = pCopy(F[j]);
236    totalS[j] = pLDeg(S[j],&k);
237    ecartS[j] = totalS[j]-pFDeg(S[j]);
238//Print("%d", pGetComp(S[j]));PrintS("  ");
239    p = S[j];
240    if (rkF==0) pSetCompP(p,1);
241    while (pNext(p)!=NULL) pIter(p);
242    pNext(p) = pHead(F[j]);
243    pIter(p);
244    if (rkF==0)
245      pSetComp(p,j+2);
246    else
247      pSetComp(p,rkF+j+1);
248  }
249//PrintLn();
250  if (rkF==0) rkF = 1;
251/*---------------creating the initial for T----------------*/
252  j=0;
253  l=-1;
254  totalmax=-1;
255  for (k=0;k<smax;k++)
256    if (totalS[k]>totalmax) totalmax=totalS[k];
257  for (kk=1;kk<=rkF;kk++)
258  {
259    for (k=0;k<=totalmax;k++)
260    {
261      for (l=0;l<smax;l++)
262      {
263        if ((pGetComp(S[l])==kk) && (totalS[l]==k))
264        {
265          ST[j] = S[l];
266          totalT[j] = totalS[l];
267          ecartT[j] = ecartS[l];
268//Print("%d", totalS[l]);PrintS("  ");
269          j++;
270        }
271      }
272    }
273  }
274//PrintLn();
275  for (j=0;j<smax;j++)
276  {
277     totalS[j] = totalT[j];
278     ecartS[j] = ecartT[j];
279  }
280
281/*---------------computing---------------------------------*/
282  for(j=0;j<smax;j++)
283  {
284    i = pGetComp(S[j]);
285    k=j+1;
286/*----------------constructing all pairs with S[j]---------*/
287    if (TEST_OPT_PROT)
288    {
289      Print("(%d)",Fl-j);
290      mflush();
291    }
292    syCreatePairs(S,j+1,Fl,k,j,i,pairs);
293/*--------------computing the syzygies----------------------*/
294    for (k=j+1;k<Fl;k++)
295    {
296      if (pairs[k]!=NULL)
297      {
298/*--------------creating T----------------------------------*/
299        for (l=0;l<smax;l++)
300        {
301          ecartT[l] = ecartS[l];
302          totalT[l] = totalS[l];
303          T[l] = ST[l];
304        }
305        tl = smax;
306/*--------------begin to reduce-----------------------------*/
307        toRed = spSpolyCreate(S[j],S[k],NULL);
308        ecartToRed = 1;
309        bestEcart = 1;
310        if (BTEST1(6))
311        {
312          PrintS("pair: ");pWrite0(S[j]);PrintS(" ");pWrite(S[k]);
313        }
314        if (TEST_OPT_PROT)
315        {
316           PrintS(".");
317           mflush();
318        }
319        while (pGetComp(toRed)<=rkF)
320        {
321          if (BTEST1(6))
322          {
323            PrintS("toRed: ");pWrite(toRed);
324          }
325/*
326*         if ((bestEcart) || (ecartToRed!=0))
327*         {
328*/
329            totalToRed = pLDeg(toRed,&kk);
330            ecartToRed = totalToRed-pFDeg(toRed);
331/*
332*         }
333*/
334          notFound = TRUE;
335          l=0;
336          bestEcart = 32000;  //a very large integer
337          p = NULL;
338          while ((l<tl) && (pGetComp(T[l])<pGetComp(toRed))) l++;
339          while ((l<tl) && (notFound))
340          {
341            if ((ecartT[l]<bestEcart) && (pDivisibleBy(T[l],toRed)))
342            {
343              if (ecartT[l]<=ecartToRed) notFound = FALSE;
344              p = T[l];
345              bestEcart = ecartT[l];
346            }
347            l++;
348          }
349          if (p==NULL)
350          {
351            WerrorS("ideal not a standardbasis");//no polynom for reduction
352            pDelete(&toRed);
353            for(k=j;k<Fl;k++) pDelete(&(pairs[k]));
354            Free((ADDRESS)pairs,Fl*sizeof(poly));
355            Free((ADDRESS)ST,Fl*sizeof(poly));
356            Free((ADDRESS)S,Fl*sizeof(poly));
357            Free((ADDRESS)T,tmax*sizeof(poly));
358            Free((ADDRESS)ecartT,tmax*sizeof(int));
359            Free((ADDRESS)totalT,tmax*sizeof(int));
360            Free((ADDRESS)ecartS,Fl*sizeof(int));
361            Free((ADDRESS)totalS,Fl*sizeof(int));
362            if (noSort)
363            {
364              Free((ADDRESS)F,Fl*sizeof(poly));
365              F = oldF;
366            }
367            for(k=0;k<*Smax;k++) pDelete(&((*Shdl)[k]));
368            return;
369          }
370          else
371          {
372//PrintS("reduced with: ");pWrite(p);PrintLn();
373            if (notFound)
374            {
375              if (tl>=tmax)
376              {
377                pEnlargeSet(&T,tmax,16);
378                tmax += 16;
379                temp = (int*)Alloc((tmax+16)*sizeof(int));
380                for(l=0;l<tmax;l++) temp[l]=totalT[l];
381                totalT = temp;
382                temp = (int*)Alloc((tmax+16)*sizeof(int));
383                for(l=0;l<tmax;l++) temp[l]=ecartT[l];
384                ecartT = temp;
385              }
386//PrintS("t");
387              l=0;
388              while ((l<tl) && (pGetComp(toRed)>pGetComp(T[l]))) l++;
389              while ((l<tl) && (totalT[l]<=totalToRed)) l++;
390              for (kk=tl;kk>l;kk--)
391              {
392                T[kk]=T[kk-1];
393                totalT[kk]=totalT[kk-1];
394                ecartT[kk]=ecartT[kk-1];
395              }
396              q = pCopy(toRed);
397              pNorm(q);
398              T[l] = q;
399              totalT[l] = totalToRed;
400              ecartT[l] = ecartToRed;
401              tl++;
402            }
403
404            toRed = spSpolyRed(p,toRed,NULL);
405          }
406        }
407//PrintS("s");
408        if (pGetComp(toRed)>rkF)
409        {
410          if (Sl>=*Smax)
411          {
412            pEnlargeSet(Shdl,*Smax,16);
413            *Smax += 16;
414          }
415          pShift(&toRed,-rkF);
416          pNorm(toRed);
417          (*Shdl)[Sl] = toRed;
418          Sl++;
419        }
420/*----------------deleting all polys not from ST--------------*/
421        for(l=0;l<tl;l++)
422        {
423          kk=0;
424          while ((kk<smax) && (T[l] != S[kk])) kk++;
425          if (kk>=smax)
426          {
427            pDelete(&T[l]);
428//Print ("#");
429          }
430        }
431      }
432    }
433    for(k=j;k<Fl;k++) pDelete(&(pairs[k]));
434  }
435  Free((ADDRESS)pairs,Fl*sizeof(poly));
436  Free((ADDRESS)ST,Fl*sizeof(poly));
437  Free((ADDRESS)S,Fl*sizeof(poly));
438  Free((ADDRESS)T,tmax*sizeof(poly));
439  Free((ADDRESS)ecartT,tmax*sizeof(int));
440  Free((ADDRESS)totalT,tmax*sizeof(int));
441  Free((ADDRESS)ecartS,Fl*sizeof(int));
442  Free((ADDRESS)totalS,Fl*sizeof(int));
443  if (noSort)
444  {
445    if (modcomp!=NULL) delete modcomp;
446    Free((ADDRESS)F,Fl*sizeof(poly));
447    F = oldF;
448  }
449}
450
451/*3
452*special Normalform for Schreyer in factor rings
453*/
454poly sySpecNormalize(poly toNorm,ideal mW=NULL)
455{
456  int j,i=0;
457  poly p;
458 
459  if (toNorm==NULL) return NULL;
460  p = pHead(toNorm);
461  if (mW!=NULL)
462  {
463    for(j=1;j<=pVariables;j++)
464      pSetExp(p,j,pGetExp(p,j) -pGetExp(mW->m[pGetComp(p)-1],j));
465  }
466  while ((p!=NULL) && (i<IDELEMS(currQuotient)))
467  {
468    if (pDivisibleBy(currQuotient->m[i],p))
469    {
470      //pNorm(toNorm);
471      toNorm = spSpolyRed(currQuotient->m[i],toNorm,NULL);
472      pDelete(&p); 
473      if (toNorm==NULL) return NULL;
474      p = pHead(toNorm);
475      if (mW!=NULL)
476      {
477        for(j=1;j<=pVariables;j++)
478          pSetExp(p,j,pGetExp(p,j) -pGetExp(mW->m[pGetComp(p)-1],j));
479      }
480      i = 0;
481    }
482    else
483    {
484      i++;
485    }
486  }
487  pDelete(&p);
488  return toNorm;
489}
490
491/*2
492* computes the Schreyer syzygies in the global case
493* input: F, Fmax,  noSort: F is already ordered by: Schreyer-order
494*              (only allocated: Shdl, Smax)
495* output: Shdl, Smax
496* modcomp, length stores the start position of the module comp. in FF
497*/
498void sySchreyersSyzygiesFB(polyset *FF,int Fmax,polyset* Shdl,int* Smax,
499   BOOLEAN noSort,intvec ** modcomp, int * length,ideal mW)
500{
501  int i,j,l,k,kkk,rkF,Sl=0,Fl=Fmax,syComponentOrder=pModuleOrder();
502  int fstart,wend,lini;
503  intvec *newmodcomp;
504  polyset pairs,oldF,F=*FF;
505  poly p,q,toRed,syz,lastmonom,multWith;
506  ideal idF=(ideal)Alloc(sizeof(*idF)),null;
507  BOOLEAN isNotReduced=TRUE;
508
509  while ((Fl!=0) && (F[Fl-1]==NULL)) Fl--;
510  newmodcomp = new intvec(Fl+2);
511//for (j=0;j<Fl;j++) pWrite(F[j]);
512//PrintLn();
513  if (currQuotient==NULL)
514    pairs=(polyset)Alloc0(Fl*sizeof(poly));
515  else
516    pairs=(polyset)Alloc0((Fl+IDELEMS(currQuotient))*sizeof(poly));
517  idF->m=F;IDELEMS(idF)=Fmax;
518  rkF=idRankFreeModule(idF);
519  null = idInit(1,rkF);
520  Free((ADDRESS)idF,sizeof(*idF));
521  if (noSort)
522  {
523    oldF = *FF;
524    F=syInitSort(*FF,rkF,Fmax,syComponentOrder,modcomp);
525  }
526  else
527  {
528    F = *FF;
529  }
530  for(j=0;j<Fl;j++)
531  {
532    (*newmodcomp)[j+1] = Sl;
533    if (TEST_OPT_PROT)
534    {
535      Print("(%d)",Fl-j);
536      mflush();
537    }
538    i = pGetComp(F[j]);
539    if (syComponentOrder==1)
540    {
541      lini=k=j+1;
542      wend=Fl;
543    }
544    else
545    {
546      lini=k=0;
547      while ((k<j) && (pGetComp(F[k]) != i)) k++;
548      wend=j;
549    }
550    syCreatePairs(F,lini,wend,k,j,i,pairs,Fl,mW);
551    if (currQuotient!=NULL) wend = Fl+IDELEMS(currQuotient);
552    for (k=lini;k<wend;k++)
553    {
554      if (pairs[k]!=NULL)
555      {
556        if (TEST_OPT_PROT)
557        {
558           PrintS(".");
559           mflush();
560        }
561        //begins to construct the syzygy
562        if (k<Fl)
563        {
564          syz = pCopy(pairs[k]);
565          syz->coef = nCopy(F[k]->coef);
566          syz->coef = nNeg(syz->coef);
567          pNext(syz) = pairs[k];
568          lastmonom = pNext(syz);
569          lastmonom->coef = nCopy(F[j]->coef);
570          pSetComp(lastmonom,k+1);
571        }
572        else
573        {
574          syz = pairs[k];
575          syz->coef = nCopy(currQuotient->m[k-Fl]->coef);
576          lastmonom = syz;
577          multWith = pDivide(syz,F[j]);
578          multWith->coef = nCopy(currQuotient->m[k-Fl]->coef);
579        }
580        pSetComp(syz,j+1);
581        pairs[k] = NULL;
582        //the next term of the syzygy
583        //constructs the spoly
584        if (BTEST1(6))
585        {
586          if (k<Fl)
587          {
588            PrintS("pair: ");pWrite0(F[j]);PrintS("  ");pWrite(F[k]);
589          }
590          else
591          {
592            PrintS("pair: ");pWrite0(F[j]);PrintS("  ");pWrite(currQuotient->m[k-Fl]);
593          }
594        }
595        if (k<Fl)
596          toRed = spSpolyCreate(F[j],F[k],NULL);
597        else
598        {
599          q = pMultT(pCopy(F[j]),multWith);
600          toRed = sySpecNormalize(q,mW);
601          pDelete(&multWith);
602        }
603        isNotReduced = TRUE;
604        while (toRed!=NULL)
605        {
606          if (BTEST1(6))
607          {
608            PrintS("toRed: ");pWrite(toRed);
609          }
610//          l=0;
611//          while ((l<Fl) && (!pDivisibleBy(F[l],toRed))) l++;
612//          if (l>=Fl)
613          l = (**modcomp)[pGetComp(toRed)+1]-1;
614          kkk = (**modcomp)[pGetComp(toRed)];
615          while ((l>=kkk) && (!pDivisibleBy(F[l],toRed))) l--;
616          if (l<kkk)
617          {
618            if ((currQuotient!=NULL) && (isNotReduced))
619            {
620              toRed = sySpecNormalize(toRed,mW);
621              isNotReduced = FALSE;
622            }
623            else
624            {
625              //no polynom for reduction
626              WerrorS("ideal not a standardbasis");
627              pDelete(&toRed);
628              pDelete(&syz);
629              for(k=j;k<Fl;k++) pDelete(&(pairs[k]));
630              Free((ADDRESS)pairs,Fl*sizeof(poly));
631              if (noSort)
632              {
633                Free((ADDRESS)F,Fl*sizeof(poly));
634                F = oldF;
635              }
636              for(k=0;k<*Smax;k++) pDelete(&((*Shdl)[k]));
637              return;
638            }
639          }
640          else
641          {
642            //the next monom of the syzygy
643            isNotReduced = TRUE;
644            if (BTEST1(6))
645            {
646              PrintS("reduced with: ");pWrite(F[l]);
647            }
648            multWith = pDivide(toRed,F[l]);
649            multWith->coef = nDiv(toRed->coef,F[l]->coef);
650            multWith->coef = nNeg(multWith->coef);
651            pNext(lastmonom) = toRed;
652            pIter(lastmonom);
653            pIter(toRed);
654            pNext(lastmonom) = NULL;
655            lastmonom->coef = nDiv(lastmonom->coef,F[l]->coef);
656            lastmonom->coef = nNeg(lastmonom->coef);
657            pSetComp(lastmonom,l+1);
658            //computes the new toRed
659            p = pCopy(pNext(F[l]));
660            p = pMultT(p,multWith);
661            pDelete(&multWith);
662            toRed = pAdd(toRed,p);
663            //the module component of the new monom
664//pWrite(toRed);
665          }
666        }
667//PrintLn();
668        if (syz!=NULL)
669        {
670          if (Sl>=*Smax)
671          {
672            pEnlargeSet(Shdl,*Smax,16);
673            *Smax += 16;
674          }
675          pNorm(syz);
676          if (BTEST1(OPT_REDTAIL))
677          {
678            (*newmodcomp)[j+2] = Sl;
679            (*Shdl)[Sl] = syRedtail2(syz,*Shdl,newmodcomp);
680            (*newmodcomp)[j+2] = 0;
681          }
682          else
683            (*Shdl)[Sl] = syz;
684          Sl++;
685        }
686      }
687    }
688//    for(k=j;k<Fl;k++) pDelete(&(pairs[k]));
689  }
690  (*newmodcomp)[Fl+1] = Sl;
691  if (currQuotient==NULL)
692    Free((ADDRESS)pairs,Fl*sizeof(poly));
693  else
694    Free((ADDRESS)pairs,(Fl+IDELEMS(currQuotient))*sizeof(poly));
695  if (noSort)
696  {
697    Free((ADDRESS)oldF,Fmax*sizeof(poly));
698    *FF = F;
699  }
700  delete *modcomp;
701  *length = Fl+2;
702  *modcomp = newmodcomp;
703}
704
705void syReOrderResolventFB(resolvente res,int length, int initial)
706{
707  int syzIndex=length-1,i,j;
708  poly p;
709
710  while ((syzIndex!=0) && (res[syzIndex]==NULL)) syzIndex--;
711  while (syzIndex>=initial)
712  {
713    for(i=0;i<IDELEMS(res[syzIndex]);i++)
714    {
715      p = res[syzIndex]->m[i];
716      while (p!=NULL)
717      {
718        if (res[syzIndex-1]->m[pGetComp(p)-1]!=NULL)
719        {
720          for(j=1;j<=pVariables;j++)
721          {
722            pSetExp(p,j,pGetExp(p,j)
723                        -pGetExp(res[syzIndex-1]->m[pGetComp(p)-1],j));
724          }
725        }
726        else
727          PrintS("error in the resolvent\n");
728        pSetm(p);
729        pIter(p);
730      }
731    }
732    syzIndex--;
733  }
734}
735
736BOOLEAN syTestOrder(ideal M)
737{
738  int i=idRankFreeModule(M);
739  int j=0;
740
741  while ((currRing->order[j]!=ringorder_c) && (currRing->order[j]!=ringorder_C))
742    j++;
743  if ((i>0) && (currRing->order[j+1]!=0))
744  {
745    return TRUE;
746  }
747  return FALSE;
748}
749
750resolvente sySchreyerResolvente(ideal arg, int maxlength, int * length,
751  BOOLEAN isMonomial,BOOLEAN notReplace)
752{
753  ideal mW=NULL;
754  int i,syzIndex = 0,j=0,lgth,*ord=NULL,*bl0=NULL,*bl1=NULL;
755  intvec * modcomp=NULL,*w=NULL;
756  short ** wv=NULL;
757  BOOLEAN sort = TRUE;
758  tHomog hom=(tHomog)idHomModule(arg,NULL,&w);
759
760  if((hom==isHomog)
761  &&(maxlength==pVariables-1)
762  &&(currQuotient==NULL)
763  &&(idRankFreeModule(arg)==0)
764  &&(!idIs0(arg)))
765  {
766   return syLaScala1(arg,length);
767  } 
768
769  if ((!isMonomial) && syTestOrder(arg))
770  {
771    WerrorS("sres only implemented for modules with ordering  ..,c or ..,C");
772    return NULL;
773  }
774  *length = 4;
775  resolvente res = (resolvente)Alloc0(4*sizeof(ideal)),newres;
776  res[0] = idCopy(arg);
777  while ((!idIs0(res[syzIndex])) && ((maxlength==-1) || (syzIndex<maxlength)))
778  {
779    i = IDELEMS(res[syzIndex]);
780    //while ((i!=0) && (!res[syzIndex]->m[i-1])) i--;
781    if (syzIndex+1==*length)
782    {
783      newres = (resolvente)Alloc((*length+4)*sizeof(ideal));
784      for (j=0;j<*length+4;j++) newres[j] = NULL;
785      for (j=0;j<*length;j++) newres[j] = res[j];
786      Free((ADDRESS)res,*length*sizeof(ideal));
787      *length += 4;
788      res=newres;
789    }
790    res[syzIndex+1] = idInit(16,1);
791    if ((currRing->OrdSgn == 1) || (hom==isHomog))
792    {
793      sySchreyersSyzygiesFB(&(res[syzIndex]->m),i,&(res[syzIndex+1]->m),
794        &(IDELEMS(res[syzIndex+1])),sort,&modcomp,&lgth,mW);
795      mW = res[syzIndex];
796    }
797    else
798      sySchreyersSyzygiesFM(res[syzIndex]->m,i,&(res[syzIndex+1]->m),
799        &(IDELEMS(res[syzIndex+1])),sort);
800//idPrint(res[syzIndex+1]);
801    if ((syzIndex==0) && (currRing->OrdSgn==1))
802    {
803      j = 0;
804      while ((currRing->order[j]!=ringorder_c)
805              && (currRing->order[j]!=ringorder_C))
806        j++;
807      if ((!notReplace) && (currRing->order[j]!=0))
808      {
809        while (currRing->order[j]!=0) j++;
810        ord = (int*)Alloc0((j+2)*sizeof(int));
811        wv = (short**)Alloc0((j+2)*sizeof(short*));
812        bl0 = (int*)Alloc0((j+2)*sizeof(int));
813        bl1 = (int*)Alloc0((j+2)*sizeof(int));
814        j = 0;
815        while ((currRing->order[j]!=ringorder_c)
816                && (currRing->order[j]!=ringorder_C))
817        {
818          ord[j] = currRing->order[j];
819          bl0[j] = currRing->block0[j];
820          bl1[j] = currRing->block1[j];
821          wv[j] = currRing->wvhdl[j];
822          j++;
823        }
824        int m_order=j;
825        while (currRing->order[j+1]!=0)
826        {
827          ord[j] = currRing->order[j+1];
828          bl0[j] = currRing->block0[j+1];
829          bl1[j] = currRing->block1[j+1];
830          wv[j] = currRing->wvhdl[j+1];
831          j++;
832        }
833        ord[j] = currRing->order[m_order];
834        bl0[j] = currRing->block0[m_order];
835        bl1[j] = currRing->block1[m_order];
836        wv[j] = currRing->wvhdl[m_order];
837        pChangeRing(pVariables,currRing->OrdSgn,ord,bl0,bl1,wv);
838      }
839    }
840    if (sort) sort=FALSE;
841    syzIndex++;
842    if (TEST_OPT_PROT) Print("[%d]\n",syzIndex);
843  }
844  if (currRing->OrdSgn == -1)
845    pSetSchreyerOrdM(NULL,0,0);
846  syReOrderResolventFB(res,*length);
847  syzIndex = 1;
848  if (/*ringOrderChanged:*/ ord!=NULL)
849  {
850    j = 0;
851    while (currRing->order[j]!=0) j++;
852    Free((ADDRESS)ord,(j+2)*sizeof(int));
853    Free((ADDRESS)bl0,(j+2)*sizeof(int));
854    Free((ADDRESS)bl1,(j+2)*sizeof(int));
855    Free((ADDRESS)wv,(j+2)*sizeof(short*));
856    pChangeRing(pVariables,currRing->OrdSgn,currRing->order,currRing->block0,
857                currRing->block1,currRing->wvhdl);
858  }
859  while ((syzIndex < *length) && (res[syzIndex]))
860  {
861    for (i=0;i<IDELEMS(res[syzIndex]);i++)
862    {
863      if (res[syzIndex]->m[i])
864        res[syzIndex]->m[i] = pOrdPolySchreyer(res[syzIndex]->m[i]);
865    }
866    syzIndex++;
867  }
868  if (modcomp!=NULL) delete modcomp;
869  if (w!=NULL) delete w;
870  return res;
871}
Note: See TracBrowser for help on using the repository browser.