3
$\begingroup$

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}
]`
$\endgroup$
14
  • $\begingroup$ You can start with: mathematica.stackexchange.com/q/65401/5478 $\endgroup$ – Kuba Jun 18 '17 at 14:45
  • $\begingroup$ 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$). $\endgroup$ – Jelmes Jun 18 '17 at 14:48
  • $\begingroup$ Then don't map it on sphere but a plane? You can also try Texture. $\endgroup$ – Kuba Jun 18 '17 at 14:50
  • $\begingroup$ 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 $\endgroup$ – Jelmes Jun 18 '17 at 14:53
  • $\begingroup$ I'll check that out though, thank you $\endgroup$ – Jelmes Jun 18 '17 at 14:53
1
$\begingroup$

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

Mathematica graphics

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

Mathematica graphics

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

Mathematica graphics

$\endgroup$
1
  • $\begingroup$ This is really good! Thank you so much! $\endgroup$ – Jelmes Jun 18 '17 at 20:34

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.