# Solve Geometric Problems as Polynomial Systems

Find the diameter of a solid in given by a polynomial inequality.

 In:= Xf[x_, y_, z_] := x^4 - 5 x^2 y z + 3 x^2 y^2 + 10 x^2 y z + 3 x^2 y^2 - y^3 z + y^4 + z^4 - 1; f[x, y, z] <= 0
 Out= Visualize the region.

 In:= XRegionPlot3D[ f[x, y, z] <= 0, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5}, PlotPoints -> 50, PlotTheme -> {"Scientific", "NoMesh"}]
 Out= Formulate a necessary condition for a local maximum of the distance between two points on the boundary of .

 In:= Xgrad[x_, y_, z_] := Grad[f[x, y, z], {x, y, z}] p = {p1, p2, p3}; q = {q1, q2, q3}; cond = f @@ p == 0 && f @@ q == 0 && And @@ Thread[grad @@ p == \[Lambda] (p - q)] && And @@ Thread[grad @@ q == \[Mu] (p - q)]
 Out= Use NSolve to find pairs satisfying the condition.

 In:= Xsols = NSolve[\!\( \*SubscriptBox[\(\[Exists]\), \({\[Lambda], \[Mu]}\)]cond\), Join[p, q], Reals];

Find the diameter of .

 In:= Xdiam = Max[Norm[p - q] /. sols]
 Out= Find the distinct pairs realizing the maximum distance.

 In:= Xpairs = Union[Select[{p, q} /. sols, Norm[Subtract @@ #] == diam &], SameTest -> (Max[Sort[#1] - Sort[#2]] < 10^-9 &)]
 Out= Visualize the result.

 Out= ## Mathematica

Questions? Comments? Contact a Wolfram expert »