# Showing a Plot3D and a StreamPlot on one Manipulated Graphic

I'm trying to combine a Plot3D and a StreamPlot to one Manipulate Graphics diagram so that the StreamPlot appears on the $x-y$ axis. Was wondering how this could be done because my attempt does not work. This question is not a duplicate of an earlier post which was about a possible error that kept appearing. This is something completely different!

    Waves =
Plot3D[Re[
H + Amp*Exp[-y*Abs[f]/Sqrt[9.81*H]]*
Exp[I*(k*x - (Sqrt[9.81*H])*t)]],
{x, -80000, 80000},
{y, 0, 100000},
PlotPoints -> 30, MeshStyle -> None,
PlotStyle -> Directive[
Opacity[0.65], Blue, Specularity[LightBlue, 10]
]
];
VelocityDiagram =
Dynamic[
StreamPlot[{Sqrt[9.81/H]*
Re[Amp*Exp[-y*Abs[f]/Sqrt[9.81*H]]*
Exp[I*(k*x - (Sqrt[9.81*H])*t)]], 0},
{x, -80000, 80000},
{y, 0, 100000}
]
];
Manipulate[
Show[Waves, VelocityDiagram,
PlotRange -> {0, H + Amp},
BoxRatios -> {1, 1, .6}, FaceGrids -> {Back, Left}],
{{t, 0, "Time {s}"}, 0, 1000},
{{Amp, 20, "Wave Amplitude"}, 0, H},
{{k, 0, "Waves per Metre (x-direction)"}, 0, 0.0005},
{{H, 100, "Depth"}, 0, 500},
{{f, 0, "Coriolis Coefficient"}, -0.001, 0.001}
]

• You can start with: mathematica.stackexchange.com/q/65401/5478
– Kuba
Jun 18, 2017 at 14:45
• Well I can't because that's not what I want. I want a Plot3D with a 2D vector plot (StreamPlot) $\left(u_x,~u_y\right)$ plotted beneath it on the x-y plane ($z=0$). Jun 18, 2017 at 14:48
• Then don't map it on sphere but a plane? You can also try Texture.
– Kuba
Jun 18, 2017 at 14:50
• I didn't say I wanted to plot it on a sphere though? I said in the question, to plot the streamplot on the x-y plane Jun 18, 2017 at 14:53
• I'll check that out though, thank you Jun 18, 2017 at 14:53

## 1 Answer

In order to plot the StreamPlot on a plane with the z value at the origin let's first create an example.

sp = With[
{
t = 0,
Amp = 20,
k = 0,
H = 100,
f = 0
},
StreamPlot[{Sqrt[9.81/H]*
Re[Amp*Exp[-y*Abs[f]/Sqrt[9.81*H]]*
Exp[I*(k*x - (Sqrt[9.81*H])*t)]], 0},
{x, -80000, 80000}, {y, 0, 100000}]
]


We can extract out a portion that contains arrows and it looks like this:

sp[[1, 2, 3, 3]]

(* {{Arrowheads[{{0.02, 1.}}],
Arrow[{{54421.9, 81872.3}, {56855.8, 81872.3}, {59289.7,
81872.3}, {60775.2, 81872.3}, {62260.7, 81872.3}, {63746.2,
81872.3}, {65231.7, 81872.3}, {66717.2, 81872.3}, {67686.4,
81872.3}}]}, {Arrowheads[{{0.0180664, 1.}}],
Arrow[{{68018., 81872.3}, {68202.8, 81872.3}, {69688.3,
81872.3}, {71173.8, 81872.3}, {72659.3, 81872.3}, {74144.8,
81872.3}, {75630.3, 81872.3}, {77115.9, 81872.3}, {78601.4,
81872.3}, {80000., 81872.3}}]}} *)


We will want to replace a two dimensional point contained within an Arrow with a three dimensional point that has a z value of 0. Here is a simple example:

Arrow[{{1, 2}, {3, 4}}] /.
Arrow[point_] :> Arrow[Cases[point, {x_, y_} -> {x, y, 0}]]

(* Arrow[{{1, 2, 0}, {3, 4, 0}}] *)


and a slightly more challenging example in a nested list along with Arrowheads.

{
{Arrowheads[{0.02, 1}],
Arrow[{{1, 2}, {3, 4}}]}, {Arrowheads[{0.02, 1}],
Arrow[{{5, 6}, {7, 8}}]}
} /. Arrow[point_] :> Arrow[Cases[point, {x_, y_} -> {x, y, 0}]]

(* {{Arrowheads[{0.02, 1}],
Arrow[{{1, 2, 0}, {3, 4, 0}}]}, {Arrowheads[{0.02, 1}],
Arrow[{{5, 6, 0}, {7, 8, 0}}]}} *)


Now let's see if we can use Show and make a 3D plot of the 2D sp figure.

With[
{
t = 0,
Amp = 20,
k = 0.0001,
H = 100,
f = 0
},
Graphics3D[
sp[[1]] /.
Arrow[point_] :> Arrow[Cases[point, {x_, y_} -> {x, y, 0}]],
PlotRange -> {0, H + Amp},
BoxRatios -> {1, 1, .6},
Axes -> True
]
]


Finally we use Manipulate in order to see the changes as the parameters change. Note that the Dynamic that was wrapping the StreamPlot is dropped as everything contained within Manipulate is already wrapped in Dynamic.

Manipulate[
Show[
Plot3D[
Re[H +
Amp*Exp[-y*Abs[f]/Sqrt[9.81*H]]*Exp[I*(k*x - (Sqrt[9.81*H])*t)]],
{x, -80000, 80000},
{y, 0, 100000},
PlotPoints -> 30,
MeshStyle -> None,
PlotStyle -> Directive[
Opacity[0.65],
Blue,
Specularity[LightBlue, 10]
],
PlotRange -> {0, H + Amp},
BoxRatios -> {1, 1, .6}
],
Graphics3D[
StreamPlot[{Sqrt[9.81/H]*
Re[Amp*Exp[-y*Abs[f]/Sqrt[9.81*H]]*
Exp[I*(k*x - (Sqrt[9.81*H])*t)]], 0}, {x, -80000,
80000}, {y, 0, 100000}][[1]] /.
Arrow[point_] :> Arrow[Cases[point, {x_, y_} -> {x, y, 0}]]
]
],
{{t, 0, "Time {s}"}, 0, 1000},
{{Amp, 20, "Wave Amplitude"}, 0, H},
{{k, 0.0001, "Waves per Metre (x-direction)"}, 0, 0.0005},
{{H, 100, "Depth"}, 0, 500},
{{f, 0, "Coriolis Coefficient"}, -0.001, 0.001}
]
`

• This is really good! Thank you so much! Jun 18, 2017 at 20:34