1
$\begingroup$

I am trying to generate a 3d animation showing two ripples interfering at a point which can be chosen. In my 3d modelling, I want to show the cross-section of the ripple towards that point. I wrote the code that correctly display all the elements but when I ran the animation, it was choppy and sometimes, after a beep from my com, the animation stop updating and nothing works thereafter.

The functions s1, s2, p1, p2 and r are all Initialization Code.

Here is my code:

    ω := 0.125 π;
s1[x0_, λ_, x_, y_, a_, t_] := 
  x0 Cos[(2 π)/λ Sqrt[(x^2 + (y - a)^2)] - ω t];
s2[x0_, λ_, x_, y_, a_, t_, phase_] := 
  x0 Cos[(2 π)/λ Sqrt[(x^2 + (y + a)^2)] - ω t - 
     phase];
p1[x0_, λ_, p_, a_, t_] := 
  x0 Cos[(2 π)/λ Sqrt[36 + Abs[(p - a)]^2] - ω t];
p2[x0_, λ_, p_, a_, t_, phase_] := 
  x0 Cos[(2 π)/λ Sqrt[36 + Abs[(p + a)]^2] - ω t - 
     phase];
r[x0_, λ_, p_, a_, t_, phase_] := 
  x0 Cos[(2 π)/λ Sqrt[36 + Abs[(p - a)]^2] - ω t] +
    x0 Cos[(
       2 π)/λ Sqrt[36 + Abs[(p + a)]^2] - ω t - 
      phase];
