Using the Disk graphics primitive

Question

Please be kind enough to give me some indication on how to use the Disk graphics primitive in any of these cases:

I want to calculate the area and perimeter of the shaded portions.

I have looked for something that tells me how to do it, but I can't find anything acceptable. Any help is welcome.

Answer 1

You can specify the quarter disks using the three-argument form of Disk.

For the first picture:

a = 1;
d1 = Disk[{0, 0}, a, {0, Pi/2}];
d2 = Disk[{a, 0}, a, {Pi/2, Pi}];
d3 = Disk[{0, a}, a, {-Pi/2, 0}];

ri = RegionIntersection[d1, d2, d3];
Through[{Perimeter, N @* Area} @ ri]

{2.61799, 0.442972}

Graphics[{EdgeForm[Gray], Opacity[.25], Orange, d1, Blue, d2, Green, d3,  
 RegionPlot[ri, PlotStyle -> Red][[1]]}]

A simpler alternative is to take the intersections of full disks with Rectangle[{0, 0}, {a, a}]:

d1b = RegionIntersection[Rectangle[{0,0}, {a,a}], Disk[{0,0}, a]];
d2b = RegionIntersection[Rectangle[{0,0}, {a,a}], Disk[{a,0}, a]];
d3b = RegionIntersection[Rectangle[{0,0}, {a,a}], Disk[{0,a}, a]];

Graphics[{EdgeForm[Gray], Opacity[.25], Orange, d1b, Blue, d2b, Green, d3b,  
 RegionPlot[ri, PlotStyle -> Red][[1]]}]

same picture

For the second picture:

d4b = RegionIntersection[Rectangle[{0, 0}, {a, a}], Disk[{a, a}, a]];
ru = RegionUnion[RegionIntersection[d1b, d4b], RegionIntersection[d2b, d3b]];
rc = RegionDifference[Rectangle[], ru];

Through[{Perimeter, N @* Area} @ rc]

{8.18879, 0.173554}

Graphics[{EdgeForm[Gray], Red, Rectangle[], 
  RegionPlot[ru, PlotStyle -> White][[1]], 
  Opacity[.05], White, d1b, d2b, d3b, d4b}]

Similarly, for the third picture:

rd = RegionDifference[ Disk[{a, a}/2, a/2], d2b];
Through[{Perimeter, N @* Area} @ rd]

{2.18282, 0.146381}

Graphics[{EdgeForm[Gray], White, Rectangle[], Opacity[.25], Blue, d2b,
   Orange, Disk[{a, a}/2, a/2], 
   RegionPlot[rd, PlotStyle -> Red, BoundaryStyle -> None][[1]]}]

Answer 2

Here is an alternative of the previous answer that might give you the plots in your question (after a sufficient number of experiments.)

Clear[RandomDisk]
RandomDisk[] := {Opacity[RandomChoice[Range[0, 1, 0.25]]], 
   FaceForm[RandomChoice[{None, Pink, Gray, LightBlue}]], 
   EdgeForm[Black], 
   Disk[RandomChoice[
     Append[Flatten[Outer[List, {0, 1}, {0, 1}], 1], {0.5, 0.5}]], 
    RandomChoice[{0.5, 1}]]};

Clear[RandomRectangle]
RandomRectangle[] := {EdgeForm[
   RandomChoice[{None, Black, Blue, Red, Gray, Orange, LightBlue}]], 
  FaceForm[None], Rectangle[]}

Multicolumn[
 Table[Graphics[{Flatten[Table[RandomDisk[], RandomChoice[Range[4]]], 
     1], RandomRectangle[]}, Frame -> True, PlotRangeClipping -> True,
    PlotRange -> {{0, 1}, {0, 1}}], 16], 4]

Answer 3

Clear["Global`*"]

For the first image

reg[1, a_] = Disk[{0, 0}, a, {0, Pi/2}];
reg[2, a_] = Disk[{a, 0}, a, {Pi/2, Pi}];
reg[3, a_] = Disk[{0, a}, a, {-Pi/2, 0}];
reg[4, a_] = RegionIntersection[reg[1, a], reg[2, a], reg[3, a]];

