source: git/kernel/combinatorics/hutil.cc @ 5a0d2ae

fieker-DuValspielwiese
Last change on this file since 5a0d2ae was aa8a7e, checked in by Hans Schoenemann <hannes@…>, 7 years ago
use include ".." for singular related .h, p9
  • Property mode set to 100644
File size: 16.7 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: Utilities for staircase operations
6*/
7
8#include "kernel/mod2.h"
9// #include "kernel/structs.h"
10#include "omalloc/omalloc.h"
11
12#include "polys/simpleideals.h"
13#include "polys/monomials/p_polys.h"
14
15// #include "kernel/ideals.h"
16#include "kernel/polys.h"
17#include "kernel/combinatorics/hutil.h"
18
19scfmon hexist, hstc, hrad, hwork;
20scmon hpure, hpur0;
21varset hvar, hsel;
22int  hNexist, hNstc, hNrad, hNvar, hNpure;
23int hisModule;
24monf stcmem, radmem;
25
26// Making a global "security" copy of the allocated exponent vectors
27// is a dirty fix for correct memory disallocation: It would be
28// better, if either the fields of heist are never touched
29// (i.e. changed) except in hInit, or, if hInit would return the
30// "security" copy as well. But then, all the relevant data is held in
31// global variables, so we might do that here, as well.
32static scfmon hsecure= NULL;
33
34scfmon hInit(ideal S, ideal Q, int *Nexist, ring tailRing)
35{
36  id_TestTail(S, currRing, tailRing);
37  if (Q!=NULL) id_TestTail(Q, currRing, tailRing);
38
39//   if (tailRing != currRing)
40    hisModule = id_RankFreeModule(S, currRing, tailRing);
41//  else
42//    hisModule = id_RankFreeModule(S, currRing);
43
44  if (hisModule < 0)
45    hisModule = 0;
46
47  int  sl, ql, i, k = 0;
48  polyset si, qi, ss;
49  scfmon ex, ek;
50
51  if (S!=NULL)
52  {
53    si = S->m;
54    sl = IDELEMS(S);
55  }
56  else
57  {
58    si = NULL;
59    sl = 0;
60  }
61  if (Q!=NULL)
62  {
63    qi = Q->m;
64    ql = IDELEMS(Q);
65  }
66  else
67  {
68    qi = NULL;
69    ql = 0;
70  }
71  if ((sl + ql) == 0)
72  {
73    *Nexist = 0;
74    return NULL;
75  }
76  ss = si;
77  for (i = sl; i>0; i--)
78  {
79    if (*ss!=0)
80      k++;
81    ss++;
82  }
83  ss = qi;
84  for (i = ql; i>0; i--)
85  {
86    if (*ss!=0)
87      k++;
88    ss++;
89  }
90  *Nexist = k;
91  if (k==0)
92    return NULL;
93  ek = ex = (scfmon)omAlloc0(k * sizeof(scmon));
94  hsecure = (scfmon) omAlloc0(k * sizeof(scmon));
95  for (i = sl; i>0; i--)
96  {
97    if (*si!=NULL)
98    {
99      *ek = (scmon) omAlloc(((currRing->N)+1)*sizeof(int));
100      p_GetExpV(*si, *ek, currRing);
101      ek++;
102    }
103    si++;
104  }
105  for (i = ql; i>0; i--)
106  {
107    if (*qi!=NULL)
108    {
109      *ek = (scmon) omAlloc(((currRing->N)+1)*sizeof(int));
110      p_GetExpV(*qi, *ek, currRing);
111      ek++;
112    }
113    qi++;
114  }
115  memcpy(hsecure, ex, k * sizeof(scmon));
116  return ex;
117}
118
119#if 0
120void hWeight()
121{
122  int i, k;
123  int x;
124
125  i = (currRing->N);
126  loop
127  {
128    if (pWeight(i) != 1) break;
129    i--;
130    if (i == 0) return;
131  }
132  for (i=(currRing->N); i>0; i--)
133  {
134    x = pWeight(i);
135    if (x != 1)
136    {
137      for (k=hNexist-1; k>=0; k--)
138      {
139        hexist[k][i] *= x;
140      }
141    }
142  }
143}
144#endif
145
146void hDelete(scfmon ev, int ev_length)
147{
148  int i;
149
150  if (ev_length>0)
151  {
152    for (i=ev_length-1;i>=0;i--)
153      omFreeSize(hsecure[i],((currRing->N)+1)*sizeof(int));
154    omFreeSize(hsecure, ev_length*sizeof(scmon));
155    omFreeSize(ev,  ev_length*sizeof(scmon));
156  }
157}
158
159
160void hComp(scfmon exist, int Nexist, int ak, scfmon stc, int *Nstc)
161{
162  int k = 0;
163  scfmon ex = exist, co = stc;
164  int i;
165
166  for (i = Nexist; i>0; i--)
167  {
168    if (((**ex) == 0) || ((**ex) == ak))
169    {
170      *co = *ex;
171      co++;
172      k++;
173    }
174    ex++;
175  }
176  *Nstc = k;
177}
178
179
180void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
181{
182  int  nv, i0, i1, i, j;
183  nv = i0 = *Nvar;
184  i1 = 0;
185  for (i = 1; i <= nv; i++)
186  {
187    j = 0;
188    loop
189    {
190      if (stc[j][i]>0)
191      {
192        i1++;
193        var[i1] = i;
194        break;
195      }
196      j++;
197      if (j == Nstc)
198      {
199        var[i0] = i;
200        i0--;
201        break;
202      }
203    }
204  }
205  *Nvar = i1;
206}
207
208void hOrdSupp(scfmon stc, int Nstc, varset var, int Nvar)
209{
210  int  i, i1, j, jj, k, l;
211  int  x;
212  scmon temp, count;
213  float o, h, g, *v1;
214
215  v1 = (float *)omAlloc(Nvar * sizeof(float));
216  temp = (int *)omAlloc(Nstc * sizeof(int));
217  count = (int *)omAlloc(Nstc * sizeof(int));
218  for (i = 1; i <= Nvar; i++)
219  {
220    i1 = var[i];
221    *temp = stc[0][i1];
222    *count = 1;
223    jj = 1;
224    for (j = 1; j < Nstc; j++)
225    {
226      x = stc[j][i1];
227      k = 0;
228      loop
229      {
230        if (x > temp[k])
231        {
232          k++;
233          if (k == jj)
234          {
235            temp[k] = x;
236            count[k] = 1;
237            jj++;
238            break;
239          }
240        }
241        else if (x < temp[k])
242        {
243          for (l = jj; l > k; l--)
244          {
245            temp[l] = temp[l-1];
246            count[l] = count[l-1];
247          }
248          temp[k] = x;
249          count[k] = 1;
250          jj++;
251          break;
252        }
253        else
254        {
255          count[k]++;
256          break;
257        }
258      }
259    }
260    h = 0.0;
261    o = (float)Nstc/(float)jj;
262    for(j = 0; j < jj; j++)
263    {
264       g = (float)count[j];
265       if (g > o)
266         g -= o;
267       else
268         g = o - g;
269       if (g > h)
270         h = g;
271    }
272    v1[i-1] = h * (float)jj;
273  }
274  omFreeSize((ADDRESS)count, Nstc * sizeof(int));
275  omFreeSize((ADDRESS)temp, Nstc * sizeof(int));
276  for (i = 1; i < Nvar; i++)
277  {
278    i1 = var[i+1];
279    h = v1[i];
280    j = 0;
281    loop
282    {
283      if (h > v1[j])
284      {
285        for (l = i; l > j; l--)
286        {
287          v1[l] = v1[l-1];
288          var[l+1] = var[l];
289        }
290        v1[j] = h;
291        var[j+1] = i1;
292        break;
293      }
294      j++;
295      if (j == i)
296        break;
297    }
298  }
299  omFreeSize((ADDRESS)v1, Nvar * sizeof(float));
300}
301
302
303static void hShrink(scfmon co, int a, int Nco)
304{
305  while ((co[a]!=NULL) && (a<Nco)) a++;
306  int i = a;
307  int j;
308  for (j = a; j < Nco; j++)
309  {
310    if (co[j]!=NULL)
311    {
312      co[i] = co[j];
313      i++;
314    }
315  }
316}
317
318
319void hStaircase(scfmon stc, int *Nstc, varset var, int Nvar)
320{
321  int  nc = *Nstc;
322  if (nc < 2)
323    return;
324  int z = 0;
325  int i = 0;
326  int j = 1;
327  scmon n = stc[1 /*j*/];
328  scmon o = stc[0];
329  int k = Nvar;
330  loop
331  {
332    int k1 = var[k];
333    if (o[k1] > n[k1])
334    {
335      loop
336      {
337        k--;
338        if (k==0)
339        {
340          stc[i] = NULL;
341          z++;
342          break;
343        }
344        else
345        {
346          k1 = var[k];
347          if (o[k1] < n[k1])
348            break;
349        }
350      }
351      k = Nvar;
352    }
353    else if (o[k1] < n[k1])
354    {
355      loop
356      {
357        k--;
358        if (k==0)
359        {
360          stc[j] = NULL;
361          z++;
362          break;
363        }
364        else
365        {
366          k1 = var[k];
367          if (o[k1] > n[k1])
368            break;
369        }
370      }
371      k = Nvar;
372    }
373    else
374    {
375      k--;
376      if (k==0)
377      {
378        stc[j] = NULL;
379        z++;
380        k = Nvar;
381      }
382    }
383    if (k == Nvar)
384    {
385      if (stc[j]==NULL)
386        i = j - 1;
387      loop
388      {
389        i++;
390        if (i == j)
391        {
392          i = -1;
393          j++;
394          if (j < nc)
395            n = stc[j];
396          else
397          {
398            if (z!=0)
399            {
400              *Nstc -= z;
401              hShrink(stc, 0, nc);
402            }
403            return;
404          }
405        }
406        else if (stc[i]!=NULL)
407        {
408          o = stc[i];
409          break;
410        }
411      }
412    }
413  }
414}
415
416
417void hRadical(scfmon rad, int *Nrad, int Nvar)
418{
419  int  nc = *Nrad, z = 0, i, j, k;
420  scmon n, o;
421  if (nc < 2)
422    return;
423  i = 0;
424  j = 1;
425  n = rad[j];
426  o = rad[0];
427  k = Nvar;
428  loop
429  {
430    if ((o[k]!=0) && (n[k]==0))
431    {
432      loop
433      {
434        k--;
435        if (k==0)
436        {
437          rad[i] = NULL;
438          z++;
439          break;
440        }
441        else
442        {
443          if ((o[k]==0) && (n[k]!=0))
444            break;
445        }
446      }
447      k = Nvar;
448    }
449    else if (!o[k] && n[k])
450    {
451      loop
452      {
453        k--;
454        if (!k)
455        {
456          rad[j] = NULL;
457          z++;
458          break;
459        }
460        else
461        {
462          if (o[k] && !n[k])
463            break;
464        }
465      }
466      k = Nvar;
467    }
468    else
469    {
470      k--;
471      if (!k)
472      {
473        rad[j] = NULL;
474        z++;
475        k = Nvar;
476      }
477    }
478    if (k == Nvar)
479    {
480      if (!rad[j])
481        i = j - 1;
482      loop
483      {
484        i++;
485        if (i == j)
486        {
487          i = -1;
488          j++;
489          if (j < nc)
490            n = rad[j];
491          else
492          {
493            if (z)
494            {
495              *Nrad -= z;
496              hShrink(rad, 0, nc);
497            }
498            return;
499          }
500        }
501        else if (rad[i])
502        {
503          o = rad[i];
504          break;
505        }
506      }
507    }
508  }
509}
510
511
512void hLexS(scfmon stc, int Nstc, varset var, int Nvar)
513{
514  if (Nstc < 2)
515    return;
516  int  j = 1, i = 0;
517  scmon n = stc[j];
518  scmon o = stc[0];
519  int k = Nvar;
520  loop
521  {
522    int k1 = var[k];
523    if (o[k1] < n[k1])
524    {
525      i++;
526      if (i < j)
527      {
528        o = stc[i];
529        k = Nvar;
530      }
531      else
532      {
533        j++;
534        if (j < Nstc)
535        {
536          i = 0;
537          o = stc[0];
538          n = stc[j];
539          k = Nvar;
540        }
541        else
542          return;
543      }
544    }
545    else if (o[k1] > n[k1])
546    {
547      int tmp_k;
548      for (tmp_k = j; tmp_k > i; tmp_k--)
549        stc[tmp_k] = stc[tmp_k - 1];
550      stc[i] = n;
551      j++;
552      if (j < Nstc)
553      {
554        i = 0;
555        o = stc[0];
556        n = stc[j];
557        k = Nvar;
558      }
559      else
560        return;
561    }
562    else
563    {
564      k--;
565      if (k<=0) return;
566    }
567  }
568}
569
570
571void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
572{
573  int  j = 1, i = 0, k, k1;
574  scmon n, o;
575  if (Nrad < 2)
576    return;
577  n = rad[j];
578  o = rad[0];
579  k = Nvar;
580  loop
581  {
582    k1 = var[k];
583    if (!o[k1] && n[k1])
584    {
585      i++;
586      if (i < j)
587      {
588        o = rad[i];
589        k = Nvar;
590      }
591      else
592      {
593        j++;
594        if (j < Nrad)
595        {
596          i = 0;
597          o = rad[0];
598          n = rad[j];
599          k = Nvar;
600        }
601        else
602          return;
603      }
604    }
605    else if (o[k1] && !n[k1])
606    {
607      for (k = j; k > i; k--)
608        rad[k] = rad[k - 1];
609      rad[i] = n;
610      j++;
611      if (j < Nrad)
612      {
613        i = 0;
614        o = rad[0];
615        n = rad[j];
616        k = Nvar;
617      }
618      else
619        return;
620    }
621    else
622      k--;
623  }
624}
625
626
627void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar,
628 scmon pure, int *Npure)
629{
630  int  nc = *Nstc, np = 0, nq = 0, j, i, i1, c, l;
631  scmon x;
632  for (j = a; j < nc; j++)
633  {
634    x = stc[j];
635    i = Nvar;
636    c = 2;
637    l = 0;
638    loop
639    {
640      i1 = var[i];
641      if (x[i1])
642      {
643        c--;
644        if (!c)
645        {
646          l = 0;
647          break;
648        }
649        else if (c == 1)
650          l = i1;
651      }
652      i--;
653      if (!i)
654        break;
655    }
656    if (l)
657    {
658      if (!pure[l])
659      {
660        np++;
661        pure[l] = x[l];
662      }
663      else if (x[l] < pure[l])
664        pure[l] = x[l];
665      stc[j] = NULL;
666      nq++;
667    }
668  }
669  *Npure = np;
670  if (nq!=0)
671  {
672    *Nstc -= nq;
673    hShrink(stc, a, nc);
674  }
675}
676
677
678void hElimS(scfmon stc, int *e1, int a2, int e2, varset var, int Nvar)
679{
680  int  nc = *e1, z = 0, i, j, k, k1;
681  scmon n, o;
682  if (!nc || (a2 == e2))
683    return;
684  j = 0;
685  i = a2;
686  o = stc[i];
687  n = stc[0];
688  k = Nvar;
689  loop
690  {
691    k1 = var[k];
692    if (o[k1] > n[k1])
693    {
694      k = Nvar;
695      i++;
696      if (i < e2)
697        o = stc[i];
698      else
699      {
700        j++;
701        if (j < nc)
702        {
703          i = a2;
704          o = stc[i];
705          n = stc[j];
706        }
707        else
708        {
709          if (z!=0)
710          {
711            *e1 -= z;
712            hShrink(stc, 0, nc);
713          }
714          return;
715        }
716      }
717    }
718    else
719    {
720      k--;
721      if (k==0)
722      {
723        stc[j] = NULL;
724        z++;
725        j++;
726        if (j < nc)
727        {
728          i = a2;
729          o = stc[i];
730          n = stc[j];
731          k = Nvar;
732        }
733        else
734        {
735          if (z!=0)
736          {
737            *e1 -= z;
738            hShrink(stc, 0, nc);
739          }
740          return;
741        }
742      }
743    }
744  }
745}
746
747
748void hElimR(scfmon rad, int *e1, int a2, int e2, varset var, int Nvar)
749{
750  int  nc = *e1, z = 0, i, j, k, k1;
751  scmon n, o;
752  if (!nc || (a2 == e2))
753    return;
754  j = 0;
755  i = a2;
756  o = rad[i];
757  n = rad[0];
758  k = Nvar;
759  loop
760  {
761    k1 = var[k];
762    if (o[k1] && !n[k1])
763    {
764      k = Nvar;
765      i++;
766      if (i < e2)
767        o = rad[i];
768      else
769      {
770        j++;
771        if (j < nc)
772        {
773          i = a2;
774          o = rad[i];
775          n = rad[j];
776        }
777        else
778        {
779          if (z!=0)
780          {
781            *e1 -= z;
782            hShrink(rad, 0, nc);
783          }
784          return;
785        }
786      }
787    }
788    else
789    {
790      k--;
791      if (!k)
792      {
793        rad[j] = NULL;
794        z++;
795        j++;
796        if (j < nc)
797        {
798          i = a2;
799          o = rad[i];
800          n = rad[j];
801          k = Nvar;
802        }
803        else
804        {
805          if (z!=0)
806          {
807            *e1 -= z;
808            hShrink(rad, 0, nc);
809          }
810          return;
811        }
812      }
813    }
814  }
815}
816
817
818void hLex2S(scfmon rad, int e1, int a2, int e2, varset var,
819 int Nvar, scfmon w)
820{
821  int  j0 = 0, j = 0, i = a2, k, k1;
822  scmon n, o;
823  if (!e1)
824  {
825    for (; i < e2; i++)
826      rad[i - a2] = rad[i];
827    return;
828  }  else if (i == e2)
829    return;
830  n = rad[j];
831  o = rad[i];
832  loop
833  {
834    k = Nvar;
835    loop
836    {
837      k1 = var[k];
838      if (o[k1] < n[k1])
839      {
840        w[j0] = o;
841        j0++;
842        i++;
843        if (i < e2)
844        {
845          o = rad[i];
846          break;
847        }
848        else
849        {
850          for (; j < e1; j++)
851          {
852            w[j0] = rad[j];
853            j0++;
854          }
855          memcpy(rad, w, (e1 + e2 - a2) * sizeof(scmon));
856          return;
857        }
858      }
859      else if (o[k1] > n[k1])
860      {
861        w[j0] = n;
862        j0++;
863        j++;
864        if (j < e1)
865        {
866          n = rad[j];
867          break;
868        }
869        else
870        {
871          for (; i < e2; i++)
872          {
873            w[j0] = rad[i];
874            j0++;
875          }
876          memcpy(rad, w, (e1 + e2 - a2) * sizeof(scmon));
877          return;
878        }
879      }
880      k--;
881    }
882  }
883}
884
885
886void hLex2R(scfmon rad, int e1, int a2, int e2, varset var,
887 int Nvar, scfmon w)
888{
889  int  j0 = 0, j = 0, i = a2, k, k1;
890  scmon n, o;
891  if (!e1)
892  {
893    for (; i < e2; i++)
894      rad[i - a2] = rad[i];
895    return;
896  }
897  else if (i == e2)
898    return;
899  n = rad[j];
900  o = rad[i];
901  loop
902  {
903    k = Nvar;
904    loop
905    {
906      k1 = var[k];
907      if (!o[k1] && n[k1])
908      {
909        w[j0] = o;
910        j0++;
911        i++;
912        if (i < e2)
913        {
914          o = rad[i];
915          break;
916        }
917        else
918        {
919          for (; j < e1; j++)
920          {
921            w[j0] = rad[j];
922            j0++;
923          }
924          memcpy(rad, w, (e1 + e2 - a2) * sizeof(scmon));
925          return;
926        }
927      }
928      else if (o[k1] && !n[k1])
929      {
930        w[j0] = n;
931        j0++;
932        j++;
933        if (j < e1)
934        {
935          n = rad[j];
936          break;
937        }
938        else
939        {
940          for (; i < e2; i++)
941          {
942            w[j0] = rad[i];
943            j0++;
944          }
945          memcpy(rad, w, (e1 + e2 - a2) * sizeof(scmon));
946          return;
947        }
948      }
949      k--;
950    }
951  }
952}
953
954
955void hStepS(scfmon stc, int Nstc, varset var, int Nvar, int *a, int *x)
956{
957  int  k1, i;
958  int  y;
959  k1 = var[Nvar];
960  y = *x;
961  i = *a;
962  loop
963  {
964    if (y < stc[i][k1])
965    {
966      *a = i;
967      *x = stc[i][k1];
968      return;
969    }
970    i++;
971    if (i == Nstc)
972    {
973      *a = i;
974      return;
975    }
976  }
977}
978
979
980void hStepR(scfmon rad, int Nrad, varset var, int Nvar, int *a)
981{
982  int  k1, i;
983  k1 = var[Nvar];
984  i = 0;
985  loop
986  {
987    if (rad[i][k1])
988    {
989      *a = i;
990      return;
991    }
992    i++;
993    if (i == Nrad)
994    {
995      *a = i;
996      return;
997    }
998  }
999}
1000
1001
1002monf hCreate(int Nvar)
1003{
1004  monf xmem;
1005  int  i;
1006  xmem = (monf)omAlloc((Nvar + 1) * sizeof(monp));
1007  for (i = Nvar; i>0; i--)
1008  {
1009    xmem[i] = (monp)omAlloc(LEN_MON);
1010    xmem[i]->mo = NULL;
1011  }
1012  return xmem;
1013}
1014
1015
1016void hKill(monf xmem, int Nvar)
1017{
1018  int  i;
1019  for (i = Nvar; i!=0; i--)
1020  {
1021    if (xmem[i]->mo!=NULL)
1022      omFreeSize((ADDRESS)xmem[i]->mo, xmem[i]->a * sizeof(scmon));
1023    omFreeSize((ADDRESS)xmem[i], LEN_MON);
1024  }
1025  omFreeSize((ADDRESS)xmem, (Nvar + 1) * sizeof(monp));
1026}
1027
1028
1029scfmon hGetmem(int lm, scfmon old, monp monmem)
1030{
1031  scfmon x = monmem->mo;
1032  int  lx = monmem->a;
1033  if ((x==NULL) || (lm > lx))
1034  {
1035    /* according to http://www.singular.uni-kl.de:8002/trac/ticket/463#comment:4
1036     * we need to work around a compiler bug:
1037    * if ((x!=NULL)&&(lx>0)) omFreeSize((ADDRESS)x, lx * sizeof(scmon));
1038    */
1039    if (x!=NULL) if (lx>0) omFreeSize((ADDRESS)x, lx * sizeof(scmon));
1040    monmem->mo = x = (scfmon)omAlloc(lm * sizeof(scmon));
1041    monmem->a = lm;
1042  }
1043  memcpy(x, old, lm * sizeof(scmon));
1044  return x;
1045}
1046
1047/*
1048* a bug in Metrowerks with "lifetime analysis"
1049*scmon hGetpure(scmon p)
1050*{
1051*  scmon p1, pn;
1052*  p1 = p + 1;
1053*  pn = p1 + (currRing->N);
1054*  memcpy(pn, p1, (currRing->N) * sizeof(int));
1055*  return pn - 1;
1056*}
1057*/
1058scmon hGetpure(scmon p)
1059{
1060  scmon p1 = p;
1061  scmon pn;
1062  p1++;
1063  pn = p1;
1064  pn += (currRing->N);
1065  memcpy(pn, p1, (currRing->N) * sizeof(int));
1066  return pn - 1;
1067}
1068
Note: See TracBrowser for help on using the repository browser.