source: git/Singular/weight.cc @ fb3158

fieker-DuValspielwiese
Last change on this file since fb3158 was fb3158, checked in by Hans Schönemann <hannes@…>, 26 years ago
* hannes: fix for wDouble git-svn-id: file:///usr/local/Singular/svn/trunk@2141 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 14.1 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: weight.cc,v 1.9 1998-06-13 14:20:07 Singular 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;
27#ifdef ALIGN_8
28#define wDouble(A) ((double *)A)
29#else
30extern "C" double * wDouble(void *adr);
31#endif
32
33#ifndef __MWERKS__
34extern "C" double (*wFunctional)(int *degw, int *lpol, int npol,
35       double *rel, double wx);
36extern "C" double wFunctionalMora(int *degw, int *lpol, int npol,
37       double *rel, double wx);
38extern "C" double wFunctionalBuch(int *degw, int *lpol, int npol,
39       double *rel, double wx);
40extern "C" void wAdd(int *A, int mons, int kn, int xx);
41extern "C" void wNorm(int *degw, int *lpol, int npol, double *rel);
42extern "C" void wFirstSearch(int *A, int *x, int mons,
43        int *lpol, int npol, double *rel, double *fopt);
44extern "C" void wSecondSearch(int *A, int *x, int *lpol,
45        int npol, int mons, double *rel, double *fk);
46extern "C" void wGcd(int *x, int n);
47extern double wNsqr;
48#else
49short * ecartWeights=NULL;
50
51double wNsqr;
52double (*wFunctional)(int *degw, int *lpol, int npol,
53       double *rel, double wx);
54
55
56static double wFunctionalMora(int *degw, int *lpol, int npol,
57       double *rel, double wx)
58{
59  int  i, j, e1, ecu, ecl, ec;
60  int  *ex;
61  double gfmax, gecart, ghom, pfmax;
62  double *r;
63
64  ex = degw;
65  r = rel;
66  gfmax = (double)0.0;
67  gecart = (double)0.4 + (double)npol;
68  ghom = (double)1.0;
69  for (i = 0; i < npol; i++)
70  {
71    ecl = ecu = e1 = *ex++;
72    for (j = lpol[i] - 1; j!=0; j--)
73    {
74      ec = *ex++;
75      if (ec > ecu)
76        ecu = ec;
77      else if (ec < ecl)
78        ecl = ec;
79    }
80    pfmax = (double)ecl / (double)ecu;
81    if (pfmax < ghom)
82      ghom = pfmax;
83    pfmax = (double)e1 / (double)ecu;
84    if (pfmax > (double)0.5)
85      gecart -= (pfmax * pfmax);
86    else
87      gecart -= (double)0.25;
88    ecu = 2 * ecu - ecl;
89    gfmax += (double)(ecu * ecu) * (*r++);
90  }
91  if (ghom > (double)0.8)
92  {
93    ghom *= (double)5.0;
94    gecart *= ((double)5.0 - ghom);
95  }
96  return (gfmax * gecart) / pow(wx, wNsqr);
97}
98
99
100static double wFunctionalBuch(int *degw, int *lpol, int npol,
101       double *rel, double wx)
102{
103  int  i, j, ecl, ecu, ec;
104  int  *ex;
105  double gfmax, ghom, pfmax;
106  double *r;
107
108  ex = degw;
109  r = rel;
110  gfmax = (double)0.0;
111  ghom = (double)1.0;
112  for (i = 0; i < npol; i++)
113  {
114    ecu = ecl = *ex++;
115    for (j = lpol[i] - 1; j!=0; j--)
116    {
117      ec = *ex++;
118      if (ec < ecl)
119        ecl = ec;
120      else if (ec > ecu)
121        ecu = ec;
122    }
123    pfmax = (double)ecl / (double)ecu;
124    if (pfmax < ghom)
125      ghom = pfmax;
126    gfmax += (double)(ecu * ecu) * (*r++);
127  }
128  if (ghom > (double)0.5)
129    gfmax *= ((double)1.0 - (ghom * ghom)) / (double)0.75;
130  return gfmax / pow(wx, wNsqr);
131}
132
133
134static void wSub(int *A, int mons, int kn, int xx)
135{
136  int  i, *B, *ex;
137
138  B = A + ((kn - 1) * mons);
139  ex = A + (pVariables * mons);
140  if (xx == 1)
141  {
142    for (i = mons; i!=0; i--)
143      *ex++ -= *B++;
144  }
145  else
146  {
147    for (i = mons; i!=0; i--)
148      *ex++ -= (*B++) * xx;
149  }
150}
151
152
153static void wAdd(int *A, int mons, int kn, int xx)
154{
155  int  i, *B, *ex;
156
157  B = A + ((kn - 1) * mons);
158  ex = A + (pVariables * mons);
159  if (xx == 1)
160  {
161    for (i = mons; i!=0; i--)
162      *ex++ += *B++;
163  }
164  else
165  {
166    for (i = mons; i!=0; i--)
167      *ex++ += (*B++) * xx;
168  }
169}
170
171
172static void wFirstSearch(int *A, int *x, int mons,
173  int *lpol, int npol, double *rel, double *fopt)
174{
175  int  a0, a, n, xn, t, xx, y1;
176  int  *y, *degw, *xopt;
177  double  fy, fmax, wx;
178  double *pr;
179  void *adr;
180
181  fy = *fopt;
182  n = pVariables;
183  xn = n + 6 + (21 / n);
184  a0 = n * sizeof(double) + 8;
185  a = n * sizeof(int);
186  y = (int * )Alloc(a);
187  adr = (void * )Alloc(a0);
188  pr = wDouble(adr);
189  *pr = (double)1.0;
190  *y = 0;
191  degw = A + (n * mons);
192  xopt = x + (n + 2);
193  t = 1;
194  loop
195  {
196    while (t < n)
197    {
198      xx = x[t] + 1;
199      wx = pr[t-1] * (double)xx;
200      y1 = y[t-1] + xx;
201      if ((y1 + n - t) <= xn)
202      {
203        pr[t] = wx;
204        y[t] = y1;
205        x[t] = xx;
206        if (xx > 1)
207          wAdd(A, mons, t, 1);
208        t++;
209      }
210      else
211      {
212        xx = x[t] - 1;
213        x[t] = 0;
214        if (xx!=0)
215          wSub(A, mons, t, xx);
216        t--;
217        if (t==0)
218        {
219          *fopt = fy;
220          Free((ADDRESS)y, a);
221          Free((ADDRESS)adr, a0);
222          return;
223        }
224      }
225    }
226    xx = xn - y[t-1];
227    wx = pr[t-1] * (double)xx;
228    x[t] = xx;
229    xx--;
230    if (xx!=0)
231      wAdd(A, mons, t, xx);
232    fmax = (*wFunctional)(degw, lpol, npol, rel, wx);
233    if (xx!=0)
234      wSub(A, mons, t, xx);
235    if (fmax < fy)
236    {
237      fy = fmax;
238      memcpy(xopt, x + 1, a);
239    }
240    t--;
241  } /* end loop */
242}
243
244
245static double wPrWeight(int *x, int n)
246{
247  int i;
248  double y;
249
250  y = (double)x[n];
251  for (i = n - 1; i!=0; i--)
252    y *= (double)x[i];
253  return y;
254}
255
256
257static void wEstimate(int *A, int *x, int *lpol, int npol, int mons,
258double wx, double *rel, double *fopt, int *s0, int *s1, int *s2)
259{
260  int  n, i1, i2, k0 = 0, k1 = 0, k2 = 0;
261  int  *degw;
262  double fo1, fo2, fmax, wx1, wx2;
263
264  n = pVariables;
265  degw = A + (n * mons);
266  fo2 = fo1 = (double)1.0e10;
267  for (i1 = n; i1!=0; i1--)
268  {
269    if (x[i1] > 1)
270    {
271      wSub(A, mons, i1, 1);
272      wx1 = wx - wx / (double)x[i1];
273      x[i1]--;
274      fmax = (*wFunctional)(degw, lpol, npol, rel, wx1);
275      if (fmax < fo1)
276      {
277        fo1 = fmax;
278        k0 = i1;
279      }
280      for (i2 = i1; i2!=0; i2--)
281      {
282        if (x[i2] > 1)
283        {
284          wSub(A, mons, i2, 1);
285          wx2 = wx1 - wx1 / (double)x[i2];
286          fmax = (*wFunctional)(degw, lpol, npol, rel, wx2);
287          if (fmax < fo2)
288          {
289            fo2 = fmax;
290            k1 = i1;
291            k2 = i2;
292          }
293          wAdd(A, mons, i2, 1);
294        }
295      }
296      wAdd(A, mons, i1, 1);
297      x[i1]++;
298    }
299  }
300  if (fo1 < fo2)
301  {
302    *fopt = fo1;
303    *s0 = k0;
304  }
305  else
306  {
307    *fopt = fo2;
308    *s0 = 0;
309  }
310  *s1 = k1;
311  *s2 = k2;
312}
313
314
315static void wSecondSearch(int *A, int *x, int *lpol,
316int npol, int mons, double *rel, double *fk)
317{
318  int  n, s0, s1, s2, *xopt;
319  double  one, fx, fopt, wx;
320
321  n = pVariables;
322  xopt = x + (n + 2);
323  fopt = *fk * (double)0.999999999999;
324  wx = wPrWeight(x, n);
325  one = (double)1.0;
326  loop
327  {
328    wEstimate(A, x, lpol, npol, mons, wx, rel, &fx, &s0, &s1, &s2);
329    if (fx > fopt)
330    {
331      if (s0!=0)
332        x[s0]--;
333      else if (s1!=0)
334      {
335        x[s1]--;
336        x[s2]--;
337      }
338      else
339        break;
340    }
341    else
342    {
343      fopt = fx;
344      if (s0!=0)
345      {
346        x[s0]--;
347        memcpy(xopt, x + 1, n * sizeof(int));
348        if (s1==0)
349          break;
350      }
351      else if (s1!=0)
352      {
353        x[s1]--;
354        x[s2]--;
355        memcpy(xopt, x + 1, n * sizeof(int));
356      }
357      else
358        break;
359    }
360    if (s0!=0)
361      wSub(A, mons, s0, 1);
362    else
363    {
364      wSub(A, mons, s1, 1);
365      wSub(A, mons, s2, 1);
366    }
367    wx = wPrWeight(x, n);
368  }
369  *fk = fopt;
370}
371
372
373static void wGcd(int *x, int n)
374{
375  int i, b, a, h;
376
377  i = n;
378  b = x[i];
379  loop
380  {
381    i--;
382    if (i==0)
383      break;
384    a = x[i];
385    if (a < b)
386    {
387      h = a;
388      a = b;
389      b = h;
390    }
391    do
392    {
393      h = a % b;
394      a = b;
395      b = h;
396    }
397    while (b!=0);
398    b = a;
399    if (b == 1)
400      return;
401  }
402  for (i = n; i; i--)
403    x[i] /= b;
404}
405
406
407static void wSimple(int *x, int n)
408{
409  int g, min, c, d, f, kopt, k, i;
410  int *xopt;
411  double sopt, s1, s2;
412
413  xopt = x + (n + 1);
414  kopt = k = g = 0;
415  min = 1000000;
416  for (i = n; i!=0; i--)
417  {
418    c = xopt[i];
419    if (c > 1)
420    {
421      if (c < min)
422        min = c;
423      if (c > k)
424        k = c;
425    }
426    else
427      g = 1;
428  }
429  k -= min;
430  if ((g==0) && (k < 4))
431    return;
432  if (k < min)
433    min = k+1;
434  sopt = (double)1.0e10;
435  for (k = min; k > 1; k--)
436  {
437    s2 = s1 = (double)0.0;
438    for(i = n; i!=0; i--)
439    {
440      c = xopt[i];
441      if (c > 1)
442      {
443        d = c / k;
444        d *= k;
445        f = d = c - d;
446        if (f!=0)
447        {
448          f = k - f;
449          if (f < d)
450            s2 += (double)f / (double)c;
451          else
452            s1 += (double)d / (double)c;
453        }
454      }
455    }
456    s1 += s2 + sqrt(s1 * s2);
457    s1 -= (double)0.01 * sqrt((double)k);
458    if (s1 < sopt)
459    {
460      sopt = s1;
461      kopt = k;
462    }
463  }
464  for(i = n; i!=0; i--)
465  {
466    x[i] = 1;
467    c = xopt[i];
468    if (c > 1)
469    {
470      d = c / kopt;
471      d *= kopt;
472      x[i] = d;
473      d = c - d;
474      if ((d!=0) && (kopt < 2 * d))
475        x[i] += kopt;
476    }
477  }
478  if (g==0)
479    wGcd(x, n);
480}
481
482
483static void wNorm(int *degw, int *lpol, int npol, double *rel)
484{
485  int  i, j, ecu, ec;
486  int  *ex;
487  double *r;
488
489  ex = degw;
490  r = rel;
491  for (i = 0; i < npol; i++)
492  {
493    ecu = *ex++;
494    for (j = lpol[i] - 1; j!=0; j--)
495    {
496      ec = *ex++;
497      if (ec > ecu)
498        ecu = ec;
499    }
500    *r = (double)1.0 / (double)(ecu * ecu);
501    r++;
502  }
503}
504#endif /* __MWERKS */
505
506
507static void wDimensions(polyset s, int sl, int *lpol, int *npol, int *mons)
508{
509  int  i, i1, j, k;
510  poly p, q;
511
512  i1 = j = 0;
513  for (i = 0; i <= sl; i++)
514  {
515    p = s[i];
516    if (p!=NULL)
517    {
518      k = 1;
519      q = pNext(p);
520      while (q!=NULL)
521      {
522        k++;
523        q = pNext(q);
524      }
525      if (k > 1)
526      {
527        lpol[i1++] = k;
528        j += k;
529      }
530    }
531  }
532  *npol = i1;
533  *mons = j;
534}
535
536
537static void wInit(polyset s, int sl, int mons, int *A)
538{
539  int  n, a, i, j, *B, *C;
540  poly p, q;
541  Exponent_t *pl;
542
543  B = A;
544  n = pVariables;
545  a = (n + 1) * sizeof(Exponent_t);
546  pl = (Exponent_t * )Alloc(a);
547  for (i = 0; i <= sl; i++)
548  {
549    p = s[i];
550    if (p!=NULL)
551    {
552      q = pNext(p);
553      if (q!=NULL)
554      {
555        C = B;
556        B++;
557        pGetExpV(p, pl);
558        for (j = 0; j < n; j++)
559        {
560          *C = pl[j+1];
561          C += mons;
562        }
563      }
564      while (q!=NULL)
565      {
566        C = B;
567        B++;
568        pGetExpV(q, pl);
569        for (j = 0; j < n; j++)
570        {
571          *C = pl[j+1];
572          C += mons;
573        }
574        pIter(q);
575      }
576    }
577  }
578  Free((ADDRESS)pl, a);
579}
580
581static void wCall(polyset s, int sl, int *x)
582{
583  int  n, q, npol, mons, i;
584  int  *A, *xopt, *lpol, *degw;
585  double  f1, fx, eps, *rel;
586  void *adr;
587
588  n = pVariables;
589  lpol = (int * )Alloc((sl + 1) * sizeof(int));
590  wDimensions(s, sl, lpol, &npol, &mons);
591  xopt = x + (n + 1);
592  for (i = n; i!=0; i--)
593    xopt[i] = 1;
594  if (mons==0)
595  {
596    Free((ADDRESS)lpol, (sl + 1) * sizeof(int));
597    return;
598  }
599  adr = (void * )Alloc(npol * sizeof(double) + 8);
600  rel = wDouble(adr);
601  q = (n + 1) * mons * sizeof(int);
602  A = (int * )Alloc(q);
603  wInit(s, sl, mons, A);
604  degw = A + (n * mons);
605  memset(degw, 0, mons * sizeof(int));
606  for (i = n; i!=0; i--)
607    wAdd(A, mons, i, 1);
608  wNorm(degw, lpol, npol, rel);
609  f1 = (*wFunctional)(degw, lpol, npol, rel, (double)1.0);
610  if (TEST_OPT_PROT) Print("// %e\n",f1);
611  eps = f1;
612  fx = (double)2.0 * eps;
613  memset(x, 0, (n + 1) * sizeof(int));
614  wFirstSearch(A, x, mons, lpol, npol, rel, &fx);
615  if (TEST_OPT_PROT) Print("// %e\n",fx);
616  memcpy(x + 1, xopt + 1, n * sizeof(int));
617  memset(degw, 0, mons * sizeof(int));
618  for (i = n; i!=0; i--)
619  {
620    x[i] *= 16;
621    wAdd(A, mons, i, x[i]);
622  }
623  wSecondSearch(A, x, lpol, npol, mons, rel, &fx);
624  if (TEST_OPT_PROT) Print("// %e\n",fx);
625  if (fx >= eps)
626  {
627    for (i = n; i!=0; i--)
628      xopt[i] = 1;
629  }
630  else
631  {
632    wGcd(xopt, n);
633//    if (BTEST1(22))
634//    {
635//      f1 = fx + (double)0.1 * (f1 - fx);
636//      wSimple(x, n);
637//      memset(degw, 0, mons * sizeof(int));
638//      for (i = n; i!=0; i--)
639//        wAdd(A, mons, i, x[i]);
640//      eps = wPrWeight(x, n);
641//      fx = (*wFunctional)(degw, lpol, npol, rel, eps);
642//      if (fx < f1)
643//      {
644//        if (TEST_OPT_PROT) Print("// %e\n",fx);
645//        memcpy(xopt + 1, x + 1, n * sizeof(int));
646//      }
647//    }
648  }
649  Free((ADDRESS)A, q);
650  Free((ADDRESS)lpol, (sl + 1) * sizeof(int));
651  Free((ADDRESS)adr, npol * sizeof(double) + 8);
652}
653
654
655void kEcartWeights(polyset s, int sl, short *eweight)
656{
657  int  n, i;
658  int  *x;
659
660  *eweight = 0;
661  n = pVariables;
662  wNsqr = (double)2.0 / (double)n;
663  if (pOrdSgn == -1)
664    wFunctional = wFunctionalMora;
665  else
666    wFunctional = wFunctionalBuch;
667  x = (int * )Alloc(2 * (n + 1) * sizeof(int));
668  wCall(s, sl, x);
669  for (i = n; i!=0; i--)
670    eweight[i] = x[i + n + 1];
671  Free((ADDRESS)x, 2 * (n + 1) * sizeof(int));
672}
673
674
675BOOLEAN kWeight(leftv res,leftv id)
676{
677  ideal F=(ideal)id->Data();
678  intvec * iv = new intvec(pVariables);
679  polyset s;
680  int  sl, n, i;
681  int  *x;
682
683  res->data=(char *)iv;
684  s = F->m;
685  sl = IDELEMS(F) - 1;
686  n = pVariables;
687  wNsqr = (double)2.0 / (double)n;
688  wFunctional = wFunctionalBuch;
689  x = (int * )Alloc(2 * (n + 1) * sizeof(int));
690  wCall(s, sl, x);
691  for (i = n; i!=0; i--)
692    (*iv)[i-1] = x[i + n + 1];
693  Free((ADDRESS)x, 2 * (n + 1) * sizeof(int));
694  return FALSE;
695}
696
697BOOLEAN kQHWeight(leftv res,leftv v)
698{
699  res->data=(char *)idQHomWeights((ideal)v->Data());
700  if (res->data==NULL)
701    res->data=(char *)new intvec(pVariables);
702  return FALSE;
703}
704
705short * iv2array(intvec * iv)
706{
707  short *s=(short *)Alloc((pVariables+1)*sizeof(short));
708  int len=iv->length();
709  int i;
710
711  for (i=pVariables;i>len;i--)
712    s[i]= 1;
713  for (;i>0;i--)
714    s[i]= (*iv)[i-1];
715  return s;
716}
717
718/*2
719*computes the degree of the leading term of the polynomial
720*with respect to given ecartWeights
721*used for Graebes method if BTEST1(31) is set
722*/
723int totaldegreeWecart(poly p)
724{
725  int i;
726  int j =0;
727
728  for (i=pVariables; i; i--)
729    j += (int)(pGetExp(p,i) * ecartWeights[i]);
730  return  j;
731}
732
733/*2
734*computes the maximal degree of all terms of the polynomial
735*with respect to given ecartWeights and
736*computes the length of the polynomial
737*used for Graebes method if BTEST1(31) is set
738*/
739int maxdegreeWecart(poly p,int *l)
740{
741  short k=pGetComp(p);
742  int ll=1;
743  int  t,max;
744
745  max=totaldegreeWecart(p);
746  pIter(p);
747  while ((p!=NULL) && (pGetComp(p)==k))
748  {
749    t=totaldegreeWecart(p);
750    if (t>max) max=t;
751    ll++;
752    pIter(p);
753  }
754  *l=ll;
755  return max;
756}
Note: See TracBrowser for help on using the repository browser.