1
$\begingroup$

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

enter image description here

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]

enter image description here

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]

enter image description here

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

enter image description here

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?

Improve this question
$\endgroup$

2 Answers 2

Reset to default
3
$\begingroup$

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

enter image description here

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

enter image description here

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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) ibb.co/vJqgbDv $\endgroup$
    – dtn
    Mar 10, 2022 at 14:01
  • $\begingroup$ Yes, that's what I need. Thank you very much for your help! $\endgroup$
    – dtn
    Mar 10, 2022 at 14:45
1
$\begingroup$ 
ℛ = 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]

enter image description here

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

enter image description here

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

enter image description here

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]

enter image description here

Improve this answer
$\endgroup$
4
  • $\begingroup$ 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. $\endgroup$
    – dtn
    Mar 10, 2022 at 11:50
  • $\begingroup$ 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] $\endgroup$
    – dtn
    Mar 10, 2022 at 12:13
  • 1
    $\begingroup$ @dtn, please see the update. $\endgroup$
    – kglr
    Mar 10, 2022 at 12:19
  • $\begingroup$ Yes, that's what I need. Thank you very much for your help! $\endgroup$
    – dtn
    Mar 10, 2022 at 14:45

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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