source: git/Singular/weight.cc @ 194f5e5

spielwiese
Last change on this file since 194f5e5 was e78cce, checked in by Olaf Bachmann <obachman@…>, 26 years ago
Mon Dec 15 23:31:56 1997 Olaf Bachmann <obachman@mathematik.uni-kl.de> * polys-impl.h: Various small bug - fixes and changes in preparation of COMP_FAST merge: hilbert series, maps are ok; sres and syz are still buggy; small things still need to be checked; git-svn-id: file:///usr/local/Singular/svn/trunk@978 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 6.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: weight.cc,v 1.6 1997-12-15 22:46:43 obachman Exp $ */
5
6/*
7* ABSTRACT:
8*/
9
10#include <math.h>
11#include "mod2.h"
12#include "tok.h"
13#include "mmemory.h"
14#include "polys.h"
15#include "intvec.h"
16#include "febase.h"
17#include "ipid.h"
18#include "ipshell.h"
19#include "subexpr.h"
20#include "ideals.h"
21#include "weight.h"
22
23/*0 implementation*/
24
25pFDegProc pFDegOld;
26pLDegProc pLDegOld;
27extern "C" double (*wFunctional)(int *degw, int *lpol, int npol,
28       double *rel, double wx);
29extern "C" double wFunctionalMora(int *degw, int *lpol, int npol,
30       double *rel, double wx);
31extern "C" double wFunctionalBuch(int *degw, int *lpol, int npol,
32       double *rel, double wx);
33extern "C" double * wDouble(void *adr);       
34extern "C" void wAdd(int *A, int mons, int kn, int xx);
35extern "C" void wNorm(int *degw, int *lpol, int npol, double *rel);
36extern "C" void wFirstSearch(int *A, int *x, int mons,
37        int *lpol, int npol, double *rel, double *fopt);
38extern "C" void wSecondSearch(int *A, int *x, int *lpol,
39        int npol, int mons, double *rel, double *fk);
40extern "C" void wGcd(int *x, int n);       
41
42
43extern double nsqr;       
44
45static void wDimensions(polyset s, int sl, int *lpol, int *npol, int *mons)
46{
47  int  i, i1, j, k;
48  poly p, q;
49
50  i1 = j = 0;
51  for (i = 0; i <= sl; i++)
52  {
53    p = s[i];
54    if (p!=NULL)
55    {
56      k = 1;
57      q = pNext(p);
58      while (q!=NULL)
59      {
60        k++;
61        q = pNext(q);
62      }
63      if (k > 1)
64      {
65        lpol[i1++] = k;
66        j += k;
67      }
68    }
69  }
70  *npol = i1;
71  *mons = j;
72}
73
74
75static void wInit(polyset s, int sl, int mons, int *A) 
76{
77  int  n, a, i, j, *B, *C;
78  poly p, q;
79  Exponent_t *pl;
80
81  B = A;
82  n = pVariables;
83  a = (n + 1) * sizeof(Exponent_t);
84  pl = (Exponent_t * )Alloc(a);
85  for (i = 0; i <= sl; i++)
86  {
87    p = s[i];
88    if (p!=NULL)
89    {
90      q = pNext(p);
91      if (q!=NULL)
92      {
93        C = B;
94        B++;
95        pGetExpV(p, pl);
96        for (j = 0; j < n; j++)
97        {
98          *C = pl[j+1];
99          C += mons;
100        }
101      }
102      while (q!=NULL)
103      {
104        C = B;
105        B++;
106        pGetExpV(q, pl);
107        for (j = 0; j < n; j++)
108        {
109          *C = pl[j+1];
110          C += mons;
111        }
112        q = pNext(q);
113      }
114    }
115  }
116  Free((ADDRESS)pl, a);
117}
118
119static void wCall(polyset s, int sl, int *x)
120{
121  int  n, q, npol, mons, i;
122  int  *A, *xopt, *lpol, *degw;
123  double  f1, fx, eps, *rel;
124  void *adr;
125
126  n = pVariables;
127  lpol = (int * )Alloc((sl + 1) * sizeof(int));
128  wDimensions(s, sl, lpol, &npol, &mons);
129  xopt = x + (n + 1);
130  for (i = n; i; i--)
131    xopt[i] = 1;
132  if (mons==0)
133  {
134    Free((ADDRESS)lpol, (sl + 1) * sizeof(int));
135    return;
136  }
137  adr = (void * )Alloc(npol * sizeof(double) + 8);
138  rel = wDouble(adr);
139  q = (n + 1) * mons * sizeof(int);
140  A = (int * )Alloc(q);
141  wInit(s, sl, mons, A);
142  degw = A + (n * mons);
143  memset(degw, 0, mons * sizeof(int));
144  for (i = n; i; i--)
145    wAdd(A, mons, i, 1);
146  wNorm(degw, lpol, npol, rel);
147  f1 = (*wFunctional)(degw, lpol, npol, rel, (double)1.0);
148  if (TEST_OPT_PROT) Print("// %e\n",f1);
149  eps = f1;
150  fx = (double)2.0 * eps;
151  memset(x, 0, (n + 1) * sizeof(int));
152  wFirstSearch(A, x, mons, lpol, npol, rel, &fx);
153  if (TEST_OPT_PROT) Print("// %e\n",fx);
154  memcpy(x + 1, xopt + 1, n * sizeof(int));
155  memset(degw, 0, mons * sizeof(int));
156  for (i = n; i; i--)
157  {
158    x[i] *= 16;
159    wAdd(A, mons, i, x[i]);
160  }
161  wSecondSearch(A, x, lpol, npol, mons, rel, &fx);
162  if (TEST_OPT_PROT) Print("// %e\n",fx);
163  if (fx >= eps)
164  {
165    for (i = n; i; i--)
166      xopt[i] = 1;
167  }
168  else
169  {
170    wGcd(xopt, n);
171//    if (BTEST1(22))
172//    {
173//      f1 = fx + (double)0.1 * (f1 - fx);
174//      wSimple(x, n);
175//      memset(degw, 0, mons * sizeof(int));
176//      for (i = n; i; i--)
177//        wAdd(A, mons, i, x[i]);
178//      eps = wPrWeight(x, n);
179//      fx = (*wFunctional)(degw, lpol, npol, rel, eps);
180//      if (fx < f1)
181//      {
182//        if (TEST_OPT_PROT) Print("// %e\n",fx);
183//        memcpy(xopt + 1, x + 1, n * sizeof(int));
184//      }
185//    }
186  }
187  Free((ADDRESS)A, q);
188  Free((ADDRESS)lpol, (sl + 1) * sizeof(int));
189  Free((ADDRESS)adr, npol * sizeof(double) + 8);
190}
191
192
193void kEcartWeights(polyset s, int sl, short *eweight)
194{
195  int  n, i;
196  int  *x;
197
198  *eweight = 0;
199  n = pVariables;
200  nsqr = (double)2.0 / (double)n;
201  if (pOrdSgn == -1)
202    wFunctional = wFunctionalMora;
203  else
204    wFunctional = wFunctionalBuch;
205  x = (int * )Alloc(2 * (n + 1) * sizeof(int));
206  wCall(s, sl, x);
207  for (i = n; i; i--)
208    eweight[i] = x[i + n + 1];
209  Free((ADDRESS)x, 2 * (n + 1) * sizeof(int));
210}
211
212
213BOOLEAN kWeight(leftv res,leftv id)
214{
215  ideal F=(ideal)id->Data();
216  intvec * iv = new intvec(pVariables);
217  polyset s;
218  int  sl, n, i;
219  int  *x;
220
221  res->data=(char *)iv;
222  s = F->m;
223  sl = IDELEMS(F) - 1;
224  n = pVariables;
225  nsqr = (double)2.0 / (double)n;
226  wFunctional = wFunctionalBuch;
227  x = (int * )Alloc(2 * (n + 1) * sizeof(int));
228  wCall(s, sl, x);
229  for (i = n; i; i--)
230    (*iv)[i-1] = x[i + n + 1];
231  Free((ADDRESS)x, 2 * (n + 1) * sizeof(int));
232  return FALSE;
233}
234
235BOOLEAN kQHWeight(leftv res,leftv v)
236{
237  res->data=(char *)idQHomWeights((ideal)v->Data());
238  if (res->data==NULL)
239    res->data=(char *)new intvec(pVariables);
240  return FALSE;
241}
242
243short * iv2array(intvec * iv)
244{
245  short *s=(short *)Alloc((pVariables+1)*sizeof(short));
246  int len=iv->length();
247  int i;
248
249  for (i=1;i<=len;i++)
250    s[i]= (*iv)[i-1];
251  for (;i<=pVariables;i++)
252    s[i]= 1;
253  return s;
254}
255
256/*2
257*computes the degree of the leading term of the polynomial
258*with respect to given ecartWeights
259*used for Graebes method if BTEST1(31) is set
260*/
261int totaldegreeWecart(poly p)
262{
263  int i;
264  int j =0;
265
266  for (i=pVariables; i; i--)
267    j += (int)(pGetExp(p,i) * ecartWeights[i]);
268  return  j;
269}
270
271/*2
272*computes the maximal degree of all terms of the polynomial
273*with respect to given ecartWeights and
274*computes the length of the polynomial
275*used for Graebes method if BTEST1(31) is set
276*/
277int maxdegreeWecart(poly p,int *l)
278{
279  short k=pGetComp(p);
280  int ll=1;
281  int  t,max;
282
283  max=totaldegreeWecart(p);
284  pIter(p);
285  while ((p!=NULL) && (pGetComp(p)==k))
286  {
287    t=totaldegreeWecart(p);
288    if (t>max) max=t;
289    ll++;
290    pIter(p);
291  }
292  *l=ll;
293  return max;
294}
Note: See TracBrowser for help on using the repository browser.