ParametricPlot3D Curve and ImplicitRegion: Projections and Intersections

Question

There is a parametric 3D-Curve:

ParametricPlot3D[{Sin[t], Cos[1 - 3 t], Sin[2 t - 1]}, {t, 0, 10}, BoxRatios -> {1, 1, 1}, AxesLabel -> {x, y, z}]

And Implicit Region:

\[ScriptCapitalR] = ImplicitRegion[x^2 + y^2 + z^2 <= 1, {x, y, z}];
RegionPlot3D[\[ScriptCapitalR], PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}, PlotPoints -> 50, ImageSize -> Small]

How to project a 3D-curve is shown here.

ClearAll[f, functions]
f[t_] := {Sin[t], Cos[1 - 3 t], Sin[2 t - 1]};
plotrange = 1;
padding = .1;
functions[t_] := 
 Prepend[f[t]][
  MapThread[
   ReplacePart[f[t], # -> #2 (plotrange + padding)] &, {{1, 2, 
     3}, {-1, 1, -1}}]]
ParametricPlot3D[Evaluate@functions[t], {t, 0, 10}, 
 PlotStyle -> Thick, BoxRatios -> {1, 1, 1}, PlotPoints -> 100, 
 PlotRange -> plotrange, PlotRangePadding -> padding, 
 Boxed -> {Back, Bottom, Left}, AxesLabel -> {x, y, z}, 
 ImageSize -> Small]

How to project ImplicitRegion is shown here:

{RegionPlot[Resolve[\!\(
\*SubscriptBox[\(\[Exists]\), \(z\)]\({x, y, 
      z} \[Element] \[ScriptCapitalR]\)\), Reals], {x, -1, 
      1}, {y, -1, 1}], RegionPlot[Resolve[\!\(
\*SubscriptBox[\(\[Exists]\), \(y\)]\({x, y, 
      z} \[Element] \[ScriptCapitalR]\)\), Reals], {x, -1, 
      1}, {z, -1, 1}], RegionPlot[Resolve[\!\(
\*SubscriptBox[\(\[Exists]\), \(x\)]\({x, y, 
      z} \[Element] \[ScriptCapitalR]\)\), Reals], {y, -1, 
      1}, {z, -1, 1}]}

Now, it is necessary to find the intersections of the projections of the three-dimensional curve with the projection of the implicit region onto the xy-yz-xz planes. How to do it in Mathematica?

cvgmt · Accepted Answer · 2022-03-10T14:40:22.427

Edit

reg = ImplicitRegion[
   x^6 - 5 x^4 y z + 3 x^4 y^2 + 10 x^2 y^3 z + 3 x^2 y^4 - y^5 z + 
     y^6 + z^6 <= 1, {x, y, z}];
plot = ParametricPlot3D[{Sin[t], Cos[1 - 3 t], Sin[2 t - 1]}, {t, 0, 
    10}, PlotStyle -> Red, 
   RegionFunction -> Function[{x, y, z}, RegionMember[reg]@{x, y, z}]];
regplot = 
  RegionPlot3D[reg, PlotPoints -> 50, Axes -> False, 
   PlotStyle -> Opacity[.1], PlotRange -> All];
regxy = RegionPlot[
   Resolve[Exists[z, {x, y, z} ∈ reg]], {x, -1.5, 
    1.5}, {y, -1.5, 1.5}, BoundaryStyle -> Blue];
regyz = RegionPlot[
   Resolve[Exists[x, {x, y, z} ∈ reg]], {y, -1.5, 
    1.5}, {z, -1.5, 1.5}, BoundaryStyle -> Blue];
regxz = RegionPlot[
   Resolve[Exists[y, {x, y, z} ∈ reg]], {x, -1.5, 
    1.5}, {z, -1.5, 1.5}, BoundaryStyle -> Blue];
plotxy = plot /. {{x_Real, y_Real, z_Real} :> {x, y}, 
    Graphics3D -> Graphics, RGBColor[a__] :> Cyan};
plotyz = plot /. {{x_Real, y_Real, z_Real} :> {y, z}, 
    Graphics3D -> Graphics, RGBColor[a__] :> Green};
plotxz = plot /. {{x_Real, y_Real, z_Real} :> {x, z}, 
    Graphics3D -> Graphics, RGBColor[a__] :> Purple};
GraphicsGrid[{{Show[regxy, plotxy], 
   Show[regyz, plotyz]}, {Show[regxz, plotxz], Show[plot, regplot]}}]

We use RegionFunction to restrict the parametric curve(we test another implicit region,not the disk)

reg = ImplicitRegion[
   x^6 - 5 x^4 y z + 3 x^4 y^2 + 10 x^2 y^3 z + 3 x^2 y^4 - y^5 z + 
     y^6 + z^6 <= 1, {x, y, z}];
