# Tag Info

6

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@GraphicsMeshFindIntersections[plot]; (* solve the s values which minimize the distance to this point *) s0 = s /. Last@...

6

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

5

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

3

ClearAll["Global`*"] m[θ_] := √Abs[Sin[θ]]; F2[a_, θ_] := -15 m[θ] a Cot[m[θ] a]^3 + 15 Cot[m[θ] a]^2 - 9 m[θ] a Cot[m[θ] a] + 4; (*-pi<theta<0*) G2[a_, θ_] := -2 (m[θ] a Cot[m[θ] a] - 1);(*-pi<theta<0*) U = 1; Q2[a_, θ_] := -(Cos[θ]/(9 m[θ]^4)) F2[a, θ] + U/m[θ]^2 G2[a, θ]; (*-pi<theta<0*) You appear to be ...

3

ContourPlot[ Q2[a, θ] == 1, {a, 1, 8}, {θ, -π + 0.001, -0.001}] Since RegionPlot not always auto discretize the region, so we need to add DiscretizeRegion by hand. RegionPlot@ DiscretizeRegion@ ImplicitRegion[ Q2[a, θ] == 1, {{a, 1, 8}, {θ, -π + 0.001, -0.001}}]

3

From 2016 and Version 11.0 we can use ImageMesh. img = ImagePad[ColorNegate@Image@Graphics[Polygon[shape]], 30]; imgD = Dilation[img, DiskMatrix[30]]; mesh0 = ImageMesh@img; meshD = ImageMesh@imgD; Graphics[{Green, Arrow[Flatten[pts0 = MeshPrimitives[mesh0, 1][[All, 1]], 1]], Red, Arrow@Flatten[ptsD = MeshPrimitives[meshD, 1][[All, 1]], 1]}]

2

shape = First @ CountryData["Chad", "Coordinates"]; poly = Polygon @ shape; srd = SignedRegionDistance @ poly; ranges = Flatten /@ Transpose[{{x, y}, CoordinateBounds[ScalingTransform[1.4 {1, 1}, Mean @ shape] @ shape]}]; ContourPlot[srd[{x, y}], ranges[[1]], ranges[[2]], Contours -> Thread[{{-1, -.5, -.25, .25, .5, 1}, ...

1

For visualization purposes only I propose a simple and robust approach using a thick boundary line: shape = CountryData["Chad", "Coordinates"]; r = 2; xmin = Min[shape[[1, ;; , 1]]] - r; xmax = Max[shape[[1, ;; , 1]]] + r; ymin = Min[shape[[1, ;; , 2]]] - r; ymax = Max[shape[[1, ;; , 2]]] + r; Graphics[{{FaceForm[Blue], EdgeForm[{...

Only top voted, non community-wiki answers of a minimum length are eligible