source: git/Singular/syz.cc @ e95eaa7

fieker-DuValspielwiese
Last change on this file since e95eaa7 was 0fcb82, checked in by Thomas Siebert <siebert@…>, 24 years ago
Correction of memory leaks git-svn-id: file:///usr/local/Singular/svn/trunk@4161 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 26.4 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: syz.cc,v 1.35 2000-02-29 10:46:03 siebert Exp $ */
5
6/*
7* ABSTRACT: resolutions
8*/
9
10
11#include "mod2.h"
12#include "tok.h"
13#include "mmemory.h"
14#include "polys.h"
15#include "febase.h"
16#include "kstd1.h"
17#include "kutil.h"
18#include "stairc.h"
19#include "cntrlc.h"
20#include "ipid.h"
21#include "intvec.h"
22#include "ipshell.h"
23#include "numbers.h"
24#include "ideals.h"
25#include "intvec.h"
26#include "ring.h"
27#include "syz.h"
28#include "prCopy.h"
29
30
31void syDeleteRes(resolvente * res,int length)
32{
33  for (int i=0;i<length;i++)
34  {
35    if (!idIs0((*res)[i]))
36      idDelete(&((*res)[i]));
37  }
38  Free((ADDRESS)res,length*sizeof(ideal));
39  *res = NULL;
40}
41
42static intvec * syPrepareModComp(ideal arg,intvec ** w)
43{
44  intvec *w1 = NULL;
45  int i;
46  BOOLEAN isIdeal=FALSE;
47
48  if ((w==NULL) || (*w==NULL)) return w1;
49  int maxxx = (*w)->length();
50  if (maxxx==1)
51  {
52    maxxx = 2;
53    isIdeal = TRUE;
54  }
55  w1 = NewIntvec1(maxxx+IDELEMS(arg));
56  if (!isIdeal)
57  {
58    for (i=0;i<maxxx;i++)
59    {
60      (*w1)[i] = (**w)[i];
61    }
62  }
63  for (i=maxxx;i<maxxx+IDELEMS(arg);i++)
64  {
65    if (arg->m[i-maxxx]!=NULL)
66    {
67      (*w1)[i] = pFDeg(arg->m[i-maxxx]);
68      if (pGetComp(arg->m[i-maxxx])!=0)
69      {
70        (*w1)[i]+=(**w)[pGetComp(arg->m[i-maxxx])-1];
71      }
72    }
73  }
74  delete (*w);
75  *w = NewIntvec1(IDELEMS(arg)+1);
76  for (i=0;i<IDELEMS(arg);i++)
77  {
78     (**w)[i+1] = (*w1)[i+maxxx];
79  }
80  return w1;
81}
82
83static void syDeleteAbove(ideal up, int k)
84{
85  if (up!=NULL)
86  {
87    for (int i=0;i<IDELEMS(up);i++)
88    {
89      if (up->m[i]!=NULL)
90        pDeleteComp(&(up->m[i]),k+1);
91    }
92  }
93}
94
95/*2
96*minimizes the module mod and cancel superfluous syzygies
97*from syz
98*/
99static void syMinStep(ideal mod,ideal syz,BOOLEAN final=FALSE,ideal up=NULL,
100                      tHomog h=isNotHomog)
101{
102  ideal deg0=NULL;
103  poly Unit1,Unit2,actWith;
104  int len,i,j,ModComp,m,k,l;
105  BOOLEAN searchUnit,existsUnit;
106
107  if (TEST_OPT_PROT) PrintS("m");
108  if ((final) && (h==isHomog))
109  /*minim is TRUE, we are in the module: maxlength, maxlength <>0*/
110  {
111    deg0=idJet(syz,0);
112    idSkipZeroes(deg0);
113    syz=deg0;
114  }
115/*--cancels empty entees and their related components above--*/
116  j = IDELEMS(syz);
117  while ((j>0) && (!syz->m[j-1])) j--;
118  k = 0;
119  while (k<j)
120  {
121    if (syz->m[k]!=NULL)
122      k++;
123    else
124    {
125      if (TEST_OPT_PROT) PrintS(".");
126      for (l=k;l<j-1;l++) syz->m[l] = syz->m[l+1];
127      syz->m[j-1] = NULL;
128      syDeleteAbove(up,k);
129      j--;
130    }
131  }
132/*--searches for syzygies coming from superfluous elements
133* in the module below--*/
134  searchUnit = TRUE;
135  int curr_syz_limit = rGetCurrSyzLimit();
136  while (searchUnit)
137  {
138    i=0;
139    j=IDELEMS(syz);
140    while ((j>0) && (syz->m[j-1]==NULL)) j--;
141    existsUnit = FALSE;
142    if (currRing->OrdSgn == 1)
143    {
144      while ((i<j) && (!existsUnit))
145      {
146        existsUnit = pVectorHasUnitB(syz->m[i],&ModComp);
147        i++;
148      }
149    }
150    else
151    {
152      int I=0;
153      l = 0;
154      len=0;
155      for (i=0;i<IDELEMS(syz);i++)
156      {
157        if (syz->m[i]!=NULL)
158        {
159          pVectorHasUnit(syz->m[i],&m, &l);
160          if ((len==0) ||((l>0) && (l<len)))
161          {
162            len = l;
163            ModComp = m;
164            I = i;
165          }
166        }
167      }
168//Print("Laenge ist: %d\n",len);
169      if (len>0) existsUnit = TRUE;
170      i = I+1;
171    }
172    if (existsUnit)
173    {
174      i--;
175//--takes out the founded syzygy--
176      if (TEST_OPT_PROT) PrintS("f");
177      actWith = syz->m[i];
178      if (!rField_has_simple_inverse()) pCleardenom(actWith);
179//Print("actWith: ");pWrite(actWith);
180      syz->m[i] = NULL;
181      for (k=i;k<j-1;k++)  syz->m[k] = syz->m[k+1];
182      syz->m[j-1] = NULL;
183      syDeleteAbove(up,i);
184      j--;
185//--makes Gauss alg. for the column ModComp--
186      Unit1 = pTakeOutComp(&(actWith), ModComp);
187//PrintS("actWith now: ");pWrite(actWith);
188//Print("Unit1: ");pWrite(Unit1);
189      k=0;
190//Print("j= %d",j);
191      while (k<j)
192      {
193        if (syz->m[k]!=NULL)
194        {
195          Unit2 = pTakeOutComp(&(syz->m[k]), ModComp);
196//Print("element %d: ",k);pWrite(syz->m[k]);
197//PrintS("Unit2: ");pWrite(Unit2);
198          syz->m[k] = pMult(syz->m[k],pCopy(Unit1));
199          syz->m[k] = pSub(syz->m[k],
200            pMult(pCopy(actWith),Unit2));
201          if (syz->m[k]==NULL)
202          {
203            for (l=k;l<j-1;l++)
204              syz->m[l] = syz->m[l+1];
205            syz->m[j-1] = NULL;
206            j--;
207            syDeleteAbove(up,k);
208            k--;
209          }
210        }
211        k++;
212      }
213      pDelete(&actWith);
214      pDelete(&Unit1);
215//--deletes superfluous elements from the module below---
216      pDelete(&(mod->m[ModComp-1 - curr_syz_limit]));
217      for (k=ModComp-1 - curr_syz_limit;k<IDELEMS(mod)-1;k++)
218        mod->m[k] = mod->m[k+1];
219      mod->m[IDELEMS(mod)-1] = NULL;
220    }
221    else
222      searchUnit = FALSE;
223  }
224  if (TEST_OPT_PROT) PrintLn();
225  idSkipZeroes(mod);
226  idSkipZeroes(syz);
227  if (deg0!=NULL)
228    idDelete(&deg0);
229}
230
231/*2
232* make Gauss for one element
233*/
234void syGaussForOne(ideal syz, int elnum, int ModComp,int from,int till)
235{
236  int k,j,i,lu;
237  poly unit1,unit2;
238  poly actWith=syz->m[elnum];
239
240  if (from<0) from = 0;
241  if ((till<=0) || (till>IDELEMS(syz))) till = IDELEMS(syz);
242  syz->m[elnum] = NULL;
243  if (!rField_has_simple_inverse()) pCleardenom(actWith);
244/*--makes Gauss alg. for the column ModComp--*/
245  pTakeOutComp(&(actWith), ModComp, &unit1, &lu);
246  while (from<till)
247  {
248    if (syz->m[from]!=NULL)
249    {
250      pTakeOutComp(&(syz->m[from]), ModComp, &unit2, &lu);
251      syz->m[from] = pMult(syz->m[from],pCopy(unit1));
252      syz->m[from] = pSub(syz->m[from],
253        pMult(pCopy(actWith),unit2));
254    }
255    from++;
256  }
257  pDelete(&actWith);
258  pDelete(&unit1);
259}
260static void syDeleteAbove1(ideal up, int k)
261{
262  poly p,pp;
263  if (up!=NULL)
264  {
265    for (int i=0;i<IDELEMS(up);i++)
266    {
267      p = up->m[i];
268      while ((p!=NULL) && (pGetComp(p)==k))
269      {
270        pp = pNext(p);
271        pNext(p) = NULL;
272        pDelete(&p);
273        p = pp;
274      }
275      up->m[i] = p;
276      if (p!=NULL)
277      {
278        while (pNext(p)!=NULL)
279        {
280          if (pGetComp(pNext(p))==k)
281          {
282            pp = pNext(pNext(p));
283            pNext(pNext(p)) = NULL;
284            pDelete(&pNext(p));
285            pNext(p) = pp;
286          }
287          else
288            pIter(p);
289        }
290      }
291    }
292  }
293}
294/*2
295*minimizes the resolution res
296*assumes homogeneous or local case
297*/
298static void syMinStep1(resolvente res, int length)
299{
300  int i,j,k,l,index=0;
301  poly p;
302  ideal deg0=NULL,reddeg0=NULL;
303  intvec *have_del=NULL,*to_del=NULL;
304
305  while ((index<length) && (res[index]!=NULL))
306  {
307/*---we take out dependend elements from syz---------------------*/
308    if (res[index+1]!=NULL)
309    {
310      deg0 = idJet(res[index+1],0);
311      reddeg0 = kInterRed(deg0);
312      idDelete(&deg0);
313      have_del = NewIntvec1(IDELEMS(res[index]));
314      for (i=0;i<IDELEMS(reddeg0);i++)
315      {
316        if (reddeg0->m[i]!=NULL)
317        {
318          j = pGetComp(reddeg0->m[i]);
319          pDelete(&(res[index]->m[j-1]));
320          res[index]->m[j-1] = NULL;
321          (*have_del)[j-1] = 1;
322        }
323      }
324      idDelete(&reddeg0);
325    }
326    if (index>0)
327    {
328/*--- we search for units and perform Gaussian elimination------*/
329      j = to_del->length();
330      while (j>0)
331      {
332        if ((*to_del)[j-1]==1)
333        {
334          k = 0;
335          while (k<IDELEMS(res[index]))
336          {
337            p = res[index]->m[k];
338            while ((p!=NULL) && ((!pIsConstantComp(p)) || (pGetComp(p)!=j)))
339              pIter(p);
340            if ((p!=NULL) && (pIsConstantComp(p)) && (pGetComp(p)==j)) break;
341            k++;
342          }
343          if (k>=IDELEMS(res[index]))
344          {
345            PrintS("out of range\n");
346          }
347          syGaussForOne(res[index],k,j);
348          if (res[index+1]!=NULL)
349            syDeleteAbove1(res[index+1],k+1);
350          (*to_del)[j-1] = 0;
351        }
352        j--;
353      }
354    }
355    if (to_del!=NULL) delete to_del;
356    to_del = have_del;
357    have_del = NULL;
358    index++;
359  }
360  if (TEST_OPT_PROT) PrintLn();
361  syKillEmptyEntres(res,length);
362}
363
364void syMinimizeResolvente(resolvente res, int length, int first)
365{
366  int syzIndex=first;
367  intvec *dummy;
368
369  if (syzIndex<1) syzIndex=1;
370  if ((syzIndex==1) && (idHomModule(res[0],currQuotient,&dummy)))
371  {
372    syMinStep1(res,length);
373    delete dummy;
374    return;
375  }
376  while ((syzIndex<length-1) && (res[syzIndex]!=NULL) && (res[syzIndex+1]!=NULL))
377  {
378    syMinStep(res[syzIndex-1],res[syzIndex],FALSE,res[syzIndex+1]);
379    syzIndex++;
380  }
381  if (res[syzIndex]!=NULL)
382    syMinStep(res[syzIndex-1],res[syzIndex]);
383  if (!idIs0(res[0]))
384    idMinEmbedding(res[0],TRUE);
385}
386
387/*2
388* resolution of ideal/module arg, <=maxlength steps, (r[0..maxlength])
389*   no limitation in length if maxlength==0
390* input:arg
391*       minim: TRUE means mres cmd, FALSE res cmd.
392*       if *len!=0: modul weights: weights[0]
393*          (and weights is defined:weights[0..len-1]
394*
395* output:resolvente r[0..length-1],
396*        modul weights: weights[0..length-1]
397*/
398resolvente syResolvente(ideal arg, int maxlength, int * length,
399                        intvec *** weights, BOOLEAN minim)
400{
401  resolvente res;
402  resolvente newres;
403  tHomog hom=isNotHomog;
404  ideal temp=NULL;
405  intvec *w = NULL,**tempW;
406  int i,k,syzIndex = 0,j,rk_arg=max(1,idRankFreeModule(arg));
407  int Kstd1_OldDeg=Kstd1_deg;
408  BOOLEAN completeMinim;
409  BOOLEAN oldDegBound=TEST_OPT_DEGBOUND;
410  BOOLEAN setRegularity=TRUE;
411  int wlength=*length;
412
413  if (maxlength!=-1) *length = maxlength+1;
414  else              *length = 5;
415  if ((wlength!=0) && (*length!=wlength))
416  {
417    intvec **wtmp = (intvec**)Alloc0((*length)*sizeof(intvec*));
418    wtmp[0]=(*weights)[0];
419    Free((ADDRESS)*weights,wlength*sizeof(intvec*));
420    *weights=wtmp;
421  }
422  res = (resolvente)Alloc0((*length)*sizeof(ideal));
423
424/*--- initialize the syzygy-ring -----------------------------*/
425  ring origR = currRing;
426  ring syz_ring = rCurrRingAssure_SyzComp();
427  rSetSyzComp(rk_arg);
428 
429  if (syz_ring != origR)
430  {
431    res[0] = idrCopyR_NoSort(arg, origR);
432  }
433  else
434  {
435    res[0] = idCopy(arg);
436  }
437 
438/*--- creating weights for the module components ---------------*/
439  if ((weights==NULL) || (*weights==NULL) || ((*weights)[0]==NULL))
440  {
441    hom=(tHomog)idHomModule(res[0],currQuotient,&w);
442    if (hom==isHomog)
443    {
444      *weights = (intvec**)Alloc0((*length)*sizeof(intvec*));
445      if (w!=NULL) (*weights)[0] = ivCopy(w);
446    }
447  }
448  else
449  {
450    if ((weights!=NULL) && (*weights!=NULL)&& ((*weights)[0]!=NULL))
451    {
452      w = ivCopy((*weights)[0]);
453      hom = isHomog;
454    }
455  }
456  if (hom==isHomog)
457  {
458    intvec *w1 = syPrepareModComp(res[0],&w);
459    if (w!=NULL) { delete w;w=NULL; }
460    w = w1;
461    j = 0;
462    while ((j<IDELEMS(res[0])) && (res[0]->m[j]==NULL)) j++;
463    if (j<IDELEMS(res[0]))
464    {
465      if (pFDeg(res[0]->m[j])!=pTotaldegree(res[0]->m[j]))
466        setRegularity = FALSE;
467    }
468  }
469  else
470  {
471    setRegularity = FALSE;
472  }
473   
474/*--- the main loop --------------------------------------*/
475  while ((!idIs0(res[syzIndex])) &&
476         ((maxlength==-1) || (syzIndex<=maxlength)))
477   // (syzIndex<maxlength+(int)minim)))
478/*--- compute one step more for minimizing-----------------*/
479  {
480    if (Kstd1_deg!=0) Kstd1_deg++;
481    if (syzIndex+1==*length)
482    {
483      newres = (resolvente)Alloc0((*length+5)*sizeof(ideal));
484      tempW = (intvec**)Alloc0((*length+5)*sizeof(intvec*));
485      for (j=0;j<*length;j++)
486      {
487        newres[j] = res[j];
488        if (*weights!=NULL) tempW[j] = (*weights)[j];
489        /*else              tempW[j] = NULL;*/
490      }
491      Free((ADDRESS)res,*length*sizeof(ideal));
492      Free((ADDRESS)*weights,*length*sizeof(intvec*));
493      *length += 5;
494      res=newres;
495      *weights = tempW;
496    }
497/*--- interreducing first -----------------------------------*/
498    if (syzIndex>0)
499    {
500      int rkI=idRankFreeModule(res[syzIndex]);
501      rSetSyzComp(rkI);
502    }
503    if (minim || (syzIndex!=0))
504    {
505      temp = kInterRed(res[syzIndex],currQuotient);
506      idDelete(&res[syzIndex]);
507      idSkipZeroes(temp);
508      res[syzIndex] = temp;
509    }
510    temp = NULL;
511/*--- computing the syzygy modules --------------------------------*/
512    if ((currQuotient==NULL)&&(syzIndex==0)&& (!TEST_OPT_DEGBOUND))
513    {
514      res[/*syzIndex+*/1] = idSyzygies(res[0/*syzIndex*/],hom,&w,FALSE,setRegularity,&Kstd1_deg);
515      if ((!TEST_OPT_NOTREGULARITY) && (Kstd1_deg>0)) test |= Sy_bit(OPT_DEGBOUND);
516    }
517    else
518    {
519        res[syzIndex+1] = idSyzygies(res[syzIndex],hom,&w,FALSE);
520    }
521    completeMinim=(syzIndex!=maxlength) || (maxlength ==-1) || (hom!=isHomog);
522    syzIndex++;
523    if (TEST_OPT_PROT) Print("[%d]\n",syzIndex);
524    if ((minim)||(syzIndex>1))
525      syMinStep(res[syzIndex-1],res[syzIndex],!completeMinim,NULL,hom);
526    if (!completeMinim)
527    /*minim is TRUE, we are in the module: maxlength, maxlength <>0*/
528    {
529      idDelete(&res[syzIndex]);
530    }
531/*---creating the iterated weights for module components ---------*/
532    if ((hom == isHomog) && (!idIs0(res[syzIndex])))
533    {
534//Print("die %d Modulegewichte sind:\n",w1->length());
535//w1->show();
536//PrintLn();
537      int max_comp = idRankFreeModule(res[syzIndex]);
538      k = max_comp - rGetCurrSyzLimit();
539      assume(w != NULL);
540      if (w != NULL)
541        w->resize(max_comp+IDELEMS(res[syzIndex]));
542      else
543        w = NewIntvec1(max_comp+IDELEMS(res[syzIndex]));
544      (*weights)[syzIndex] = NewIntvec1(k);
545      for (i=0;i<k;i++)
546      {
547        if (res[syzIndex-1]->m[i]!=NULL) // hs
548        {
549          (*w)[i + rGetCurrSyzLimit()] = pFDeg(res[syzIndex-1]->m[i]);
550          if (pGetComp(res[syzIndex-1]->m[i])>0)
551            (*w)[i + rGetCurrSyzLimit()] 
552              += (*w)[pGetComp(res[syzIndex-1]->m[i])-1];
553          (*((*weights)[syzIndex]))[i] = (*w)[i+rGetCurrSyzLimit()];
554        }
555      }
556      for (i=k;i<k+IDELEMS(res[syzIndex]);i++)
557      {
558        if (res[syzIndex]->m[i-k]!=NULL)
559          (*w)[i+rGetCurrSyzLimit()] = pFDeg(res[syzIndex]->m[i-k])
560                    +(*w)[pGetComp(res[syzIndex]->m[i-k])-1];
561      }
562    }
563  }
564/*--- end of the main loop --------------------------------------*/
565/*--- deleting the temporare data structures --------------------*/
566  if ((syzIndex!=0) && (res[syzIndex]!=NULL) && (idIs0(res[syzIndex])))
567    idDelete(&res[syzIndex]);
568  if (w !=NULL) delete w;
569
570  Kstd1_deg=Kstd1_OldDeg;
571  if (!oldDegBound)
572    test &= ~Sy_bit(OPT_DEGBOUND);
573
574  for (i=1; i<=syzIndex; i++)
575  {
576    if (! idIs0(res[i]))
577    {
578      for (j=0; j<IDELEMS(res[i]); j++)
579      {
580        pShift(&res[i]->m[j], -rGetMaxSyzComp(i));
581      }
582    }
583  }
584/*--- going back to the original ring -------------------------*/
585  if (origR != syz_ring)
586  {
587    rChangeCurrRing(origR, TRUE);
588    for (i=0; i<=syzIndex; i++)
589    {
590      res[i] = idrMoveR_NoSort(res[i], syz_ring);
591    }
592    rKill(syz_ring);
593  }
594  return res;
595}
596
597syStrategy syResolution(ideal arg, int maxlength,intvec * w, BOOLEAN minim)
598{
599  int typ0;
600  syStrategy result=(syStrategy)Alloc0SizeOf(ssyStrategy);
601
602  if (w!=NULL)
603  {
604    result->weights = (intvec**)Alloc0SizeOf(void_ptr);
605    (result->weights)[0] = ivCopy(w);
606    result->length = 1;
607  }
608  resolvente fr = syResolvente(arg,maxlength,&(result->length),&(result->weights),minim),fr1;
609  if (minim)
610  {
611    result->minres = (resolvente)Alloc0((result->length+1)*sizeof(ideal));
612    fr1 =  result->minres;
613  }
614  else
615  {
616    result->fullres = (resolvente)Alloc0((result->length+1)*sizeof(ideal));
617    fr1 =  result->fullres;
618  }
619  for (int i=result->length-1;i>=0;i--)
620  {
621    if (fr[i]!=NULL)
622      fr1[i] = fr[i];
623    fr[i] = NULL;
624  }
625  Free((ADDRESS)fr,(result->length)*sizeof(ideal));
626  return result;
627}
628
629static poly sypCopyConstant(poly inp)
630{
631  poly outp=NULL,q;
632
633  while (inp!=NULL)
634  {
635    if (pIsConstantComp(inp))
636    {
637      if (outp==NULL)
638      {
639        q = outp = pHead(inp);
640      }
641      else
642      {
643        pNext(q) = pHead(inp);
644        pIter(q);
645      }
646    }
647    pIter(inp);
648  }
649  return outp;
650}
651int syDetect(ideal id,int index,BOOLEAN homog,int * degrees,int * tocancel)
652{
653  int i, j, k, ModComp,subFromRank=0, lu;
654  poly p, q, qq, Unit1, Unit2;
655  ideal temp;
656
657  if (idIs0(id)) return 0;
658  temp = idInit(IDELEMS(id),id->rank);
659  for (i=0;i<IDELEMS(id);i++)
660  {
661    temp->m[i] = sypCopyConstant(id->m[i]);
662  }
663  i = IDELEMS(id);
664  while ((i>0) && (temp->m[i-1]==NULL)) i--;
665  if (i==0)
666  {
667    idDelete(&temp);
668    return 0;
669  }
670  j = 0;
671  p = NULL;
672  while ((j<i) && (temp->m[j]==NULL)) j++;
673  while (j<i)
674  {
675    if (homog)
676    {
677      k = pFDeg(id->m[j])+degrees[pGetComp(id->m[j])];
678      if (k>=index) tocancel[k-index]++;
679      if ((k>=0) && (index==0)) subFromRank++;
680    }
681    else
682    {
683      tocancel[0]--;
684    }
685    syGaussForOne(temp,j,pGetComp(temp->m[j]),j+1,i);
686    j++;
687    while ((j<i) && (temp->m[j]==NULL)) j++;
688  }
689  idDelete(&temp);
690  return subFromRank;
691}
692
693void syDetect(ideal id,int index,int rsmin, BOOLEAN homog,
694              intvec * degrees,intvec * tocancel)
695{
696  int * deg=NULL;
697  int * tocan=(int*) Alloc0(tocancel->length()*sizeof(int));
698  int i;
699
700  if (homog)
701  {
702    deg = (int*) Alloc0(degrees->length()*sizeof(int));
703    for (i=degrees->length();i>0;i--)
704      deg[i-1] = (*degrees)[i-1]-rsmin;
705  }
706  int dummy=syDetect(id,index,homog,deg,tocan);
707  for (i=tocancel->length();i>0;i--)
708    (*tocancel)[i-1] = tocan[i-1];
709  if (homog)
710    Free((ADDRESS)deg,degrees->length()*sizeof(int));
711  Free((ADDRESS)tocan,tocancel->length()*sizeof(int));
712}
713
714/*2
715* computes the betti numbers from a given resolution
716* of length 'length' (0..length-1), not necessairily minimal,
717* (if weights are given, they are used)
718* returns the int matrix of betti numbers
719* and the regularity
720*/
721intvec * syBetti(resolvente res,int length, int * regularity,
722                 intvec* weights,BOOLEAN tomin,int * row_shift)
723{
724//#define BETTI_WITH_ZEROS
725  //tomin = FALSE;
726  int i,j=0,k=0,l,rows,cols,mr;
727  int *temp1,*temp2,*temp3;/*used to compute degrees*/
728  int *tocancel; /*(BOOLEAN)tocancel[i]=element is superfluous*/
729  int r0_len;
730
731  /*------ compute size --------------*/
732  *regularity = -1;
733  cols = length;
734  while ((cols>0)
735  && ((res[cols-1]==NULL)
736    || (idIs0(res[cols-1]))))
737  {
738    cols--;
739  }
740  intvec * result;
741  if (idIs0(res[0]))
742  {
743    if (res[0]==NULL)
744      result = NewIntvec3(1,1,1);
745    else
746      result = NewIntvec3(1,1,res[0]->rank);
747    return result;
748  }
749  r0_len=IDELEMS(res[0]);
750  while ((r0_len>0) && (res[0]->m[r0_len-1]==NULL)) r0_len--;
751  intvec *w=NULL;
752  if (idHomModule(res[0],currQuotient,&w)!=isHomog)
753  {
754    Warn("betti-command: Input is not homogeneous!");
755  }
756  delete w;
757  int rkl=l = max(idRankFreeModule(res[0]),res[0]->rank);
758  i = 0;
759  while ((i<length) && (res[i]!=NULL))
760  {
761    if (IDELEMS(res[i])>l) l = IDELEMS(res[i]);
762    i++;
763  }
764  temp1 = (int*)Alloc0((l+1)*sizeof(int));
765  temp2 = (int*)Alloc((l+1)*sizeof(int));
766  rows = 1;
767  mr = 1;
768  cols++;
769  for (i=0;i<cols-1;i++)
770  {
771    if ((i==0) && (weights!=NULL)) pSetModDeg(weights);
772    memset(temp2,0,(l+1)*sizeof(int));
773    for (j=0;j<IDELEMS(res[i]);j++)
774    {
775      if (res[i]->m[j]!=NULL)
776      {
777        if ((pGetComp(res[i]->m[j])>l)
778        || ((i>1) && (res[i-1]->m[pGetComp(res[i]->m[j])-1]==NULL)))
779        {
780          WerrorS("input not a resolvent");
781          Free((ADDRESS)temp1,(l+1)*sizeof(int));
782          Free((ADDRESS)temp2,(l+1)*sizeof(int));
783          return NULL;
784        }
785        temp2[j+1] = pFDeg(res[i]->m[j])+temp1[pGetComp(res[i]->m[j])];
786        if (temp2[j+1]-i>rows) rows = temp2[j+1]-i;
787        if (temp2[j+1]-i<mr) mr = temp2[j+1]-i;
788      }
789    }
790    if ((i==0) && (weights!=NULL)) pSetModDeg(NULL);
791    temp3 = temp1;
792    temp1 = temp2;
793    temp2 = temp3;
794  }
795  mr--;
796  /*------ computation betti numbers --------------*/
797  rows -= mr;
798  result = NewIntvec3(rows,cols,0);
799  (*result)[(-mr)*cols] = /*idRankFreeModule(res[0])*/ rkl;
800  if ((!idIs0(res[0])) && ((*result)[(-mr)*cols]==0))
801    (*result)[(-mr)*cols] = 1;
802  tocancel = (int*)Alloc0((rows+1)*sizeof(int));
803  memset(temp2,0,l*sizeof(int));
804  memset(temp1,0,(l+1)*sizeof(int));
805  int dummy = syDetect(res[0],0,TRUE,temp2,tocancel);
806  if (tomin)
807    (*result)[(-mr)*cols] -= dummy;
808  for (i=0;i<cols-1;i++)
809  {
810    if ((i==0) && (weights!=NULL)) pSetModDeg(weights);
811    memset(temp2,0,l*sizeof(int));
812    for (j=0;j<IDELEMS(res[i]);j++)
813    {
814      if (res[i]->m[j]!=NULL)
815      {
816        temp2[j+1] = pFDeg(res[i]->m[j])+temp1[pGetComp(res[i]->m[j])];
817        //(*result)[i+1+(temp2[j+1]-i-1)*cols]++;
818        //if (temp2[j+1]>i) IMATELEM((*result),temp2[j+1]-i-mr,i+2)++;
819        IMATELEM((*result),temp2[j+1]-i-mr,i+2)++;
820      }
821      else if (i==0)
822      {
823        if (j<r0_len) IMATELEM((*result),-mr,2)++;
824      }
825    }
826  /*------ computation betti numbers, if res not minimal --------------*/
827    if (tomin)
828    {
829      for (j=mr;j<rows+mr;j++)
830      {
831        //(*result)[i+1+j*cols] -= tocancel[j+1];
832        IMATELEM((*result),j+1-mr,i+2) -= tocancel[j+1];
833      }
834      if ((i<length-1) && (res[i+1]!=NULL))
835      {
836        memset(tocancel,0,(rows+1)*sizeof(int));
837        dummy = syDetect(res[i+1],i+1,TRUE,temp2,tocancel);
838        for (j=0;j<rows;j++)
839        {
840          //(*result)[i+1+j*cols] -= tocancel[j];
841          IMATELEM((*result),j+1,i+2) -= tocancel[j];
842        }
843      }
844    }
845    temp3 = temp1;
846    temp1 = temp2;
847    temp2 = temp3;
848    for (j=0;j<rows;j++)
849    {
850    //  if (((*result)[i+1+j*cols]!=0) && (j>*regularity)) *regularity = j;
851      if ((IMATELEM((*result),j+1,i+2)!=0) && (j>*regularity)) *regularity = j;
852    }
853    if ((i==0) && (weights!=NULL)) pSetModDeg(NULL);
854  }
855  /*------ clean up --------------*/
856  Free((ADDRESS)tocancel,(rows+1)*sizeof(int));
857  Free((ADDRESS)temp1,(l+1)*sizeof(int));
858  Free((ADDRESS)temp2,(l+1)*sizeof(int));
859  if ((tomin) && (mr<0))  // deletes the first (zero) line
860  {
861    for (j=1;j<=rows+mr;j++)
862    {
863      for (k=1;k<=cols;k++)
864      {
865        IMATELEM((*result),j,k) = IMATELEM((*result),j-mr,k);
866      }
867    }
868    for (j=rows+mr+1;j<=rows;j++)
869    {
870      for (k=1;k<=cols;k++)
871      {
872        IMATELEM((*result),j,k) = 0;
873      }
874    }
875  }
876  j = 0;
877  k = 0;
878  for (i=0;i<rows*cols;i++)
879  {
880    if ((*result)[i] != 0)
881    {
882      if (i/cols>j) j = i/cols;
883      if (i>k+(i/cols)*cols) k = i-(i/cols)*cols;
884    }
885  }
886  intvec * exactresult=NewIntvec3(j+1,k+1,0);
887  for (i=0;i<exactresult->rows();i++)
888  {
889    for (j=0;j<exactresult->cols();j++)
890    {
891      IMATELEM(*exactresult,i+1,j+1) = IMATELEM(*result,i+1,j+1);
892    }
893  }
894  if (row_shift!=NULL) *row_shift = mr;
895  delete result;
896  return exactresult;
897}
898
899/*2
900* minbare via syzygies
901*/
902ideal syMinBase(ideal arg)
903{
904  intvec ** weights=NULL;
905  int leng;
906  if (idIs0(arg)) return idInit(1,arg->rank);
907  resolvente res=syResolvente(arg,1,&leng,&weights,TRUE);
908  ideal result=res[0];
909  Free((ADDRESS)res,leng*sizeof(ideal));
910  if (weights!=NULL)
911  {
912    if (*weights!=NULL)
913    {
914      delete (*weights);
915      *weights=NULL;
916    }
917    if ((leng>=1) && (*(weights+1)!=NULL))
918    {
919      delete *(weights+1);
920      *(weights+1)=NULL;
921    }
922  }
923  idSkipZeroes(result);
924  return result;
925}
926
927/*2
928* computes Betti-numbers from a resolvente of
929* (non-)homogeneous objects
930* the numbers of entrees !=NULL in res and weights must be equal
931* and < length
932*/
933intvec * syNewBetti(resolvente res, intvec ** weights, int length)
934{
935  intvec * result,*tocancel;
936  int i,j,k,rsmin=0,rsmax=0,rs=0;
937  BOOLEAN homog=TRUE;
938
939  if (weights!=NULL)           //---homogeneous Betti numbers
940  {
941/*--------------computes size of the field----------------------*/
942    for (i=1;i<length;i++)
943    {
944      if (weights[i] != NULL)
945      {
946        for (j=1;j<(weights[i])->length();j++)
947        {
948          if ((*(weights[i]))[j]-i<rsmin) rsmin = (*(weights[i]))[j]-i;
949          if ((*(weights[i]))[j]-i>rsmax) rsmax = (*(weights[i]))[j]-i;
950        }
951      }
952    }
953    i = 0;
954    while (weights[i] != NULL) i++;
955    i--;
956    for (j=0;j<IDELEMS(res[i]);j++)
957    {
958      if (res[i]->m[j]!=NULL)
959      {
960        k = pFDeg(res[i]->m[j])+(*(weights[i]))[pGetComp(res[i]->m[j])]-i-1;
961        if (k>rsmax) rsmax = k;
962        if (k<rsmin) rsmin = k;
963      }
964    }
965    for (j=1;j<(weights[0])->length();j++)
966    {
967      if ((*weights[0])[j]>rsmax) rsmax = (*weights[0])[j];
968      if ((*weights[0])[j]<rsmin) rsmin = (*weights[0])[j];
969    }
970//Print("rsmax = %d\n",rsmax);
971//Print("rsmin = %d\n",rsmin);
972    rs = rsmax-rsmin+1;
973    result = NewIntvec3(rs,i+2,0);
974    tocancel = NewIntvec1(rs);
975/*-----------enter the Betti numbers-------------------------------*/
976    if (/*idRankFreeModule(res[0])*/ res[0]->rank==0)
977    {
978      IMATELEM(*result,1-rsmin,1)=1;
979    }
980    else
981    {
982      for (i=1;i<(weights[0])->length();i++)
983        IMATELEM(*result,(*weights[0])[i]+1-rsmin,1)++;
984    }
985    i = 1;
986    while (weights[i]!=NULL)
987    {
988      for (j=1;j<(weights[i])->length();j++)
989      {
990        IMATELEM(*result,(*(weights[i]))[j]-i+1-rsmin,i+1)++;
991      }
992      i++;
993    }
994    i--;
995    for (j=0;j<IDELEMS(res[i]);j++)
996    {
997      if (res[i]->m[j]!=NULL)
998      {
999        k = pFDeg(res[i]->m[j])+(*(weights[i]))[pGetComp(res[i]->m[j])]-i;
1000        IMATELEM(*result,k-rsmin,i+2)++;
1001      }
1002    }
1003  }
1004  else                //-----the non-homgeneous case
1005  {
1006    homog = FALSE;
1007    tocancel = NewIntvec1(1);
1008    k = length;
1009    while ((k>0) && (idIs0(res[k-1]))) k--;
1010    result = NewIntvec3(1,k+1,0);
1011    (*result)[0] = res[0]->rank;
1012    for (i=0;i<length;i++)
1013    {
1014      if (res[i]!=NULL)
1015      {
1016        for (j=0;j<IDELEMS(res[i]);j++)
1017        {
1018          if (res[i]->m[j]!=NULL) (*result)[i+1]++;
1019        }
1020      }
1021    }
1022  }
1023/*--------computes the Betti numbers for the minimized reolvente----*/
1024
1025  i = 1;
1026  while ((res[i]!=NULL) && (weights[i]!=NULL))
1027  {
1028    syDetect(res[i],i,rsmin,homog,weights[i],tocancel);
1029    if (homog)
1030    {
1031      for (j=0;j<rs-1;j++)
1032      {
1033        IMATELEM((*result),j+1,i+1) -= (*tocancel)[j];
1034        IMATELEM((*result),j+1,i+2) -= (*tocancel)[j+1];
1035      }
1036      IMATELEM((*result),rs,i+1) -= (*tocancel)[rs-1];
1037    }
1038    else
1039    {
1040      (*result)[i+1] -= (*tocancel)[0];
1041      (*result)[i+2] -= (*tocancel)[0];
1042    }
1043    i++;
1044  }
1045
1046/*--------print Betti numbers for control---------------------------*/
1047  for(i=rsmin;i<=rsmax;i++)
1048  {
1049    Print("%2d:",i);
1050    for(j=1;j<=result->cols();j++)
1051    {
1052      Print(" %5d",IMATELEM(*result,i-rsmin+1,j));
1053    }
1054    PrintLn();
1055  }
1056  return result;
1057}
1058
1059/*2
1060* is looking for the minimal minimized module of a resolvente
1061* i.e. returns 0 if res comes from a mres-command and 1 in the
1062* case of res-commands
1063*/
1064int syIsMinimizedFrom(resolvente res,int length)
1065{
1066  poly p;
1067  int i,j=length;
1068
1069  while ((j>0) && (res[j-1]==NULL)) j--;
1070  while (j>0)
1071  {
1072    for (i=0;i<IDELEMS(res[j-1]);i++)
1073    {
1074      p = res[j-1]->m[i];
1075      while (p!=NULL)
1076      {
1077        if (pIsConstantComp(p)) return j;
1078        p = pNext(p);
1079      }
1080    }
1081    j--;
1082  }
1083  return j;
1084}
Note: See TracBrowser for help on using the repository browser.