Ache o maior polígono pequeno
Ache o polígono com área máxima entre os polígonos com 
lados e diâmetro d≤1.
No Mathematica 11, FindMinimum adicione um solucionador IPOPT para resolver de forma mais eficiente problemas de otimização restringidos a grande escala.
Determine por n o número de vértices do polígono.
In[1]:=
n = 50;Deixe 
serem as coordenadas polares do vértice do polígono 
.
In[2]:=
vars = Join[Array[r, n], Array[\[Theta], n]];Estes satisfazem as restrições 
, 
, 
, 
.
In[3]:=
varbounds =
Join[Table[0 <= r[i] <= 1, {i, n - 1}], {r[n] == 0},
Table[0 <= \[Theta][i] <= Pi, {i, n - 1}], {\[Theta][n] == Pi}];A área do polígono é a soma das áreas de triângulos com vértices 
, 
, e 
(a origem).
In[4]:=
area = 1/2 Sum[
r[i] r[i + 1] Sin[\[Theta][i + 1] - \[Theta][i]], {i, 1, n - 1}];A distância entre cada dois vértices não deve exceder 1.
In[5]:=
constr1 =
Flatten[Table[
0 < r[i]^2 + r[j]^2 -
2 r[i] r[j] Cos[\[Theta][i] - \[Theta][j]] <= 1, {i, 1,
n - 1}, {j, i + 1, n}], 2];Devido a ordem dos vértices, as seguintes restrições também existem.
In[6]:=
constr2 = Table[\[Theta][i] <= \[Theta][i + 1], {i, 1, n - 1}];Escolha pontos iniciais para as variáveis.
In[7]:=
x0 = vars /. {r[i_] ->
4. i (n + 1 - i)/(n + 1)^2, \[Theta][i_] -> \[Pi] i/n};Maximize as áreas sujeitas às restrições.
In[8]:=
sol = FindMaximum[{area, constr1, constr2, varbounds},
Thread[{vars, x0}]];Converta para coordenadas cartesianas.
In[9]:=
rectpts =
Table[FromPolarCoordinates[{r[i], \[Theta][i]}], {i, 1, n}] /.
sol[[2]];Faça um gráfico da solução.
In[10]:=
Show[ListPlot[rectpts, PlotStyle -> {Blue, PointSize -> Medium}],
Graphics[{Opacity[.1], Blue, EdgeForm[Blue], Polygon[rectpts]}],
AspectRatio -> 1, ImageSize -> Medium]Out[10]=