Show[
 Graphics[{
   EdgeForm[Black],
   Lighter[Blue, 0.6],
   Opacity[0.75],
   reg[1, 1], reg[2, 1], reg[3, 1]}],
 Region[reg[4, 1],
  BaseStyle -> Opacity[0.5, Blue]]]

EDIT: The gap at the lower-left corner can be filled by using DiscretizeRegion

Graphics[{
  EdgeForm[Black],
  Lighter[Blue, 0.6],
  Opacity[0.75],
  reg[1, 1], reg[2, 1], reg[3, 1],
  DiscretizeRegion[reg[4, 1],
   MeshCellStyle -> Opacity[0.5, Blue],
   MaxCellMeasure -> 1]}]

The area is proportional to a^2

And @@ Table[
  Area[reg[4, a]] == a^2*Area[reg[4, 1]],
  {a, 1, 10}]

(* True *)

area1 = a^2*Area[reg[4, 1]]

(* 1/12 a^2 (-6 Sqrt[3] + 5 π) *)

area1 // N

(* 0.442972 a^2 *)

Perimeter[reg[4, 1]]

(* 2.61799 *)

For the second image

reg[5, a_] = Disk[{a, a}, a, {Pi, 3 Pi/2}]; reg[6, a_] = 
 RegionUnion[
  BooleanRegion[#1 && #2 && ! #3 && ! #4 &, #] & /@
   {{reg[1, a], reg[2, a],
      reg[3, a], reg[5, a]},
    {reg[2, a], reg[5, a], reg[1, a], reg[3, a]},
    {reg[1, a], reg[3, a], reg[2, a], reg[5, a]},
    {reg[3, a], reg[5, a], reg[1, a], reg[2, a]}}];

Show[
 Graphics[{
   EdgeForm[Black],
   White, Opacity[0.25],
   reg[1, 1], reg[2, 1], reg[3, 1], reg[5, 1]}],
 Region[reg[6, 1], BaseStyle -> LightGray],
 Frame -> True]

The area is proportional to a^2

And @@ Table[
  Area[reg[6, a]] == a^2*Area[reg[6, 1]],
  {a, 1, 10}]

(* True *)

area2 = a^2*Area[reg[6, 1]] // Simplify

(* -(1/3) a^2 (3 (-4 + Sqrt[3]) + 2 π) *)

area2 // N

(* 0.173554 a^2 *)

Perimeter[reg[6, 1]]

(* 7.11792 *)

This number for the perimeter is too low since each of the four subregions has a perimeter that must exceed 2. Looking at 4 times the perimeter of a subregion

reg[6 sr, a_] = BooleanRegion[#1 && #2 && ! #3 && ! #4 &,
   {reg[1, a], reg[2, a], reg[3, a], reg[5, a]}];

4*Perimeter[reg[6 sr, 1]]

(* 8.18879 *)

For the last image

reg[7, a_] = Disk[{a/2, a/2}, a/2];

reg[8, a_] = BooleanRegion[#1 && ! #2 &, {reg[7, a], reg[2, a]}];

Show[
 Graphics[{
   EdgeForm[Black],
   White, Opacity[0.25],
   Rectangle[{0, 0}],
   reg[2, 1], reg[7, 1]}],
 Region[reg[8, 1], BaseStyle -> Red]]

The area is proportional to a^2

And @@ Table[
  Area[reg[8, a]] == a^2*Area[reg[8, 1]] // Simplify,
  {a, 1, 10}]

(* True *)

area3 = a^2*Area[reg[8, 1]] //
   TrigToExp // FullSimplify

(* 1/8 a^2 (Sqrt[7] + π - ArcCot[3/Sqrt[7]] - 4 ArcTan[(5 Sqrt[7])/9]) *)

area3 // N

(* 0.146381 a^2 *)

Perimeter[reg[8, 1]]

(* 2.18282 *)