5
$\begingroup$

I would like to make a dynamic circle with the inner radius ($R_a(t)$) moving to $R_b$ like the image below. I had difficulty using Manipulate and leaving the intersections colored as in the image. Would anyone know how to do it that way?

Thank you very much for your attention!

enter image description here

Improve this question
$\endgroup$
3
  • 1
    $\begingroup$ Can you show us the code you've tried so far? $\endgroup$
    – MarcoB
    Oct 15 at 0:58
  • 1
    $\begingroup$ Welcome to MMA SE! as already requested, in general please post the code you've tried so far so others can copy-and-paste and fiddle with it. You might find it useful to construct this as three Disks of decreasing radius stacked one on top of the other, or as two Annuluses. $\endgroup$
    – thorimur
    Oct 15 at 1:06
  • $\begingroup$ Excellent question applicable to many industries such as oil/gas, EM, transmission lines, and all the STEM fields really. I request that you modify your title to help search engines so as to bring more visitors to this page. The word "graph" has a different usage in Math/CS. $\endgroup$
    – Syed
    Oct 15 at 7:28
11
$\begingroup$ 
{minradiusa, radiusb, radiusr} = {.2, .85, 1};

Labeled arrow annotations:

labeledArrows[r_] := {PointSize[Medium], Point[{0, 0}], 
  MapThread[{
     Arrowheads[{{.025, 1}, 
         {Automatic, .5, Graphics[{Text[Style[#, 16], {0, 0}, {0, -1.2}, #2]}]}}], 
     Arrow[{{0, 0}, #3 {Cos[#4 Pi/4], Sin[#4 Pi/4]}}]} &, 
   {{#<>"(t)", ##2}& @@ (ToString[Subscript[R, #], StandardForm] & /@ {"a", "r", "b"}),
   {{-1, 0}, {1, 0}, {1, 0}}, 
   {r, radiusr, radiusb}, 
   {5, 1, 7}}]}

Graphics @ labeledArrows[.5]

enter image description here

Animate + Graphics:

Alternatively, use Annulus + Graphics + Animate:

Animate[Graphics[{EdgeForm[Gray],
   LightYellow, Annulus[{0, 0}, {rt, radiusb}], 
   LightGray, Annulus[{0, 0}, {radiusb, radiusr}],
   Opacity[1], Black, labeledArrows[rt]},
   PlotLabel -> Style[PromptForm[Area, 
     Pane[Round[ Pi (radiusb^2 - rt^2), .001], ImageSize -> {50, 20}]], 16, Black]], 
 {rt, minradiusa, radiusb}]

enter image description here

Animation without controls:

frames = Table[Graphics[{EdgeForm[Gray], LightYellow, 
     Annulus[{0, 0}, {rt, radiusb}], LightGray, 
     Annulus[{0, 0}, {radiusb, radiusr}], 
     Opacity[1], Black, labeledArrows[rt]},
   PlotLabel -> Style[PromptForm[Area, 
     Pane[Round[ Pi (radiusb^2 - rt^2), .001], ImageSize -> {50, 20}]], 16, Black]], 
   {rt, Most@Subdivide[minradiusa, radiusb, 100]}];

 Export["dynamicradius.gif", frames, AnimationRepetitions -> Infinity]

enter image description here

Manipulate + ParametricPlot

Use ParametricPlot with the options MeshFunctions, Mesh and MeshShading, and use labeledArrows[] as Epilog. Dynamically control first element of the mesh values using Manipulate:

Manipulate[
 ParametricPlot[
  r { Cos @ t,  Sin @ t}, {t, 0 , 2 Pi}, {r, minradiusa, 1}, 
  MeshFunctions -> {#4 &}, 
  Mesh -> {{rt, radiusb, radiusr}}, 
  MeshStyle -> Thick, 
  Epilog -> labeledArrows[rt], 
  MeshShading -> {White, LightYellow, LightGray}, 
  PerformanceGoal -> "Quality", 
  PlotPoints -> 90, 
  BoundaryStyle -> None, 
  Frame -> False, Axes -> False, 
  ImageSize -> 600
  PlotLabel -> Style[PromptForm[Area, 
     Pane[Round[ Pi (radiusb^2 - rt^2), .001], ImageSize -> {50, 20}]], 16, Black]], 
 {{rt, .3, Style[ToString[Subscript[R, a], StandardForm] <> "(t)", 14]}, 
   .2, .85, Appearance -> "Open"}]

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ thank you very much! Can i save an animate video without the "manipulation controls" at the top? $\endgroup$
    – Felipe
    Oct 15 at 1:47
  • $\begingroup$ @Felipe, please see the update. $\endgroup$
    – kglr
    Oct 15 at 1:55
5
$\begingroup$

A starting point.

annulus = RegionDifference[Disk[{0, 0}, 2.3], Disk[{0, 0}, 2]];
regint[r_] := RegionDifference[Disk[{0, 0}, 2.3], Disk[{0, 0}, r]];
ani = Animate[
  Show[Region[regint[r], 
    BaseStyle -> {Blend[{LightYellow, Orange}, .15], 
      EdgeForm[Directive[Thick, Black]]}], 
   Region[annulus, 
    BaseStyle -> {Gray, EdgeForm[Directive[Thick, Black]]}], 
   PlotLabel -> "Area = " <> ToString[RegionMeasure@regint[r]]], {r, 
   1, 2}]
Export["test.gif", ani, "ControlAppearance" -> None, 
 "AnimationRepetitions" -> Infinity, ImageSize -> Large]

(* Export["test.mp4", ani, "ControlAppearance" -> None, FrameRate -> 20, 
 "AnimationDuration" -> 10, ImageSize -> Large] *)

enter image description here

Improve this answer
$\endgroup$

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.