Manipulate[
 Show[
  Plot3D[s1[x0, λ, x, y, a, t], {x, 0, 6}, {y, -2.5, 2.5},
   AxesLabel -> {"distance \!\(\*
StyleBox[\"x\",\nFontSlant->\"Italic\"]\)", "slits \!\(\*
StyleBox[\"y\",\nFontSlant->\"Italic\"]\)", "\!\(\*
StyleBox[\"z\",\nFontSlant->\"Italic\"]\)"},
   BoxRatios -> {1, 1, 0.2},
   ImageSize -> {400, 400},
   Mesh -> None,
   PlotPoints -> 25,
   PlotRange -> {{0, 6}, {-2.5, 2.5}, {-1, 1}},
   PlotStyle -> {LightOrange, Opacity[v1]},
   RegionFunction -> Function[{x, y, z}, (-p + a) x + 6 y > chop a],
   SphericalRegion -> True,
   ViewPoint -> {5, -4, 5}],(* Ripple from source 1 *)
  Plot3D[s2[x0, λ, x, y, a, t, phase], {x, 0, 6}, {y, -2.5, 
    2.5},
   Mesh -> None,
   PlotPoints -> 25, 
   PlotRange -> {{0, 6}, {-2.5, 2.5}, {-1, 1}},
   PlotStyle -> {LightBlue, Opacity[v2]},
   RegionFunction -> Function[{x, y, z}, (p + a) x - 6 y > chop a]],(* 
  Ripple from source 2 *)
  ParametricPlot3D[{u, (p - a)/6 u + a, 
    x0 Cos[(2 π)/λ Sqrt[
         u^2 + ((p - a)/6 u)^2] - ω t]}, {u, 0, 6}, 
   PlotPoints -> 50,
   PlotStyle -> {Red, Thickness[0.006], Opacity[v4]}],(* 
  Wave from source 1 to point *)
  ParametricPlot3D[{u, ((p + a)/6) u - a, 
    x0 Cos[(2 π)/λ Sqrt[
         u^2 + ((p + a)/6 u)^2] - ω t - phase]}, {u, 0, 6},
   PlotPoints -> 50,
   PlotStyle -> {Blue, Thickness[0.006], 
     Opacity[v5]}]], (* Wave from source 2 to point *)
  Grid[{
   {"Time, \!\(\*
StyleBox[\"t\",\nFontSlant->\"Italic\"]\)", 
    Control[{{t, 0., ""}, 0., 15., 1., Appearance -> "Open"}], 
    "Opacity of Ripple 1", Control[{{v1, 0.25, ""}, 0., 1., 0.25}]},
   {"Position of P", 
    Control[{{p, 1., ""}, -2.5, 2.5, 0.05, Appearance -> "Open"}], 
    "Opacity of Ripple 2", Control[{{v2, 0.25, ""}, 0., 1., 0.25}]},
   {"Slit Position, \!\(\*
StyleBox[\"a\",\nFontSlant->\"Italic\"]\)", 
    Control[{{a, 1., ""}, 0.5, 2., 0.5}], "Opacity of Resultant", 
    Control[{{v4, 1., ""}, 0., 1., 0.25}]},
   {"Amplitude, \!\(\*SubscriptBox[
StyleBox[\"x\",\nFontSlant->\"Italic\"], \(0\)]\)", 
    Control[{{x0, 0.3, ""}, 0.1, 0.5, 0.1}], "Opacity of Wave 1", 
    Control[{{v5, 1, ""}, 0., 1., 0.25}]},
   {"Wavelength, λ", 
    Control[{{λ, 0.5, ""}, 0.2, 2., 0.1}], 
    "Cross-Section View", 
    Control[{{chop, 6., ""}, {-40. -> "Full", 6. -> "Cross-Section"}, 
      ControlType -> RadioButtonBar, Appearance -> "Labeled"}]},
   {"Phase of \!\(\*SubscriptBox[\(S\), \(2\)]\) rel. to \
\!\(\*SubscriptBox[\(S\), \(1\)]\), \!\(\*SubscriptBox[\(ϕ\), \
\(i\)]\)", Control[{{phase, 0., ""}, 0., 2 π, 0.25 π}], ""}},
  Dividers -> {{{False, False, True, False}}, False}, 
  Spacings -> {{0, 2, 10, 2}, 0}, Alignment -> Left],
 ControlPlacement -> Bottom,
 SaveDefinitions -> True]
$\endgroup$
  • 3
    $\begingroup$ Hi Wongy, what's your question exactly? A general trick is to use less plot points when the sliders are active: PlotPoints -> ControlActive[15, 50]. $\endgroup$ – Thies Heidecke Sep 6 '19 at 15:25
  • 5
    $\begingroup$ I'm voting to close this question as off-topic because no one seem to be able to reproduce the problem the OP is experiencing $\endgroup$ – m_goldberg Sep 7 '19 at 0:04
  • 1
    $\begingroup$ @CATrevillian. I have 8 GB ot ram. $\endgroup$ – m_goldberg Sep 7 '19 at 2:27
  • 1
    $\begingroup$ My com is 6700HQ with 16GB ram. I checked and my processor is running at 60+%. No other programmes are taking up much processing cycle (mostly <2-3%). $\endgroup$ – Wongy Sep 7 '19 at 10:27
  • 1
    $\begingroup$ Oh..I m running mathematica 12.0 on windows 10 pro $\endgroup$ – Wongy Sep 7 '19 at 10:27
3
$\begingroup$

Not an answer, but a suggestion for improving your code by using Row to display plot and control labels. I think Row makes the label formatting easier to write and certainly easier to read when displayed on this site,

Manipulate[
  Show[
    Plot3D[s1[x0, λ, x, y, a, t], {x, 0, 6}, {y, -2.5, 2.5},
      Mesh -> None,
      PlotPoints -> 25,
      PlotRange -> {{0, 6}, {-2.5, 2.5}, {-1, 1}},
      PlotStyle -> {LightOrange, Opacity[v1]},
      RegionFunction -> Function[{x, y, z}, (-p + a) x + 6 y > chop a],
      SphericalRegion -> True,
      ViewPoint -> {5, -4, 5}],
    Plot3D[s2[x0, λ, x, y, a, t, phase], {x, 0, 6}, {y, -2.5, 2.5},
      Mesh -> None,
      PlotPoints -> 25,
      PlotStyle -> {LightBlue, Opacity[v2]},
      RegionFunction -> Function[{x, y, z}, (p + a) x - 6 y > chop a]], 
    ParametricPlot3D[
      {u, (p - a)/6 u + a, x0 Cos[(2 π)/λ Sqrt[u^2 + ((p - a)/6 u)^2] - ω t]}, 
      {u, 0, 6},
      PlotPoints -> 50,
      PlotStyle -> {Red, Thickness[0.006], Opacity[v4]}],
    ParametricPlot3D[
      {u, ((p + a)/6) u - a, x0 Cos[(2 π)/λ Sqrt[u^2 + ((p + a)/6 u)^2] - ω t - phase]}, 
      {u, 0, 6},
      PlotPoints -> 50,
      PlotStyle -> {Blue, Thickness[0.006], Opacity[v5]}],
    BoxRatios -> {1, 1, 0.2},
    ImageSize -> {400, 400},
    AxesLabel ->
      {Row[{"distance ", Style["x", "TI"]}],
       Row[{"slits ", Style["y", "TI"]}],
       Style["z", "TI"]}],
  Grid[
    {{Row[{"Time ", Style["t", "TI"]}], 
      Control[{{t, 0., ""}, 0., 15., 1., Appearance -> "Open"}],
      "Opacity of Ripple 1", 
      Control[{{v1, 0.25, ""}, 0., 1., 0.25}]}, 
     {"Position of P", 
      Control[{{p, 1., ""}, -2.5, 2.5, 0.05, Appearance -> "Open"}],
      "Opacity of Ripple 2", 
      Control[{{v2, 0.25, ""}, 0., 1., 0.25}]},
     {Row[{"Slit Position, ", Style["a", "TI"]}], 
      Control[{{a, 1., ""}, 0.5, 2., 0.5}],
      "Opacity of Resultant", 
      Control[{{v4, 1., ""}, 0., 1., 0.25}]},
     {Row[{"Amplitude, ", Subscript["x", Style["0", "TI"]]}], 
      Control[{{x0, 0.3, ""}, 0.1, 0.5, 0.1}], 
      "Opacity of Wave 1", 
      Control[{{v5, 1, ""}, 0., 1., 0.25}]}, 
     {"Wavelength, λ", 
      Control[{{λ, 0.5, ""}, 0.2, 2., 0.1}],
      "Cross-Section View", 
      Control[{{chop, 6., ""}, {-40. -> "Full", 6. -> "Cross-Section"},
        ControlType -> RadioButtonBar, 
        Appearance -> "Labeled"}]}, 
     {Row[{"Phase of ", Subscript["S", 1], " rel. to ", Subscript["S", 2], ", ", 
           Subscript["ϕ", Style["i", "TI"]]}],
      Control[{{phase, 0., ""}, 0., 2 π, 0.25 π}], ""}},
    Dividers -> {{{False, False, True, False}}, False},
    Spacings -> {{0, 2, 10, 2}, 0},
    Alignment -> Left],
  ControlPlacement -> Bottom,
  SaveDefinitions -> True]

Note: "TI" is built-in but not well documented shortcut that produces nice-looking italic symbols. It is a shortcut for Times Italic.

$\endgroup$
  • $\begingroup$ @goldberg, will certainly implement your suggestion. thanks a lot $\endgroup$ – Wongy Sep 7 '19 at 10:45

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