# Trying to find the area enclosed by custom curves

I have a custom curve set, that self-intersects, but has a limited value set. As you can see in the attached picture, there is an area in the middle, that remains untouched by the curves. My question would be if anyone knows how I could get Mathematica to calculate the area of the middle area? Also if there was a way to get the area/radius of the greatest inscribable and smallest enclosing circle that would just make my day! Thanks in advance.

CLARIFICATION: The values of "c" I'm trying to make this work for are between 0<c<1. Also when I mean the smallest enclosing circle I'm talking about the shape that remains untouched inside, not the entire curve including the outside self-intersecting bits (I know the entire outer enclosing diameter is 2r+R)

The code and image of the central area I'm trying to find:

pathRot[r_, R_, c_, \[Phi]_, x_, y_] := {Cos[\[Phi]] (r +
R + (r) Cos[c \[Phi]]) - (r) Sin[\[Phi]] Sin[c \[Phi]] +
x, (r + R + (r) Cos[c \[Phi]]) Sin[\[Phi]] + (r) Cos[\[Phi]] Sin[
c \[Phi]] + y};
Manipulate[
ParametricPlot[
pathRot[r, R, c, \[Phi], x, y], {\[Phi], 0, \[Phi]max},
ColorFunction -> (ColorData["Rainbow"][#3] &),
PlotLegends ->
BarLegend[{"Rainbow", {0, \[Phi]max}},
LegendLabel -> Style[\[Phi], 14]], Frame -> True,
FrameLabel -> (Tooltip @@@
Transpose[{Style[#, 14] & /@ {"x", "y"},
pathRot[r, R, c, \[Phi], x, y]}]),
AspectRatio -> True], {{\[Phi]max, 2 Pi}, 2 Pi, 6 Pi, Pi,
Appearance -> "Labeled"}, {{r, 1}, 1, 10, 0.05,
Appearance -> "Labeled"}, {{R, 1}, 1, 10, 0.05,
Appearance -> "Labeled"}, {{c, 1}, 1, 100, 0.5,
Appearance -> "Labeled"},
{{x, 1}, 1, 100, 0.5, Appearance -> "Labeled"},
{{y, 1}, 1, 100, 0.5, Appearance -> "Labeled"},
SynchronousUpdating -> True,
TrackedSymbols :> {\[Phi]max, r, R, c, x, y}]


• Welcome to the Mathematica Stack Exchange. Please include Mathematica code that can be copied, pasted and executed in our own notebook sessions. Copy code directly from your input cell, click the Edit button under your post and format as code using the { } icon in the Edit window. Thanks.
– Syed
Nov 25, 2023 at 14:41
• You should remove x and y, they just change the center of the whole curve and needlessly complicate the mathematics. Nov 25, 2023 at 14:56
• In the specific case where the interior forms a spiky hexagon star like shape, such as r=1,R=1/2,c=6, if you somehow knew the ϕ values for the innermost intersections then you could form an integral with an indicator function i.e Boole which is 1 for the ranges of ϕ corresponding to the arcs of the star, and zero elsewhere. I doubt this integral has a nice closed form, and this method does not generalize well at all. Nov 25, 2023 at 15:26
• Oh yeah, I only added x and y to center it off because I tried to export it to another app that had trouble with the axes intersecting in the middle, but it should have no effect on the area really. Nov 25, 2023 at 15:26
• If I correctly understand you question, the radius of the greatest inscribed circle can be found as Minimize[{(Cos[\[Phi]] (r + R + (r) Cos[c \[Phi]]) - (r) Sin[\[Phi]] Sin[ c \[Phi]])^2 + ((r + R + (r) Cos[c \[Phi]]) Sin[\[Phi]] + (r) Cos[\[Phi]] Sin[ c \[Phi]])^2, \[Phi] >= 0 && \[Phi] <= 2*Pi && r >= 1 && r <= 10 && R >= 1 && R <= 10 && c >= 1 && c <= 100}, {\[Phi], c, r, R}] which results in {1, {\[Phi] -> (2 \[Pi])/29, c -> 29/2, r -> 1, R -> 1}}. Nov 25, 2023 at 16:10

\$Version

(* "13.3.1 for Mac OS X ARM (64-bit) (July 24, 2023)" *)

Clear["Global*"]

pathRot[r_, R_, c_, ϕ_, x_,
y_] := {Cos[ϕ] (r + R + r Cos[c ϕ]) -
r Sin[ϕ] Sin[
c ϕ], (r + R + r Cos[c ϕ]) Sin[ϕ] +
r Cos[ϕ] Sin[c ϕ]};


EDIT: Added Normal after plt in definition of allPts so that Mathematica versions that generate a GraphicsComplex for plt will execute properly.

Manipulate[
Module[
{plt, center, inr, innerCircle, outr, outerCircle, ϕmax, c},
c = Rationalize[cv];
ϕmax = Denominator[c]*2 Pi;
(* ϕmax is set to close the curve without overlap *)
plt = ParametricPlot[
pathRot[r, R, c, ϕ, x, y], {ϕ, 0, ϕmax},
ColorFunction -> (ColorData["Rainbow"][#3] &),
PlotLegends -> Placed[
BarLegend[{"Rainbow", {0, ϕmax}},
LegendLabel -> Style[ϕ, 14],
LegendMarkerSize -> {380, 15},
LegendLayout -> "Row"],
Below],
Axes -> axes,
Frame -> True,
FrameLabel -> (Tooltip @@@
Transpose[{Style[#, 14] & /@ {"x", "y"},
pathRot[r, R, c, ϕ, x, y]}]),
AspectRatio -> True];
allPts = Flatten[Cases[plt//Normal, Line[pts_] :> pts, Infinity], 1];
center = {0, 0};
innerCircle = Circle[center,
inr = Min[EuclideanDistance[center, #] & /@ allPts]];
inLbl = StringForm["inner circle\nradius = \n" <>
"area = ", NumberForm[inr, {5, 3}],
NumberForm[Pi*inr^2, {5, 3}]];
outerCircle = Circle[center,
outr = Max[EuclideanDistance[center, #] & /@ allPts]];
outLbl = StringForm["outer circle\nradius = \n" <>
"area = ", NumberForm[outr, {5, 3}],
NumberForm[Pi*outr^2, {5, 3}]];
Legended[
Show[{plt,
If[inner, Graphics[{Magenta, Dashed, innerCircle}], Nothing],
If[outer,
Graphics[{Gray, AbsoluteThickness[2], Dashed, outerCircle}],
Nothing]},
PlotRange -> All],
If[inner && outer,
LineLegend[{Directive[Magenta, Dashed],
Directive[Gray, AbsoluteThickness[2], Dashed]},
{inLbl, outLbl}],
If[inner,
LineLegend[{Directive[Magenta, Dashed]}, {inLbl}],
If[outer,
LineLegend[{Directive[Gray, AbsoluteThickness[2],
Dashed]}, {outLbl}], {}]]]]],
{{cv, 1.25, "c"}, 1.25, 100, 0.25, Appearance -> "Labeled"},
{{r, 1}, 1, 10, 0.05, Appearance -> "Labeled"},
{{R, 1}, 1, 10, 0.05, Appearance -> "Labeled"},
Delimiter,
Row[{
Control[{{axes, False}, {True, False}}],
Spacer[50],
Control[{{inner, True, "inner circle"}, {True, False}}],
Spacer[50],
Control[{{outer, True, "outer circle"}, {True, False}}]}],
SynchronousUpdating -> False,
TrackedSymbols :> {cv, r, R, axes, inner, outer}]


• This looks great, but when I try to run your code on my machine I get "Radius DirectedInfinity[-1] should be a positive number or pair of positive numbers, or a Scaled or Offset form." Any idea? Nov 26, 2023 at 11:39
• I copied the above code into a notebook and it evaluated without any problems. Did you try restarting Mathematica? What Mathematica version are you using? What OS are you on? Did you get any output other than the error message? If so, what? Nov 26, 2023 at 15:09
• The code works to me in 13.3.1 on Windows 10. Nov 26, 2023 at 15:14
• I'm running 13.2.1 on MacOS Catalina. I get the original curve, but not the inscribable/encompassing circles. It also says the radius and areas of the circles are infinite. Nov 26, 2023 at 15:53
• See edit. Should now work with your version. Nov 26, 2023 at 16:16

Create a ParametricRegion

reg[r_, R_, c_, \[Phi]max_ ] =
ParametricRegion[{Cos[\[Phi]] (r +R + (r) Cos[c \[Phi]]) - (r) Sin[\[Phi]] Sin[c \[Phi]] , (r +  R + (r) Cos[c \[Phi]]) Sin[\[Phi]] + (r) Cos[\[Phi]] Sin[c \[Phi]] }
, {{\[Phi], 0, \[Phi]max}}];

With[{r = 1, R = Pi, c = 7, \[Phi]max = 3 Pi},
mini = NMinimize[x . x, x \[Element] reg[r, R, c, \[Phi]max]];
maxi = NMaximize[x . x, x \[Element] reg[r, R, c, \[Phi]max] ];
Show[Region[reg[r, R, c, \[Phi]max ]],
Graphics[{Circle[{0, 0}, Sqrt[mini[[1]]]],Circle[{0, 0},Sqrt[maxi[[1]]]]}]]
]
`