# Minimal perimeter of all possible polygons

We had a fun problem for a student activity today:

Let $P(z) = z^8 + \left(4\sqrt{3} + 6\right)z^4 - \left(4\sqrt{3} + 7\right)$. What is the minimum perimeter among all the $8$-sided polygons in the complex plane whose vertices are precisely the zeros of $P(z)$?

Solution: $8\sqrt{2}$.

I managed to find the solutions, change them to points, and use Graphics to plot them.

sols = Solve[z^8 + (4 Sqrt[3] + 6) z^4 - (4 Sqrt[3] + 7) == 0, z];
pts = {Re[z], Im[z]} /. sols;
Graphics[{
PointSize[Large], Point[pts]}


Which produced this image:

I would like to ask: How can I use Mathematica to determine how to find the minimum perimeter among all 8-sided polygonal in the complex plane whose vertices are the vertices indicated in my image? And how to best draw the resulting polygon?

Update: Based on Rahul's answer, I was able to do the following. Same start:

sols = Solve[z^8 + (4 Sqrt[3] + 6) z^4 - (4 Sqrt[3] + 7) == 0, z];
pts = {Re[z], Im[z]} /. sols;


Then, Rahul's command:

tour = FindShortestTour[pts] // FullSimplify


Which gave the correct answer for the length of the shortest tour, but it also ordered the points for the shortest tour.

(* {8 Sqrt[2], {1, 2, 3, 4, 5, 6, 7, 8, 9, 1}} *)


So it looks like they were already in the preferred order. Then I did this:

pts = pts[[Last[tour]]]


Which sorted my points (which were already sorted, but added point number one at the end). Then:

Graphics[{
Line[pts],
Red, PointSize[Large], Point[pts]
}]


This produced am image similar to that provided by m_goldberg. Then I worried I wasn't interpreting the sort order properly, so I mixed up the list of points.

pts = {{1/2 (-1 - Sqrt[3]), -(1/2) Sqrt[4 + 2 Sqrt[3]]}, {1/
2 (1 + Sqrt[3]), -(1/2) Sqrt[4 + 2 Sqrt[3]]},
{-1, 0}, {0, -1}, {0, 1}, {1, 0}, {1/2 (-1 - Sqrt[3]),
1/2 Sqrt[4 + 2 Sqrt[3]]}, {1/2 (1 + Sqrt[3]),
1/2 Sqrt[4 + 2 Sqrt[3]]}}


Then:

tour = FindShortestTour[pts] // FullSimplify


Provided this order and the same shortest length:

(* {8 Sqrt[2], {1, 3, 7, 5, 8, 6, 2, 4, 1}} *)


And:

pts = pts[[Last[tour]]];
Graphics[{
Line[pts],
Red, PointSize[Large], Point[pts]
}]


Again produced the same result.

So I hope I am interpreting the FindShortesTour command correctly.

I am wondering about m_goldberg's approach, which works for this situation, but look what happens when I apply it to these points:

pts = {{1, 1}, {1, 2}, {1, 3}, {1, 4}, {1, 5}, {2, 1}, {2, 3}, {2,
5}, {3, 1}, {3, 2}, {3, 4}, {3, 5}, {4, 1}, {4, 3}, {4, 5}, {5,
1}, {5, 2}, {5, 3}, {5, 4}};
poly = SortBy[pts, ToPolarCoordinates[#][[2]] &];
Graphics[{FaceForm[], EdgeForm[Red], Polygon[poly], PointSize[Large],
Point[pts]}]


Whereas:

tour = FindShortestTour[pts];
pts = pts[[Last[tour]]];
Graphics[{
Line[pts],
Red, PointSize[Large], Point[pts]
}]


Produces:

• FindShortestTour
– user484
Commented Nov 14, 2015 at 4:25
• @Rahul Wow! Cool answer. Commented Nov 14, 2015 at 5:32
• FindShortestTour gets my vote too, with the caveat that you have to allow self-intersecting polygons in general. Commented Nov 14, 2015 at 21:00

sols = Solve[z^8 + (4 Sqrt[3] + 6) z^4 - (4 Sqrt[3] + 7) == 0, z];

• Slightly shorter: poly = N[ReIm /@ SortBy[z /. sols, N @* Arg]]. Commented Nov 14, 2015 at 14:05