source: git/Singular/LIB/polymake.lib @ 61fbaf

spielwiese
Last change on this file since 61fbaf was 998959, checked in by Hans Schoenemann <hannes@…>, 20 months ago
fix: TOPCOM url
  • Property mode set to 100644
File size: 60.6 KB
Line 
1//////////////////////////////////////////////////////////////////////////////
2version="version polymake.lib 4.3.1.1 Sep_2022 ";
3category="Tropical Geometry";
4info="
5LIBRARY:   polymake.lib    Computations with polytopes and fans,
6                           interface to TOPCOM
7AUTHOR:    Thomas Markwig,  email: keilen@mathematik.uni-kl.de
8           Yue Ren,         email: ren@mathematik.uni-kl.de
9
10WARNING:
11   Most procedures will not work unless polymake or topcom is installed and
12   if so, they will only work with the operating system LINUX!
13   For more detailed information see IMPORTANT NOTE respectively consult the
14   help string of the procedures.
15
16   The conventions used in this library for polytopes and fans, e.g. the
17   length and labeling of their vertices resp. rays, differs from the conventions
18   used in polymake and thus from the conventions used in the polymake
19   extension polymake.so of Singular. We recommend to use the newer polymake.so
20   whenever possible.
21
22IMPORTANT NOTE:
23@texinfo
24   Even though this is a Singular library for computing polytopes and fans
25   such as the Newton polytope or the Groebner fan of a polynomial, most of
26   the hard computations are NOT done by Singular but by the program
27@* - TOPCOM by Joerg Rambau, Universitaet Bayreuth (see
28     @uref{http://www.uni-bayreuth.de/de/team/rambau_joerg/TOPCOM/});
29@* this library should rather be seen as an interface which allows to use a
30   (very limited) number of options which topcom offers
31   to compute with polytopes and fans and to make the results available in
32   Singular for further computations;
33   moreover, the user familiar with Singular does not have to learn the syntax
34   of topcom, if the options offered here are sufficient for his
35   purposes.
36@* Note, though, that the procedures concerned with planar polygons are
37   independent of topcom.
38@end texinfo
39
40PROCEDURES USING TOPCOM:
41  triangulations()    computes all triangulations of a marked polytope
42  secondaryPolytope() computes the secondary polytope of a marked polytope
43
44PROCEDURES CONCERNED WITH PLANAR POLYGONS:
45  cycleLength()    computes the cycleLength of cycle
46  splitPolygon()   splits a marked polygon into vertices, facets, interior points
47  eta()            computes the eta-vector of a triangulation
48  findOrientedBoundary()  computes the boundary of a convex hull
49  cyclePoints()    computes lattice points connected to some lattice point
50  latticeArea()    computes the lattice area of a polygon
51  picksFormula()   computes the ingrediants of Pick's formula for a polygon
52  ellipticNF()     computes the normal form of an elliptic polygon
53
54KEYWORDS:    polytope; fan; secondary fan; secondary polytope;
55             Newton polytope; Groebner fan
56";
57
58////////////////////////////////////////////////////////////////////////////////
59/// Auxiliary Static Procedures in this Library
60////////////////////////////////////////////////////////////////////////////////
61/// - scalarproduct
62/// - intmatcoldelete
63/// - intmatconcat
64/// - sortlist
65/// - minInList
66/// - stringdelete
67/// - abs
68/// - commondenominator
69/// - maxPosInIntvec
70/// - maxPosInIntmat
71/// - sortintvec
72/// - matrixtointmat
73////////////////////////////////////////////////////////////////////////////////
74
75////////////////////////////////////////////////////////////////////////////////
76LIB "polylib.lib";
77LIB "linalg.lib";
78LIB "random.lib";
79////////////////////////////////////////////////////////////////////////////////
80
81static proc mod_init()
82{
83  intvec save=option(get);
84  option(noredefine);
85  LIB "customstd.so";
86  LIB "gfanlib.so";
87  load("polymake.so","try");
88  option(set,save);
89}
90
91///////////////////////////////////////////////////////////////////////////////
92/// PROCEDURES USING TOPCOM
93///////////////////////////////////////////////////////////////////////////////
94
95proc triangulations (list polygon,list #)
96"USAGE:  triangulations(polygon[,#]); list polygon, list #
97ASSUME:  polygon is a list of integer vectors of the same size representing
98         the affine coordinates of the lattice points
99PURPOSE: the procedure considers the marked polytope given as the convex hull of
100         the lattice points and with these lattice points as markings; it then
101         computes all possible triangulations of this marked polytope
102RETURN:  list, each entry corresponds to one triangulation and the ith entry is
103               itself a list of integer vectors of size three, where each integer
104               vector defines one triangle in the triangulation by telling which
105               points of the input are the vertices of the triangle
106NOTE:- the procedure calls for its computations the program points2triangs
107       from the program topcom by Joerg Rambau, Universitaet Bayreuth; it
108       therefore is necessary that this program is installed in order to use
109       this  procedure; see http://www.rambau.wm.uni-bayreuth.de/TOPCOM/);
110@*   - if you only want to have the regular triangulations the procedure should
111       be called with the string 'regular' as optional argument
112@*   - the procedure creates the files /tmp/triangulationsinput and
113       /tmp/triangulationsoutput;
114       the former is used as input for points2triangs and the latter is its
115       output containing the triangulations of corresponding to points in the
116       format of points2triangs; if you wish to use this for further
117       computations with topcom, you have to call the procedure with the
118       string 'keepfiles' as optional argument
119@*   - note that an integer i in an integer vector representing a triangle
120       refers to the ith lattice point, i.e. polygon[i]; this convention is
121       different from TOPCOM's convention, where i would refer to the i-1st
122       lattice point
123EXAMPLE: example triangulations;   shows an example"
124{
125  int i,j;
126  // check for optional arguments
127  int regular,keepfiles;
128  if (size(#)>0)
129  {
130    for (i=1;i<=size(#);i++)
131    {
132      if (typeof(#[i])=="string")
133      {
134        if (#[i]=="keepfiles")
135        {
136          keepfiles=1;
137        }
138        if (#[i]=="regular")
139        {
140          regular=1;
141        }
142      }
143    }
144  }
145  // prepare the input for points2triangs by writing the input polygon in the
146  // necessary format
147  string spi="[";
148  for (i=1;i<=size(polygon);i++)
149  {
150    polygon[i][size(polygon[i])+1]=1;
151    spi=spi+"["+string(polygon[i])+"]";
152    if (i<size(polygon))
153    {
154      spi=spi+",";
155    }
156  }
157  spi=spi+"]";
158  write(":w /tmp/triangulationsinput",spi);
159  // call points2triangs
160  if (regular==1) // compute only regular triangulations
161  {
162    system("sh","cd /tmp; points2triangs --regular < triangulationsinput > triangulationsoutput");
163  }
164  else // compute all triangulations
165  {
166    system("sh","cd /tmp; points2triangs < triangulationsinput > triangulationsoutput");
167  }
168  string p2t=read("/tmp/triangulationsoutput"); // takes result of points2triangs
169  // delete the tmp-files, if no second argument is given
170  if (keepfiles==0)
171  {
172    system("sh","cd /tmp; rm -f triangulationsinput; rm -f triangulationsoutput");
173  }
174  // preprocessing of p2t if points2triangs is version >= 0.15
175  // brings p2t to the format of version 0.14
176  string np2t; // takes the triangulations in Singular format
177  for (i=1;i<=size(p2t)-2;i++)
178  {
179    if ((p2t[i]==":") and (p2t[i+1]=="=") and (p2t[i+2]=="["))
180    {
181      np2t=np2t+p2t[i]+p2t[i+1];
182      i=i+3;
183      while (p2t[i]!=":")
184      {
185        i=i+1;
186      }
187    }
188    else
189    {
190      if ((p2t[i]=="]") and (p2t[i+1]==";"))
191      {
192        np2t=np2t+p2t[i+1];
193        i=i+1;
194      }
195      else
196      {
197        np2t=np2t+p2t[i];
198      }
199    }
200  }
201  if (p2t[size(p2t)-1]=="]")
202  {
203    np2t=np2t+p2t[size(p2t)];
204  }
205  else
206  {
207    if (np2t[size(np2t)]!=";")
208    {
209      np2t=np2t+p2t[size(p2t)-1]+p2t[size(p2t)];
210    }
211  }
212  p2t=np2t;
213  np2t="";
214  // transform the points2triangs output of version 0.14 into Singular format
215  for (i=1;i<=size(p2t);i++)
216  {
217    if (p2t[i]=="=")
218    {
219      np2t=np2t+p2t[i]+"list(";
220      i++;
221    }
222    else
223    {
224      if (p2t[i]!=":")
225      {
226        if ((p2t[i]=="}") and (p2t[i+1]=="}"))
227        {
228          np2t=np2t+"))";
229          i++;
230        }
231        else
232        {
233          if (p2t[i]=="{")
234          {
235            np2t=np2t+"intvec(";
236          }
237          else
238          {
239            if (p2t[i]=="}")
240            {
241              np2t=np2t+")";
242            }
243            else
244            {
245              if (p2t[i]=="[")
246              {
247                // in Topcom version 17.4 (and maybe also in earlier versions) the list
248                // of triangulations is indexed starting with index 0, in Singular
249                // we have to start with index 1
250                np2t=np2t+p2t[i]+"1+";
251              }
252              else
253              {
254                np2t=np2t+p2t[i];
255              }
256            }
257          }
258        }
259      }
260    }
261  }
262  list T;
263  execute(np2t);
264  // depending on the version of Topcom, the list T has or has not an entry T[1]
265  // if it has none, the entry should be removed
266  while (typeof(T[1])=="none")
267  {
268    T=delete(T,1);
269  }
270  // raise each index by one
271  for (i=1;i<=size(T);i++)
272  {
273    for (j=1;j<=size(T[i]);j++)
274    {
275      T[i][j]=T[i][j]+1;
276    }
277  }
278  return(T);
279}
280example
281{
282   "EXAMPLE:";
283   echo=2;
284   // the lattice points of the unit square in the plane
285   list polygon=intvec(0,0),intvec(0,1),intvec(1,0),intvec(1,1);
286   // the triangulations of this lattice point configuration are computed
287   list triang=triangulations(polygon);
288   triang;
289}
290
291/////////////////////////////////////////////////////////////////////////////
292
293proc secondaryPolytope (list polygon,list #)
294"USAGE:  secondaryPolytope(polygon[,#]); list polygon, list #
295ASSUME:  - polygon is a list of integer vectors of the same size representing
296           the affine coordinates of lattice points
297@*       - if the triangulations of the corresponding polygon have already been
298           computed with the procedure triangulations then these can be given as
299           a second (optional) argument in order to avoid doing this computation
300           again
301PURPOSE: the procedure considers the marked polytope given as the convex hull of
302         the lattice points and with these lattice points as markings; it then
303         computes the lattice points of the secondary polytope given by this
304         marked polytope which correspond to the triangulations computed by
305         the procedure triangulations
306RETURN:  list, say L, such that:
307@*             L[1] = intmat, each row gives the affine coordinates of a lattice
308                      point in the secondary polytope given by the marked
309                      polytope corresponding to polygon
310@*             L[2] = the list of corresponding triangulations
311NOTE: if the triangluations are not handed over as optional argument the
312      procedure calls for its computation of these triangulations the program
313      points2triangs from the program topcom by Joerg Rambau, Universitaet
314      Bayreuth; it therefore is necessary that this program is installed in
315      order to use this procedure; see
316@*    http://www.rambau.wm.uni-bayreuth.de/TOPCOM/);
317EXAMPLE: example secondaryPolytope;   shows an example"
318{
319  // compute the triangulations of the point configuration with points2triangs
320  if (size(#)==0)
321  {
322    list triangs=triangulations(polygon);
323  }
324  else
325  {
326    list triangs=#;
327  }
328  int i,j,k,l;
329  intmat N[2][2]; // is used to compute areas of triangles
330  intvec vertex;  // stores a point in the secondary polytope as
331                  // intermediate result
332  int eintrag;
333  int halt;
334  intmat secpoly[size(triangs)][size(polygon)];   // stores all lattice points
335                                                  // of the secondary polytope
336  // consider each triangulation and compute the corresponding point
337  // in the secondary polytope
338  for (i=1;i<=size(triangs);i++)
339  {
340    // for each triangulation we have to compute the coordinates
341    // corresponding to each marked point
342    for (j=1;j<=size(polygon);j++)
343    {
344      eintrag=0;
345      // for each marked point we have to consider all triangles in the
346      // triangulation which involve this particular point
347      for (k=1;k<=size(triangs[i]);k++)
348      {
349        halt=0;
350        for (l=1;(l<=3) and (halt==0);l++)
351        {
352          if (triangs[i][k][l]==j)
353          {
354            halt=1;
355            N[1,1]=polygon[triangs[i][k][3]][1]-polygon[triangs[i][k][1]][1];
356            N[1,2]=polygon[triangs[i][k][2]][1]-polygon[triangs[i][k][1]][1];
357            N[2,1]=polygon[triangs[i][k][3]][2]-polygon[triangs[i][k][1]][2];
358            N[2,2]=polygon[triangs[i][k][2]][2]-polygon[triangs[i][k][1]][2];
359            eintrag=eintrag+abs(det(N));
360          }
361        }
362      }
363      vertex[j]=eintrag;
364    }
365    secpoly[i,1..size(polygon)]=vertex;
366  }
367  return(list(secpoly,triangs));
368}
369example
370{
371   "EXAMPLE:";
372   echo=2;
373   // the lattice points of the unit square in the plane
374   list polygon=intvec(0,0),intvec(0,1),intvec(1,0),intvec(1,1);
375   // the secondary polytope of this lattice point configuration is computed
376   list secpoly=secondaryPolytope(polygon);
377   // the points in the secondary polytope
378   print(secpoly[1]);
379   // the corresponding triangulations
380   secpoly[2];
381}
382
383
384////////////////////////////////////////////////////////////////////////////////
385/// PROCEDURES CONCERNED WITH PLANAR POLYGONS
386////////////////////////////////////////////////////////////////////////////////
387
388proc cycleLength (list boundary,intvec interior)
389"USAGE:  cycleLength(boundary,interior); list boundary, intvec interior
390ASSUME:  boundary is a list of integer vectors describing a cycle in some
391         convex lattice polygon around the lattice point interior ordered
392         clock wise
393RETURN:  string, the cycle length of the corresponding cycle in the dual
394                 tropical curve
395EXAMPLE: example cycleLength;   shows an example"
396{
397  int j;
398  // create a ring whose variables are indexed by the points in
399  // boundary resp. by interior
400 string rst="(u"+string(interior[1])+string(interior[2]);
401 for (j=1;j<=size(boundary);j++)
402 {
403   rst=rst+",u"+string(boundary[j][1])+string(boundary[j][2]);
404 }
405 rst=rst+")";
406 ring cyclering = create_ring(0, rst, "lp");
407  // add the first and second point at the end of boundary
408  boundary[size(boundary)+1]=boundary[1];
409  boundary[size(boundary)+1]=boundary[2];
410  poly cl,summand; // takes the cycle length
411  matrix N1[2][2]; // used to compute the area of a triangle
412  matrix N2[2][2]; // used to compute the area of a triangle
413  matrix N3[2][2]; // used to compute the area of a triangle
414  // for each original point in boundary compute its contribution to the cycle
415  for (j=2;j<=size(boundary)-1;j++)
416  {
417    N1=boundary[j-1]-interior,boundary[j]-interior;
418    N2=boundary[j]-interior,boundary[j+1]-interior;
419    N3=boundary[j+1]-interior,boundary[j-1]-interior;
420    execute("summand=-u"+string(boundary[j][1])+string(boundary[j][2])+"+u"+string(interior[1])+string(interior[2])+";");
421    summand=summand*(det(N1)+det(N2)+det(N3))/(det(N1)*det(N2));
422    cl=cl+summand;
423  }
424  return(string(cl));
425}
426example
427{
428   "EXAMPLE:";
429   echo=2;
430   // the integer vectors in boundary are lattice points on the boundary
431   // of a convex lattice polygon in the plane
432   list boundary=intvec(0,0),intvec(0,1),intvec(0,2),intvec(2,2),
433                 intvec(2,1),intvec(2,0);
434   // interior is a lattice point in the interior of this lattice polygon
435   intvec interior=1,1;
436   // compute the general cycle length of a cycle of the corresponding cycle
437   // in the dual tropical curve, note that (0,1) and (2,1) do not contribute
438   cycleLength(boundary,interior);
439}
440
441/////////////////////////////////////////////////////////////////////////////
442
443proc splitPolygon (list markings)
444"USAGE:  splitPolygon (markings);  markings list
445ASSUME:  markings is a list of integer vectors representing lattice points in
446         the plane which we consider as the marked points of the convex lattice
447         polytope spanned by them
448PURPOSE: split the marked points in the vertices, the points on the facets
449         which are not vertices, and the interior points
450RETURN:  list, L consisting of three lists
451@*             L[1]    : represents the vertices the polygon ordered clockwise
452@*                       L[1][i][1] = intvec, the coordinates of the ith vertex
453@*                       L[1][i][2] = int, the position of L[1][i][1] in markings
454@*             L[2][i] : represents the lattice points on the facet of the
455                         polygon with endpoints L[1][i] and L[1][i+1]
456                         (i considered modulo size(L[1]))
457@*                       L[2][i][j][1] = intvec, the coordinates of the jth
458                                                 lattice point on that facet
459@*                       L[2][i][j][2] = int, the position of L[2][i][j][1]
460                                              in markings
461@*             L[3]    : represents the interior lattice points of the polygon
462@*                       L[3][i][1] = intvec, coordinates of ith interior point
463@*                       L[3][i][2] = int, the position of L[3][i][1] in markings
464EXAMPLE: example splitPolygon;   shows an example"
465{
466  list vert; // stores the result
467  // compute the boundary of the polygon in an oriented way
468  list pb=findOrientedBoundary(markings);
469  // the vertices are just the second entry of pb
470  vert[1]=pb[2];
471  int i,j,k;      // indices
472  list boundary;  // stores the points on the facets of the
473                  // polygon which are not vertices
474  // append to the boundary points as well as to the vertices
475  // the first vertex a second time
476  pb[1]=pb[1]+list(pb[1][1]);
477  pb[2]=pb[2]+list(pb[2][1]);
478  // for each vertex find all points on the facet of the polygon with this vertex
479  // and the next vertex as endpoints
480  int z=2;
481  for (i=1;i<=size(vert[1]);i++)
482  {
483    j=1;
484    list facet; // stores the points on this facet which are not vertices
485    // while the next vertex is not reached, store the boundary lattice point
486    while (pb[1][z]!=pb[2][i+1])
487    {
488      facet[j]=pb[1][z];
489      j++;
490      z++;
491    }
492    // store the points on the ith facet as boundary[i]
493    boundary[i]=facet;
494    kill facet;
495    z++;
496  }
497  // store the information on the boundary in vert[2]
498  vert[2]=boundary;
499  // find the remaining points in the input which are not on
500  // the boundary by checking
501  // for each point in markings if it is contained in pb[1]
502  list interior=markings;
503  for (i=size(interior);i>=1;i--)
504  {
505    for (j=1;j<=size(pb[1])-1;j++)
506    {
507      if (interior[i]==pb[1][j])
508      {
509        interior=delete(interior,i);
510        j=size(pb[1]);
511      }
512    }
513  }
514  // store the interior points in vert[3]
515  vert[3]=interior;
516  // add to each point in vert the index which it gets from
517  // its position in the input markings;
518  // do so for ver[1]
519  for (i=1;i<=size(vert[1]);i++)
520  {
521    j=1;
522    while (markings[j]!=vert[1][i])
523    {
524      j++;
525    }
526    vert[1][i]=list(vert[1][i],j);
527  }
528  // do so for ver[2]
529  for (i=1;i<=size(vert[2]);i++)
530  {
531    for (k=1;k<=size(vert[2][i]);k++)
532    {
533      j=1;
534      while (markings[j]!=vert[2][i][k])
535      {
536        j++;
537      }
538      vert[2][i][k]=list(vert[2][i][k],j);
539    }
540  }
541  // do so for ver[3]
542  for (i=1;i<=size(vert[3]);i++)
543  {
544    j=1;
545    while (markings[j]!=vert[3][i])
546    {
547      j++;
548    }
549    vert[3][i]=list(vert[3][i],j);
550  }
551  return(vert);
552}
553example
554{
555   "EXAMPLE:";
556   echo=2;
557   // the lattice polygon spanned by the points (0,0), (3,0) and (0,3)
558   // with all integer points as markings
559   list polygon=intvec(1,1),intvec(3,0),intvec(2,0),intvec(1,0),
560                intvec(0,0),intvec(2,1),intvec(0,1),intvec(1,2),
561                intvec(0,2),intvec(0,3);
562   // split the polygon in its vertices, its facets and its interior points
563   list sp=splitPolygon(polygon);
564   // the vertices
565   sp[1];
566   // the points on facets which are not vertices
567   sp[2];
568   // the interior points
569   sp[3];
570}
571
572
573/////////////////////////////////////////////////////////////////////////////
574
575proc eta (list triang,list polygon)
576"USAGE:  eta(triang,polygon);  triang, polygon list
577ASSUME:  polygon has the format of the output of splitPolygon, i.e. it is a
578         list with three entries describing a convex lattice polygon in the
579         following way:
580@*       polygon[1] : is a list of lists; for each i the entry polygon[1][i][1]
581                      is a lattice point which is a vertex of the lattice
582                      polygon, and polygon[1][i][2] is an integer assigned to
583                      this lattice point as identifying index
584@*       polygon[2] : is a list of lists; for each vertex of the polygon,
585                      i.e. for each entry in polygon[1], it contains a list
586                      polygon[2][i], which contains the lattice points on the
587                      facet with endpoints polygon[1][i] and polygon[1][i+1]
588                      - i considered mod size(polygon[1]);
589                      each such lattice point contributes an entry
590                      polygon[2][i][j][1] which is an integer
591                      vector giving the coordinate of the lattice point and an
592                      entry polygon[2][i][j][2] which is the identifying index
593@*       polygon[3] : is a list of lists, where each entry corresponds to a
594                      lattice point in the interior of the polygon, with
595                      polygon[3][j][1] being the coordinates of the point
596                      and polygon[3][j][2] being the identifying index;
597@*       triang is a list of integer vectors all of size three describing a
598         triangulation of the polygon described by polygon; if an entry of
599         triang is the vector (i,j,k) then the triangle is built by the vertices
600         with indices i, j and k
601RETURN:  intvec, the integer vector eta describing that vertex of the Newton
602                 polytope discriminant of the polygon whose dual cone in the
603                 Groebner fan contains the cone of the secondary fan of the
604                 polygon corresponding to the given triangulation
605NOTE:  for a better description of eta see Gelfand, Kapranov,
606       Zelevinski: Discriminants, Resultants and multidimensional Determinants.
607       Chapter 10.
608EXAMPLE: example eta;   shows an example"
609{
610  int i,j,k,l,m,n; // index variables
611  list ordpolygon;   // stores the lattice points in the order
612                     // used in the triangulation
613  list triangarea; // stores the areas of the triangulations
614  intmat N[2][2];  // used to compute triangle areas
615  // 1) store the lattice points in the order used in the triangulation
616  // go first through all vertices of the polytope
617  for (j=1;j<=size(polygon[1]);j++)
618  {
619    ordpolygon[polygon[1][j][2]]=polygon[1][j][1];
620  }
621  // then consider all inner points
622  for (j=1;j<=size(polygon[3]);j++)
623  {
624    ordpolygon[polygon[3][j][2]]=polygon[3][j][1];
625  }
626  // finally consider all lattice points on the boundary which are not vertices
627  for (j=1;j<=size(polygon[2]);j++)
628  {
629    for (i=1;i<=size(polygon[2][j]);i++)
630    {
631      ordpolygon[polygon[2][j][i][2]]=polygon[2][j][i][1];
632    }
633  }
634  // 2) compute for each triangle in the triangulation the area of the triangle
635  for (i=1;i<=size(triang);i++)
636  {
637    // Note that the ith lattice point in orderedpolygon has the
638    // number i-1 in the triangulation!
639    N=ordpolygon[triang[i][1]]-ordpolygon[triang[i][2]],ordpolygon[triang[i][1]]-ordpolygon[triang[i][3]];
640    triangarea[i]=abs(det(N));
641  }
642  intvec ETA;        // stores the eta_ij
643  int etaij;         // stores the part of eta_ij during computations
644                     // which comes from triangle areas
645  int seitenlaenge;  // stores the part of eta_ij during computations
646                     // which comes from boundary facets
647  list seiten;       // stores the lattice points on facets of the polygon
648  intvec v;          // used to compute a facet length
649  // 3) store first in seiten[i] all lattice points on the facet
650  //    connecting the ith vertex,
651  //    i.e. polygon[1][i], with the i+1st vertex, i.e. polygon[1][i+1],
652  //    where we replace i+1
653  //    1 if i=size(polygon[1]);
654  //    then append the last entry of seiten once more at the very
655  //    beginning of seiten, so
656  //    that the index is shifted by one
657  for (i=1;i<=size(polygon[1]);i++)
658  {
659    if (i<size(polygon[1]))
660    {
661      seiten[i]=list(polygon[1][i])+polygon[2][i]+list(polygon[1][i+1]);
662    }
663    else
664    {
665      seiten[i]=list(polygon[1][i])+polygon[2][i]+list(polygon[1][1]);
666    }
667  }
668  seiten=insert(seiten,seiten[size(seiten)],0);
669  // 4) compute the eta_ij for all vertices of the polygon
670  for (j=1;j<=size(polygon[1]);j++)
671  {
672    // the vertex itself contributes a 1
673    etaij=1;
674    // check for each triangle in the triangulation ...
675    for (k=1;k<=size(triang);k++)
676    {
677      // ... if the vertex is actually a vertex of the triangle ...
678      if ((polygon[1][j][2]==triang[k][1]) or (polygon[1][j][2]==triang[k][2]) or (polygon[1][j][2]==triang[k][3]))
679      {
680        // ... if so, add the area of the triangle to etaij
681        etaij=etaij+triangarea[k];
682        // then check if that triangle has a facet which is contained
683        // in one of the
684        // two facets of the polygon which are adjecent to the given vertex ...
685        // these two facets are seiten[j] and seiten[j+1]
686        for (n=j;n<=j+1;n++)
687        {
688          // check for each lattice point in the facet of the polygon ...
689          for (l=1;l<=size(seiten[n]);l++)
690          {
691            // ... and for each lattice point in the triangle ...
692            for (m=1;m<=size(triang[k]);m++)
693            {
694              // ... if they coincide and are not the vertex itself ...
695              if ((seiten[n][l][2]==triang[k][m]) and (seiten[n][l][2]!=polygon[1][j][2]))
696              {
697                // if so, then compute the vector pointing from this
698                // lattice point to the vertex
699                v=polygon[1][j][1]-seiten[n][l][1];
700                // and the lattice length of this vector has to be
701                // subtracted from etaij
702                etaij=etaij-abs(gcd(v[1],v[2]));
703              }
704            }
705          }
706        }
707      }
708    }
709    // store etaij in the list
710    ETA[polygon[1][j][2]]=etaij;
711  }
712  // 5) compute the eta_ij for all lattice points on the facets
713  //    of the polygon which are not vertices, these are the
714  //    lattice points in polygon[2][1] to polygon[2][size(polygon[1])]
715  for (i=1;i<=size(polygon[2]);i++)
716  {
717    for (j=1;j<=size(polygon[2][i]);j++)
718    {
719      // initialise etaij
720      etaij=0;
721      // initialise seitenlaenge
722      seitenlaenge=0;
723      // check for each triangle in the triangulation ...
724      for (k=1;k<=size(triang);k++)
725      {
726        // ... if the vertex is actually a vertex of the triangle ...
727        if ((polygon[2][i][j][2]==triang[k][1]) or (polygon[2][i][j][2]==triang[k][2]) or (polygon[2][i][j][2]==triang[k][3]))
728        {
729          // ... if so, add the area of the triangle to etaij
730          etaij=etaij+triangarea[k];
731          // then check if that triangle has a facet which is contained in the
732          // facet of the polygon which contains the lattice point in question,
733          // this is the facet seiten[i+1];
734          // check for each lattice point in the facet of the polygon ...
735          for (l=1;l<=size(seiten[i+1]);l++)
736          {
737            // ... and for each lattice point in the triangle ...
738            for (m=1;m<=size(triang[k]);m++)
739            {
740              // ... if they coincide and are not the vertex itself ...
741              if ((seiten[i+1][l][2]==triang[k][m]) and (seiten[i+1][l][2]!=polygon[2][i][j][2]))
742              {
743                // if so, then compute the vector pointing from
744                // this lattice point to the vertex
745                v=polygon[2][i][j][1]-seiten[i+1][l][1];
746                // and the lattice length of this vector contributes
747                // to seitenlaenge
748                seitenlaenge=seitenlaenge+abs(gcd(v[1],v[2]));
749              }
750            }
751          }
752        }
753      }
754      // if the lattice point was a vertex of any triangle
755      // in the triangulation ...
756      if (etaij!=0)
757      {
758        // then eta_ij is the sum of the triangle areas minus seitenlaenge
759        ETA[polygon[2][i][j][2]]=etaij-seitenlaenge;
760      }
761      else
762      {
763        // otherwise it is just zero
764        ETA[polygon[2][i][j][2]]=0;
765      }
766    }
767  }
768  // 4) compute the eta_ij for all inner lattice points of the polygon
769  for (j=1;j<=size(polygon[3]);j++)
770  {
771    // initialise etaij
772    etaij=0;
773    // check for each triangle in the triangulation ...
774    for (k=1;k<=size(triang);k++)
775    {
776      // ... if the vertex is actually a vertex of the triangle ...
777      if ((polygon[3][j][2]==triang[k][1]) or (polygon[3][j][2]==triang[k][2]) or (polygon[3][j][2]==triang[k][3]))
778      {
779        // ... if so, add the area of the triangle to etaij
780        etaij=etaij+triangarea[k];
781      }
782    }
783    // store etaij in ETA
784    ETA[polygon[3][j][2]]=etaij;
785  }
786  return(ETA);
787}
788example
789{
790   "EXAMPLE:";
791   echo=2;
792   // the lattice polygon spanned by the points (0,0), (3,0) and (0,3)
793   // with all integer points as markings
794   list polygon=intvec(1,1),intvec(3,0),intvec(2,0),intvec(1,0),
795                intvec(0,0),intvec(2,1),intvec(0,1),intvec(1,2),
796                intvec(0,2),intvec(0,3);
797   // split the polygon in its vertices, its facets and its interior points
798   list sp=splitPolygon(polygon);
799   // define a triangulation by connecting the only interior point
800   //        with the vertices
801   list triang=intvec(1,2,5),intvec(1,5,10),intvec(1,5,10);
802   // compute the eta-vector of this triangulation
803   eta(triang,sp);
804}
805
806/////////////////////////////////////////////////////////////////////////////
807
808proc findOrientedBoundary (list polygon)
809"USAGE: findOrientedBoundary(polygon); polygon list
810ASSUME: polygon is a list of integer vectors defining integer lattice points
811        in the plane
812RETURN: list l with the following interpretation
813@*            l[1] = list of integer vectors such that the polygonal path
814                     defined by these is the boundary of the convex hull of
815                     the lattice points in polygon
816@*            l[2] = list, the redundant points in l[1] have been removed
817EXAMPLE:     example findOrientedBoundary;   shows an example"
818{
819  // Order the vertices such that passing from one to the next we travel along
820  // the boundary of the convex hull of the vertices clock wise
821  int d,k,i,j;
822  intmat D[2][2];
823  /////////////////////////////////////
824  // Treat first the pathological cases that the polygon is not two-dimensional:
825  /////////////////////////////////////
826  // if the polygon is empty or only one point or a line segment of two points
827  if (size(polygon)<=2)
828  {
829    return(list(polygon,polygon));
830  }
831  // check is the polygon is only a line segment given by more than two points;
832  // for this first compute sum of the absolute values of the determinants
833  // of the matrices whose
834  // rows are the vectors pointing from the first to the second point
835  // and from the
836  // the first point to the ith point for i=3,...,size(polygon);
837  // if this sum is zero
838  // then the polygon is a line segment and we have to find its end points
839  d=0;
840  for (i=3;i<=size(polygon);i++)
841  {
842    D=polygon[2]-polygon[1],polygon[i]-polygon[1];
843    d=d+abs(det(D));
844  }
845  if (d==0) // then polygon is a line segment
846  {
847    intmat laenge[size(polygon)][size(polygon)];
848    intvec mp;
849    //   for this collect first all vectors pointing from one lattice
850    //   point to the next,
851    //   compute their pairwise angles and their lengths
852    for (i=1;i<=size(polygon)-1;i++)
853    {
854      for (j=i+1;j<=size(polygon);j++)
855      {
856        mp=polygon[i]-polygon[j];
857        laenge[i,j]=abs(gcd(mp[1],mp[2]));
858      }
859    }
860    mp=maxPosInIntmat(laenge);
861    list endpoints=polygon[mp[1]],polygon[mp[2]];
862    intvec abstand;
863    for (i=1;i<=size(polygon);i++)
864    {
865      abstand[i]=0;
866      if (i<mp[1])
867      {
868        abstand[i]=laenge[i,mp[1]];
869      }
870      if (i>mp[1])
871      {
872        abstand[i]=laenge[mp[1],i];
873      }
874    }
875    polygon=sortlistbyintvec(polygon,abstand);
876    return(list(polygon,endpoints));
877  }
878  ///////////////////////////////////////////////////////////////
879  list orderedvertices;  // stores the vertices in an ordered way
880  list minimisedorderedvertices;  // stores the vertices in an ordered way;
881                                  // redundant ones removed
882  list comparevertices; // stores vertices which should be compared to
883                        // the testvertex
884  orderedvertices[1]=polygon[1]; // set the starting vertex
885  minimisedorderedvertices[1]=polygon[1]; // set the starting vertex
886  intvec testvertex=polygon[1];  //vertex to which the others have to be compared
887  intvec startvertex=polygon[1]; // keep the starting vertex to test,
888                                 // when the end is reached
889  int endtest;                   // is set to one, when the end is reached
890  int startvertexfound;// is 1, once for some testvertex a candidate
891                       // for the next vertex has been found
892  polygon=delete(polygon,1);    // delete the testvertex
893  intvec v,w;
894  int l=1;  // counts the vertices
895  // the basic idea is that a vertex can be
896  // the next one on the boundary if all other vertices
897  // lie to the right of the vector v pointing
898  // from the testvertex to this one; this can be tested
899  // by checking if the determinant of the 2x2-matrix
900  // with first column v and second column the vector w,
901  // pointing from the testvertex to the new vertex,
902  // is non-positive; if this is the case for all
903  // new vertices, then the one in consideration is
904  // a possible choice for the next vertex on the boundary
905  // and it is stored in naechste; we can then order
906  // the candidates according to their distance from
907  // the testvertex; then they occur on the boundary in that order!
908  while (endtest==0)
909  {
910    list naechste;  // stores the possible choices for the next vertex
911    k=1;
912    for (i=1;i<=size(polygon);i++)
913    {
914      d=0;  // stores the value of the determinant of (v,w)
915      v=polygon[i]-testvertex; // points from the testvertex to the ith vertex
916      comparevertices=delete(polygon,i); // we needn't compare v to itself
917      // we should compare v to the startvertex-testvertex;
918      // in the first calling of the loop
919      // this is irrelevant since the difference will be zero;
920      // however, later on it will
921      // be vital, since we delete the vertices
922      // which we have already tested from the list
923      // of all vertices, and when all vertices
924      // on the boundary have been found we would
925      // therefore find a vertex in the interior
926      // as candidate; but always testing against
927      // the starting vertex, this cannot happen
928      comparevertices[size(comparevertices)+1]=startvertex;
929      for (j=1;(j<=size(comparevertices)) and (d<=0);j++)
930      {
931        w=comparevertices[j]-testvertex; // points form the testvertex
932                                         // to the jth vertex
933        D=v,w;
934        d=det(D);
935      }
936      if (d<=0) // if all determinants are non-positive,
937      { // then the ith vertex is a candidate
938        naechste[k]=list(polygon[i],i,scalarproduct(v,v));// we store the vertex,
939                                                          //its position, and its
940        k++; // distance from the testvertex
941      }
942    }
943    if (size(naechste)>0) // then a candidate for the next vertex has been found
944    {
945      startvertexfound=1; // at least once a candidate has been found
946      naechste=sortlist(naechste,3);  // we order the candidates according
947                                      // to their distance from testvertex;
948      for (j=1;j<=size(naechste);j++) // then we store them in this
949      { // order in orderedvertices
950        l++;
951        orderedvertices[l]=naechste[j][1];
952      }
953      testvertex=naechste[size(naechste)][1];  // we store the last one as
954                                               // next testvertex;
955      // store the next corner of NSD
956      minimisedorderedvertices[size(minimisedorderedvertices)+1]=testvertex;
957      naechste=sortlist(naechste,2); // then we reorder the vertices
958                                     // according to their position
959      for (j=size(naechste);j>=1;j--) // and we delete them from the vertices
960      {
961        polygon=delete(polygon,naechste[j][2]);
962      }
963    }
964    else // that means either that the vertex was inside the polygon,
965    {    // or that we have reached the last vertex on the boundary
966         // of the polytope
967      if (startvertexfound==0) // the vertex was in the interior;
968      { // we delete it and start all over again
969        orderedvertices[1]=polygon[1];
970        minimisedorderedvertices[1]=polygon[1];
971        testvertex=polygon[1];
972        startvertex=polygon[1];
973        polygon=delete(polygon,1);
974      }
975      else // we have reached the last vertex on the boundary of
976      { // the polytope and can stop
977        endtest=1;
978      }
979    }
980    kill naechste;
981  }
982  // test if the first vertex in minimisedorderedvertices
983  // is on the same line with the second and
984  // the last, i.e. if we started our search in the
985  // middle of a face; if so, delete it
986  v=minimisedorderedvertices[2]-minimisedorderedvertices[1];
987  w=minimisedorderedvertices[size(minimisedorderedvertices)]-minimisedorderedvertices[1];
988  D=v,w;
989  if (det(D)==0)
990  {
991    minimisedorderedvertices=delete(minimisedorderedvertices,1);
992  }
993  // test if the first vertex in minimisedorderedvertices
994  // is on the same line with the two
995  // last ones, i.e. if we started our search at the end of a face;
996  // if so, delete it
997  v=minimisedorderedvertices[size(minimisedorderedvertices)-1]-minimisedorderedvertices[1];
998  w=minimisedorderedvertices[size(minimisedorderedvertices)]-minimisedorderedvertices[1];
999  D=v,w;
1000  if (det(D)==0)
1001  {
1002    minimisedorderedvertices=delete(minimisedorderedvertices,size(minimisedorderedvertices));
1003  }
1004  return(list(orderedvertices,minimisedorderedvertices));
1005}
1006example
1007{
1008   "EXAMPLE:";
1009   echo=2;
1010// the following lattice points in the plane define a polygon
1011   list polygon=intvec(0,0),intvec(3,1),intvec(1,0),intvec(2,0),
1012                intvec(1,1),intvec(3,2),intvec(1,2),intvec(2,3),
1013                intvec(2,4);
1014// we compute its boundary
1015   list boundarypolygon=findOrientedBoundary(polygon);
1016// the points on the boundary ordered clockwise are boundarypolygon[1]
1017   boundarypolygon[1];
1018// the vertices of the boundary are boundarypolygon[2]
1019   boundarypolygon[2];
1020}
1021
1022
1023/////////////////////////////////////////////////////////////////////////////
1024
1025proc cyclePoints (list triang,list points,int pt)
1026"USAGE:      cyclePoints(triang,points,pt)  triang,points list, pt int
1027ASSUME:      - points is a list of integer vectors describing the lattice
1028               points of a marked polygon;
1029@*           - triang is a list of integer vectors describing a triangulation
1030               of the marked polygon in the sense that an integer vector of
1031               the form (i,j,k) describes the triangle formed by polygon[i],
1032               polygon[j] and polygon[k];
1033@*           - pt is an integer between 1 and size(points), singling out a
1034               lattice point among the marked points
1035PURPOSE:     consider the convex lattice polygon, say P, spanned by all lattice
1036             points in points which in the triangulation triang are connected
1037             to the point points[pt]; the procedure computes all marked points
1038             in points which lie on the boundary of that polygon, ordered
1039             clockwise
1040RETURN:      list, of integer vectors which are the coordinates of the lattice
1041                   points on the boundary of the above mentioned polygon P, if
1042                   this polygon is not the empty set (that would be the case if
1043                   points[pt] is not a vertex of any triangle in the
1044                   triangulation); otherwise return the empty list
1045EXAMPLE:     example cyclePoints;   shows an example"
1046{
1047  int i,j; // indices
1048  list v;  // saves the indices of lattice points connected to the
1049           // interior point in the triangulation
1050  // save all points in triangulations containing pt in v
1051  for (i=1;i<=size(triang);i++)
1052  {
1053    if ((triang[i][1]==pt) or (triang[i][2]==pt) or (triang[i][3]==pt))
1054    {
1055      j++;
1056      v[3*j-2]=triang[i][1];
1057      v[3*j-1]=triang[i][2];
1058      v[3*j]=triang[i][3];
1059    }
1060  }
1061  if (size(v)==0)
1062  {
1063    return(list());
1064  }
1065  // remove pt itself and redundancies in v
1066  for (i=size(v);i>=1;i--)
1067  {
1068    j=1;
1069    while ((j<i) and (v[i]!=v[j]))
1070    {
1071      j++;
1072    }
1073    if ((j<i) or (v[i]==pt))
1074    {
1075      v=delete(v,i);
1076    }
1077  }
1078  // save in pts the coordinates of the points with indices in v
1079  list pts;
1080  for (i=1;i<=size(v);i++)
1081  {
1082    pts[i]=points[v[i]];
1083  }
1084  // consider the convex polytope spanned by the points in pts,
1085  // find the points on the
1086  // boundary and order them clockwise
1087  return(findOrientedBoundary(pts)[1]);
1088}
1089example
1090{
1091   "EXAMPLE:";
1092   echo=2;
1093   // the lattice polygon spanned by the points (0,0), (3,0) and (0,3)
1094   // with all integer points as markings
1095   list points=intvec(1,1),intvec(3,0),intvec(2,0),intvec(1,0),
1096               intvec(0,0),intvec(2,1),intvec(0,1),intvec(1,2),
1097               intvec(0,2),intvec(0,3);
1098   // define a triangulation
1099   list triang=intvec(1,2,5),intvec(1,5,7),intvec(1,7,9),intvec(8,9,10),
1100               intvec(1,8,9),intvec(1,2,8);
1101   // compute the points connected to (1,1) in triang
1102   cyclePoints(triang,points,1);
1103}
1104
1105/////////////////////////////////////////////////////////////////////////////
1106
1107proc latticeArea (list polygon)
1108"USAGE:  latticeArea(polygon);   polygon list
1109ASSUME:  polygon is a list of integer vectors in the plane
1110RETURN:  int, the lattice area of the convex hull of the lattice points in
1111              polygon, i.e. twice the Euclidean area
1112EXAMPLE: example polygonlatticeArea;   shows an example"
1113{
1114  list pg=findOrientedBoundary(polygon)[2];
1115  int area;
1116  intmat M[2][2];
1117  for (int i=2;i<=size(pg)-1;i++)
1118  {
1119    M[1,1..2]=pg[i]-pg[1];
1120    M[2,1..2]=pg[i+1]-pg[1];
1121    area=area+abs(det(M));
1122  }
1123  return(area);
1124}
1125example
1126{
1127   "EXAMPLE:";
1128   echo=2;
1129   // define a polygon with lattice area 5
1130   list polygon=intvec(1,2),intvec(1,0),intvec(2,0),intvec(1,1),
1131                intvec(2,1),intvec(0,0);
1132   latticeArea(polygon);
1133}
1134
1135/////////////////////////////////////////////////////////////////////////////
1136
1137proc picksFormula (list polygon)
1138"USAGE:  picksFormula(polygon);   polygon list
1139ASSUME:  polygon is a list of integer vectors in the plane and consider their
1140         convex hull C
1141RETURN:  list, L of three integersthe
1142@*             L[1] : the lattice area of C, i.e. twice the Euclidean area
1143@*             L[2] : the number of lattice points on the boundary of C
1144@*             L[3] : the number of interior lattice points of C
1145NOTE: the integers in L are related by Pick's formula, namely: L[1]=L[2]+2*L[3]-2
1146EXAMPLE: example picksFormula;   shows an example"
1147{
1148  list pg=findOrientedBoundary(polygon)[2];
1149  int area,bdpts,i;
1150  intmat M[2][2];
1151  // compute the lattice area of the polygon, i.e. twice the Euclidean area
1152  for (i=2;i<=size(pg)-1;i++)
1153  {
1154    M[1,1..2]=pg[i]-pg[1];
1155    M[2,1..2]=pg[i+1]-pg[1];
1156    area=area+abs(det(M));
1157  }
1158  // compute the number of lattice points on the boundary
1159  intvec edge;
1160  pg[size(pg)+1]=pg[1];
1161  for (i=1;i<=size(pg)-1;i++)
1162  {
1163    edge=pg[i]-pg[i+1];
1164    bdpts=bdpts+abs(gcd(edge[1],edge[2]));
1165  }
1166  // Pick's formula says that the lattice area A, the number g of interior
1167  // points and
1168  // the number b of boundary points are connected by the formula: A=b+2g-2
1169  return(list(area,bdpts,(area-bdpts+2) div 2));
1170}
1171example
1172{
1173   "EXAMPLE:";
1174   echo=2;
1175   // define a polygon with lattice area 5
1176   list polygon=intvec(1,2),intvec(1,0),intvec(2,0),intvec(1,1),
1177                intvec(2,1),intvec(0,0);
1178   list pick=picksFormula(polygon);
1179   // the lattice area of the polygon is:
1180   pick[1];
1181   // the number of lattice points on the boundary is:
1182   pick[2];
1183   // the number of interior lattice points is:
1184   pick[3];
1185   // the number's are related by Pick's formula:
1186   pick[1]-pick[2]-2*pick[3]+2;
1187}
1188
1189/////////////////////////////////////////////////////////////////////////////
1190
1191proc ellipticNF (list polygon)
1192"USAGE:  ellipticNF(polygon);   polygon list
1193ASSUME:  polygon is a list of integer vectors in the plane such that their
1194         convex hull C has precisely one interior lattice point; i.e. C is the
1195         Newton polygon of an elliptic curve
1196PURPOSE: compute the normal form of the polygon with respect to the unimodular
1197         affine transformations T=A*x+v; there are sixteen different normal forms
1198         (see e.g. Bjorn Poonen, Fernando Rodriguez-Villegas: Lattice Polygons
1199                   and the number 12.  Amer. Math. Monthly  107  (2000),  no. 3,
1200                   238--250.)
1201RETURN:  list, L such that
1202@*             L[1] : list whose entries are the vertices of the normal form of
1203                      the polygon
1204@*             L[2] : the matrix A of the unimodular transformation
1205@*             L[3] : the translation vector v of the unimodular transformation
1206@*             L[4] : list such that the ith entry is the image of polygon[i]
1207                      under the unimodular transformation T
1208EXAMPLE: example ellipticNF;   shows an example"
1209{
1210  int i;            // index
1211  intvec edge;      // stores the vector of an edge
1212  intvec boundary;  // stores lattice lengths of the edges of the Newton cycle
1213  // find the vertices of the Newton cycle and order it clockwise
1214  list pg=findOrientedBoundary(polygon)[2];
1215  // check if there is precisely one interior point in the Newton polygon
1216  if (picksFormula(pg)[3]!=1)
1217  {
1218    ERROR("The polygon has not precisely one interior point!");
1219  }
1220  // insert the first vertex at the end once again
1221  pg[size(pg)+1]=pg[1];
1222  // compute the number of lattice points on each edge
1223  for (i=1;i<=size(pg)-1;i++)
1224  {
1225    edge=pg[i]-pg[i+1];
1226    boundary[i]=1+abs(gcd(edge[1],edge[2]));
1227  }
1228  // store the values of boundary once more adding the first two at the end
1229  intvec tboundary=boundary,boundary[1],boundary[2];
1230  // sort boundary in an asecending way
1231  intvec sbd=sortintvec(boundary);
1232  // find the first edge having the maximal number of lattice points
1233  int max=maxPosInIntvec(boundary);
1234  // some computations have to be done over the rationals
1235  ring transformationring=0,x,lp;
1236  intvec trans;    // stores the vector by which we have to translate the polygon
1237  intmat A[2][2];  // stores the matrix by which we have to transform the polygon
1238  matrix M[3][3];  // stores the projective coordinates of the points
1239                   // which are to be transformed
1240  matrix N[3][3];  // stores the projective coordinates of the points to
1241                   // which M is to be transformed
1242  intmat T[3][3];  // stores the unimodular affine transformation in
1243                   // projective form
1244  // add the second point of pg once again at the end
1245  pg=insert(pg,pg[2],size(pg));
1246  // if there is only one edge which has the maximal number of lattice points,
1247  // then M should be:
1248  M=pg[max],1,pg[max+1],1,pg[max+2],1;
1249  // consider the 16 different cases which can occur:
1250  // Case 1:
1251  if (sbd==intvec(2,2,2))
1252  {
1253    N=0,1,1,1,2,1,2,0,1;
1254  }
1255  // Case 2:
1256  if (sbd==intvec(2,2,3))
1257  {
1258    N=2,0,1,0,0,1,1,2,1;
1259  }
1260  // Case 3:
1261  if (sbd==intvec(2,3,4))
1262  {
1263    // here the orientation of the Newton polygon is important !
1264    if (tboundary[max+1]==3)
1265    {
1266      N=3,0,1,0,0,1,0,2,1;
1267    }
1268    else
1269    {
1270      N=0,0,1,3,0,1,0,2,1;
1271    }
1272  }
1273  // Case 4:
1274  if (sbd==intvec(3,3,5))
1275  {
1276    N=4,0,1,0,0,1,0,2,1;
1277  }
1278  // Case 5:
1279  if (sbd==intvec(4,4,4))
1280  {
1281    N=3,0,1,0,0,1,0,3,1;
1282  }
1283  // Case 6+7:
1284  if (sbd==intvec(2,2,2,2))
1285  {
1286    // there are two different polygons which has four edges all of length 2,
1287    // but only one of them has two edges whose direction vectors form a matrix
1288    // of determinant 3
1289    A=pg[1]-pg[2],pg[3]-pg[2];
1290    while ((max<4) and (det(A)!=3))
1291    {
1292      max++;
1293      A=pg[max]-pg[max+1],pg[max+2]-pg[max+1];
1294    }
1295    // Case 6:
1296    if (det(A)==3)
1297    {
1298      M=pg[max],1,pg[max+1],1,pg[max+2],1;
1299      N=1,0,1,0,2,1,2,1,1;
1300    }
1301    // Case 7:
1302    else
1303    {
1304      N=2,1,1,1,0,1,0,1,1;
1305    }
1306  }
1307  // Case 8:
1308  if (sbd==intvec(2,2,2,3))
1309  {
1310    // the orientation of the polygon is important
1311    A=pg[max]-pg[max+1],pg[max+2]-pg[max+1];
1312    if (det(A)==2)
1313    {
1314      N=2,0,1,0,0,1,0,1,1;
1315    }
1316    else
1317    {
1318      N=0,0,1,2,0,1,1,2,1;
1319    }
1320  }
1321  // Case 9:
1322  if (sbd==intvec(2,2,3,3))
1323  {
1324    // if max==1, then the 5th entry in tboundary is the same as the first
1325    if (max==1)
1326    {
1327      max=5;
1328    }
1329    // if boundary=3,2,2,3 then set max=4
1330    if (tboundary[max+1]!=3)
1331    {
1332      max=4;
1333    }
1334    M=pg[max],1,pg[max+1],1,pg[max+2],1;
1335    // the orientation of the polygon matters
1336    A=pg[max-1]-pg[max],pg[max+1]-pg[max];
1337    if (det(A)==4)
1338    {
1339      N=2,0,1,0,0,1,0,2,1;
1340    }
1341    else
1342    {
1343      N=0,2,1,0,0,1,2,0,1;
1344    }
1345  }
1346  // Case 10:
1347  if (sbd==intvec(2,2,3,4))
1348  {
1349    // the orientation of the polygon matters
1350    if (tboundary[max+1]==3)
1351    {
1352      N=3,0,1,0,0,1,0,2,1;
1353    }
1354    else
1355    {
1356      N=0,0,1,3,0,1,2,1,1;
1357    }
1358  }
1359  // Case 11:
1360  if (sbd==intvec(2,3,3,4))
1361  {
1362    N=3,0,1,0,0,1,0,2,1;
1363  }
1364  // Case 12:
1365  if (sbd==intvec(3,3,3,3))
1366  {
1367    N=2,0,1,0,0,1,0,2,1;
1368  }
1369  // Case 13:
1370  if (sbd==intvec(2,2,2,2,2))
1371  {
1372    // compute the angles of the polygon vertices
1373    intvec dt;
1374    for (i=1;i<=5;i++)
1375    {
1376      A=pg[i]-pg[i+1],pg[i+2]-pg[i+1];
1377      dt[i]=det(A);
1378    }
1379    dt[6]=dt[1];
1380    // find the vertex to be mapped to (0,1)
1381    max=1;
1382    while ((dt[max]!=2) or (dt[max+1]!=2))
1383    {
1384      max++;
1385    }
1386    M=pg[max],1,pg[max+1],1,pg[max+2],1;
1387    N=0,1,1,1,2,1,2,1,1;
1388  }
1389  // Case 14:
1390  if (sbd==intvec(2,2,2,2,3))
1391  {
1392    N=2,0,1,0,0,1,0,1,1;
1393  }
1394  // Case 15:
1395  if (sbd==intvec(2,2,2,3,3))
1396  {
1397    // find the vertex to be mapped to (2,0)
1398    if (tboundary[max+1]!=3)
1399    {
1400      max=5;
1401      M=pg[max],1,pg[max+1],1,pg[max+2],1;
1402    }
1403    N=2,0,1,0,0,1,0,2,1;
1404  }
1405  // Case 16:
1406  if (sbd==intvec(2,2,2,2,2,2))
1407  {
1408    N=2,0,1,1,0,1,0,1,1;
1409  }
1410  // we have to transpose the matrices M and N
1411  M=transpose(M);
1412  N=transpose(N);
1413  // compute the unimodular affine transformation, which is of the form
1414  // A11 A12 | T1
1415  // A21 A22 | T2
1416  //  0   0  | 1
1417  T=matrixtointmat(N*inverse(M));
1418  // the upper-left 2x2-block is A
1419  A=T[1..2,1..2];
1420  // the upper-right 2x1-block is the translation vector
1421  trans=T[1,3],T[2,3];
1422  // transform now the lattice points of the polygon with respect to A and T
1423  list nf;
1424  for (i=1;i<=size(polygon);i++)
1425  {
1426    intmat V[2][1]=polygon[i];
1427    V=A*V;
1428    nf[i]=intvec(V[1,1]+trans[1],V[2,1]+trans[2]);
1429    kill V;
1430  }
1431  return(list(findOrientedBoundary(nf)[2],A,trans,nf));
1432}
1433example
1434{
1435   "EXAMPLE:";
1436   echo=2;
1437   ring r=0,(x,y),dp;
1438   // the Newton polygon of the following polynomial
1439   //     has precisely one interior point
1440   poly f=x22y11+x19y10+x17y9+x16y9+x12y7+x9y6+x7y5+x2y3;
1441   list polygon=list(intvec(22,11),intvec(19,10),intvec(17,9),
1442                     intvec(16,9), intvec(12,7),intvec(9,6),
1443                     intvec(7,5),intvec(2,3));
1444   // its lattice points are
1445   polygon;
1446   // find its normal form
1447   list nf=ellipticNF(polygon);
1448   // the vertices of the normal form are
1449   nf[1];
1450   // it has been transformed by the unimodular affine transformation A*x+v
1451   // with matrix A
1452   nf[2];
1453   // and translation vector v
1454   nf[3];
1455   // the 3rd lattice point ...
1456   polygon[3];
1457   // ... has been transformed to
1458   nf[4][3];
1459}
1460
1461
1462/////////////////////////////////////////////////////////////////////////////////
1463/////////////////////////////////////////////////////////////////////////////////
1464/// AUXILIARY PROCEDURES, WHICH ARE DECLARED STATIC
1465/////////////////////////////////////////////////////////////////////////////////
1466/////////////////////////////////////////////////////////////////////////////////
1467/// - scalarproduct
1468/// - intmatcoldelete
1469/// - intmatconcat
1470/// - sortlist
1471/// - minInList
1472/// - stringdelete
1473/// - abs
1474/// - commondenominator
1475/// - maxPosInIntvec
1476/// - maxPosInIntmat
1477/// - sortintvec
1478/// - matrixtointmat
1479/////////////////////////////////////////////////////////////////////////////////
1480
1481static proc scalarproduct (intvec w,intvec v)
1482"USAGE:      scalarproduct(w,v); w,v intvec
1483ASSUME:      w and v are integer vectors of the same length
1484RETURN:      int, the scalarproduct of v and w
1485NOTE:        the procedure is called by findOrientedBoundary"
1486{
1487  int sp;
1488  for (int i=1;i<=size(w);i++)
1489  {
1490    sp=sp+v[i]*w[i];
1491  }
1492  return(sp);
1493}
1494
1495static proc intmatcoldelete (def w,int i)
1496"USAGE:      intmatcoldelete(w,i); w intmat, i int
1497RETURN:      intmat, the integer matrix w with the ith comlumn deleted
1498NOTE:        the procedure is called by intmatsort"
1499{
1500  if (typeof(w)=="intmat")
1501  {
1502    if ((i<1) or (i>ncols(w)) or (ncols(w)==1))
1503    {
1504      return(w);
1505    }
1506    if (i==1)
1507    {
1508      intmat M[nrows(w)][ncols(w)-1]=w[1..nrows(w),2..ncols(w)];
1509      return(M);
1510    }
1511    if (i==ncols(w))
1512    {
1513      intmat M[nrows(w)][ncols(w)-1]=w[1..nrows(w),1..ncols(w)-1];
1514      return(M);
1515    }
1516    else
1517    {
1518      intmat M[nrows(w)][i-1]=w[1..nrows(w),1..i-1];
1519      intmat N[nrows(w)][ncols(w)-i]=w[1..nrows(w),i+1..ncols(w)];
1520      return(intmatconcat(M,N));
1521    }
1522  }
1523  if (typeof(w)=="bigintmat")
1524  {
1525    if ((i<1) or (i>ncols(w)) or (ncols(w)==1))
1526    {
1527      return(w);
1528    }
1529    if (i==1)
1530    {
1531      bigintmat M[nrows(w)][ncols(w)-1]=w[1..nrows(w),2..ncols(w)];
1532      return(M);
1533    }
1534    if (i==ncols(w))
1535    {
1536      bigintmat M[nrows(w)][ncols(w)-1]=w[1..nrows(w),1..ncols(w)-1];
1537      return(M);
1538    }
1539    else
1540    {
1541      bigintmat MN[nrows(w)][ncols(w)-1];
1542      MN[1..nrows(w),1..i-1]=w[1..nrows(w),1..i-1];
1543      MN[1..nrows(w),i..ncols(w)-1]=w[1..nrows(w),i+1..ncols(w)];
1544      return(MN);
1545    }
1546  } else
1547  {
1548    ERROR("intmatcoldelete: input matrix has to be of type intmat or bigintmat");
1549    intmat M; return(M);
1550  }
1551}
1552
1553static proc intmatconcat (intmat M,intmat N)
1554"USAGE:      intmatconcat(M,N); M,N intmat
1555RETURN:      intmat, M and N concatenated
1556NOTE:        the procedure is called by intmatcoldelete and sortintmat"
1557{
1558  if (nrows(M)>=nrows(N))
1559  {
1560    int m=nrows(M);
1561
1562  }
1563  else
1564  {
1565    int m=nrows(N);
1566  }
1567  intmat P[m][ncols(M)+ncols(N)];
1568  P[1..nrows(M),1..ncols(M)]=M[1..nrows(M),1..ncols(M)];
1569  P[1..nrows(N),ncols(M)+1..ncols(M)+ncols(N)]=N[1..nrows(N),1..ncols(N)];
1570  return(P);
1571}
1572
1573static proc sortlist (list v,int pos)
1574"USAGE:      sortlist(v,pos); v list, pos int
1575RETURN:      list, the list L ordered in an ascending way according to the pos-th entries
1576NOTE:        called by tropicalCurve"
1577{
1578  if(size(v)==1)
1579  {
1580    return(v);
1581  }
1582  list w=minInList(v,pos);
1583  v=delete(v,w[2]);
1584  v=sortlist(v,pos);
1585  v=list(w[1])+v;
1586  return(v);
1587}
1588
1589static proc minInList (list v,int pos)
1590"USAGE:      minInList(v,pos); v list, pos int
1591RETURN:      list, (v[i],i) such that v[i][pos] is minimal
1592NOTE:        called by sortlist"
1593{
1594  int min=v[1][pos];
1595  int minpos=1;
1596  for (int i=2;i<=size(v);i++)
1597  {
1598    if (v[i][pos]<min)
1599    {
1600      min=v[i][pos];
1601      minpos=i;
1602    }
1603  }
1604  return(list(v[minpos],minpos));
1605}
1606
1607static proc stringdelete (string w,int i)
1608"USAGE:      stringdelete(w,i); w string, i int
1609RETURN:      string, the string w with the ith component deleted
1610NOTE:        the procedure is called by texnumber and choosegfanvector"
1611{
1612  if ((i>size(w)) or (i<=0))
1613  {
1614    return(w);
1615  }
1616  if ((size(w)==1) and (i==1))
1617  {
1618    return("");
1619
1620  }
1621  if (i==1)
1622  {
1623    return(w[2..size(w)]);
1624  }
1625  if (i==size(w))
1626  {
1627    return(w[1..size(w)-1]);
1628  }
1629  else
1630  {
1631    string erg=w[1..i-1],w[i+1..size(w)];
1632    return(erg);
1633  }
1634}
1635
1636static proc abs (def n)
1637"USAGE:      abs(n); n poly or int
1638RETURN:      poly or int, the absolute value of n"
1639{
1640  if (n>=0)
1641  {
1642    return(n);
1643  }
1644  else
1645  {
1646    return(-n);
1647  }
1648}
1649
1650static proc commondenominator (matrix M)
1651"USAGE:   commondenominator(M);  M matrix
1652ASSUME:   the base ring has characteristic zero
1653RETURN:   int, the lowest common multiple of the denominators of the leading coefficients
1654               of the entries in M
1655NOTE:        the procedure is called from polymakeToIntmat"
1656{
1657  int i,j;
1658  int kgV=1;
1659  // successively build the lowest common multiple of the denominators of the leading coefficients
1660  // of the entries in M
1661  for (i=1;i<=nrows(M);i++)
1662  {
1663    for (j=1;j<=ncols(M);j++)
1664    {
1665      kgV=lcm(kgV,int(denominator(leadcoef(M[i,j]))));
1666    }
1667  }
1668  return(kgV);
1669}
1670
1671static proc maxPosInIntvec (intvec v)
1672"USAGE:      maxPosInIntvec(v); v intvec
1673RETURN:      int, the first position of a maximal entry in v
1674NOTE:        called by sortintmat"
1675{
1676  int max=v[1];
1677  int maxpos=1;
1678  for (int i=2;i<=size(v);i++)
1679  {
1680    if (v[i]>max)
1681    {
1682      max=v[i];
1683      maxpos=i;
1684    }
1685  }
1686  return(maxpos);
1687}
1688
1689static proc maxPosInIntmat (intmat v)
1690"USAGE:      maxPosInIntmat(v); v intmat
1691ASSUME:      v has a unique maximal entry
1692RETURN:      intvec, the position (i,j) of the maximal entry in v
1693NOTE:        called by findOrientedBoundary"
1694{
1695  int max=v[1,1];
1696  intvec maxpos=1,1;
1697  int i,j;
1698  for (i=1;i<=nrows(v);i++)
1699  {
1700    for (j=1;j<=ncols(v);j++)
1701    {
1702      if (v[i,j]>max)
1703      {
1704        max=v[i,j];
1705        maxpos=i,j;
1706      }
1707    }
1708  }
1709  return(maxpos);
1710}
1711
1712static proc sortintvec (intvec w)
1713"USAGE:      sortintvec(v); v intvec
1714RETURN:      intvec, the entries of v are ordered in an ascending way
1715NOTE:        called from ellipticNF"
1716{
1717  int j,k,stop;
1718  intvec v=w[1];
1719  for (j=2;j<=size(w);j++)
1720  {
1721    k=1;
1722    stop=0;
1723    while ((k<=size(v)) and (stop==0))
1724    {
1725      if (v[k]<w[j])
1726      {
1727        k++;
1728      }
1729      else
1730      {
1731        stop=1;
1732      }
1733    }
1734    if (k==size(v)+1)
1735    {
1736      v=v,w[j];
1737    }
1738    else
1739    {
1740      if (k==1)
1741      {
1742        v=w[j],v;
1743      }
1744      else
1745      {
1746        v=v[1..k-1],w[j],v[k..size(v)];
1747      }
1748    }
1749  }
1750  return(v);
1751}
1752
1753static proc sortlistbyintvec (list L,intvec w)
1754"USAGE:      sortlistbyintvec(L,w); L list, w intvec
1755RETURN:      list, the entries of L are ordered such that the corresponding reordering of
1756                   w would order w in an ascending way
1757NOTE:        called from ellipticNF"
1758{
1759  int j,k,stop;
1760  intvec v=w[1];
1761  list LL=L[1];
1762  for (j=2;j<=size(w);j++)
1763  {
1764    k=1;
1765    stop=0;
1766    while ((k<=size(v)) and (stop==0))
1767    {
1768      if (v[k]<w[j])
1769      {
1770        k++;
1771      }
1772      else
1773      {
1774        stop=1;
1775      }
1776    }
1777    if (k==size(v)+1)
1778    {
1779      v=v,w[j];
1780      LL=insert(LL,L[j],size(LL));
1781    }
1782    else
1783    {
1784      if (k==1)
1785      {
1786        v=w[j],v;
1787        LL=insert(LL,L[j]);
1788      }
1789      else
1790      {
1791        v=v[1..k-1],w[j],v[k..size(v)];
1792        LL=insert(LL,L[j],k-1);
1793      }
1794    }
1795  }
1796  return(LL);
1797}
1798
1799static proc matrixtointmat (matrix MM)
1800"USAGE:      matrixtointmat(v); MM matrix
1801ASSUME:      MM is a matrix with only integers as entries
1802RETURN:      intmat, the matrix MM has been transformed to type intmat
1803NOTE:        called from ellipticNF"
1804{
1805  intmat M[nrows(MM)][ncols(MM)]=M;
1806  int i,j;
1807  for (i=1;i<=nrows(M);i++)
1808  {
1809    for (j=1;j<=ncols(M);j++)
1810    {
1811      execute("M["+string(i)+","+string(j)+"]="+string(MM[i,j])+";");
1812    }
1813  }
1814  return(M);
1815}
1816
1817//////////////////////////////////////////////////////////////////////////////
1818
1819static proc polygonToCoordinates (list points)
1820"USAGE:      polygonToCoordinates(points);   points list
1821ASSUME:      points is a list of integer vectors each of size two describing the
1822             marked points of a convex lattice polygon like the output of
1823             polygonDB
1824RETURN:      list, the first entry is a string representing the coordinates
1825                   corresponding to the latticpoints separated by commata
1826                   the second entry is a list where the ith entry is a string
1827                   representing the coordinate of corresponding to the ith
1828                   lattice point the third entry is the latex format of the
1829                   first entry
1830NOTE:        the procedure is called by fan"
1831{
1832  string coord;
1833  list coords;
1834  string latex;
1835  for (int i=1;i<=size(points);i++)
1836  {
1837    coords[i]="u"+string(points[i][1])+string(points[i][2]);
1838    coord=coord+coords[i]+",";
1839    latex=latex+"u_{"+string(points[i][1])+string(points[i][2])+"},";
1840  }
1841  coord=coord[1,size(coord)-1];
1842  latex=latex[1,size(latex)-1];
1843  return(list(coord,coords,latex));
1844}
1845
1846static proc intmatAddFirstColumn (def M,string art)
1847"USAGE:  intmatAddFirstColumn(M,art);  M intmat, art string
1848ASSUME:  - M is an integer matrix where a first column of 0's or 1's should be added
1849@*       - art is one of the following strings:
1850@*         + 'rays'   : indicating that a first column of 0's should be added
1851@*         + 'points' : indicating that a first column of 1's should be added
1852RETURN:  intmat, a first column has been added to the matrix"
1853{
1854  if (typeof (M) == "intmat")
1855  {
1856    intmat N[nrows(M)][ncols(M)+1];
1857    int i,j;
1858    for (i=1;i<=nrows(M);i++)
1859    {
1860      if (art=="rays")
1861      {
1862        N[i,1]=0;
1863      }
1864      else
1865      {
1866        N[i,1]=1;
1867      }
1868      for (j=1;j<=ncols(M);j++)
1869      {
1870        N[i,j+1]=M[i,j];
1871      }
1872    }
1873    return(N);
1874  }
1875  if (typeof (M) == "bigintmat")
1876  {
1877    bigintmat N[nrows(M)][ncols(M)+1];
1878    int i,j;
1879    for (i=1;i<=nrows(M);i++)
1880    {
1881      if (art=="rays")
1882      {
1883        N[i,1]=0;
1884      }
1885      else
1886      {
1887        N[i,1]=1;
1888      }
1889      for (j=1;j<=ncols(M);j++)
1890      {
1891        N[i,j+1]=M[i,j];
1892      }
1893    }
1894    return(N);
1895  }
1896  else
1897  {
1898    ERROR ("intmatAddFirstColumn: input matrix has to be either intmat or bigintmat");
1899    intmat N;
1900    return (N);
1901  }
1902}
1903
Note: See TracBrowser for help on using the repository browser.