# Fitting a disk in a non-polygonal region

Clear["Global*"];
d1 = Disk[{0, 0}, 16, {0, π/2}];
d2 = Disk[{0, 8}, 8, {-π/2, π/2}];

Graphics[{
FaceForm[Lighter@Yellow], EdgeForm[Thin], d1
, FaceForm[Lighter@Pink], EdgeForm[Thin], d2
, Lighter@Green, Disk[{8 Sqrt[2], 4}, 4]
, Red, AbsolutePointSize[6]
, Point@{0, 8}, Point@{8, 0}
, Black, Text[{8, 0}, {8, 0}, {0, 2}]
, Black, Text[{0, 8}, {0, 8}, {3/2, 0}]
}
]


A solution is present here and that is how I could solve it, but I would like to learn Mathematica idioms for setting up and automating such tasks. The green disk is externally tangent to the pink semi-disk and internally tangent to the yellow quarter-disk.

I am grateful for the excellent answers presented so far. My own failed attempt was:

p1 = RegionDifference[d1, d2];
Maximize[{r, RegionWithin[p1, Disk[{x, y}, r]]}, {x, y, r}] //   FullSimplify[#, Reals] &


This keeps on running. I have also tried various permutations of DiscretizeRegion but to no avail. I hope that someone can elaborate upon or write a solution based on regions. Thanks.

• Reply to the updated edition of the question. We use Circle and Simplfy and FullSimplify.
Clear["Global*"];
d1 = Disk[{0, 0}, 16, {0, π/2}];
d2 = Disk[{0, 8}, 8, {-π/2, π/2}];
p1 = RegionDifference[d1, d2];
conditions1 = Simplify[RegionWithin[p1, Circle[{x, y}, r]], r > 0];
conditions2 = FullSimplify[conditions1]

sol=Maximize[{r, conditions2}, {x, y, r}]
Graphics[{Yellow, d1, Pink, d2, Green, Circle[{x, y}, r] /. sol[[2]]}]


{4, {x -> 8 Sqrt[2], y -> 4, r -> 4}}

With some Warning messages.

Origional

• A starting point.
• We use Inversive Transformation. Mapping the two circles to two paralle infinitelines. The third circle tangent to the two circles if and only if the inverseive image tangent to the two paralle infinitelines.
Clear["Global*"];
inversion[{a_, b_}, r_][x_,
y_] := {a,
b} + (r^2  ({x, y} - {a, b}))/({x, y} - {a, b}) . ({x, y} - {a,
b});
invC = {0, 16};
invR = 16*2;
inv[{x_, y_}] := inversion[invC, invR][x, y];
c1 = Circle[{0, 0}, 16];
c2 = Circle[{0, 8}, 8];
pts1 = {x, y} /.
FindInstance[{x, y} ∈ c1, {x, y}, Reals, 2];
pts2 = {x, y} /.
FindInstance[{x, y} ∈ c2, {x, y}, Reals, 2];
Manipulate[
Show[Graphics[{{Lighter@Yellow, EdgeForm[Cyan], Disk @@ c1, Cyan,
InfiniteLine[inv /@ pts1]}, {Thick, Lighter@Pink, Disk @@ c2,
InfiniteLine[inv /@ pts2]}, Green, Disk[{c, -32}, 16], Black,
Green, Disk @@
CircleThrough[
inv /@ {{c, -32} + {16, 0}, {c, -32} + {-16,
0}, {c, -32} + {0, -16}}]},
PlotRange -> {{-80, 80}, {-60, 20}}], ImageSize -> Large], {c, -60,
60}]


Manipulate[
Show[Graphics[{{Lighter@Yellow, EdgeForm[Cyan], Disk @@ c1, Cyan,
InfiniteLine[inv /@ pts1]}, {Thick, Lighter@Pink, Disk @@ c2,
InfiniteLine[inv /@ pts2]}, Green,
Table[Disk[{c + 32 k, -32}, 16], {k, {-2, -1, 0, 1, 2}}], Black,
Green, Table[
Disk @@ CircleThrough[
inv /@ {{c + k*32, -32} + {16, 0}, {c + k*32, -32} + {-16,
0}, {c + k*32, -32} + {0, -16}}], {k, {-2, -1, 0, 1, 2}}]},
PlotRange -> {{-80, 80}, {-60, 20}}],
ImageSize -> Large], {c, -30, 30}]


• Very nice! +1 :) Apr 17 at 6:36
• RegionPlot3D[conditions2, {x, 0, 20}, {y, 0, 20}, {r, 0, 5}, PlotPoints -> 80, MaxRecursion -> 4, BoxRatios -> Automatic] Apr 17 at 9:50

It is all experimental so maybe that is why I was not able to obtain exact solutions.

But maybe someone can modify my code to get exact results.

line = InfiniteLine[{{0, 0}, {1, 0}}];
c1 = Circle[{0, 8}, 8];
c2 = Circle[{0, 0}, 16];
c3 = Circle[a, r];

RandomInstance[
GeometricScene[{{a}, {r}},
{GeometricAssertion[{c1, c2, c3}, "PairwiseTangent"],
GeometricAssertion[{line, c3}, "PairwiseTangent"]}]]
%["Quantities"]
%%["Points"][[1]]


• This does not evaluate on v12.2.0 but works on the cloud. Thanks.
– Syed
Apr 16 at 16:44
• In version 14, we can use line = InfiniteLine[{{0, 0}, {1, 0}}]; c1 = Circle[{0, 8}, 8]; c2 = Circle[{0, 0}, 16]; c3 = Circle[a, r]; conditions = GeometricScene[{{a}, {r}}, {GeometricAssertion[{c1, c2, c3}, "PairwiseTangent"], GeometricAssertion[{line, c3}, "PairwiseTangent"]}]; GeometricSolveValues[conditions, {a, r}] Apr 17 at 9:56
• We can reduce possibilities by adding more restriction. line = InfiniteLine[{{0, 0}, {1, 0}}]; line2 = InfiniteLine[{{0, 0}, {0, 1}}]; c1 = Circle[{0, 8}, 8]; c2 = Circle[{0, 0}, 16]; c3 = Circle[a, r]; p1 = Point[{0, -1}]; p2 = Point[{-1, 0}]; RandomInstance[ GeometricScene[{{a}, {r}}, {GeometricAssertion[{c1, c2, c3}, "PairwiseTangent"], GeometricAssertion[{line, c3}, "PairwiseTangent"], GeometricAssertion[{{c3}, {p1}}, {"OppositeSides", line}], GeometricAssertion[{{c3}, {p2}}, {"OppositeSides", line2}]}]] %["Quantities"] %%["Points"][[1]] Apr 17 at 15:14

Define the 3 circles like:

c1 = {0, 0}; r1 = 16;
c2 = {0, 8}; r2 = 8;
c3 = {x, y}; r3 = y;


Then the distance between center 2 and 3 is equal to the sum of the radii r2+r3. And the difference between r1 and r3 is equal to the distance of c3 from the origin:

eq = {Norm[c2 - c3] == r3 + r2, 16 - r3 == Norm[c3]};

{cx, cy} = {x, y} /. Solve[eq, {x, y}, PositiveReals][[1]]

{8 Sqrt[2], 4}

Graphics[{Circle[{0, 0}, 16, {0, Pi/2}], Circle[{0, 8}, r2],
Circle[{cx, cy}, cy], Point[{c1, c2, {cx, cy}}]}, Axes -> True]


• Can you please include the eq`?
– Syed
Apr 16 at 15:58
• Sorry, copy and paste error. Apr 16 at 16:54