# 領域上の最適化

 In[1]:= Xpmin = ArgMin[x^2 - x y + y^2, {x, y} \[Element] Disk[]]
 Out[1]=
 In[2]:= Xpmax = ArgMax[x^2 - x y + y^2, {x, y} \[Element] Disk[]]
 Out[2]=
 In[3]:= XLegended[Show[ContourPlot[x^2 - x y + y^2, {x, y} \[Element] Disk[]], Graphics[{PointSize[Medium], {Red, Point[pmin]}, {Blue, Point[pmax]}}]], SwatchLegend[{Red, Blue}, {"min", "max"}]]
 Out[3]=

2つの領域間で最短距離および最長距離となる点のペアを求める．

 In[4]:= X\[ScriptCapitalR]1 = Disk[]; \[ScriptCapitalR]2 = Rectangle[{2, 1}, {3, 3}];
 In[5]:= X{p1t, p2t} = NArgMin[EuclideanDistance[p1, p2], {p1 \[Element] \[ScriptCapitalR]1, p2 \[Element] \[ScriptCapitalR]2}]
 Out[5]=
 In[6]:= X{q1t, q2t} = NArgMax[EuclideanDistance[p1, p2], {p1 \[Element] \[ScriptCapitalR]1, p2 \[Element] \[ScriptCapitalR]2}]
 Out[6]=
 In[7]:= XGraphics[{{LightBlue, \[ScriptCapitalR]1, \[ScriptCapitalR]2}, \ {Dashed, Line[{p1t, p2t}], Red, Point[{p1t, p2t}]}, {Dashed, Line[{q1t, q2t}], Red, Point[{q1t, q2t}]}}]
 Out[7]=

 In[8]:= X\[ScriptCapitalR]1 = Line[{{0, 0, 0}, {1, 1, 1}}]; \[ScriptCapitalR]2 = Ball[{5, 5, 0}, 1];
 In[9]:= X{p1t, p2t} = Simplify@ArgMin[ EuclideanDistance[p1, p2], {p1 \[Element] \[ScriptCapitalR]1, p2 \[Element] \[ScriptCapitalR]2}]
 Out[9]=
 In[10]:= X{q1t, q2t} = Simplify@ArgMax[ EuclideanDistance[p1, p2], {p1 \[Element] \[ScriptCapitalR]1, p2 \[Element] \[ScriptCapitalR]2}]
 Out[10]=
 In[11]:= XGraphics3D[{{Opacity[ 0.5], \[ScriptCapitalR]1, \[ScriptCapitalR]2}, {Dashed, Line[{p1t, p2t}], Red, Point[{p1t, p2t}]}, {Dashed, Line[{q1t, q2t}], Red, Point[{q1t, q2t}]}}]
 Out[11]=

## Mathematica

Questions? Comments? Contact a Wolfram expert »