source: git/Singular/LIB/recover.lib @ b474f1

spielwiese
Last change on this file since b474f1 was b474f1, checked in by Hans Schoenemann <hannes@…>, 9 years ago
new libs: deflation.lib maxlike.lib recover.lib
  • Property mode set to 100644
File size: 66.6 KB
Line 
1//////////////////////////////////////////////////////////////////////////////
2version="version recover.lib 4.0.2.0 30.03.2015 "; // $Id$
3category="Algebraic Geometry";
4info="
5LIBRARY:  recover.lib  Hybrid numerical/symbolical algorithms for algebraic geometry
6AUTHOR:  Adrian Koch (kocha at rhrk.uni-kl.de)
7
8OVERVIEW: In this library you'll find implementations of some of the algorithms presented
9          in the paper listed below: Bertini is used to compute a witness set of a given
10          ideal I. Then a lattice basis reduction algorithm is used to recover exact
11          results from the inexact numerical data. More precisely, we obtain elements
12          of prime components of I, the radical of I, or an elimination ideal of I.
13
14          NOTE that Bertini may create quite a lot of files in the current directory
15          (or overwrite files which have the same names as the files it wants to create).
16          It also prints information to the screen.
17
18          The usefulness of the results of the exactness recovery algorithms heavily
19          depends on the quality of the witness set and the quality of the lattice basis
20          reduction algorithm.
21          The procedures requiring a witness set as part of their input use a simple,
22          unsofisticated version of the LLL algorithm.
23
24REFERENCES:
25 Daniel Bates, Jonathan Hauenstein, Timothy McCoy, Chris Peterson, and Andrew Sommese;
26   Recovering exact results from inexact numerical data in algebraic geometry;
27   Published in Experimental Mathematics 22(1) on pages 38-50 in 2013
28
29KEYWORDS: numerical algebraic geometry; hybrid algorithms; exactness recovery
30
31PROCEDURES:
32 substAll(v,p);           poly: ring variables in v substituted by elements of p
33 veronese(d,p);           ideal: image of p under the degree d Veronese embedding
34 getRelations(p,..);      list of ideals: homogeneous polynomial relations between
35                          components of p
36 getRelationsRadical(p,..); modified version of getRelations
37 gaussRowWithoutPerm(M);  matrix: a row-reduced form of M
38 gaussColWithoutPerm(M);  matrix: a column-reduced form of M
39 getWitnessSet();         extracts the witness set from the file \"main_data\" produced
40                          by Bertini
41 writeBertiniInput(J);    writes the input-file for bertini with the polynomials in J
42                          as functions
43 num_prime_decom(I,..);   is supposed to compute a prime decomposition of the radical of I
44 num_prime_decom1(P,..);  is supposed to compute a prime decomposition for the ideal
45                          represented by the witness point set P
46 num_radical_via_decom(I,..);
47                          compute elements of the radical of I by using num_prime_decom
48 num_radical_via_randlincom(I,..);
49                        computes elements of the radical of I by using a different method
50 num_radical1(P,..);      computes elements of the radical via num_prime_decom1
51 num_radical2(P,..);      computes elements of the radical using a different method
52 num_elim(I,f,..);        computes elements of the elimination ideal of I w.r.t. the
53                          variables specified by f
54 num_elim1(P,..,v);       computes elements of the elimination ideal of the ideal
55                          represented by the witness point set P (w.r.t. the variables
56                          specified in v)
57 realLLL(M);              simple version of the LLL-algorithm;works only over real numbers
58";
59
60
61LIB "matrix.lib";
62LIB "linalg.lib";
63LIB "inout.lib";
64LIB "atkins.lib";
65
66/////////////////////////////////////////////////////////////////////////////////////////
67///////////////////////    static procs for rounding      ///////////////////////////////
68/////////////////////////////////////////////////////////////////////////////////////////
69
70static proc getposi(string s)
71{//returns the position of the . in a complex number, or 0 if there is no . in s
72   int i;
73   for(i=1; i<=size(s); i++)
74   {
75      if(s[i] == "."){return(i);}
76   }
77   return(0);
78}
79
80static proc string2digit(string ti)
81{
82   intvec v=0,1,2,3,4,5,6,7,8,9;
83   int i;
84   for(i=1; i<=size(v); i++)
85   {
86      if( ti == string(v[i]) )
87      {
88         return(poly(v[i]));
89      }
90   }
91}
92
93static proc string2poly(string t)
94{
95   poly r=string2digit(t[1]);
96   int i;
97   for(i=2; i<=size(t); i++)
98   {
99      r=r*10+string2digit(t[i]);
100   }
101   return(r);
102}
103
104static proc roundstringpoly(string s, int posi)
105{//returns the
106   string t;
107   //first check, whether s is negative or not
108   int e=0;
109   if(s[1]=="-")
110   {
111      e=1;
112      t=s[2..(posi-1)];//start at the second symbol (to drop the minus)
113   }
114   else
115   {
116      t=s[1..(posi-1)];
117   }
118
119   poly r=string2poly(t);//this is always the rounded-down version of the absolute value
120   //of r
121   //we have to check now, whether we should have rounded up
122   //for that, we check the digit after the .
123   if(string2digit(s[posi+1]) >= 5)
124   {
125      r=r+1;
126   }
127
128   if(e == 1)
129   {//readjust the sign, if needed
130      r=-r;
131   }
132   return(r);
133}
134
135static proc roundpoly(poly r)
136{
137   string s=string(r);
138   int posi=getposi(s);
139   if(posi == 0)
140   {//there is no . in r, so r is an integer
141      return(r);
142   }
143   return(roundstringpoly(s, posi));
144}
145
146/////////////////////////////////////////////////////////////////////////////////////////
147/////////////////////////      Veronese embedding        ////////////////////////////////
148/////////////////////////////////////////////////////////////////////////////////////////
149
150proc substAll(poly v, list p)
151"USAGE:   substAll(v,p); poly v, list p
152RETURN:  poly: the polynomial obtained from v by substituting the elements of p for the
153               ring variables
154NOTE:    The list p should have as many elements as there are ring variables.
155EXAMPLE: example substAll; shows an example
156"
157{//substitutes the elements of p for the ring variables
158   //used to obtain the value of the veronese map
159   int i;
160   poly f=v;
161   for(i=1; i<=nvars(basering); i++)
162   {
163      f=subst(f,var(i),p[i]);
164   }
165   return(f);
166}
167example
168{ "EXAMPLE:"; echo=2;
169  ring r=0,(x,y,z),dp;
170  poly v=x+y+z;
171  list p=7/11,5/11,-1/11;
172  poly f=substAll(v,p);
173  f;
174}
175
176proc veronese(int d, list p)
177"USAGE:   veronese(d,p); int d, list p
178RETURN:  ideal: the image of the point p under the degree d Veronese embedding
179NOTE:    The list p should have as many elements as there are ring variables.
180         The order of the points in the returned ideal corresponds to the order of the
181         monomials in maxideal(d).
182SEE ALSO: maxideal
183EXAMPLE: example veronese; shows an example
184"
185{//image of p under the degree d Veronese embedding
186   ideal V=maxideal(d);
187   int i;
188   poly v;
189   int len=size(V);
190   for(i=1; i <= len; i++)
191   {
192      v=V[i];
193      v=substAll(v,p);
194      V[i]=v;
195   }
196   return(V);
197}
198example
199{ "EXAMPLE:"; echo=2;
200  ring R=0,(x,y,z),dp;
201  list p=2,3,5;
202  ideal V=veronese(1,p);
203  V;
204  V=veronese(2,p);
205  V;
206}
207
208static proc veronese_radical(int d, list P)
209{//returns a random linear combination of the images of the points in P under the
210   //degree d Veronese embedding
211   list p;//one of the points in P
212   ideal Vp;//the Veronese embedding of p
213   int i;
214   for(i=1; i<=size(P); i++)
215   {
216      p=P[i];
217      Vp=veronese(d,p);
218      P[i]=Vp;
219   }
220   //so we've replaced the points p with their images under the Veronese embedding
221   //now we do a random linear combination of all these images
222
223   //first, we rand some factors
224   int di=10**7;
225   int de=1;
226   ideal F=poly(random(de,di))/di;
227   poly f;
228   for(i=2; i<=size(P); i++)
229   {
230      f=poly(random(de,di))/di;
231      F=F,f;
232   }
233
234   //then we compute the linear combination
235   poly v;
236   int j;
237   for(j=1; j<=size(P); j++)
238   {
239      Vp=P[j];
240      v=v+F[j]*Vp[1];
241   }
242   ideal V=v;
243   int len=size(maxideal(d));
244   for(i=2; i<=len; i++)
245   {
246      v=0;
247      for(j=1; j<=size(P); j++)
248      {
249         Vp=P[j];
250         v=v+F[j]*Vp[i];
251      }
252      V=V,v;
253   }
254
255   return(V);
256}
257
258/////////////////////////////////////////////////////////////////////////////////////////
259//////////////////////////          some static procs          //////////////////////////
260/////////////////////////////////////////////////////////////////////////////////////////
261
262static proc randlincom(ideal V, int len)
263{//produces a random linear combination of the real vectors defined by the real and the
264   //imaginary part of V, respectively
265   //(V is the image of a complex point p under a veronese embedding)
266   poly randre,randim;
267   int di=10**9;
268   int de=1;
269   //we get one of 2(di-de) numbers between (-)de/di and (-)1
270   randre=(-1)**random(1,2)*poly(random(de,di))/di;
271   randim=(-1)**random(1,2)*poly(random(de,di))/di;
272
273   ideal lincom=randre*repart(leadcoef(V[1]))+randim*impart(leadcoef(V[1]));
274
275   int i;
276   for(i=2; i<=len; i++)
277   {
278      lincom=lincom,randre*repart(leadcoef(V[i]))+randim*impart(leadcoef(V[i]));
279   }
280   return(lincom);
281}
282
283static proc getmatrix(ideal V, bigint C, int len)
284{//constructs the stacked matrix, but with randlincom(V,len) instead of V
285   ideal rl=randlincom(V,len);
286   matrix v=transpose(matrix(rl));
287   matrix E=diag(1,len);
288   v=C*v;
289   E=concat(E,v);
290   E=transpose(E);
291   return(E);
292}
293
294static proc getpolys(matrix B, int d)
295{//takes the integer parts* of the columns of B and uses them as coefficients in a
296   //homogeneous poly of degree d
297   //i.e. the first nrows-1 entries
298   ideal V=maxideal(d);
299   poly r=0;//will be one of the relation-polys
300   ideal R;//will contain all the relations
301   intvec rM=1..(nrows(B)-1);
302   intvec cM=1..ncols(B);
303   matrix M=submat(B,rM,cM);//B without the last row
304   //poly nu=poly(10)**(2*d);
305   int i,j;
306   for(i=1; i<=ncols(M); i++)
307   {
308      if(absValue(B[nrows(B),i]) < 10)//if(is_almost_zero(B,i,d))
309      {//we should check first, if the value of the generated poly in p (i.e. the last
310         //entry of the respective column in B) is "almost" 0
311         if(1)
312         {
313            for(j=1; j<=size(V); j++)
314            {
315               r=r+M[j,i]*V[j];
316            }
317            R=R,r;
318            r=0;
319         }
320      }
321   }
322   R=simplify(R,2);//gets rid of the zeroes
323   return(R);
324}
325
326static proc getD(ideal J)
327{
328   //computes the maximal degree among elements of J
329   int maxdeg,c,i;
330   poly g;
331   for(i=1; i<=size(J); i++)
332   {
333      g=J[i];
334      c=deg(g);
335      if(c > maxdeg)
336      {
337         maxdeg=c;
338      }
339   }
340   return(maxdeg);
341}
342
343//////////////////////////////////////////////////////////////////////////////////////////
344//////////////////////////////////////////////////////////////////////////////////////////
345///////////////////////////      use_LLL procedures     //////////////////////////////////
346//////////////////////////////////////////////////////////////////////////////////////////
347//////////////////////////////////////////////////////////////////////////////////////////
348
349
350static proc mat2list(bigintmat B)
351{
352   list c;//column of B
353   list M;//the matrix: list of column-lists
354
355   int i,j;
356   for(i=1; i<=ncols(B); i++)
357   {
358      for(j=1; j<=nrows(B); j++)
359      {
360         c=c+list(B[j,i]);
361      }
362      M=M+list(c);
363      c=list();
364   }
365
366   return(M);
367}
368
369static proc list2bigintmat(list L);
370{
371   int c=size(L);
372   int r=size(L[1]);
373   bigintmat B[r][c];
374   list Li;
375   int i,j;
376   for(i=1; i<=c; i++)
377   {
378      Li=L[i];
379      for(j=1; j<=r; j++)
380      {
381         B[j,i]=Li[j];
382      }
383   }
384
385   return(B);
386}
387
388static proc bigint2poly(bigint b)
389{
390   poly p;
391   string bs=string(b);
392
393   int st=1;
394   int c;
395   if(bs[1] == "-")
396   {
397      st=2;
398      c=1;
399   }
400
401
402   int i;
403   for(i=st; i<=size(bs); i++)
404   {
405      p=p*10+string2intdigit(bs[i]);
406   }
407
408
409   if(c == 1)
410   {
411      return(-p);
412   }
413
414   return(p);
415}
416
417static proc bigintmat2matrix(bigintmat B)
418{//type conversion via matrix(B) does not work
419   int r=nrows(B);
420   int c=ncols(B);
421   matrix M[r][c];
422
423   int i,j;
424   for(i=1; i<=r; i++)
425   {
426      for(j=1; j<=c; j++)
427      {
428         M[i,j]=bigint2poly(B[i,j]);
429      }
430   }
431
432   return(M);
433}
434
435static proc use_LLL(matrix A)
436{
437   //first, we round the entries in the last row of A
438   int r=nrows(A);
439   int c=ncols(A);
440   int i;
441   for(i=1; i<=c; i++)
442   {
443      A[r,i]=roundpoly(A[r,i]);
444   }
445
446   //now, all entries of A are integers, but still have type poly
447   //so we convert A to a bigintmat B
448   bigintmat B=mat2bigintmat(A);
449
450   //apply LLL
451   list M=mat2list(B);
452   list L=LLL(M);
453   B=list2bigintmat(L);
454
455   return(bigintmat2matrix(B));
456}
457
458
459static proc use_LLL_bigintmat(matrix A)
460{//returns a bigintmat instead of a matrix
461   //first, we round the entries in the last row of A
462   int r=nrows(A);
463   int c=ncols(A);
464   int i;
465   for(i=1; i<=c; i++)
466   {
467      A[r,i]=roundpoly(A[r,i]);
468   }
469
470   //now, all entries of A are integers, but still have type poly
471   //so we convert A to a bigintmat B
472   bigintmat B=mat2bigintmat(A);
473
474   //apply LLL
475   list M=mat2list(B);
476   list L=LLL(M);
477   B=list2bigintmat(L);
478
479   return(B);
480}
481
482static proc use_FLINT_LLL(matrix A)
483{
484   //first, we round the entries in the last row of A
485   int r=nrows(A);
486   int c=ncols(A);
487   int i;
488   for(i=1; i<=c; i++)
489   {
490      A[r,i]=roundpoly(A[r,i]);
491   }
492
493   //now, all entries of A are integers, but still have type poly
494   //so we convert A to a bigintmat B
495   bigintmat B=mat2bigintmat(A);
496
497   //apply LLL
498   bigintmat BB=system("LLL_Flint",B);
499
500   return(BB);
501}
502
503static proc use_NTL_LLL(matrix A)
504{
505   //first, we round the entries in the last row of A
506   int r=nrows(A);
507   int c=ncols(A);
508   int i;
509   for(i=1; i<=c; i++)
510   {
511      A[r,i]=roundpoly(A[r,i]);
512   }
513
514
515   //now, all entries of A are integers, but still have type poly
516   //so we convert A to a bigintmat B
517   bigintmat B=mat2bigintmat(A);
518
519   def br=basering;
520   ring newr=0,x,dp;
521   matrix A=bigintmat2matrix(B);
522
523   //NTL wants the lattice-vectors as row-vectors and returns a matrix of row-vectors
524   A=transpose(A);
525   matrix AA=system("LLL",A);
526   AA=transpose(AA);
527   bigintmat BB=mat2bigintmat(AA);
528   setring br;
529
530   return(BB);
531}
532
533//////////////////////////////////////////////////////////////////////////////////////////
534//////////////////////////////////////////////////////////////////////////////////////////
535///////////////////////////    the main procedure(s)    //////////////////////////////////
536//////////////////////////////////////////////////////////////////////////////////////////
537//////////////////////////////////////////////////////////////////////////////////////////
538
539proc getRelations(list p, int D, bigint C)
540"USAGE:    getRelations(p,D,C); list p, int D, bigint C
541RETURN:   list K: a list of ideals; the ideals contain homogeneous polynomial relations of
542          degree <=D between the components of the point p
543NOTE:     This procedure uses only the images of the one point p under the Veronese
544          embeddings to find homogeneous polynomial relations.
545SEE ALSO: getRelationsRadical
546EXAMPLE:  example getRelations; shows an example
547"
548{//uses degree d Veronese embeddings (for all d<=D) and LLL-algorithm to find
549   //(homogeneous) polynomial relations between the entries of p
550   //C is the Value with which the Veronese embedding is being multiplied (cf getmatrix)
551
552   if(nvars(basering) != size(p) )
553   {
554      ERROR("Number of variables not equal to the number of components of p.");
555   }
556
557   //get the precision
558   list RL=ringlist(basering);
559   RL=RL[1];
560   RL=RL[2];
561   int Prec=RL[2];
562
563   list P=list(p);
564
565   int d,i,len;
566   intvec rm;
567   ideal vd,Kd;
568   list K;
569   matrix A,B;
570   for(d=1; d<=D; d++)
571   {
572      vd=veronese(d,p);
573      len=size(maxideal(d));
574      A=getmatrix(vd,C,len);
575      B=realLLL(A);
576
577      Kd=getpolys(B,d);
578
579      if(size(Kd) == 0)//i.e. Kd has only zero-entries
580      {//then dont add Kd to the list of relations
581         d++;
582         continue;
583      }
584
585
586      rm=check_is_zero_lincomradical(Prec,Kd,P);
587      for(i=1; i<=size(rm); i++)
588      {
589         if( rm[i] == 1 )
590         {
591              Kd[i] = 0;
592         }
593      }
594
595      Kd=simplify(Kd,2);
596
597
598      if(size(Kd) == 0)//i.e. Kd has only zero-entries
599      {//then dont add Kd to the list of relations
600         d++;
601         continue;
602      }
603
604      K=K+list(Kd);
605   }
606   return(K);
607}
608example
609{ "EXAMPLE:"; echo=2;
610  ring r=(complex,50),(x,y,z),dp;
611  list p=1,-1,0.5;
612  getRelations(p,2,10000);
613}
614
615proc getRelationsRadical(list P, int D, bigint C)
616"USAGE:    getRelationsRadical(P,D,C); list P, int D, bigint C
617RETURN:   list K: a list of ideals; the ideals contain homogeneous polynomial relations of
618          degree <=D between the components of the points in P
619NOTE:     This procedure uses random linear combination of the Veronese embeddings of all
620          points in P to find homogeneous polynomial relations.
621SEE ALSO: getRelations
622EXAMPLE:  example getRelationsRadical; shows an example
623"
624{//here we compute random linear combinations of the degree d Veronese embeddings of the
625   //points in P and then proceed as in getRelations to get homogeneous polynomials
626   //which vanish on all points in P (with high probability)
627
628   if(nvars(basering) != size(P[1]) )
629   {
630      ERROR("Number of variables not equal to the number of components of P[1].");
631   }
632
633   //get the precision
634   list RL=ringlist(basering);
635   RL=RL[1];
636   RL=RL[2];
637   int Prec=RL[2];
638
639   int d,i,len;
640   intvec rm;
641   ideal vd,Kd;
642   list K;
643   matrix A,B;
644   for(d=1; d<=D; d++)
645   {
646      vd=veronese_radical(d,P);
647      len=size(maxideal(d));
648      A=getmatrix(vd,C,len);
649      B=realLLL(A);
650      Kd=getpolys(B,d);
651
652      if(size(Kd) == 0)//i.e. Kd has only zero-entries
653      {//then dont add Kd to the list of relations
654         d++;
655         continue;
656      }
657
658
659      rm=check_is_zero_lincomradical(Prec,Kd,P);
660      for(i=1; i<=size(rm); i++)
661      {
662         if( rm[i] == 1 )
663         {
664              Kd[i] = 0;
665         }
666      }
667
668      Kd=simplify(Kd,2);
669
670
671      if(size(Kd) == 0)//i.e. Kd has only zero-entries
672      {//then dont add Kd to the list of relations
673         d++;
674         continue;
675      }
676
677      K=K+list(Kd);
678   }
679   return(K);
680}
681example
682{ "EXAMPLE:"; echo=2;
683  ring r=(complex,50),(x,y,z),dp;
684  list p1=1,-1,0.5;
685  list p2=1,0,-1;
686  list P=list(p1)+list(p2);
687  getRelationsRadical(P,2,10**5);
688}
689
690//////////////////////////////////////////////////////////////////////////////////////////
691//////////////////////////////////////////////////////////////////////////////////////////
692///////////////////////////       Gauss reduction       //////////////////////////////////
693//////////////////////////////////////////////////////////////////////////////////////////
694//////////////////////////////////////////////////////////////////////////////////////////
695
696static proc find_unused_nonzero(matrix M, int j, intvec used)
697{//look in column j of M for a non-zero entry in an unused row
698   //if there is one, return its row index
699   //if there isn't, return 0
700   int i;
701   int r=nrows(M);
702   for(i=1; i<=r; i++)
703   {
704      if(used[i] == 0)
705      {
706         if(M[i,j] != 0)
707         {
708            return(i);
709         }
710      }
711   }
712   return(0);
713}
714
715proc gaussRowWithoutPerm(matrix M)
716"USAGE:   gaussRowWithoutPerm(M); M a matrix of constant polynomials
717RETURN:  matrix: basic Gaussian row reduction of M, just without permuting the rows
718EXAMPLE: example gaussRowWithoutPerm; shows an example
719"
720{//M a matrix of constant polys
721   int n=ncols(M);
722   int r=nrows(M);
723   int i,j,k;
724   intvec used;//the rows we already used to make entries in other rows 0
725   used[r]=0;//makes it a zero-intvec of length r
726   //we dont want to change these used rows anymore and we dont want to use them again
727   //entry i will be set to 1 if we used row i already
728   for(j=1; j<=n; j++)//go through all columns of M
729   {
730      //find the first non-zero entry
731      i=find_unused_nonzero(M,j,used);
732      if(i != 0)
733      {//and use it to make all non-pivot entries in the column equal to 0
734         used[i]=1;
735         for(k=1; k<=r; k++)
736         {
737            if(used[k] == 0)
738            {
739               if(M[k,j] != 0)
740               {
741                  M=addrow(M,i,-M[k,j]/M[i,j],k);
742               }
743            }
744         }
745      }
746   }
747   return(M);
748}
749example
750{ "EXAMPLE:"; echo=2;
751  ring r=0,x,dp;
752  matrix M[5][4]=0,0,2,1,4,5,1,3,0,9,2,0,8,1,0,6,0,9,4,1;
753  print(M);
754  print(gaussRowWithoutPerm(M));
755}
756
757proc gaussColWithoutPerm(matrix M)
758"USAGE:   gaussColWithoutPerm(M); M a matrix of constant polynomials
759RETURN:  matrix: basic Gaussian column reduction of M, just without permuting the columns
760EXAMPLE: example gaussColWithoutPerm; shows an example
761"
762{
763   matrix T=transpose(M);
764   matrix G=gaussRowWithoutPerm(T);
765   return(transpose(G));
766}
767example
768{ "EXAMPLE:"; echo=2;
769  ring r=0,x,dp;
770  matrix M[3][4]=0,1,0,2,1,2,3,4,1,0,5,0;
771  print(M);
772  print(gaussColWithoutPerm(M));
773}
774
775//////////////////////////////////////////////////////////////////////////////////////////
776//////////////////////////////////////////////////////////////////////////////////////////
777///////////////////////   static procs needed for minrelations      //////////////////////
778//////////////////////////////////////////////////////////////////////////////////////////
779//////////////////////////////////////////////////////////////////////////////////////////
780
781static proc multwithmaxideal(ideal I, int a)
782{//returns the ideal IM containing all products of elements of I and maxideal(a)
783   ideal M=maxideal(a);
784   int sM=size(M);
785   ideal IM=I*M[1];
786
787   int i;
788   for(i=2; i<=sM; i++)
789   {
790      IM=IM,I*M[i];
791   }
792   return(IM);
793}
794
795static proc prodofallringvars(int dummy)
796{//returns the product of all ring variables
797   poly f=1;
798   int i;
799   for(i=1; i<=nvars(basering); i++)
800   {
801      f=f*var(i);
802   }
803   return(f);
804}
805
806static proc getcoefmat(ideal IM, int m)
807{//computes the matrix of coefficients of the elements of IM
808   //the order of the coefficients in each column corresponds to the order of the
809   //monomials in maxideal(m);
810   matrix Co;
811   ideal M=maxideal(m);
812   int sM=size(M);
813   matrix C[sM][1];//the coeff vector of an element of IM with the coeffs placed at
814   //the appropriate positions
815   IM=simplify(IM,2);//be sure that size(IM) is the right thing -> get rid of zeroes
816   int sIM=size(IM);
817   matrix B;
818   poly pr=prodofallringvars(1);
819   poly g, Coj;
820   int i,j,k;
821   for(i=1; i<=sIM; i++)
822   {
823      g=IM[i];
824      Co=coef(g,pr);
825
826      //we now have to put the coeffs in the appropriate places (corresponding to the
827      //position of the respective monomial in maxideal)
828      for(j=1; j<=ncols(Co); j++)
829      {
830         Coj=Co[1,j];//arranged as row vectors
831         //compare the monomials of g with the elements of maxideal(m)
832         //and when we find a match, place the coef at the appropriate place in C
833         for(k=1; k<=sM; k++)
834         {
835            if(M[k] == Coj)
836            {
837               C[k,1]=Co[2,j];
838               break;//we dont need to check any other elements of M
839               //since theyre all different
840            }
841         }
842      }
843
844      if(i==1)
845      {
846         B=C;
847         C=0;
848         i++;
849         continue;
850      }
851      B=concat(B,C);
852      C=0;//reset C to the zero vector
853   }
854   return(B);
855}
856
857static proc getconcatcoefmats(list L)
858{//L the first size(L) entries of K
859   //returns the concatenated coef matrices
860   //more precisely: let m be the degree of the elements of L[size(L)], then we want
861   //to know, which homogenous polynomials of degree m can be written as a combination
862   //of polynomials in the ideals contained in L. In particular, we want to know which
863   //of the elements of L[size(L)] can be written as a combination of other polys
864   //in L and are thereby superfluous (cf superfluousL)
865   //what we do here is, we multiply each polynomial (of degree, say, d) in L with a
866   //monomial of degree m-d and then store the coefficients of the resulting poly
867   //in a matrix
868   //(this is rather cumbersome and can probably be improved upon significantly)
869
870   matrix B,C;
871   ideal IM,I;
872   int i,d,m;
873   poly l;
874   int sL=size(L);
875
876   l=L[sL][1];//the polys are homogeneous; deg rising along L; deg same in L[j]
877   //for all j
878   m=deg(l);//the max degree
879
880   if(sL == 1)
881   {//then we only consider polys of one certain degree, so we don't have to
882      //multiply any of the ideals with any maxideal
883      C=getcoefmat(L[1],m);
884      return(C);//we dont concatenate anything here, so the initialization of
885      //C as the 1x1-zero-matrix is not an issue
886   }
887
888   for(i=1; i<sL; i++)
889   {
890      I=L[i];
891      d=deg(I[1]);
892      IM=multwithmaxideal(I,m-d);
893      B=getcoefmat(IM,m);
894      C=concat(C,B);//will again have as first column the zero vector
895   }
896
897   //if i=sL, the polys in L[i] already have the degree m, so we dont need to multiply
898   B=getcoefmat(L[sL],m);
899   C=concat(C,B);
900
901   //C will contain a zero-column at the beginning, because of the
902   //initialization of B as the 1x1-mat with single entry 0 + the way
903   //concat handles that situation
904   return( submat(C,1..nrows(C),2..ncols(C)) );
905}
906
907static proc string2intdigit(string ti)
908{//ti a string of size 1, containing an integer digit
909   //return the digit
910   intvec v=0,1,2,3,4,5,6,7,8,9;
911   int i;
912   for(i=1; i<=size(v); i++)
913   {
914      if( ti == string(v[i]) )
915      {
916         return(v[i]);
917      }
918   }
919}
920
921static proc string2bigint(string s)
922{
923   string t=s;
924   int e=0;
925   if(s[1]=="-")
926   {
927      e=1;
928      t=s[2..size(s)];//start at the second symbol (to drop the minus)
929   }
930   bigint r=string2intdigit(t[1]);
931   int i;
932   for(i=2; i<=size(t); i++)
933   {
934      r=r*10+string2intdigit(t[i]);
935   }
936
937   if(e == 1)
938   {//readjust the sign, if needed
939      r=-r;
940   }
941
942   return(r);
943}
944
945static proc mat2bigintmat(matrix M)
946{//M a matrix filled with constant polys of integer value
947   //return the corresponding bigintmat
948   int c=ncols(M);
949   int r=nrows(M);
950   bigintmat intM[r][c];
951   int i,j;
952   for(i=1; i<=r; i++)
953   {
954      for(j=1; j<=c; j++)
955      {
956         intM[i,j]=string2bigint(string(M[i,j]));
957      }
958   }
959   return(intM);
960}
961
962static proc findnonzero(matrix M, int j)
963{//look in column j of M for a non-zero entry
964   //if there is one, return its row index
965   //if there isn't, return 0
966   int i;
967   int r=nrows(M);
968   for(i=1; i<=r; i++)
969   {
970      if(M[i,j] != 0)
971      {
972         return(i);
973      }
974   }
975   return(0);
976}
977
978//////////////////////////////////////////////////////////////////////////////////////////
979///////////////////////////////      minrelations      ///////////////////////////////////
980//////////////////////////////////////////////////////////////////////////////////////////
981
982static proc superfluousL(list L)
983{//returns an intvec containing the indices of the elements (of the ideal with highest
984   //degree in L) which can be dropped
985   intvec sprfls;
986   matrix C=getconcatcoefmats(L);
987   bigintmat intC=mat2bigintmat(C);
988   int l=size(L[size(L)]);
989
990   ring ratr=0,x,dp;
991   matrix M=bigintmat2matrix(intC);
992   M=gaussColWithoutPerm(M);
993   int i;
994   int c=1;//counts the number of elements (+1) of sprfls
995   int k=ncols(M)-l;//the number of cols in M which correspond to polys of lower degree
996   //is = ncols(M) - number of elements in L[size(L)]
997   for(i=k+1; i<=ncols(M); i++)
998   {
999      if( findnonzero(M,i) == 0 )
1000      {
1001         sprfls[c]=i-k;
1002         c++;
1003      }
1004   }
1005   return(sprfls);
1006}
1007
1008static proc minrelations(list K)
1009{//K a list of homogeneous ideals - all individually of "pure degree d" -
1010   //ordered from d=1 up to D
1011
1012   list L;
1013   intvec sprfls;
1014   int sj;
1015
1016   int i,j;
1017   ideal Ki;
1018   for(i=1; i<=size(K); i++)
1019   {
1020      L=K[1..i];//will give the list with one ideal as the only entry, when i=1
1021      //i=1 would make trouble, if K was a list of lists: then L would be the first
1022      //list in K
1023
1024      sprfls=superfluousL(L);
1025
1026      if(sprfls[1] == 0)
1027      {//then sprfls returned the intvec v=0; so there are no superfluous elements
1028         i++;
1029         continue;
1030      }
1031
1032      Ki=K[i];
1033      for(j=1; j<=size(sprfls); j++)
1034      {
1035         sj=sprfls[j];
1036         Ki[sj]=0;
1037      }
1038      Ki=simplify(Ki,2);
1039
1040      if( size(Ki) == 0 )
1041      {//then all polys in K[i] can be generated by polys in the K[<i], so we can delete
1042         //K[i] from the list
1043
1044         K=delete(K,i);
1045         continue;
1046
1047         //but we dont want to change i
1048         //size(K) adjusts itself, so we're fine there
1049      }
1050
1051      K[i]=Ki;
1052   }
1053
1054   return(K);
1055}
1056
1057//////////////////////////////////////////////////////////////////////////////////
1058//////////////////////////////////////////////////////////////////////////////////
1059////////////////   Procs for Bertini-Singular-Conversation   /////////////////////
1060//////////////////////////////////////////////////////////////////////////////////
1061//////////////////////////////////////////////////////////////////////////////////
1062
1063proc getWitnessSet()
1064"USAGE:   getWitnessSet();
1065ASSUME:  There is a text-document \"main_data\" in the current directory which was
1066         produced by Bertini.
1067         The basefield is the field of real numbers or the field of complex numbers.
1068RETURN:  list; a list P of lists p_i of numbers: P a set of witness points
1069NOTE:    Reads the file \"main_data\", searches the strings containing the witness points,
1070         and converts them into floating point numbers.
1071EXAMPLE: example getWitnessSet; shows an example
1072"
1073{//goes through the file main_data generated by bertini and returns the witness points
1074   //as a list of complex numbers
1075   //(the precision specified in the definition of the basering should* be at least as
1076   //high as the precision used by/to be expected from bertini)
1077   string r;
1078   list P,p;
1079   int i, j;
1080   r=read("main_data");
1081   intvec posi=find_string("Estimated",r);
1082   intvec endpos=find_string("Multiplicity",r);
1083   for(i=1; i<=size(posi); i++)
1084   {
1085      p=read_point(r,posi[i],endpos[i]);
1086
1087      if( size(p) == 0 )
1088      {
1089         ERROR("Bertini nicht erfolgreich");
1090      }
1091
1092      P=P+list( convert_p(p) );
1093   }
1094
1095   return(P);
1096}
1097example
1098{ "EXAMPLE:"; echo=2;
1099  //First, we write the input file for bertini, then run bertini
1100  ring r=0,(x,y,z),dp;
1101  ideal I=(x-y)*(y-z)*(x-z);
1102  writeBertiniInput(I,40);
1103  system("sh","bertini input");
1104
1105  //Then we change the ring and extract the witness set from main_data
1106  ring R=(complex,40,i),(x,y,z),dp;
1107  list P=getWitnessSet();
1108  P;
1109}
1110
1111
1112static proc get_hom_var_group_str(int dummy)
1113{
1114   string vg=varstr(basering);
1115   int i;
1116   for(i=1; i<size(vg); i++)
1117   {
1118      if(vg[i]==",")
1119      {
1120         vg=vg[1,i]+" "+vg[(i+1),size(vg)-i];
1121      }
1122
1123      if( vg[i] == "(" )
1124      {
1125         vg=vg[1,i-1]+vg[(i+1),size(vg)-i];
1126         continue;
1127      }
1128
1129      if( vg[i] == ")" )
1130      {
1131         vg=vg[1,(i-1)]+vg[(i+1),size(vg)-i];
1132         continue;
1133      }
1134   }
1135
1136   i=size(vg);
1137   if(vg[i]==",")
1138   {
1139      vg=vg[1,i];
1140   }
1141
1142   if( vg[i] == "(" )
1143   {
1144      vg=vg[1,i-1];
1145   }
1146
1147   if( vg[i] == ")" )
1148   {
1149      vg=vg[1,(i-1)];
1150   }
1151
1152   vg="hom_variable_group "+vg+";"+newline;
1153
1154   return(vg);
1155}
1156
1157static proc get_declare_function_str(ideal J)
1158{
1159   string dfs;
1160   int i;
1161   for(i=1; i<=size(J); i++)
1162   {
1163      if(size(dfs) > 0)
1164      {
1165         dfs=dfs+", f"+string(i);
1166      }
1167      else
1168      {
1169         dfs=dfs+"f"+string(i);
1170      }
1171   }
1172
1173   dfs="function "+dfs+";"+newline;
1174
1175   return(dfs);
1176}
1177
1178static proc remove_brackets(string vg)
1179{//removes any round brackets from a string
1180   int i;
1181   for(i=1; i<size(vg); i++)
1182   {
1183      if( vg[i] == "(" )
1184      {
1185         vg=vg[1,i-1]+vg[(i+1),size(vg)-i];
1186         continue;
1187      }
1188
1189      if( vg[i] == ")" )
1190      {
1191         vg=vg[1,(i-1)]+vg[(i+1),size(vg)-i];
1192         continue;
1193      }
1194   }
1195
1196   i=size(vg);
1197
1198   if( vg[i] == "(" )
1199   {
1200      vg=vg[1,i-1];
1201   }
1202   if( vg[i] == ")" )
1203   {
1204      vg=vg[1,(i-1)];
1205   }
1206   return(vg);
1207}
1208
1209static proc get_function_str(ideal J)
1210{
1211   string fs, m;
1212   matrix C;
1213   poly fi;
1214   int i,j,k;
1215   string s;
1216   for(i=1; i<=size(J); i++)
1217   {
1218      fs=fs+"f"+string(i)+" = ";
1219      fi=J[i];
1220
1221      s=string(fi);
1222      s=remove_brackets(s);
1223
1224      fs=fs+s;
1225
1226      fs=fs+";"+newline;
1227   }
1228   return(fs);
1229}
1230
1231static proc get_coef_bound_poly(poly f)
1232{
1233   poly pr=prodofallringvars(1);
1234   matrix C=coef(f,pr);
1235   int c=ncols(C);
1236   poly b;
1237   int i;
1238   for(i=1; i<=c; i++)
1239   {
1240      b=b+absValue(C[2,i]);
1241   }
1242   return(b);
1243}
1244
1245static proc get_coef_bound_ideal(ideal J)
1246{//is supposed to compute the maximum among the sums of coefficients in each individual
1247   //polynomial in J
1248   if(size(J) == 0){ return(1); }
1249
1250   J=simplify(J,2);
1251   poly b=get_coef_bound_poly(J[1]);
1252   poly a;
1253   int i;
1254   for(i=2; i<=size(J); i++)
1255   {
1256      a=get_coef_bound_poly(J[i]);
1257      if(a > b)
1258      {
1259         b=a;
1260      }
1261   }
1262   return(string(b));
1263}
1264
1265static proc get_prec_in_bits(int Prec)
1266{//log_10(2) is approximately 3,3219281
1267
1268   //conversion from decimal digits to bits, rounded up
1269   int pb = (3322*Prec div 1000) + 1;
1270
1271   int upb=3328;//upper bound on the precision
1272   if( pb > upb )
1273   {//bertini allows a maximum of 3328 bits of precision
1274      return(upb);
1275   }
1276
1277   int lowb=64;//lower bound
1278   if( pb < lowb)
1279   {//bertini requires a minimum of 64 bits of precision
1280      //however, using such a low precision is not recommended, since it will
1281      //probably not yield any useful results
1282      return(lowb);
1283   }
1284
1285   //bertini wants the precision to be a multiple of 32
1286   pb = pb + 32 - (pb mod 32);
1287   return(pb);
1288}
1289
1290
1291proc writeBertiniInput(ideal J, int Prec)
1292"USAGE:   writeBertiniInput(J); ideal J
1293RETURN:  none; writes the input-file for bertini using the polynomials given by J as
1294         functions
1295NOTE:    Either creates a file named input in the current directory or overwrites the
1296         existing one.
1297         If you want to pass different parameters to bertini, you can edit the produced
1298         input file or redefine this procedure.
1299EXAMPLE: example writeBertiniInput; shows an example
1300"
1301{//writes the input-file for bertini
1302
1303   //we change the ring so that the names of the ring variables are convenient for us
1304   def br=basering;
1305   int nv=nvars(br);
1306   ring r=0,x(1..nv),dp;
1307   ideal J=fetch(br,J);
1308
1309
1310   link l=":w ./input";
1311   write(l,"CONFIG");
1312   write(l,"");
1313   write(l,"TRACKTYPE: 1;");
1314   write(l,"TRACKTOLBEFOREEG: 1e-8;");
1315   write(l,"TRACKTOLDURINGEG: 1e-11;");
1316   write(l,"FINALTOL: 1e-14;");
1317   write(l,"");
1318   write(l,"");
1319   write(l,"PrintPathProgress: 1;");
1320   write(l,"MPTYPE: 2;");
1321
1322   int pb=get_prec_in_bits(Prec);
1323   write(l,"AMPMaxPrec: "+string(pb)+";");
1324
1325   string cb=get_coef_bound_ideal(J);
1326   write(l,"COEFFBOUND: "+cb+";");
1327
1328   string db=string(getD(J));
1329   write(l,"DEGREEBOUND: "+db+";");
1330   write(l,"");
1331   write(l,"SHARPENDIGITS: "+string(Prec)+";");
1332
1333   write(l,"END;");
1334   write(l,"");
1335   write(l,"");
1336
1337
1338   write(l,"INPUT"+newline);
1339
1340   string vg=get_hom_var_group_str(1);
1341   write(l,vg);
1342
1343   string dfs=get_declare_function_str(J);
1344   write(l,dfs);
1345
1346   string fs=get_function_str(J);
1347   write(l,fs);
1348
1349   write(l,"END;");
1350}
1351example
1352{ "EXAMPLE:"; echo=2;
1353  ring r=0,(x,y,z),dp;
1354  poly f1=x+y+z;
1355  poly f2=x2+xy+y2;
1356  ideal I=f1,f2;
1357  writeBertiniInput(I,300);
1358}
1359
1360static proc find_string(string F, string S)
1361{//search in string S for the string F
1362   //output all the positions in an intvec v
1363   string s;
1364   intvec v;
1365   int c=1;//counts the number of elements of v
1366
1367   int i;
1368   int a=size(S);
1369   int len=size(F);
1370   for(i=1; i<=a; i++)
1371   {
1372      s=S[i,len];
1373      if(F==s)
1374      {
1375         v[c]=i;
1376         c++;
1377      }
1378   }
1379
1380   return(v);
1381}
1382
1383static proc read_point(string r, int po, int endpo)
1384{//reads out a single point from main_data
1385   //return as string representing a floating point number split into real and imaginary
1386   //part
1387   int i, b;
1388   for(i=po; i<=size(r); i++)
1389   {
1390      if(r[i] == newline)
1391      {
1392         b=i+1;//b is the first character in the line containing components of the point
1393         break;
1394      }
1395   }
1396
1397   list p;
1398   string pj;
1399   int len, strt;
1400   strt=b;
1401   for(i=b; i<=endpo; i++)
1402   {
1403      if(r[i] == newline)
1404      {
1405         len=i-strt;
1406         pj=r[strt,len];
1407         p=p+list(pj);
1408         strt=i+1;
1409      }
1410   }
1411
1412   return(p);
1413}
1414
1415static proc string2num(string numstr)
1416{
1417   number n=0;
1418
1419   int c=0;
1420   if(numstr[1] == "-")
1421   {
1422      numstr=numstr[2,size(numstr)-1];
1423      c=1;
1424   }
1425
1426   int i;
1427   for(i=size(numstr); i>=3; i--)
1428   {
1429      n=n/10+string2intdigit(numstr[i]);
1430   }
1431   n=n/10+string2intdigit(numstr[1]);
1432
1433   if(c==1)
1434   {
1435      n=-n;
1436   }
1437
1438   return(n);
1439}
1440
1441static proc string2e(string estr)
1442{//compute the exponent from the scientific notation
1443   int e=0;
1444   int c=0;
1445   if(estr[1] == "-")
1446   {
1447      c=1;
1448   }
1449   else
1450   {
1451      if(estr[1] != "+")
1452      {
1453         estr="+"+estr;
1454         return(string2e(estr));
1455      }
1456   }
1457
1458   estr=estr[2,size(estr)-1];
1459
1460   int i;
1461   for(i=1; i<=size(estr); i++)
1462   {
1463      e=e*10+string2intdigit(estr[i]);
1464   }
1465
1466   if(c==1)
1467   {
1468      e=-e;
1469   }
1470
1471   return(e);
1472}
1473
1474static proc dismantle_string(string si)
1475{//cuts the string into the real/imaginary parts and their exponents
1476   //example of a string si:
1477   //1.124564280901713e+00 -2.550064206873323e-01
1478   int e1,e2;
1479   number im,re;
1480   string prt;//the currently considered part of the string
1481   int i, len;
1482   int strt=1;
1483   for(i=1; i<=size(si); i++)
1484   {
1485      if( si[i] == "e" )
1486      {
1487         len=i-strt;
1488         prt=si[strt,len];
1489         re=string2num(prt);
1490         break;
1491      }
1492   }
1493
1494   strt=i+1;//start at the character coming after "e"
1495   for(i=strt; i<=size(si); i++)
1496   {
1497      if( si[i] == " " )
1498      {
1499         len=i-strt;
1500         prt=si[strt,len];
1501         e1=string2e(prt);
1502         break;
1503      }
1504   }
1505
1506   strt=i+1;//start at the character coming after " "
1507   for(i=strt; i<=size(si); i++)
1508   {
1509      if( si[i] == "e" )
1510      {
1511         len=i-strt;
1512         prt=si[strt,len];
1513         im=string2num(prt);
1514         break;
1515      }
1516   }
1517
1518   strt=i+1;//start at the character coming after "e"
1519   len=size(si)-strt+1;
1520   prt=si[strt,len];
1521   e2=string2e(prt);
1522
1523   number ten=10;
1524   if(0)//e1 < -1000
1525   {
1526      re=0;
1527   }
1528   else
1529   {
1530      re=re*(ten^e1);
1531   }
1532
1533   if(0)//e2 < -1000
1534   {
1535      im=0;
1536   }
1537   else
1538   {
1539      im=im*(ten^e2);
1540   }
1541   number n=re + IUnit*im;
1542
1543   return(n);
1544}
1545
1546
1547static proc convert_p(list p)
1548{//p a list of strings representing the components of the point p
1549   //converts the list of strings to a list of numbers
1550
1551   //interesting: apparently, since p is a list of strings to begin with, it is not
1552   //bound to the basering, so it will exist in the ring r, as well. But, as we change
1553   //the entries of p from type string to type number/poly, it gets bound to the ring r,
1554   //so it doesnt exist in br anymore. Hence, we have do define list p=fetch.
1555
1556
1557   //we change the ring, so that we know, what the imaginary unit is called, define the
1558   //points over that ring and then fetch them to the original ring
1559   def br=basering;
1560   list l=ringlist(br);
1561   l[1][3]="IUnit";
1562   def r=ring(l);
1563   setring r;
1564
1565   string si;
1566   number pi;
1567   int i;
1568   for(i=1; i<=size(p); i++)
1569   {
1570      pi=dismantle_string(p[i]);
1571      p[i]=pi;
1572   }
1573
1574   setring br;
1575   list p=fetch(r,p);
1576
1577   return(p);
1578}
1579
1580
1581static proc getP_plus_posis(int dummy)
1582{//goes through the file main_data generated by bertini and returns the witness points
1583   //as a list of complex numbers
1584   //(the precision specified in the definition of the basering should* be at least as
1585   //high as the precision used by/to be expected from bertini)
1586   string r;
1587   list P,p;
1588   int i, j;
1589   r=read("main_data");
1590   intvec posi=find_string("Estimated",r);
1591   intvec endpos=find_string("Multiplicity",r);
1592   for(i=1; i<=size(posi); i++)
1593   {
1594      p=read_point(r,posi[i],endpos[i]);
1595
1596      if( size(p) == 0 )
1597      {
1598         ERROR("Bertini nicht erfolgreich");
1599      }
1600
1601      P=P+list( convert_p(p) );
1602   }
1603   return(posi, endpos, P);
1604}
1605
1606
1607static proc getPi_from_main_data(int i, intvec posi, intvec endpos)
1608{//gets only the i-th point in main_data; is used by check_is_zero
1609   string r;
1610   list P,p;
1611   int j;
1612   r=read("main_data");
1613   p=read_point(r,posi[i],endpos[i]);
1614
1615   if( size(p) == 0 )
1616   {
1617      ERROR("Bertini nicht erfolgreich");
1618   }
1619
1620   P=P+list( convert_p(p) );
1621
1622   return(P);
1623}
1624
1625//////////////////////////////////////////////////////////////////////////////////////////
1626//////////////////////////////////////////////////////////////////////////////////////////
1627//////////////////////////////       Applications       //////////////////////////////////
1628//////////////////////////////////////////////////////////////////////////////////////////
1629//////////////////////////////////////////////////////////////////////////////////////////
1630
1631
1632//////////////////////////////////////////////////////////////////////////////////////////
1633//////////////////  static procs to get the relations from the  //////////////////////////
1634//////////////////       complex to the rational numbers        //////////////////
1635//////////////////////////////////////////////////////////////////////////////////////////
1636
1637static proc get_relations_as_bigintmats(list p, int D, bigint C)
1638{//uses degree d Veronese embeddings (for all d<=D) and LLL-algorithm to find
1639   //(homogeneous) polynomial relations between the entries of p
1640   //C is the Value with which the Veronese embedding is being multiplied (cf getmatrix)
1641
1642   //returns the list of the bigintmats computed by the LLL-algorithm
1643   //these are then processed further by get_relations_over_rationals after a switch
1644   //of rings in the level above
1645
1646   if(nvars(basering) != size(p) )
1647   {
1648      ERROR("Number of variables not equal to the number of components of p.");
1649   }
1650
1651   int d,len;
1652   list mats;
1653   ideal vd;
1654   matrix A;
1655   bigintmat B;
1656   for(d=1; d<=D; d++)
1657   {
1658      vd=veronese(d,p);
1659      len=size(maxideal(d));
1660      A=getmatrix(vd,C,len);
1661      //B=use_FLINT_LLL(A);
1662      B=use_NTL_LLL(A);
1663      //B=use_LLL_bigintmat(A);
1664
1665      mats=mats+list(B);
1666   }
1667   return(mats);
1668}
1669
1670static proc get_relations_radical_as_bigintmats(list P, int D, bigint C)
1671{//is to get_relations_as_bigintmats what get_relationsRadical is to get_relations
1672   //ie uses a random linear combination of the Veronese embeddings of all points in P
1673   //in order to get polynomials which vanish over all points simultaneously
1674
1675   int d,len;
1676   list mats;
1677   ideal vd;
1678   matrix A;
1679   bigintmat B;
1680   for(d=1; d<=D; d++)
1681   {
1682      vd=veronese_radical(d,P);
1683      len=size(maxideal(d));
1684      A=getmatrix(vd,C,len);
1685      //B=use_FLINT_LLL(A);
1686      B=use_NTL_LLL(A);
1687      //B=use_LLL_bigintmat(A);
1688
1689      mats=mats+list(B);
1690   }
1691   return(mats);
1692}
1693
1694static proc check_is_zero(int Prec, ideal Kd, intvec posi, intvec endpos, int k)
1695{
1696   def br=basering;
1697   int n=nvars(basering);
1698   ring R=(complex,Prec,IUnit),x(1..n),dp;
1699   ideal I=fetch(br,Kd);
1700   list P=getPi_from_main_data(k, posi, endpos);
1701   list p;
1702   poly v;
1703   number eps=number(10)**(5-Prec);
1704   number a;
1705   int i,j,c;
1706   int len = size(I);
1707   intvec rm;
1708   rm[len]=0;
1709   for(i=1; i<=len; i++)
1710   {
1711      for(j=1;j<=size(P); j++)
1712      {
1713         p=P[j];
1714         v=substAll(I[i],p);
1715         a=number(v);
1716         a=absValue(repart(a))+absValue(impart(a));
1717         //v=v*( poly(10)**(Prec-10) );
1718         if( a > eps)
1719         {
1720            rm[i] = 1;
1721            break;
1722         }
1723      }
1724   }
1725   return(rm);
1726}
1727
1728
1729static proc get_relations_over_rationals(int D, int Prec, list mats, intvec posi,
1730     intvec endpos, int k)
1731{//finds the relations by passing the bigintmats to getpolys
1732   //returns a list of ideals containing the corresponding polynomials
1733   bigintmat B;
1734   int d;
1735   list K;
1736   ideal Kd;
1737   intvec rm;
1738   int i;
1739
1740   for(d=1; d<=D; d++)
1741   {
1742      B=mats[d];
1743      Kd=getpolys(bigintmat2matrix(B),d);
1744      if(size(Kd) != 0)
1745      {
1746         rm=check_is_zero(Prec,Kd,posi,endpos,k);
1747
1748         for(i=1; i<=size(rm); i++)
1749         {
1750            if( rm[i] == 1 )
1751            {
1752                 Kd[i] = 0;
1753            }
1754         }
1755         Kd=simplify(Kd,2);
1756      }
1757
1758      if(size(Kd) == 0)//i.e. Kd has only zero-entries
1759      {//then dont add Kd to the list of relations
1760         d++;
1761         continue;
1762      }
1763      K=K+list(Kd);
1764   }
1765   return(K);
1766}
1767
1768
1769static proc getP_from_known_posis(intvec posi, intvec endpos)
1770{//goes through the file main_data generated by bertini and returns the witness points
1771   //as a list of complex numbers
1772   //(the precision specified in the definition of the basering should* be at least as
1773   //high as the precision used by/to be expected from bertini)
1774   string r;
1775   list P,p;
1776   int i, j;
1777   r=read("main_data");
1778   for(i=1; i<=size(posi); i++)
1779   {
1780      p=read_point(r,posi[i],endpos[i]);
1781
1782      if( size(p) == 0 )
1783      {
1784         ERROR("Bertini nicht erfolgreich");
1785      }
1786
1787      P=P+list( convert_p(p) );
1788   }
1789   return(P);
1790}
1791
1792static proc check_is_zero_lincomradical(int Prec, ideal I, list P)
1793{
1794   //altered ckeck_is_zero for the linear-combination-of-Veronese-embeddings version
1795   //of the procedures
1796   list p;
1797   poly v;
1798   number eps=number(10)**(5-Prec);
1799   number a;
1800   int i,j,c;
1801   int len = size(I);
1802   intvec rm;
1803   rm[len]=0;
1804   for(i=1; i<=len; i++)
1805   {
1806      for(j=1;j<=size(P); j++)
1807      {
1808         p=P[j];
1809         v=substAll(I[i],p);
1810         a=number(v);
1811         a=absValue(repart(a))+absValue(impart(a));
1812         //v=v*( poly(10)**(Prec-10) );
1813         if( a > eps)
1814         {
1815            rm[i] = 1;
1816            break;
1817         }
1818      }
1819   }
1820   return(rm);
1821}
1822
1823
1824static proc get_relations_lincomradical_over_rationals(int D, int Prec, list mats,
1825       intvec posi, intvec endpos)
1826{//finds the relations by passing the bigintmats to getpolys
1827   //returns a list of ideals containing the corresponding polynomials
1828   bigintmat B;
1829   int d;
1830   list K;
1831   ideal Kd;
1832   intvec rm;
1833   int i;
1834
1835
1836   //set up the ring to check whether the supposed relations have value zero at
1837   //all the witness points
1838   def br=basering;
1839   int n=nvars(br);
1840   ring cr=(complex,Prec,IUnit),x(1..n),dp;
1841   list P=getP_from_known_posis(posi, endpos);
1842   ideal I;
1843   int le;
1844
1845   setring br;
1846   for(d=1; d<=D; d++)
1847   {
1848      B=mats[d];
1849      Kd=getpolys(bigintmat2matrix(B),d);
1850
1851      //go to the complex ring to see which candidate relations should be removed
1852      setring cr;
1853      I=fetch(br,Kd);
1854      le=size(I);
1855      if(le != 0)
1856      {
1857         rm=check_is_zero_lincomradical(Prec,I,P);
1858      }
1859
1860      //remove from the ideal over the rational numbers
1861      setring br;
1862
1863      if(le != 0)
1864      {
1865         for(i=1; i<=size(rm); i++)
1866         {
1867            if( rm[i] == 1 )
1868            {
1869                 Kd[i] = 0;
1870            }
1871         }
1872         Kd=simplify(Kd,2);
1873      }
1874
1875      if(size(Kd) == 0)//i.e. Kd has only zero-entries
1876      {//then dont add Kd to the list of relations
1877         d++;
1878         continue;
1879      }
1880      K=K+list(Kd);
1881   }
1882   return(K);
1883}
1884
1885//////////////////////////////////////////////////////////////////////////////////////////
1886//////////////////////////////      num_prime_decom      /////////////////////////////////
1887//////////////////////////////////////////////////////////////////////////////////////////
1888
1889proc num_prime_decom(ideal I, int D, int Prec)
1890"USAGE:   num_prime_decom(I,D); ideal I, int D
1891         D a bound to the degree of the elements of the components of a prime
1892           decomposition of I.
1893RETURN:  list of ideals: each of the ideals a prime component of the radical of I
1894REMARKS: Uses Bertini.
1895NOTE:    Should only be called from a ring over the rational numbers.
1896EXAMPLE: example num_prime_decom; shows an example
1897"
1898{//App. 3.1: computes a prime decomposition of the radical of I
1899   //returns a list of ideals, each of them a prime component
1900   def br=basering;
1901   int n=nvars(br);
1902   list K;//will contain the relations over the basering
1903   list Q;//will contain the components
1904   ideal M;
1905
1906   writeBertiniInput(I,Prec);
1907
1908   //move to a ring over the complex numbers to get the points computed by bertini
1909   ring Ri=(complex,Prec,IUnit),x(1..n),dp;
1910   system("sh","bertini input");
1911   list P;
1912   intvec posi, endpos;
1913   (posi, endpos, P)=getP_plus_posis(1);
1914   int sP=size(P);
1915
1916
1917   bigint C=bigint(10)**Prec;//digits of precision
1918   list p, mats;
1919   int i,j;
1920   for(i=1; i<=sP; i++)
1921   {
1922      setring Ri;
1923
1924      //compute the relations (with LLL, NTL_LLL or FLINT_LLL) in the form of bigintmats
1925      p=P[i];
1926      mats=get_relations_as_bigintmats(p,D,C);
1927
1928
1929      //move to br again to obtain the relation-polynomials over the rational numbers
1930      setring br;
1931      K=get_relations_over_rationals(D, Prec, mats, posi, endpos, i);
1932
1933      if(size(K) == 0)//ie K the empty list
1934      {
1935         i++;
1936         continue;
1937      }
1938
1939      K=minrelations(K);
1940      //K is now the list of ideals containing min gens in the respective degrees
1941      //now, we put these min gens in one ideal
1942      M=K[1];
1943      for(j=2; j<=size(K); j++)
1944      {
1945         M=M+K[j];
1946      }
1947
1948      Q=Q+list(M);
1949   }
1950
1951   return(Q);
1952}
1953example
1954{ "EXAMPLE:"; echo=2;
1955  ring R=0,(x,y,z),dp;
1956  ideal I=(x+y)*(y+2z), (x+y)*(x-3z);
1957  int D=2;
1958  int Prec=300;
1959  num_prime_decom(I,D,Prec);
1960
1961  //Let us compare that to the result of primdecSY:
1962  primdecSY(I);
1963}
1964
1965proc num_prime_decom1(list P, int D, bigint C)
1966"USAGE:   num_prime_decom1(P,D,C); list P, int D, bigint C
1967         P a list of lists representing a witness point set representing an ideal I
1968         D should be a bound to the degree of the elements of the components of the
1969           prime decomposition of I
1970         C the number with which the images of the Veronese embeddings are multiplied
1971RETURN:  list of ideals: each of the ideals a prime component of the radical of I
1972NOTE:    Should only be called from a ring over the complex numbers.
1973EXAMPLE: example num_prime_decom1; shows an example
1974"
1975{//P a list of lists containing the witness points
1976   //returns (or is supposed to return) a list containing the prime components
1977   //of the radical of the ideal which is represented by the witness points in P
1978   list p,K,Q;
1979   int i,j;
1980   ideal M;
1981   for(i=1; i<=size(P); i++)
1982   {
1983      p=P[i];
1984      K=getRelations(p,D,C);
1985
1986      if(size(K) == 0)//ie K the empty list
1987      {
1988         i++;
1989         continue;
1990      }
1991
1992      K=minrelations(K);
1993      //K is now the list of ideals containing min gens in the respective degrees
1994      //now, we put these min gens in one ideal
1995      M=K[1];
1996      for(j=2; j<=size(K); j++)
1997      {
1998         M=M+K[j];
1999      }
2000
2001      Q=Q+list(M);
2002   }
2003   return(Q);
2004}
2005example
2006{ "EXAMPLE:"; echo=2;
2007  //First, we compute a prime decomposition of the ideal I=x+y;
2008  ring R1=(complex,300,IUnit),(x,y),dp;
2009  list p1=1,-1;
2010  list P=list(p1);
2011  int D=2;
2012  bigint C=bigint(10)**300;
2013  num_prime_decom1(P,D,C);
2014
2015
2016  //Now, we try to obtain a prime decomposition of the ideal I=(x+y)*(y+2z), (x+y)*(x-3z);
2017  ring R2=(complex,20,IUnit),(x,y,z),dp;
2018  p1=1.7381623928,-1.7381623928,0.2819238763;
2019  list p2=-3.578512854,2.385675236,-1.192837618;
2020  P=p1,p2;
2021  num_prime_decom1(P,D,10000);
2022
2023  //Now, we look at the result of a purely symbolic algorithm
2024  ring r2=0,(x,y,z),dp;
2025  ideal I=(x+y)*(y+2z), (x+y)*(x-3z);
2026  primdecSY(I);
2027
2028  //If you compare the results, you may find that they don't match.
2029  //Most likely, the hybrid algorithm got the second component wrong. This is due to the
2030  //way the algorithm looks for homogeneous polynomial relations, and the specific version
2031  //of the LLL algorithm used here (an implementation into Singular of a rather simple
2032  //version which allows real input). It looks in degree 1, finds one relation and is
2033  //thereafter unable to see a second one. Then it moves on to degree 2 and finds
2034  //relations containing degree-1 relations as a factor.
2035}
2036
2037
2038//////////////////////////////////////////////////////////////////////////////////////////
2039////////////////////////////////      num_radical      ///////////////////////////////////
2040//////////////////////////////////////////////////////////////////////////////////////////
2041
2042
2043proc num_radical_via_decom(ideal I, int D, int Prec)
2044"USAGE:   num_radical_via_decom(I,D); ideal I, int D
2045         D a bound to the degree of the elements of the components.
2046RETURN:  ideal: the radical of I
2047REMARKS: Uses Bertini.
2048         This procedure merely calls num_prime_decom with the same input and then
2049         intersects the returned components.
2050NOTE:    Should only be called from a ring over the rational numbers.
2051SEE ALSO: num_prime_decom, num_radical_via_randlincom
2052EXAMPLE: example num_radical_via_decom; shows an example
2053"
2054{//check p.14/15, App. 3.2
2055   list Q=num_prime_decom(I,D,Prec);
2056   ideal interQ=1;
2057   int i;
2058   for(i=1; i<=size(Q); i++)
2059   {
2060      interQ=intersect(interQ,Q[i]);
2061   }
2062   return(interQ);
2063}
2064example
2065{ "EXAMPLE:"; echo=2;
2066  //First, we attempt to compute the radical via the hybrid algorithm.
2067  ring R=0,(x,y,z),dp;
2068  ideal I=(x+y)^2*(y+2z)^3, (x+y)^3*(x-3z)^2;
2069  int D=2;
2070  int Prec=300;
2071  ideal numRad=num_radical_via_decom(I,D,Prec);
2072  numRad;
2073
2074  //Then we compute the radical symbolically and compare the results.
2075  ideal Rad=radical(I);
2076  Rad;
2077
2078  reduce(Rad,std(numRad));
2079
2080  reduce(numRad,std(Rad));
2081}
2082
2083proc num_radical_via_randlincom(ideal I, int D, int Prec)
2084"USAGE:   num_radical_via_randlincom(I,D); ideal I, int D
2085         D a bound to the degree of the elements of the components.
2086RETURN:  ideal: the radical of I
2087REMARKS: Uses Bertini.
2088         Instead of using the images of the Veronese embeddings of each individual witness
2089         point, this procedure first computes a random linear combination of those images
2090         and searches for homogeneous polynomial relations for this linear combination.
2091NOTE:    Should only be called from a ring over the rational numbers.
2092SEE ALSO: num_radical_via_decom
2093EXAMPLE: example num_radical_via_randlincom; shows an example
2094"
2095{//check p.14/15, App. 3.2
2096
2097   bigint C=bigint(10)**Prec;//digits of precision
2098   def br=basering;
2099   int n=nvars(br);
2100
2101   writeBertiniInput(I,Prec);
2102
2103   //move to a ring over the complex numbers to get the points computed by bertini
2104   ring Ri=(complex,Prec,IUnit),x(1..n),dp;
2105   system("sh","bertini input");
2106   list P;
2107   intvec posi, endpos;
2108   (posi, endpos, P)=getP_plus_posis(1);
2109   list mats=get_relations_radical_as_bigintmats(P,D,C);
2110
2111   setring br;
2112   list K=get_relations_lincomradical_over_rationals(D,Prec,mats,posi,endpos);
2113
2114   ideal Q;
2115
2116   if(size(K) > 0)
2117   {
2118      K=minrelations(K);
2119      Q=K[1];
2120      int i;
2121      for(i=2; i<=size(K); i++)
2122      {
2123         Q=Q,K[i];
2124      }
2125   }
2126
2127   return(Q);
2128}
2129example
2130{ "EXAMPLE:"; echo=2;
2131  //First, we attempt to compute the radical via the hybrid algorithm.
2132  ring R=0,(x,y,z),dp;
2133  ideal I=(x+y)^2*(y+2z)^3, (x+y)^3*(x-3z)^2;
2134  int D=2;
2135  int Prec=300;
2136  ideal numRad=num_radical_via_randlincom(I,D,Prec);
2137  numRad;
2138
2139  //Then we compute the radical symbolically and compare the results.
2140  ideal Rad=radical(I);
2141  Rad;
2142
2143  reduce(Rad,std(numRad));
2144
2145  reduce(numRad,std(Rad));
2146}
2147
2148proc num_radical1(list P, int D, bigint C)
2149"USAGE:   num_radical1(P,D,C); list P, int D, bigint C
2150         P a list of lists representing a witness point set representing an ideal I
2151         D should be a bound to the degree of the elements of the components
2152         C the number with which the images of the Veronese embeddings are multiplied
2153RETURN:  list of ideals: each of the ideals a prime component of the radical of I
2154REMARKS: This procedure merely calls num_prime_decom1 with the same input and then
2155         intersects the returned components.
2156NOTE:    Should only be called from a ring over the complex numbers.
2157SEE ALSO: num_prime_decom1, num_radical2
2158EXAMPLE: example num_radical1; shows an example
2159"
2160{//computes the radical via num_prime_decom (intersecting the obtained prime decom)
2161   list Q=num_prime_decom1(P,D,C);
2162   ideal interQ=1;
2163   int i;
2164   for(i=1; i<=size(Q); i++)
2165   {
2166      interQ=intersect(interQ,Q[i]);
2167   }
2168   return(interQ);
2169}
2170example
2171{ "EXAMPLE:"; echo=2;
2172  //First, we write the input file for bertini and compute the radical symbolically.
2173  ring r=0,(x,y,z),dp;
2174  ideal I=4xy2-4z3,-2x2y+5xz2;
2175  ideal Rad=radical(I);
2176  writeBertiniInput(I,100);
2177
2178  //Then we attempt to compute the radical via the hybrid algorithm.
2179  ring R=(complex,100,i),(x,y,z),dp;
2180  system("sh","bertini input");
2181  list P=getWitnessSet();
2182  int D=2;
2183  bigint C=bigint(10)**30;
2184  ideal Rad1=num_radical1(P,D,C);
2185
2186  //Lastly, we compare the results.
2187  Rad1;
2188
2189  ideal Rad=fetch(r,Rad);
2190  Rad;
2191
2192  reduce(Rad,std(Rad1));
2193
2194  reduce(Rad1,std(Rad));
2195}
2196
2197proc num_radical2(list P, int D, bigint C)
2198"USAGE:   num_radical2(P,D,C); list P, int D, bigint C
2199         P a list of lists representing a witness point set representing an ideal I
2200         D should be a bound to the degree of the elements of the components
2201         C the number with which the images of the Veronese embeddings are multiplied
2202RETURN:  list of ideals: each of the ideals a prime component of the radical of I
2203REMARKS: Instead of using the images of the Veronese embeddings of each individual witness
2204         point, this procedure first computes a random linear combination of those images
2205         and searches for homogeneous polynomial relations for this linear combination.
2206NOTE:    Should only be called from a ring over the complex numbers.
2207SEE ALSO: num_radical1
2208EXAMPLE: example num_radical2; shows an example
2209"
2210{//computes the radical via getRelationsRadical
2211   list K=getRelationsRadical(P,D,C);
2212   K=minrelations(K);
2213   K;
2214   //unite the elements of K into one ideal
2215   ideal Q=K[1];
2216   int i;
2217   for(i=2; i<=size(K); i++)
2218   {
2219      Q=Q,K[i];
2220   }
2221
2222   return(Q);
2223}
2224example
2225{ "EXAMPLE:"; echo=2;
2226  //First, we write the input file for bertini and compute the radical symbolically.
2227  ring r=0,(x,y,z),dp;
2228  ideal I=4xy2-4z3,-2x2y+5xz2;
2229  ideal Rad=radical(I);
2230  writeBertiniInput(I,100);
2231
2232  //Then we attempt to compute the radical via the hybrid algorithm.
2233  ring R=(complex,100,i),(x,y,z),dp;
2234  system("sh","bertini input");
2235  list P=getWitnessSet();
2236  int D=2;
2237  bigint C=bigint(10)**30;
2238  ideal Rad2=num_radical2(P,D,C);
2239
2240  //Lastly, we compare the results.
2241  Rad2;
2242
2243  ideal Rad=fetch(r,Rad);
2244  Rad;
2245
2246  reduce(Rad,std(Rad2));
2247
2248  reduce(Rad2,std(Rad));
2249}
2250
2251//////////////////////////////////////////////////////////////////////////////////////////
2252/////////////////////////////////      num_elim      /////////////////////////////////////
2253//////////////////////////////////////////////////////////////////////////////////////////
2254
2255static proc project_p(list p, intvec projvec)
2256{//projects a single point p onto the components specified in projvec
2257   list pr;//the projection
2258   int i,k;
2259   for(i=1; i<=size(projvec); i++)
2260   {
2261      k=projvec[i];
2262      pr=pr+list(p[k]);
2263   }
2264   return(pr);
2265}
2266
2267static proc project_P(list P, intvec projvec)
2268{//projects the points in P onto the components specified in projvec
2269   list p;//elements of P
2270   list Pr;//the list of projections
2271   list pr;//projection of a point p
2272
2273   int i;
2274   for(i=1; i<=size(P); i++)
2275   {
2276      p=P[i];
2277      pr=project_p(p,projvec);
2278      Pr=Pr+list(pr);
2279   }
2280   return(Pr);
2281}
2282
2283static proc get_projection_intvec(intvec elvec)
2284{//computes the intvec containing the indices of the variables which are not to be
2285   //eliminated
2286   int nv=nvars(basering);
2287   intvec projvec;
2288   int i,j,c,count;//count counts the elements of projvec
2289   for(i=1; i<=nv; i++)
2290   {
2291      c=1;
2292      for(j=1; j<=size(elvec); j++)
2293      {
2294         if(i == elvec[j])
2295         {
2296            c=0;
2297            break;
2298         }
2299      }
2300
2301      //if i is not among the elements of elvec, store it in projvec
2302      if(c == 1)
2303      {
2304         count++;
2305         projvec[count]=i;
2306      }
2307   }
2308   return(projvec);
2309}
2310
2311static proc get_elvec(poly f)
2312{//computes the elimination intvec from a product of ring variables
2313   if(size(f) != 1)
2314   {
2315      ERROR("f must be a product of ringvariables, i.e. a monomial.");
2316   }
2317
2318   int n=nvars(basering);
2319   intvec elvec;
2320   int i, c;
2321   for(i=1; i<=n; i++)
2322   {
2323      if( f/var(i) != 0)
2324      {
2325         c++;
2326         elvec[c]=i;
2327      }
2328   }
2329   return(elvec);
2330}
2331
2332proc num_elim(ideal I, poly f, int D, int Prec)
2333"USAGE:   num_elim(I,f,D); ideal I, poly f, int D
2334         f the product of the ring variables you want to eliminate
2335         D a bound to the degree of the elements of the components
2336RETURN:  ideal: the ideal obtained from I by eliminating the variables specified in f
2337REMARKS: This procedure uses Bertini to compute a set of witness points for I, projects
2338         them onto the components corresponding to the variables specified in f and then
2339         proceeds as num_radical_via_randlincom.
2340NOTE:    Should only be called from a ring over the rational numbers.
2341EXAMPLE: example num_elim; shows an example
2342"
2343{//App. 3.3
2344   bigint C=bigint(10)**Prec;//digits of precision
2345
2346   //first, get elvec and projvec
2347   intvec elvec=get_elvec(f);
2348   intvec projvec=get_projection_intvec(elvec);
2349   writeBertiniInput(I,Prec);
2350
2351   //define the ring with eliminated variables
2352   //we have to compute the relations over this ring, since the number of variables
2353   //must be the same as the number of components of the projected point
2354   def br=basering;
2355   list l=ringlist(br);
2356
2357   int i;
2358   for(i=size(elvec); i>=1; i--)
2359   {
2360      l[2]=delete(l[2],elvec[i]);
2361   }
2362
2363   def brel=ring(l);
2364   int n=nvars(brel);
2365
2366   //move to a ring over the complex numbers to get the points computed by bertini
2367   ring Ri=(complex,Prec,IUnit),x(1..n),dp;
2368   system("sh","bertini input");
2369   list P;
2370   intvec posi, endpos;
2371   (posi, endpos, P)=getP_plus_posis(1);
2372   list Pr=project_P(P,projvec);
2373   list mats=get_relations_radical_as_bigintmats(Pr,D,C);
2374
2375   setring brel;
2376   list K=get_relations_lincomradical_over_rationals(D,Prec,mats,posi,endpos);
2377
2378   ideal R;
2379   if(size(K) > 0)
2380   {
2381      K=minrelations(K);
2382      R=K[1];
2383      for(i=2; i<=size(K); i++)
2384      {
2385         R=R,K[i];
2386      }
2387   }
2388
2389   setring br;
2390   ideal R=imap(brel,R);
2391
2392   return(R);
2393}
2394example
2395{ "EXAMPLE:"; echo=2;
2396  ring r=0,(x,y,z),dp;
2397  poly f1=x-y;
2398  poly f2=z*(x+3y);
2399  poly f3=z*(x2+y2);
2400  ideal I=f1,f2,f3;
2401
2402  //First, we attempt to compute the elimination ideal with the hybrid algorithm.
2403  ideal E1=num_elim(I,z,3,200);
2404
2405  //Now, we compute the elimination ideal symbolically.
2406  ideal E2=elim(I,z);
2407
2408  //Lastly, we compare the results.
2409  E1;
2410  E2;
2411}
2412
2413proc num_elim1(list P, int D, bigint C, intvec elvec)
2414"USAGE:   num_elim1(P,D,C,v); list P, int D, bigint C, intvec v
2415         P a list of lists representing a witness point set representing an ideal J
2416         D should be a bound to the degree of the elements of the components
2417         C the number with which the images of the Veronese embeddings are multiplied
2418         v an intvec specifying the numbers/positions of the variables to be eliminated
2419RETURN:  ideal: the ideal obtained from J by eliminating the variables specified in v
2420REMARKS: This procedure just canonically projects the witness points onto the components
2421         specified in the intvec v and then applies num_radical1 to the resulting points.
2422NOTE:    Should only be called from a ring over the complex numbers.
2423EXAMPLE: example num_elim1; shows an example
2424"
2425{//let J be the ideal represented by the witness points in P
2426   //returns (or is supposed to return) the prime decomposition of the radical of the
2427   //elimination ideal of J
2428   //(where we eliminate the variables with the indices specified in elvec)
2429
2430   //Note that, since we are in a homogeneous setting eliminating all variables
2431   //is quite simple, since we only have to decide, whether its the 0-ideal or the
2432   //whole ring. This procedure won't work in that case.
2433
2434   intvec projvec=get_projection_intvec(elvec);
2435   list Pr=project_P(P,projvec);
2436
2437   //We now have to change the ring we work over: we delete the variables which are
2438   //to be eliminated. -> The number of variables and the number of components in
2439   //the projected point are the same. Then we can apply our procedure and imap the
2440   //results to our original ring, since we didnt change the names of the variables.
2441   def br=basering;
2442   list l=ringlist(br);
2443
2444   int i;
2445   for(i=size(elvec); i>=1; i--)
2446   {
2447      l[2]=delete(l[2],elvec[i]);
2448   }
2449
2450   def r=ring(l);
2451   setring r;
2452   list Pr=fetch(br,Pr);
2453
2454   ideal R=num_radical1(Pr,D,C);
2455
2456   setring br;
2457   ideal R=imap(r,R);
2458
2459   return(R);
2460}
2461example
2462{ "EXAMPLE:"; echo=2;
2463  //First, we write the input file for bertini and compute the elimination ideal
2464  //symbolically.
2465  ring r=0,(x,y,z),dp;
2466  poly f1=x-y;
2467  poly f2=z*(x+3y);
2468  poly f3=z*(x2+y2);
2469  ideal J=f1,f2,f3;
2470  ideal E2=elim(J,z);
2471  writeBertiniInput(J,100);
2472
2473  //Then we attempt to compute the elimination ideal via the hybrid algorithm.
2474  ring R=(complex,100,i),(x,y,z),dp;
2475  system("sh","bertini input");
2476  list P=getWitnessSet();
2477  intvec v=3;
2478  bigint C=bigint(10)**25;
2479  ideal E1=num_elim1(P,2,C,v);
2480
2481  //Lastly, we compare the results.
2482  E1;
2483  setring r;
2484  E2;
2485}
2486
2487///////////////////////////////////////////////////////////////////////////////////////
2488///////////////////////////////////////////////////////////////////////////////////////
2489////////////////////////////   lattice basis reduction   //////////////////////////////
2490///////////////////////////////////////////////////////////////////////////////////////
2491///////////////////////////////////////////////////////////////////////////////////////
2492//An implementation of a simple LLL algorithm
2493//Works with real numbers
2494//Is only used by those procedures which require the user to provide a witness set,
2495//  instead of calling Bertini to compute one.
2496
2497static proc eucl(int m, vector u)
2498{//the square of the Euclidean norm of u
2499   poly e=inner_product(u,u);
2500   return(e);
2501}
2502
2503static proc red(int i, module B, module U)
2504{
2505   int j;
2506   poly r;
2507   for(j=i-1; j>=1; j--)
2508   {
2509      r=roundpoly(U[i][j]);
2510      B[i]=B[i]-r*B[j];
2511      U[i]=U[i]-r*U[j];
2512   }
2513   return(B,matrix(U));
2514}
2515
2516static proc initBBsU(matrix M)
2517{//the columns of M a basis of a lattice over R
2518   int m=nrows(M);
2519   int c=ncols(M);
2520   module B=M;
2521   module Bs=M;
2522   poly f,k,u;
2523   matrix U=diag(1,c);
2524   int i,j;
2525   for(i=1; i<=c; i++)
2526   {
2527      for(j=1; j<=i-1; j++)
2528      {
2529         f=inner_product(B[i],Bs[j]);
2530         k=inner_product(Bs[j],Bs[j]);
2531         u=f/k;
2532         U[j,i]=u;
2533         Bs[i]=Bs[i]-u*Bs[j];
2534      }
2535      (B,U)=red(i,B,U);
2536   }
2537   return(B,Bs,U);
2538}
2539
2540static proc mymax(int i, int k)
2541{
2542   if(i >= k)
2543   {
2544      return(i);
2545   }
2546   return(k);
2547}
2548
2549proc realLLL(matrix M)
2550"USAGE:   realLLL(M); matrix M
2551ASSUME:  The columns of M represent a basis of a lattice.
2552         The groundfield is the field of real number or the field of complex numbers, the
2553         elements of M are real numbers.
2554RETURN:  matrix: the columns representing an LLL-reduced basis of the lattice given by M
2555EXAMPLE: example realLLL; shows an example
2556"
2557{
2558   int n=ncols(M);
2559   int m=nrows(M);
2560   matrix U;
2561   module B,Bs;
2562   poly f,k,u;
2563   (B,Bs,U)=initBBsU(M);
2564   int i=1;
2565   int j;
2566   while(i<n)
2567   {
2568      //check whether there is an i sth eucl(Bs[i,i]) <= 4/3*euclid(Bs[i+1,i])
2569      //if so, thats fine
2570      //if not, b_i and b_i+1 are swapped + we do the necessary changes in Bs and U
2571      if(inner_product(B[i],B[i]) <= (301/300)*inner_product(B[i+1],B[i+1]))
2572      {
2573         i++;
2574      }
2575      else
2576      {
2577         Bs[i+1]=Bs[i+1]+U[i,i+1]*Bs[i];
2578         f=inner_product(B[i],Bs[i+1]);
2579         k=inner_product(Bs[i+1],Bs[i+1]);
2580         u=f/k;
2581         U[i,i]=u;
2582         U[i+1,i]=1;
2583         U[i,i+1]=1;
2584         U[i+1,i+1]=0;
2585         Bs[i]=Bs[i]-U[i,i]*Bs[i+1];
2586         U=permcol(U,i,i+1);
2587         Bs=permcol(Bs,i,i+1);
2588         B=permcol(B,i,i+1);
2589
2590         for(j=i+2; j<=n; j++)
2591         {
2592            f=inner_product(B[j],Bs[i]);
2593            k=inner_product(Bs[i],Bs[i]);
2594            u=f/k;
2595            U[i,j]=u;
2596
2597            f=inner_product(B[j],Bs[i+1]);
2598            k=inner_product(Bs[i+1],Bs[i+1]);
2599            u=f/k;
2600            U[i+1,j]=u;
2601         }
2602
2603         if(absValue(U[i,i+1]) > 1/2)
2604         {
2605            (B,U)=red(i+1,B,U);
2606         }
2607         i=mymax(i-1,1);
2608      }
2609   }
2610   return(B);
2611}
2612example
2613{ "EXAMPLE:"; echo=2;
2614  ring r=(real,50),x,dp;
2615  matrix M[5][4]=
2616  1,0,0,0,
2617  0,1,0,0,
2618  0,0,1,0,
2619  0,0,0,1,
2620  5*81726716.91827716, 817267.1691827716, poly(10)**30, 13*81726716.91827716;
2621  matrix L=realLLL(M);
2622  print(L);
2623}
Note: See TracBrowser for help on using the repository browser.