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, 2017 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, 2017 at 14:48
  • $\begingroup$ Then don't map it on sphere but a plane? You can also try Texture. $\endgroup$
    – Kuba
    Jun 18, 2017 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, 2017 at 14:53
  • $\begingroup$ I'll check that out though, thank you $\endgroup$
    – Jelmes
    Jun 18, 2017 at 14:53

1 Answer 1

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, 2017 at 20:34

Your Answer

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

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