6
$\begingroup$

For an arbitrary self-intersecting parametric curve, how to construct the region at its first intersection. Thanks!

plot = ParametricPlot[{Cos[s] + Sin[4 s]/12, 
   Sin[3 s] - Cos[7 s]/4}, {s, 0, 4.5}]

enter image description here

Edit

I draw such region by solving the equation and using the method which come from How to fill a closed parametric curve?

f[s_] = {Cos[s] + Sin[4 s]/12, Sin[3 s] - Cos[7 s]/4};
sol = FindInstance[{f[s1] == f[s2], 0 < s1 < s2 < 4.5}, {s1, s2}, 
   Reals][[1]]
fig = ParametricPlot[f[s], {s, s1, s2} /. sol // Evaluate] /. 
   l_Line :> {Green, FilledCurve[l]};
Show[ParametricPlot[f[s], {s, 0, 4.5}], fig]

enter image description here

$\endgroup$
2
  • 1
    $\begingroup$ What have you tried? $\endgroup$ Dec 4 '21 at 17:11
  • $\begingroup$ plot = ParametricPlot[{Cos[s] + Sin[4 s]/12, Sin[3 s] - Cos[7 s]/4}, {s, 0, 5.5}, Axes -> False]; data = MorphologicalComponents[ColorNegate[Binarize[plot]]]; ArrayPlot[data, ColorRules -> {0 -> Black, 1 -> White, 2 -> Cyan, 3 -> Green}] $\endgroup$
    – cvgmt
    Dec 31 '21 at 3:21
6
$\begingroup$
Remove["Global`*"];
(* the function *)
f[s_] := {Cos[s] + Sin[4 s]/12, Sin[3 s] - Cos[7 s]/4};

(* first get a boring plot *)
plot = ParametricPlot[f[s], {s, 0, 4.5}];

(* find the first intersection point *)
isect = First@Graphics`Mesh`FindIntersections[plot];

(* solve the s values which minimize the distance to this point *)
s0 = s /. Last@Minimize[{Norm[isect - f[s]], 0 < s < 3}, s];
s1 = s /. Last@Minimize[{Norm[isect - f[s]], 4 < s < 4.5}, s];

(* create the vertices for a filled Bezier curve *)
pts = Table[f[s], {s, s0, s1, .01}];

(* plot it with the filled curve *)
ParametricPlot[f[s], {s, 0, 4.5}, 
 Prolog -> {RGBColor["#B4E41D"], FilledCurve@BezierCurve[pts]}]

filled bezier curve on a parametric plot

$\endgroup$
6
$\begingroup$
 plot = ParametricPlot[{Cos[s] + Sin[4 s]/12, Sin[3 s] - Cos[7 s]/4}, {s, 0, 4.5}];

firstlast = First @ Cases[plot, Line[x_] :> x[[{1, -1}]], All];

poly = Select[ContainsNone[firstlast]@*First] @
       MeshPrimitives[#, 2] & @
       BoundaryDiscretizeGraphics @
       ReplaceAll[Line -> Polygon] @ 
       plot;

Show[plot, Graphics[{Opacity[.5], RandomColor[], #} & /@ poly]] 

enter image description here

This approach gives multiple polygons if there are multiple self-intersections. For example, replace 4.5 with 2 Pi - .1 above to get:

enter image description here

$\endgroup$
5
$\begingroup$
Clear["Global`*"]

f[s_] = {Cos[s] + Sin[4 s]/12, Sin[3 s] - Cos[7 s]/4};

To get estimates for the values of s at the intersection for use in FindRoot, plot the curve

plot1 = ParametricPlot[f[s], {s, 0, 4.5},
  AxesLabel -> (Style[#, 14] & /@ {x, y}),
  ColorFunction ->
   Function[{x, y, s}, ColorData["Rainbow"][s]],
  PlotLegends -> BarLegend[{"Rainbow", {0, 9/2}},
    LegendLabel -> Style[s, 14]]]

enter image description here

The intersection of the curve occurs at

Clear[s1, s2]

{s1, s2} = 
 Values@FindRoot[Thread[Equal @@ (f /@ {s1, s2})], {{s1, 2}, {s2, 4}}]

(* {2.13129, 4.31933} *)

The polygon covering the enclosed are is

poly = Polygon[Table[f[s], {s, s1, s2, (s2 - s1)/150}]];

Then,

plot2 = ParametricPlot[f[s], {s, 0, 4.5},
  AxesLabel -> (Style[#, 14] & /@ {x, y}),
  ColorFunction ->
   Function[{x, y, s}, ColorData["Rainbow"][s]],
  PlotLegends -> BarLegend[{"Rainbow", {0, 9/2}},
    LegendLabel -> Style[s, 14]],
  Prolog -> {LightBlue, poly}]

enter image description here

$\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.