# Wolfram言語™

## 面積が最大になる多角形を求める

Mathematica 11ではFindMinimumにIPOPTソルバが加わり，大規模な制約条件付き最適化問題がより効率的に解けるようになった．

In[1]:=
`n = 50;`

を多角形の第 番目の頂点の極座標とする．

In[2]:=
`vars = Join[Array[r, n], Array[\[Theta], n]];`

これらは制約条件 を満足する．

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}];```

In[4]:=
```area = 1/2 Sum[ r[i] r[i + 1] Sin[\[Theta][i + 1] - \[Theta][i]], {i, 1, n - 1}];```

2頂点間の距離はどれも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];```

In[6]:=
`constr2 = Table[\[Theta][i] <= \[Theta][i + 1], {i, 1, n - 1}];`

In[7]:=
```x0 = vars /. {r[i_] -> 4. i (n + 1 - i)/(n + 1)^2, \[Theta][i_] -> \[Pi] i/n};```

In[8]:=
```sol = FindMaximum[{area, constr1, constr2, varbounds}, Thread[{vars, x0}]];```

In[9]:=
```rectpts = Table[FromPolarCoordinates[{r[i], \[Theta][i]}], {i, 1, n}] /. sol[[2]];```

In[10]:=
```Show[ListPlot[rectpts, PlotStyle -> {Blue, PointSize -> Medium}], Graphics[{Opacity[.1], Blue, EdgeForm[Blue], Polygon[rectpts]}], AspectRatio -> 1, ImageSize -> Medium]```
Out[10]=