plot = ParametricPlot3D[{Sin[t], Cos[1 - 3 t], Sin[2 t - 1]}, {t, 0, 
    10}, PlotStyle -> Red, 
   RegionFunction -> Function[{x, y, z}, RegionMember[reg]@{x, y, z}]];
plotxy = plot /. {{x_Real, y_Real, z_Real} :> {x, y}, 
    Graphics3D -> Graphics, RGBColor[a__] :> Cyan};
plotyz = plot /. {{x_Real, y_Real, z_Real} :> {y, z}, 
    Graphics3D -> Graphics, RGBColor[a__] :> Green};
plotxz = plot /. {{x_Real, y_Real, z_Real} :> {x, z}, 
    Graphics3D -> Graphics, RGBColor[a__] :> Purple};
GraphicsGrid[{{plotxy, plotyz}, {plotxz, plot}}]

Wow! Is it possible now on your chart to combine the projections of the curve with the corresponding projection of the implicit region? I mean just something like that (for example - sphere) https://ibb.co/vJqgbDv — dtn, Mar 10 '22 at 14:01

kglr · Answer 2 · 2022-03-10T12:19:28.727

ℛ = ImplicitRegion[x^2 + y^2 + z^2 <= 1, {x, y, z}];

ClearAll[g, f, functions]

g[t_] := {Sin[t], Cos[1 - 3 t], Sin[2 t - 1]};

f[t_] := ConditionalExpression[g[t], g[t] ∈ ℛ];

plotrange = 1;
padding = .1;

functions[t_] := Prepend[f[t]] @ 
  MapThread[ReplacePart[f[t], # -> #2 (plotrange + padding)] &,
   {Thread[{1, {1, 2, 3}}], {-1, 1, -1}}]

ParametricPlot3D[Evaluate @ functions[t], {t, 0, 10}, 
 PlotStyle -> Thick, BoxRatios -> {1, 1, 1}, PlotPoints -> 100, 
 PlotRange -> plotrange, PlotRangePadding -> padding, 
 Boxed -> {Back, Bottom, Left}, AxesLabel -> {x, y, z}, ImageSize -> Medium]

Row[ParametricPlot3D[Evaluate@functions[t], {t, 0, 10}, 
    PlotStyle -> Thick, BoxRatios -> {1, 1, 1}, PlotPoints -> 100, 
    PlotRange -> plotrange, PlotRangePadding -> padding, 
    Boxed -> False, Axes -> False, ImageSize -> Small, 
    ViewPoint -> #] & /@ {{-∞, 0, 0}, {0, ∞, 0}, {0, 0, -∞}}, 
 Spacer[30]]

Update:

show = Show[ParametricPlot3D[Evaluate@functions[t], {t, 0, 10}, 
  PlotStyle -> Thick, BoxRatios -> {1, 1, 1}, PlotPoints -> 100, 
  PlotRange -> plotrange, PlotRangePadding -> padding, 
  Boxed -> {Back, Bottom, Left}, AxesLabel -> {x, y, z}, ImageSize -> Medium], 
 ParametricPlot3D[{{-(plotrange + padding), Cos[t], Sin[t]}, 
    {Cos[t], (plotrange + padding), Sin[t]},
    {Cos[t], Sin[t], -(plotrange + padding)}}, {t, 0, 2 π}, 
  PlotStyle -> Directive[Gray, Thin], PlotPoints -> 90], 
 RegionPlot3D[ℛ, PlotStyle -> Opacity[.3, Orange], PlotPoints -> 50]]

To add the intersection of the lines in the main plot with the surface of the ball:

lineswithendpoints = ParametricPlot3D[functions[t][[1]], {t, 0, 10}, 
    PlotStyle -> Thick, BoxRatios -> {1, 1, 1}, PlotPoints -> 100, 
    PlotRange -> plotrange, PlotRangePadding -> padding] /. 
  Line[x_] :> {Line[x], Purple, Sphere[x[[{1, -1}]], .03]};
Show[show, lineswithendpoints]

Thank you for your answer! I would also like to add something, namely1: in one picture, combine the projection of the implicit region with the projection of the curve and mark the intersection points. 2. combine a three-dimensional curve and an implicit region with adjustable transparency on one plot. — dtn, Mar 10 '22 at 11:50
For the 3D case, I did it like this: Show[{ParametricPlot3D[{g[t]}, {t, 0, 10}], RegionPlot3D[\[ScriptCapitalR], PlotStyle -> Opacity[0.25], PlotPoints -> 50]}, ImageSize -> Small] — dtn, Mar 10 '22 at 12:13

ParametricPlot3D Curve and ImplicitRegion: Projections and Intersections

2 Answers2