What's the most efficient way to draw this region?

Question

Viral question on YouTube. But let me start by saying the guy got it wrong. We don't do such things at the age of 11, we do this question about Year 11 (aged 14/15, 16 for some).

I want to draw the following.

Tried this

f1 = 10 - Sqrt[10^2 - x^2];
f2 = 5 - Sqrt[5^2 - (x - 5)^2];
f3 = 5 + Sqrt[5^2 - (x - 5)^2];

And

r00 = Graphics[{EdgeForm[Thick], Transparent, Rectangle[{0, 0}, {10, 10}]}]
r0 = Plot[{f1, f2, f3}, {x, 0, 10}, Frame -> True, AspectRatio -> 1,   PlotRange -> {{-0.5, 10.5}, {-0.5, 10.5}}]
r1 = Plot[{f1, f2, f3}, {x, 6.25 - 1.25 Sqrt[7], 6.25 + 1.25 Sqrt[7]},    Filling -> {1 -> {2}}, Frame -> True, AspectRatio -> 1,   PlotRange -> {{-0.5, 10.5}, {-0.5, 10.5}}]
r2 = Plot[{f1, f2, f3}, {x, 6.25 + 1.25 Sqrt[7], 10},   Filling -> {3 -> {2}}, Frame -> True, AspectRatio -> 1,   PlotRange -> {{-0.5, 10.5}, {-0.5, 10.5}}]

Show[{r00, r0, r1, r2}]

Surely there is a simpler way to do this?

Answer 1

f1h = HoldForm[10 - Sqrt[10^2 - x^2]];
f1 = f1h // ReleaseHold;
f2h = HoldForm[5 - Sqrt[5^2 - (x - 5)^2]];
f2 = f2h // ReleaseHold;
f3h = HoldForm[5 + Sqrt[5^2 - (x - 5)^2]];
f3 = f3h // ReleaseHold;

The x values for the curve intersections are

{x1, x2} = x /. Solve[f1 == #, x][[1]] & /@ {f2, f3};

The point coordinates for the curve intersections are

{pt1, pt2} = ({#, f1 /. x -> #} // FullSimplify) & /@ {x1, x2};

reg1 = ImplicitRegion[f1 < y < 10 && x > 0, {x, y}];
reg2 = ImplicitRegion[f2 < y < f3, {x, y}];

Show[
 Region[
  regDiff = RegionDifference[reg2, reg1]],
 Plot[{f1, f2, f3}, {x, 0, 10},
  PlotStyle -> {
    {Orange, AbsoluteThickness[4]},
    {Purple, AbsoluteThickness[4]},
    {Darker@Green, AbsoluteThickness[4]}}],
 Epilog -> {
   Text[Style[x1, 14, Bold], {x1, 2}, {0, -1}],
   Arrow[{pt1, {x1, 2}}],
   Text[Style[x2, 14, Bold], {7.75, pt2[[2]]}, {1, 0}],
   Arrow[{pt2, {7.75, pt2[[2]]}}],
   Text[Style[f1h, 14, Bold], {10, 8}, {-1, 0}],
   Text[Style[f2h, 14, Bold], {9.5, 1.5}, {-1, 0}],
   Text[Style[f3h, 14, Bold], {5, 11}],
   Red, AbsolutePointSize[7],
   Point[{pt1, pt2}]},
 Ticks -> {{5, 10}, {5, 10}},
 PlotRange -> {{-1, 14}, {-1, 12}},
 Axes -> True]

The area of the shaded region is

area = Area[regDiff] // FullSimplify

(* 25/2 (Sqrt[7] + π - ArcCot[3/Sqrt[7]] - 4 ArcTan[(5 Sqrt[7])/9]) *)

The area relative to the smaller circle is

area/Area[reg2] // N

(* 0.186378 *)

Answer 2

One simple way to visualize complicated regions in mathematica

disk1 = Region[Disk[{5, 5}, 5]]

disk2 = Region[Disk[{0, 10}, 10]]

disk3 = Region[Disk[{10, 0}, 10]]

result = Region[
  RegionUnion[RegionDifference[disk1, disk3], 
   RegionDifference[disk1, disk2]]]

Answer 3

RegionPlot[
  x^2 + y^2 < 25 \[And] 
 ((x - 5)^2 + (y + 5)^2 > 100 \[Or] (x + 5)^2 + (y - 5)^2 > 100),
 {x, -5, 5}, {y, -5, 5}]

Or...

z[w_] := EuclideanDistance[{x, y}, w {5, -5}];
RegionPlot[
 z[0] < 5 \[And] (z[1] > 10 \[Or] z[-1] > 10),
 {x, -5, 5}, {y, -5, 5}]

Or...

z[w_] := (a = ({x, y} - 5 {w, -w})).a;
RegionPlot[
 z[0] < 25 \[And] (z[1] > 100 \[Or] z[-1] > 100), 
 {x, -5, 5}, {y, -5, 5}]

Or even shorter....

z[w_, k_] := (a = ({x, y} - 5 {w, -w})).a > 25 k;
RegionPlot[
Not[z[0, 1]] \[And] (z[1, 4] \[Or] z[-1, 4]), 
{x, -5, 5}, {y, -5, 5}]

I would be very impressed if someone uses fewer keystrokes than this in a Region-based solution:

d[c_, r_:10] := Region[Disk[c, r]];
RegionDifference[d[{5, 5}, 5], RegionIntersection[d[{0, 10}], d[{10, 0}]]]

Or...

d[c_, r_:10] := Region[Disk[c, r]];
q = {0, 10};
h = {5, -5};
RegionDifference[d[q + h, 5], RegionIntersection[d[q], d[q + 2 h]]]

Or....

d[c_, r_:10] := Region[Disk[c, r]]; q = {5, 5}; h = {5, -5};
RegionDifference[d[q, 5], RegionIntersection[d[q - h], d[q + h]]]

Pretty efficient!