4
$\begingroup$

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

enter image description here

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.

$\endgroup$
6
$\begingroup$

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]]}]

enter image description here

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}]

enter image description here

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]]}]

enter image description here

$\endgroup$
  • $\begingroup$ Hello, @kglr , for the third image I get img.fenixzone.net/i/CDrVGNz.png why is this happening to me in my matthematca (ver 11.3) $\endgroup$ – zeros Sep 20 at 4:38
  • $\begingroup$ @zeros, I don't have access to v11.3. Do you still get the circle if you remove RegionPlot[rd, PlotStyle -> Red, BoundaryStyle -> None][[1]]? $\endgroup$ – kglr Sep 20 at 4:54
  • $\begingroup$ if I remove RegionPlot[rd, PlotStyle -> Red, BoundaryStyle -> None][[1]] ,nothing appears $\endgroup$ – zeros Sep 20 at 5:16
  • $\begingroup$ I still have no clear use of the command, you can show me with those 2 axes a little more how to work with disk ibb.co/hMrH6K5, THANKS $\endgroup$ – zeros Sep 25 at 3:23
  • $\begingroup$ @zeros, with the link in your comment i get a "malicious content" warning from my virus protection app. $\endgroup$ – kglr Sep 25 at 3:42
5
$\begingroup$

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]

enter image description here

enter image description here

$\endgroup$
5
$\begingroup$
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]]]

enter image description here

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]}]

enter image description here

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]

enter image description here

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]]

enter image description here

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 *)
$\endgroup$
  • $\begingroup$ a doubt the drawings do not come out exact, they leave me incomplete, why is this? img.fenixzone.net/i/nlD72cz.png $\endgroup$ – zeros Sep 18 at 22:37
  • $\begingroup$ In the first image use of DiscretizeRegion fills the gap. I cannot reproduce any gaps in the third image. Recommend that you try using DiscretizeRegion there as well. $\endgroup$ – Bob Hanlon Sep 19 at 3:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.