1 /****************************************
2 * Computer Algebra System SINGULAR *
3 ****************************************/
4 /*
5 * ABSTRACT:utils for hilbert driven kStd
6 */
7
8 #include "kernel/mod2.h"
9
10 #include "misc/options.h"
11 #include "misc/intvec.h"
12
13 #include "polys/simpleideals.h"
14
15 #include "kernel/combinatorics/stairc.h"
16 #include "kernel/combinatorics/hilb.h"
17
18 #include "kernel/GBEngine/kutil.h"
19 #include "kernel/GBEngine/kstd1.h"
20 #include "kernel/GBEngine/khstd.h"
21
22 #include "kernel/polys.h"
23
24 /*2
25 * compare the given hilbert series with the current one,
26 * delete not needed pairs (if possible)
27 */
khCheck(ideal Q,intvec * w,intvec * hilb,int & eledeg,int & count,kStrategy strat)28 void khCheck( ideal Q, intvec *w, intvec *hilb, int &eledeg, int &count,
29 kStrategy strat)
30 /* ideal S=strat->Shdl, poly p=strat->P.p */
31 /*
32 * compute the number eledeg of elements with a degree >= deg(p) going into kStd,
33 * p is already in S and for all further q going into S yields deg(q) >= deg(p),
34 * the real computation is only done if the degree has changed,
35 * then we have eledeg == 0 on this degree and we make:
36 * - compute the Hilbert series newhilb from S
37 * (hilb is the final Hilbert series)
38 * - in module case: check that all comp up to strat->ak are used
39 * - compute the eledeg from newhilb-hilb for the first degree deg with
40 * newhilb-hilb != 0
41 * (Remark: consider the Hilbert series with coeff. up to infinity)
42 * - clear the set L for degree < deg
43 * the number count is only for statistics (in the caller initialise count = 0),
44 * in order to get a first computation, initialise eledeg = 1 in the caller.
45 * The weights w are needed in the module case, otherwise NULL.
46 */
47 {
48 intvec *newhilb;
49 int deg,l,ln,mw;
50 pFDegProc degp;
51
52 eledeg--;
53 if (eledeg == 0)
54 {
55 if (strat->ak>0)
56 {
57 char *used_comp=(char*)omAlloc0(strat->ak+1);
58 int i;
59 for(i=strat->sl;i>0;i--)
60 {
61 used_comp[pGetComp(strat->S[i])]='\1';
62 }
63 for(i=strat->ak;i>0;i--)
64 {
65 if(used_comp[i]=='\0')
66 {
67 omFree((ADDRESS)used_comp);
68 return;
69 }
70 }
71 omFree((ADDRESS)used_comp);
72 }
73 degp=currRing->pFDeg;
74 // if weights for variables were given to std computations,
75 // then pFDeg == degp == kHomModDeg (see kStd)
76 if ((degp!=kModDeg) && (degp!=kHomModDeg)) degp=p_Totaldegree;
77 // degp = pWDegree;
78 l = hilb->length()-1;
79 mw = (*hilb)[l];
80 newhilb = hHstdSeries(strat->Shdl,w,strat->kHomW,Q,strat->tailRing);
81 ln = newhilb->length()-1;
82 deg = degp(strat->P.p,currRing)-mw;
83 loop // compare the series in degree deg, try to increase deg -----------
84 {
85 if (deg < ln) // deg may be out of range
86 {
87 if (deg < l)
88 eledeg = (*newhilb)[deg]-(*hilb)[deg];
89 else
90 eledeg = (*newhilb)[deg];
91 }
92 else
93 {
94 if (deg < l)
95 eledeg = -(*hilb)[deg];
96 else // we have newhilb = hilb
97 {
98 while (strat->Ll>=0)
99 {
100 count++;
101 if(TEST_OPT_PROT)
102 {
103 PrintS("h");
104 mflush();
105 }
106 deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
107 }
108 delete newhilb;
109 return;
110 }
111 }
112 if (eledeg > 0) // elements to delete
113 break;
114 else if (eledeg <0) // strange....see bug_43
115 return;
116 deg++;
117 } /* loop */
118 delete newhilb;
119 while ((strat->Ll>=0) && (degp(strat->L[strat->Ll].p,currRing)-mw < deg)) // the essential step
120 {
121 count++;
122 if(TEST_OPT_PROT)
123 {
124 PrintS("h");
125 mflush();
126 }
127 deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
128 }
129 }
130 }
131
132
khCheckLocInhom(ideal Q,intvec * w,intvec * hilb,int & count,kStrategy strat)133 void khCheckLocInhom(ideal Q, intvec *w, intvec *hilb, int &count,
134 kStrategy strat)
135
136 /*
137 This will be used for the local orderings in the case of the inhomogenous ideals.
138 Assume f1,...,fs are already in the standard basis. Test if hilb(LM(f1),...,LM(fs),1)
139 is equal to the inputed one.
140 If no, do nothing.
141 If Yes, we know that all polys that we need are already in the standard basis
142 so delete all the remaining pairs
143 */
144 {
145 ideal Lm;
146 intvec *newhilb;
147
148 Lm = id_Head(strat->Shdl,currRing);
149
150 newhilb =hHstdSeries(Lm,w,strat->kHomW,Q,currRing); // ,strat->tailRing?
151
152 if(newhilb->compare(hilb) == 0)
153 {
154 while (strat->Ll>=0)
155 {
156 count++;
157 if(TEST_OPT_PROT)
158 {
159 PrintS("h");
160 mflush();
161 }
162 deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
163 }
164 delete newhilb;
165 return;
166 }
167 id_Delete(&Lm,currRing);
168 }
169