Ache o maior polígono pequeno: Novos Recursos do Wolfram Language 11

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]=