source: git/kernel/combinatorics/hilb.cc @ a4771e1

spielwiese
Last change on this file since a4771e1 was a4771e1, checked in by Oleksandr Motsak <motsak@…>, 9 years ago
Separation of hilbert function into kernel/combinatorics/hilb.h + include cleanup
  • Property mode set to 100644
File size: 30.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5*  ABSTRACT -  Hilbert series
6*/
7
8#include <kernel/mod2.h>
9
10#include <omalloc/omalloc.h>
11#include <misc/auxiliary.h>
12#include <misc/mylimits.h>
13#include <misc/intvec.h>
14
15#include <kernel/combinatorics/hilb.h>
16#include <kernel/combinatorics/stairc.h>
17#include <kernel/combinatorics/hutil.h>
18
19#include <polys/monomials/ring.h>
20#include <polys/monomials/p_polys.h>
21#include <polys/simpleideals.h>
22
23
24// #include <kernel/structs.h>
25// #include <kernel/polys.h>
26//ADICHANGES:
27#include <kernel/ideals.h>
28// #include <kernel/GBEngine/kstd1.h>
29// #include<gmp.h>
30// #include<vector>
31
32
33static int  **Qpol;
34static int  *Q0, *Ql;
35static int  hLength;
36   
37
38static int hMinModulweight(intvec *modulweight)
39{
40  int i,j,k;
41
42  if(modulweight==NULL) return 0;
43  j=(*modulweight)[0];
44  for(i=modulweight->rows()-1;i!=0;i--)
45  {
46    k=(*modulweight)[i];
47    if(k<j) j=k;
48  }
49  return j;
50}
51
52static void hHilbEst(scfmon stc, int Nstc, varset var, int Nvar)
53{
54  int  i, j;
55  int  x, y, z = 1;
56  int  *p;
57  for (i = Nvar; i>0; i--)
58  {
59    x = 0;
60    for (j = 0; j < Nstc; j++)
61    {
62      y = stc[j][var[i]];
63      if (y > x)
64        x = y;
65    }
66    z += x;
67    j = i - 1;
68    if (z > Ql[j])
69    {
70      if (z>(MAX_INT_VAL)/2)
71      {
72       Werror("interal arrays too big");
73       return;
74      }
75      p = (int *)omAlloc((unsigned long)z * sizeof(int));
76      if (Ql[j]!=0)
77      {
78        if (j==0)
79          memcpy(p, Qpol[j], Ql[j] * sizeof(int));
80        omFreeSize((ADDRESS)Qpol[j], Ql[j] * sizeof(int));
81      }
82      if (j==0)
83      {
84        for (x = Ql[j]; x < z; x++)
85          p[x] = 0;
86      }
87      Ql[j] = z;
88      Qpol[j] = p;
89    }
90  }
91}
92
93static int  *hAddHilb(int Nv, int x, int *pol, int *lp)
94{
95  int  l = *lp, ln, i;
96  int  *pon;
97  *lp = ln = l + x;
98  pon = Qpol[Nv];
99  memcpy(pon, pol, l * sizeof(int));
100  if (l > x)
101  {
102    for (i = x; i < l; i++)
103      pon[i] -= pol[i - x];
104    for (i = l; i < ln; i++)
105      pon[i] = -pol[i - x];
106  }
107  else
108  {
109    for (i = l; i < x; i++)
110      pon[i] = 0;
111    for (i = x; i < ln; i++)
112      pon[i] = -pol[i - x];
113  }
114  return pon;
115}
116
117static void hLastHilb(scmon pure, int Nv, varset var, int *pol, int lp)
118{
119  int  l = lp, x, i, j;
120  int  *p, *pl;
121  p = pol;
122  for (i = Nv; i>0; i--)
123  {
124    x = pure[var[i + 1]];
125    if (x!=0)
126      p = hAddHilb(i, x, p, &l);
127  }
128  pl = *Qpol;
129  j = Q0[Nv + 1];
130  for (i = 0; i < l; i++)
131    pl[i + j] += p[i];
132  x = pure[var[1]];
133  if (x!=0)
134  {
135    j += x;
136    for (i = 0; i < l; i++)
137      pl[i + j] -= p[i];
138  }
139  j += l;
140  if (j > hLength)
141    hLength = j;
142}
143
144static void hHilbStep(scmon pure, scfmon stc, int Nstc, varset var,
145 int Nvar, int *pol, int Lpol)
146{
147  int  iv = Nvar -1, ln, a, a0, a1, b, i;
148  int  x, x0;
149  scmon pn;
150  scfmon sn;
151  int  *pon;
152  if (Nstc==0)
153  {
154    hLastHilb(pure, iv, var, pol, Lpol);
155    return;
156  }
157  x = a = 0;
158  pn = hGetpure(pure);
159  sn = hGetmem(Nstc, stc, stcmem[iv]);
160  hStepS(sn, Nstc, var, Nvar, &a, &x);
161  Q0[iv] = Q0[Nvar];
162  ln = Lpol;
163  pon = pol;
164  if (a == Nstc)
165  {
166    x = pure[var[Nvar]];
167    if (x!=0)
168      pon = hAddHilb(iv, x, pon, &ln);
169    hHilbStep(pn, sn, a, var, iv, pon, ln);
170    return;
171  }
172  else
173  {
174    pon = hAddHilb(iv, x, pon, &ln);
175    hHilbStep(pn, sn, a, var, iv, pon, ln);
176  }
177  b = a;
178  x0 = 0;
179  loop
180  {
181    Q0[iv] += (x - x0);
182    a0 = a;
183    x0 = x;
184    hStepS(sn, Nstc, var, Nvar, &a, &x);
185    hElimS(sn, &b, a0, a, var, iv);
186    a1 = a;
187    hPure(sn, a0, &a1, var, iv, pn, &i);
188    hLex2S(sn, b, a0, a1, var, iv, hwork);
189    b += (a1 - a0);
190    ln = Lpol;
191    if (a < Nstc)
192    {
193      pon = hAddHilb(iv, x - x0, pol, &ln);
194      hHilbStep(pn, sn, b, var, iv, pon, ln);
195    }
196    else
197    {
198      x = pure[var[Nvar]];
199      if (x!=0)
200        pon = hAddHilb(iv, x - x0, pol, &ln);
201      else
202        pon = pol;
203      hHilbStep(pn, sn, b, var, iv, pon, ln);
204      return;
205    }
206  }
207}
208
209/*
210*basic routines
211*/
212static void hWDegree(intvec *wdegree)
213{
214  int i, k;
215  int x;
216
217  for (i=(currRing->N); i; i--)
218  {
219    x = (*wdegree)[i-1];
220    if (x != 1)
221    {
222      for (k=hNexist-1; k>=0; k--)
223      {
224        hexist[k][i] *= x;
225      }
226    }
227  }
228}
229// ---------------------------------- ADICHANGES ---------------------------------------------
230//!!!!!!!!!!!!!!!!!!!!! Just for Monomial Ideals !!!!!!!!!!!!!!!!!!!!!!!!!!!!
231
232//returns the degree of the monomial
233static int DegMon(poly p)
234{
235    #if 1
236    int i,deg;
237    deg = 0;
238    for(i=1;i<=currRing->N;i++)
239    {
240        deg = deg + p_GetExp(p, i, currRing);
241    }
242    return(deg);
243    #else
244    return(p_Deg(p, currRing));
245    #endif
246}
247
248//Tests if the ideal is sorted by degree
249static bool idDegSortTest(ideal I)
250{
251    if((I == NULL)||(idIs0(I)))
252    {
253        return(TRUE);
254    }
255    for(int i = 0; i<IDELEMS(I)-1; i++)
256    {
257        if(DegMon(I->m[i])>DegMon(I->m[i+1]))
258        {
259            idPrint(I);
260            Werror("Ideal is not deg sorted!!");
261            return(FALSE);
262        }
263    }
264    return(TRUE);
265}
266
267//adds the new polynomial at the coresponding position
268//and simplifies the ideal
269static ideal SortByDeg_p(ideal I, poly p)
270{
271    int i,j;
272    if((I == NULL) || (idIs0(I)))
273    {
274        ideal res = idInit(1,1);
275        res->m[0] = p;
276        return(res);
277    }
278    idSkipZeroes(I);
279    #if 1
280    for(i = 0; (i<IDELEMS(I)) && (DegMon(I->m[i])<=DegMon(p)); i++)
281    {
282        if(p_DivisibleBy( I->m[i],p, currRing))
283        {
284            return(I);
285        }
286    }
287    for(i = IDELEMS(I)-1; (i>=0) && (DegMon(I->m[i])>=DegMon(p)); i--)
288    {
289        if(p_DivisibleBy(p,I->m[i], currRing))
290        {
291            I->m[i] = NULL;
292        }
293    }
294    if(idIs0(I))
295    {
296        idSkipZeroes(I);
297        I->m[0] = p;
298        return(I);
299    }
300    #endif
301    idSkipZeroes(I);
302    //First I take the case when all generators have the same degree
303    if(DegMon(I->m[0]) == DegMon(I->m[IDELEMS(I)-1]))
304    {
305        if(DegMon(p)<DegMon(I->m[0]))
306        {
307            idInsertPoly(I,p);
308            idSkipZeroes(I);
309            for(i=IDELEMS(I)-1;i>=1; i--)
310            {
311                I->m[i] = I->m[i-1];
312            }
313            I->m[0] = p;
314            return(I);
315        }
316        if(DegMon(p)>=DegMon(I->m[IDELEMS(I)-1]))
317        {
318            idInsertPoly(I,p);
319            idSkipZeroes(I);
320            return(I);
321        }
322    }
323    if(DegMon(p)<=DegMon(I->m[0]))
324    {
325        idInsertPoly(I,p);
326        idSkipZeroes(I);
327        for(i=IDELEMS(I)-1;i>=1; i--)
328        {
329            I->m[i] = I->m[i-1];
330        }
331        I->m[0] = p;
332        return(I);
333    }
334    if(DegMon(p)>=DegMon(I->m[IDELEMS(I)-1]))
335    {
336        idInsertPoly(I,p);
337        idSkipZeroes(I);
338        return(I);
339    }
340    for(i = IDELEMS(I)-2; ;)
341    {
342        if(DegMon(p)==DegMon(I->m[i]))
343        {
344            idInsertPoly(I,p);
345            idSkipZeroes(I);
346            for(j = IDELEMS(I)-1; j>=i+1;j--)
347            {
348                I->m[j] = I->m[j-1];
349            }
350            I->m[i] = p;
351            return(I);
352        }
353        if(DegMon(p)>DegMon(I->m[i]))
354        {
355            idInsertPoly(I,p);
356            idSkipZeroes(I);
357            for(j = IDELEMS(I)-1; j>=i+2;j--)
358            {
359                I->m[j] = I->m[j-1];
360            }
361            I->m[i+1] = p;
362            return(I);
363        }
364        i--;
365    }
366}
367
368//it sorts the ideal by the degrees
369static ideal SortByDeg(ideal I)
370{
371    if(idIs0(I))
372    {
373        return(I);
374    }
375    idSkipZeroes(I);
376    int i;
377    ideal res;
378    idSkipZeroes(I);
379    res = idInit(1,1);
380    res->m[0] = poly(0);
381    for(i = 0; i<=IDELEMS(I)-1;i++)
382    {
383        res = SortByDeg_p(res, I->m[i]);
384    }
385    idSkipZeroes(res);
386    //idDegSortTest(res);
387    return(res);
388}
389
390//idQuot(I,p) for I monomial ideal, p a ideal with a single monomial.
391ideal idQuotMon(ideal Iorig, ideal p)
392{
393    if(idIs0(Iorig))
394    {
395        ideal res = idInit(1,1);
396        res->m[0] = poly(0);
397        return(res);
398    }
399    if(idIs0(p))
400    {
401        ideal res = idInit(1,1);
402        res->m[0] = pOne();
403        return(res);
404    }
405    ideal I = idCopy(Iorig);
406    ideal res = idInit(IDELEMS(I),1);
407    int i,j;
408    int dummy;
409    for(i = 0; i<IDELEMS(I); i++)
410    {
411        res->m[i] = p_Copy(I->m[i], currRing);
412        for(j = 1; (j<=currRing->N) ; j++)
413        {
414            dummy = p_GetExp(p->m[0], j, currRing);
415            if(dummy > 0)
416            {
417                if(p_GetExp(I->m[i], j, currRing) < dummy)
418                {
419                    p_SetExp(res->m[i], j, 0, currRing);
420                }
421                else
422                {
423                    p_SetExp(res->m[i], j, p_GetExp(I->m[i], j, currRing) - dummy, currRing);
424                }
425            }
426        }
427        p_Setm(res->m[i], currRing);
428        if(DegMon(res->m[i]) == DegMon(I->m[i]))
429        {
430            res->m[i] = NULL;
431        }
432        else
433        {
434            I->m[i] = NULL;
435        }
436    }
437    idSkipZeroes(res);
438    idSkipZeroes(I);
439    if(!idIs0(res))
440    {
441    for(i = 0; i<=IDELEMS(res)-1; i++)
442    {
443        I = SortByDeg_p(I,res->m[i]);
444    }
445    }
446    //idDegSortTest(I);
447    return(I);
448}
449
450//id_Add for monomials
451static ideal idAddMon(ideal I, ideal p)
452{
453    #if 1
454    I = SortByDeg_p(I,p->m[0]);
455    #else
456    I = id_Add(I,p,currRing);
457    #endif
458    //idSkipZeroes(I);
459    return(I);
460}
461
462//searches for a variable that is not yet used (assumes that the ideal is sqrfree)
463static poly ChoosePVar (ideal I)
464{
465    bool flag=TRUE;
466    int i,j;
467    poly res;
468    for(i=1;i<=currRing->N;i++)
469    {
470        flag=TRUE;
471        for(j=IDELEMS(I)-1;(j>=0)&&(flag);j--)
472        {
473            if(p_GetExp(I->m[j], i, currRing)>0)
474            {
475                flag=FALSE;
476            }
477        }
478       
479        if(flag == TRUE)
480        {
481            res = p_ISet(1, currRing);
482            p_SetExp(res, i, 1, currRing);
483            p_Setm(res,currRing);
484            return(res);
485        }
486        else
487        {
488            p_Delete(&res, currRing);
489        }
490    }
491    return(NULL); //i.e. it is the maximal ideal
492}
493
494//choice XL: last entry divided by x (xy10z15 -> y9z14)
495static poly ChoosePXL(ideal I)
496{
497    int i,j,dummy=0;
498    poly m;
499    for(i = IDELEMS(I)-1; (i>=0) && (dummy == 0); i--)
500    {
501        for(j = 1; (j<=currRing->N) && (dummy == 0); j++)
502        {
503            if(p_GetExp(I->m[i],j, currRing)>1)
504            {
505                dummy = 1;
506            }
507        }
508    }
509    m = p_Copy(I->m[i+1],currRing);
510    for(j = 1; j<=currRing->N; j++)
511    {
512        dummy = p_GetExp(m,j,currRing);
513        if(dummy >= 1)
514        {
515            p_SetExp(m, j, dummy-1, currRing);
516        }
517    }
518    if(!p_IsOne(m, currRing))
519    {
520        p_Setm(m, currRing);
521        return(m);
522    }
523    m = ChoosePVar(I);
524    return(m);
525}
526
527//choice XF: first entry divided by x (xy10z15 -> y9z14)
528static poly ChoosePXF(ideal I)
529{
530    int i,j,dummy=0;
531    poly m;
532    for(i =0 ; (i<=IDELEMS(I)-1) && (dummy == 0); i++)
533    {
534        for(j = 1; (j<=currRing->N) && (dummy == 0); j++)
535        {
536            if(p_GetExp(I->m[i],j, currRing)>1)
537            {
538                dummy = 1;
539            }
540        }
541    }
542    m = p_Copy(I->m[i-1],currRing);
543    for(j = 1; j<=currRing->N; j++)
544    {
545        dummy = p_GetExp(m,j,currRing);
546        if(dummy >= 1)
547        {
548            p_SetExp(m, j, dummy-1, currRing);
549        }
550    }
551    if(!p_IsOne(m, currRing))
552    {
553        p_Setm(m, currRing);
554        return(m);
555    }
556    m = ChoosePVar(I);
557    return(m);
558}
559
560//choice OL: last entry the first power (xy10z15 -> xy9z15)
561static poly ChoosePOL(ideal I)
562{
563    int i,j,dummy;
564    poly m;
565    for(i = IDELEMS(I)-1;i>=0;i--)
566    {
567        m = p_Copy(I->m[i],currRing);
568        for(j=1;j<=currRing->N;j++)
569        {
570            dummy = p_GetExp(m,j,currRing);
571            if(dummy > 0)
572            {
573                p_SetExp(m,j,dummy-1,currRing);
574                p_Setm(m,currRing);
575            }       
576        }
577        if(!p_IsOne(m, currRing))
578        {
579            return(m);
580        }
581        else
582        {
583            p_Delete(&m,currRing);
584        }
585    }
586    m = ChoosePVar(I);
587    return(m);
588}
589
590//choice OF: first entry the first power (xy10z15 -> xy9z15)
591static poly ChoosePOF(ideal I)
592{
593    int i,j,dummy;
594    poly m;
595    for(i = 0 ;i<=IDELEMS(I)-1;i++)
596    {
597        m = p_Copy(I->m[i],currRing);
598        for(j=1;j<=currRing->N;j++)
599        {
600            dummy = p_GetExp(m,j,currRing);
601            if(dummy > 0)
602            {
603                p_SetExp(m,j,dummy-1,currRing);
604                p_Setm(m,currRing);
605            }       
606        }
607        if(!p_IsOne(m, currRing))
608        {
609            return(m);
610        }
611        else
612        {
613            p_Delete(&m,currRing);
614        }
615    }
616    m = ChoosePVar(I);
617    return(m);
618}
619
620//choice VL: last entry the first variable with power (xy10z15 -> y)
621static poly ChoosePVL(ideal I)
622{
623    int i,j,dummy;
624    bool flag = TRUE;
625    poly m = p_ISet(1,currRing);
626    for(i = IDELEMS(I)-1;(i>=0) && (flag);i--)
627    {
628        flag = TRUE;
629        for(j=1;(j<=currRing->N) && (flag);j++)
630        {
631            dummy = p_GetExp(I->m[i],j,currRing);
632            if(dummy >= 2)
633            {
634                p_SetExp(m,j,1,currRing);
635                p_Setm(m,currRing);
636                flag = FALSE;
637            }       
638        }
639        if(!p_IsOne(m, currRing))
640        {
641            return(m);
642        }
643    }
644    m = ChoosePVar(I);
645    return(m);
646}
647
648//choice VF: first entry the first variable with power (xy10z15 -> y)
649static poly ChoosePVF(ideal I)
650{
651    int i,j,dummy;
652    bool flag = TRUE;
653    poly m = p_ISet(1,currRing);
654    for(i = 0;(i<=IDELEMS(I)-1) && (flag);i++)
655    {
656        flag = TRUE;
657        for(j=1;(j<=currRing->N) && (flag);j++)
658        {
659            dummy = p_GetExp(I->m[i],j,currRing);
660            if(dummy >= 2)
661            {
662                p_SetExp(m,j,1,currRing);
663                p_Setm(m,currRing);
664                flag = FALSE;
665            }       
666        }
667        if(!p_IsOne(m, currRing))
668        {
669            return(m);
670        }
671    }
672    m = ChoosePVar(I);
673    return(m);
674}
675
676//choice JL: last entry just variable with power (xy10z15 -> y10)
677static poly ChoosePJL(ideal I)
678{
679    int i,j,dummy;
680    bool flag = TRUE;
681    poly m = p_ISet(1,currRing);
682    for(i = IDELEMS(I)-1;(i>=0) && (flag);i--)
683    {
684        flag = TRUE;
685        for(j=1;(j<=currRing->N) && (flag);j++)
686        {
687            dummy = p_GetExp(I->m[i],j,currRing);
688            if(dummy >= 2)
689            {
690                p_SetExp(m,j,dummy-1,currRing);
691                p_Setm(m,currRing);
692                flag = FALSE;
693            }       
694        }
695        if(!p_IsOne(m, currRing))
696        {
697            return(m);
698        }
699    }
700    m = ChoosePVar(I);
701    return(m);
702}
703
704//choice JF: last entry just variable with power -1 (xy10z15 -> y9)
705static poly ChoosePJF(ideal I)
706{
707    int i,j,dummy;
708    bool flag = TRUE;
709    poly m = p_ISet(1,currRing);
710    for(i = 0;(i<=IDELEMS(I)-1) && (flag);i++)
711    {
712        flag = TRUE;
713        for(j=1;(j<=currRing->N) && (flag);j++)
714        {
715            dummy = p_GetExp(I->m[i],j,currRing);
716            if(dummy >= 2)
717            {
718                p_SetExp(m,j,dummy-1,currRing);
719                p_Setm(m,currRing);
720                flag = FALSE;
721            }       
722        }
723        if(!p_IsOne(m, currRing))
724        {
725            return(m);
726        }
727    }
728    m = ChoosePVar(I);
729    return(m);
730}
731
732//chooses 1 \neq p \not\in S. This choice should be made optimal
733static poly ChooseP(ideal I)
734{
735    poly m;
736    //  TEST TO SEE WHICH ONE IS BETTER
737    //m = ChoosePXL(I);
738    //m = ChoosePXF(I);
739    //m = ChoosePOL(I);
740    //m = ChoosePOF(I);
741    //m = ChoosePVL(I);
742    //m = ChoosePVF(I);
743    m = ChoosePJL(I);
744    //m = ChoosePJF(I);
745    return(m);
746}
747
748///searches for a monomial of degree d>=2 and divides it by a variable (result monomial of deg d-1)
749static poly SearchP(ideal I)
750{
751    int i,j,exp;
752    poly res;
753    if(DegMon(I->m[IDELEMS(I)-1])<=1)
754    {
755        res = ChoosePVar(I);
756        return(res);
757    }
758    i = IDELEMS(I)-1;
759    res = p_Copy(I->m[i], currRing);
760    for(j=1;j<=currRing->N;j++)
761    {
762        exp = p_GetExp(I->m[i], j, currRing);
763        if(exp > 0)
764        {
765            p_SetExp(res, j, exp - 1, currRing);
766            p_Setm(res,currRing);
767            break;
768        }
769    }
770    assume( j <= currRing->N );
771    return(res);
772}
773
774//test if the ideal is of the form (x1, ..., xr)
775static bool JustVar(ideal I)
776{
777    #if 0
778    int i,j;
779    bool foundone;
780    for(i=0;i<=IDELEMS(I)-1;i++)
781    {
782        foundone = FALSE;
783        for(j = 1;j<=currRing->N;j++)
784        {
785            if(p_GetExp(I->m[i], j, currRing)>0)
786            {
787                if(foundone == TRUE)
788                {
789                    return(FALSE);
790                }
791                foundone = TRUE;
792            }
793        }       
794    }
795    return(TRUE);
796    #else
797    if(DegMon(I->m[IDELEMS(I)-1])>1)
798    {
799        return(FALSE);
800    }
801    return(TRUE);
802    #endif
803}
804
805//computes the Euler Characteristic of the ideal
806static void eulerchar (ideal I, int variables, mpz_ptr ec)
807{
808  loop
809  {
810    mpz_t dummy;
811    if(JustVar(I) == TRUE)
812    {
813        if(IDELEMS(I) == variables)
814        {
815            mpz_init(dummy);
816            if((variables % 2) == 0)
817                {mpz_set_si(dummy, 1);}
818            else
819                {mpz_set_si(dummy, -1);}
820            mpz_add(ec, ec, dummy);
821        }
822        //mpz_clear(dummy);
823        return;       
824    }
825    ideal p = idInit(1,1);
826    p->m[0] = SearchP(I);
827    //idPrint(I);
828    //idPrint(p);
829    //printf("\nNow get in idQuotMon\n");
830    ideal Ip = idQuotMon(I,p);
831    //idPrint(Ip);
832    //Ip = SortByDeg(Ip);
833    int i,howmanyvarinp = 0;
834    for(i = 1;i<=currRing->N;i++)
835    {
836        if(p_GetExp(p->m[0],i,currRing)>0)
837        {
838            howmanyvarinp++;
839        }
840    }   
841    eulerchar(Ip, variables-howmanyvarinp, ec);
842    id_Delete(&Ip, currRing);
843    I = idAddMon(I,p);
844  }
845}
846
847//tests if an ideal is Square Free, if no, returns the variable which appears at powers >1
848static poly SqFree (ideal I)
849{
850    int i,j;
851    bool flag=TRUE;
852    poly notsqrfree = NULL;
853    if(DegMon(I->m[IDELEMS(I)-1])<=1)
854    {
855        return(notsqrfree);
856    }
857    for(i=IDELEMS(I)-1;(i>=0)&&(flag);i--)
858    {
859        for(j=1;(j<=currRing->N)&&(flag);j++)
860        {
861            if(p_GetExp(I->m[i],j,currRing)>1)
862            {
863                flag=FALSE;
864                notsqrfree = p_ISet(1,currRing);
865                p_SetExp(notsqrfree,j,1,currRing);
866            }
867        }
868    }
869    if(notsqrfree != NULL)
870    {
871        p_Setm(notsqrfree,currRing);
872    }
873    return(notsqrfree);
874}
875
876//checks if a polynomial is in I
877static bool IsIn(poly p, ideal I)
878{
879    //assumes that I is ordered by degree
880    if(idIs0(I))
881    {
882        if(p==poly(0))
883        {
884            return(TRUE);
885        }
886        else
887        {
888            return(FALSE);
889        }
890    }
891    if(p==poly(0))
892    {
893        return(FALSE);
894    }
895    int i,j;
896    bool flag;
897    for(i = 0;i<IDELEMS(I);i++)
898    {
899        flag = TRUE;
900        for(j = 1;(j<=currRing->N) &&(flag);j++)
901        {
902            if(p_GetExp(p, j, currRing)<p_GetExp(I->m[i], j, currRing))
903            {
904                flag = FALSE;
905            }
906        }
907        if(flag)
908        {
909            return(TRUE);
910        }
911    }
912    return(FALSE);
913}
914
915//computes the lcm of min I, I monomial ideal
916static poly LCMmon(ideal I)
917{
918    if(idIs0(I))
919    {
920        return(NULL);
921    }
922    poly m;
923    int dummy,i,j;
924    m = p_ISet(1,currRing);
925    for(i=1;i<=currRing->N;i++)
926    {
927        dummy=0;
928        for(j=IDELEMS(I)-1;j>=0;j--)
929        {
930            if(p_GetExp(I->m[j],i,currRing) > dummy)
931            {
932                dummy = p_GetExp(I->m[j],i,currRing);
933            }
934        }
935        p_SetExp(m,i,dummy,currRing);
936    }
937    p_Setm(m,currRing);
938    return(m);
939}
940
941//the Roune Slice Algorithm
942void rouneslice(ideal I, ideal S, poly q, poly x, int &prune, int &moreprune, int &steps, int &NNN, mpz_ptr &hilbertcoef, int* &hilbpower)
943{
944  loop
945  {
946    (steps)++;
947    int i,j;
948    int dummy;
949    poly m;
950    ideal p, koszsimp;
951    //----------- PRUNING OF S ---------------
952    //S SHOULD IN THIS POINT BE ORDERED BY DEGREE
953    for(i=IDELEMS(S)-1;i>=0;i--)
954    {
955        if(IsIn(S->m[i],I))
956        {
957            S->m[i]=NULL;
958            prune++;
959        }
960    }
961    idSkipZeroes(S);
962    //----------------------------------------
963    for(i=IDELEMS(I)-1;i>=0;i--)
964    {
965        m = p_Copy(I->m[i],currRing);
966        for(j=1;j<=currRing->N;j++)
967        {
968            dummy = p_GetExp(m,j,currRing);
969            if(dummy > 0)
970            {
971                p_SetExp(m,j,dummy-1,currRing);
972            }       
973        }
974        p_Setm(m, currRing);
975        if(IsIn(m,S))
976        {
977            I->m[i]=NULL;
978            //printf("\n Deleted, since pi(m) is in S\n");pWrite(m);
979        }
980    }
981    idSkipZeroes(I);
982    //----------- MORE PRUNING OF S ------------
983    m = LCMmon(I); 
984    if(m != NULL)
985    {
986        for(i=0;i<IDELEMS(S);i++)
987        {     
988            if(!(p_DivisibleBy(S->m[i], m, currRing))) 
989            {
990                S->m[i] = NULL;
991                j++;
992                moreprune++;
993            }
994            else
995            {
996                if(pLmEqual(S->m[i],m))
997                {
998                    S->m[i] = NULL;
999                    moreprune++;
1000                }
1001            }
1002        }
1003    idSkipZeroes(S);
1004    }
1005    /*printf("\n---------------------------\n");
1006    printf("\n      I\n");idPrint(I);
1007    printf("\n      S\n");idPrint(S);
1008    printf("\n      q\n");pWrite(q);
1009    getchar();*/
1010   
1011    if(idIs0(I))
1012    {
1013        id_Delete(&I, currRing);
1014        id_Delete(&S, currRing);
1015        p_Delete(&m, currRing);
1016        break;
1017    }
1018    m = LCMmon(I);
1019    if(!p_DivisibleBy(x,m, currRing))
1020    {
1021        //printf("\nx does not divide lcm(I)");
1022        //printf("\nEmpty set");pWrite(q);
1023        id_Delete(&I, currRing);
1024        id_Delete(&S, currRing);
1025        p_Delete(&m, currRing);
1026        break;
1027    }
1028    m = SqFree(I);
1029    if(m==NULL)
1030    {
1031        //printf("\n      Corner: ");
1032        //pWrite(q);
1033        //printf("\n      With the facets of the dual simplex:\n");
1034        //idPrint(I);
1035        mpz_t ec;
1036        mpz_init(ec);
1037        mpz_ptr ec_ptr = ec;
1038        eulerchar(I, currRing->N, ec_ptr);
1039        bool flag = FALSE;
1040        if(NNN==0)
1041            {
1042                hilbertcoef = (mpz_ptr)omAlloc((NNN+1)*sizeof(mpz_t));
1043                hilbpower = (int*)omAlloc((NNN+1)*sizeof(int));
1044                mpz_init( &hilbertcoef[NNN]);
1045                mpz_set(  &hilbertcoef[NNN], ec);
1046                mpz_clear(ec);
1047                hilbpower[NNN] = DegMon(q);
1048                NNN++;
1049            }
1050        else
1051        {
1052            //I look if the power appears already
1053            for(i = 0;(i<NNN)&&(flag == FALSE)&&(DegMon(q)>=hilbpower[i]);i++)
1054            {
1055                if((hilbpower[i]) == (DegMon(q)))
1056                {
1057                    flag = TRUE;
1058                    mpz_add(&hilbertcoef[i],&hilbertcoef[i],ec_ptr);
1059                }
1060            }
1061            if(flag == FALSE)
1062            {
1063                hilbertcoef = (mpz_ptr)omRealloc(hilbertcoef, (NNN+1)*sizeof(mpz_t));
1064                hilbpower = (int*)omRealloc(hilbpower, (NNN+1)*sizeof(int));
1065                mpz_init(&hilbertcoef[NNN]);
1066                for(j = NNN; j>i; j--)
1067                {
1068                    mpz_set(&hilbertcoef[j],&hilbertcoef[j-1]);
1069                    hilbpower[j] = hilbpower[j-1];
1070                }
1071                mpz_set(  &hilbertcoef[i], ec);
1072                mpz_clear(ec);
1073                hilbpower[i] = DegMon(q);
1074                NNN++;
1075            }
1076        }
1077        break;
1078    }
1079    m = ChooseP(I);
1080    p = idInit(1,1);
1081    p->m[0] = m;
1082    ideal Ip = idQuotMon(I,p);
1083    ideal Sp = idQuotMon(S,p);
1084    poly pq = pp_Mult_mm(q,m,currRing);
1085    rouneslice(Ip, Sp, pq, x, prune, moreprune, steps, NNN, hilbertcoef,hilbpower);
1086    //id_Delete(&Ip, currRing);
1087    //id_Delete(&Sp, currRing);
1088    S = idAddMon(S,p);
1089    p->m[0]=NULL; 
1090    id_Delete(&p, currRing); // p->m[0] was also in S
1091    p_Delete(&pq,currRing);
1092  }
1093}
1094
1095//it computes the first hilbert series by means of Roune Slice Algorithm
1096void slicehilb(ideal I)
1097{
1098    //printf("Adi changes are here: \n");
1099    int i, NNN = 0;
1100    int steps = 0, prune = 0, moreprune = 0;
1101    mpz_ptr hilbertcoef;
1102    int *hilbpower;
1103    ideal S = idInit(1,1);
1104    poly q = p_ISet(1,currRing);
1105    ideal X = idInit(1,1);
1106    X->m[0]=p_One(currRing);
1107    for(i=1;i<=currRing->N;i++)
1108    {
1109            p_SetExp(X->m[0],i,1,currRing);   
1110    }
1111    p_Setm(X->m[0],currRing);
1112    I = id_Mult(I,X,currRing);
1113    I = SortByDeg(I);
1114    //printf("\n-------------RouneSlice--------------\n");
1115    rouneslice(I,S,q,X->m[0],prune, moreprune, steps, NNN, hilbertcoef, hilbpower);
1116    //printf("\nIn total Prune got rid of %i elements\n",prune);
1117    //printf("\nIn total More Prune got rid of %i elements\n",moreprune);
1118    //printf("\nSteps of rouneslice: %i\n\n", steps);
1119    mpz_t coefhilb;
1120    mpz_t dummy;
1121    mpz_init(coefhilb);
1122    mpz_init(dummy);
1123    printf("\n//  %8d t^0",1);
1124    for(i = 0; i<NNN; i++)
1125    {
1126        if(mpz_sgn(&hilbertcoef[i])!=0)
1127        {
1128            gmp_printf("\n//  %8Zd t^%d",&hilbertcoef[i],hilbpower[i]);
1129        }
1130    }
1131    omFreeSize(hilbertcoef, (NNN)*sizeof(mpz_t));
1132    omFreeSize(hilbpower, (NNN)*sizeof(int));
1133    //printf("\n-------------------------------------\n");
1134}
1135
1136// -------------------------------- END OF CHANGES -------------------------------------------
1137static intvec * hSeries(ideal S, intvec *modulweight,
1138                int /*notstc*/, intvec *wdegree, ideal Q, ring tailRing)
1139{
1140  intvec *work, *hseries1=NULL;
1141  int  mc;
1142  int  p0;
1143  int  i, j, k, l, ii, mw;
1144  hexist = hInit(S, Q, &hNexist, tailRing);
1145  if (hNexist==0)
1146  {
1147    hseries1=new intvec(2);
1148    (*hseries1)[0]=1;
1149    (*hseries1)[1]=0;
1150    return hseries1;
1151  }
1152
1153  #if 0
1154  if (wdegree == NULL)
1155    hWeight();
1156  else
1157    hWDegree(wdegree);
1158  #else
1159  if (wdegree != NULL) hWDegree(wdegree);
1160  #endif
1161
1162  p0 = 1;
1163  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1164  hvar = (varset)omAlloc(((currRing->N) + 1) * sizeof(int));
1165  hpure = (scmon)omAlloc((1 + ((currRing->N) * (currRing->N))) * sizeof(int));
1166  stcmem = hCreate((currRing->N) - 1);
1167  Qpol = (int **)omAlloc(((currRing->N) + 1) * sizeof(int *));
1168  Ql = (int *)omAlloc0(((currRing->N) + 1) * sizeof(int));
1169  Q0 = (int *)omAlloc(((currRing->N) + 1) * sizeof(int));
1170  *Qpol = NULL;
1171  hLength = k = j = 0;
1172  mc = hisModule;
1173  if (mc!=0)
1174  {
1175    mw = hMinModulweight(modulweight);
1176    hstc = (scfmon)omAlloc(hNexist * sizeof(scmon));
1177  }
1178  else
1179  {
1180    mw = 0;
1181    hstc = hexist;
1182    hNstc = hNexist;
1183  }
1184  loop
1185  {
1186    if (mc!=0)
1187    {
1188      hComp(hexist, hNexist, mc, hstc, &hNstc);
1189      if (modulweight != NULL)
1190        j = (*modulweight)[mc-1]-mw;
1191    }
1192    if (hNstc!=0)
1193    {
1194      hNvar = (currRing->N);
1195      for (i = hNvar; i>=0; i--)
1196        hvar[i] = i;
1197      //if (notstc) // TODO: no mon divides another
1198        hStaircase(hstc, &hNstc, hvar, hNvar);
1199      hSupp(hstc, hNstc, hvar, &hNvar);
1200      if (hNvar!=0)
1201      {
1202        if ((hNvar > 2) && (hNstc > 10))
1203          hOrdSupp(hstc, hNstc, hvar, hNvar);
1204        hHilbEst(hstc, hNstc, hvar, hNvar);
1205        memset(hpure, 0, ((currRing->N) + 1) * sizeof(int));
1206        hPure(hstc, 0, &hNstc, hvar, hNvar, hpure, &hNpure);
1207        hLexS(hstc, hNstc, hvar, hNvar);
1208        Q0[hNvar] = 0;
1209        hHilbStep(hpure, hstc, hNstc, hvar, hNvar, &p0, 1);
1210      }
1211    }
1212    else
1213    {
1214      if(*Qpol!=NULL)
1215        (**Qpol)++;
1216      else
1217      {
1218        *Qpol = (int *)omAlloc(sizeof(int));
1219        hLength = *Ql = **Qpol = 1;
1220      }
1221    }
1222    if (*Qpol!=NULL)
1223    {
1224      i = hLength;
1225      while ((i > 0) && ((*Qpol)[i - 1] == 0))
1226        i--;
1227      if (i > 0)
1228      {
1229        l = i + j;
1230        if (l > k)
1231        {
1232          work = new intvec(l);
1233          for (ii=0; ii<k; ii++)
1234            (*work)[ii] = (*hseries1)[ii];
1235          if (hseries1 != NULL)
1236            delete hseries1;
1237          hseries1 = work;
1238          k = l;
1239        }
1240        while (i > 0)
1241        {
1242          (*hseries1)[i + j - 1] += (*Qpol)[i - 1];
1243          (*Qpol)[i - 1] = 0;
1244          i--;
1245        }
1246      }
1247    }
1248    mc--;
1249    if (mc <= 0)
1250      break;
1251  }
1252  if (k==0)
1253  {
1254    hseries1=new intvec(2);
1255    (*hseries1)[0]=0;
1256    (*hseries1)[1]=0;
1257  }
1258  else
1259  {
1260    l = k+1;
1261    while ((*hseries1)[l-2]==0) l--;
1262    if (l!=k)
1263    {
1264      work = new intvec(l);
1265      for (ii=l-2; ii>=0; ii--)
1266        (*work)[ii] = (*hseries1)[ii];
1267      delete hseries1;
1268      hseries1 = work;
1269    }
1270    (*hseries1)[l-1] = mw;
1271  }
1272  for (i = 0; i <= (currRing->N); i++)
1273  {
1274    if (Ql[i]!=0)
1275      omFreeSize((ADDRESS)Qpol[i], Ql[i] * sizeof(int));
1276  }
1277  omFreeSize((ADDRESS)Q0, ((currRing->N) + 1) * sizeof(int));
1278  omFreeSize((ADDRESS)Ql, ((currRing->N) + 1) * sizeof(int));
1279  omFreeSize((ADDRESS)Qpol, ((currRing->N) + 1) * sizeof(int *));
1280  hKill(stcmem, (currRing->N) - 1);
1281  omFreeSize((ADDRESS)hpure, (1 + ((currRing->N) * (currRing->N))) * sizeof(int));
1282  omFreeSize((ADDRESS)hvar, ((currRing->N) + 1) * sizeof(int));
1283  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1284  hDelete(hexist, hNexist);
1285  if (hisModule!=0)
1286    omFreeSize((ADDRESS)hstc, hNexist * sizeof(scmon));
1287  return hseries1;
1288}
1289
1290
1291intvec * hHstdSeries(ideal S, intvec *modulweight, intvec *wdegree, ideal Q, ring tailRing)
1292{
1293  return hSeries(S, modulweight, 0, wdegree, Q, tailRing);
1294}
1295
1296intvec * hFirstSeries(ideal S, intvec *modulweight, ideal Q, intvec *wdegree, ring tailRing)
1297{
1298  return hSeries(S, modulweight, 1, wdegree, Q, tailRing);
1299}
1300
1301intvec * hSecondSeries(intvec *hseries1)
1302{
1303  intvec *work, *hseries2;
1304  int i, j, k, s, t, l;
1305  if (hseries1 == NULL)
1306    return NULL;
1307  work = new intvec(hseries1);
1308  k = l = work->length()-1;
1309  s = 0;
1310  for (i = k-1; i >= 0; i--)
1311    s += (*work)[i];
1312  loop
1313  {
1314    if ((s != 0) || (k == 1))
1315      break;
1316    s = 0;
1317    t = (*work)[k-1];
1318    k--;
1319    for (i = k-1; i >= 0; i--)
1320    {
1321      j = (*work)[i];
1322      (*work)[i] = -t;
1323      s += t;
1324      t += j;
1325    }
1326  }
1327  hseries2 = new intvec(k+1);
1328  for (i = k-1; i >= 0; i--)
1329    (*hseries2)[i] = (*work)[i];
1330  (*hseries2)[k] = (*work)[l];
1331  delete work;
1332  return hseries2;
1333}
1334
1335void hDegreeSeries(intvec *s1, intvec *s2, int *co, int *mu)
1336{
1337  int m, i, j, k;
1338  *co = *mu = 0;
1339  if ((s1 == NULL) || (s2 == NULL))
1340    return;
1341  i = s1->length();
1342  j = s2->length();
1343  if (j > i)
1344    return;
1345  m = 0;
1346  for(k=j-2; k>=0; k--)
1347    m += (*s2)[k];
1348  *mu = m;
1349  *co = i - j;
1350}
1351
1352static void hPrintHilb(intvec *hseries)
1353{
1354  int  i, j, l, k;
1355  if (hseries == NULL)
1356    return;
1357  l = hseries->length()-1;
1358  k = (*hseries)[l];
1359  for (i = 0; i < l; i++)
1360  {
1361    j = (*hseries)[i];
1362    if (j != 0)
1363    {
1364      Print("//  %8d t^%d\n", j, i+k);
1365    }
1366  }
1367}
1368
1369/*
1370*caller
1371*/
1372void hLookSeries(ideal S, intvec *modulweight, ideal Q)
1373{
1374  int co, mu, l;
1375  intvec *hseries2;
1376  intvec *hseries1 = hFirstSeries(S, modulweight, Q);
1377  hPrintHilb(hseries1);
1378  l = hseries1->length()-1;
1379  if (l > 1)
1380    hseries2 = hSecondSeries(hseries1);
1381  else
1382    hseries2 = hseries1;
1383  hDegreeSeries(hseries1, hseries2, &co, &mu);
1384  PrintLn();
1385  hPrintHilb(hseries2);
1386  if ((l == 1) &&(mu == 0))
1387    scPrintDegree((currRing->N)+1, 0);
1388  else
1389    scPrintDegree(co, mu);
1390  if (l>1)
1391    delete hseries1;
1392  delete hseries2;
1393}
1394
1395
1396
Note: See TracBrowser for help on using the repository browser.