22
$\begingroup$

I would like to display an electromagnetic (EM) wave. I have written code that works, but it does not "shade" the area between the graph and the axes. Both the Filling and EdgeForm commands are ignored.

strength = 2; frequency = 3;

wave1 = ParametricPlot3D[{t (x/6.28), -strength Sin[frequency t (x/6.28)], 0}, 
  {t, 0, 2 Pi}, 
  PlotStyle->Directive[Thickness[.007], Lighter[Red, .5], Filling -> Axis]];
wave2 = ParametricPlot3D[{t (x/6.28), 0, strength Sin[frequency t(x/6.28)]}, 
  {t, 0, 2 Pi}, 
  PlotStyle -> Directive[Thickness[.007], Lighter[Blue, .5], Filling -> Axis]];

Show[wave1, wave2, Graphics3D[EdgeForm[Pink], wave1],
  Graphics3D[EdgeForm[LightBlue], wave2], 
  Axes->False, Boxed->False, PlotRange->All, ImageSize->{500, 400}]

I would like to accomplish filling the portion between the two sinusoidal waves and the direction of propagation of the wave with color.

$\endgroup$
0
16
$\begingroup$

Here's a variation of the plane wave rendering done in rm -rf's answer. Here, I use arrows instead of lines to indicate the wave's displacement from the axis:

waveDiagram[xm_, col_, k_] := Flatten[First[
    Normal[Plot[Sin[x], {x, 0, xm}, Mesh -> Full, 
                PlotStyle -> Directive[col, Arrowheads[Small]]]] /. 
           Point[{x_, y_}] :> 
             If[Chop[Abs[y]] < 0.1, Point[{x, 0}], Arrow[{{x, 0}, {x, y}}]]]] /. 
          v_?VectorQ /; Length[v] == 2 :> Insert[v, 0, k]

Graphics3D[(* axes *)
           {{Gray, {Arrowheads[.02], 
            Arrow[{{0, 0, 0}, {9 π/2, 0, 0}}]}, {Arrowheads[.01 {-1, 1}], 
            Arrow[{{0, 1, 0}, {0, -1, 0}}], Arrow[{{0, 0, 1}, {0, 0, -1}}]}}, 
           waveDiagram[4 π, Darker[Blue], 2], 
           waveDiagram[4 π, Darker[Green], 3]},
           Boxed -> False, BoxRatios -> {2, 1, 1}]

plane wave diagram

As a variation, here's a depiction of the circular polarization of a plane wave:

Show[
     (* circularly polarized wave *)
     Normal[ParametricPlot3D[{t, -Sin[t], Cos[t]}, {t, 0, 4 π}, Mesh -> Full, 
            PlotStyle -> Directive[Darker[Blue], Arrowheads[Small]]]] /. 
     Point[{x_, y_, z_}] :> 
           If[Chop[Norm[{y, z}]] < 0.1, Point[{x, 0, 0}], 
              Arrow[{{x, 0, 0}, {x, y, z}}]],
     (* axes *)
     Graphics3D[{{Gray, {Arrowheads[.02], Arrow[{{0, 0, 0}, {9 π/2, 0, 0}}]},
                 {Arrowheads[.01 {-1, 1}], Arrow[{{0, 1, 0}, {0, -1, 0}}], 
                  Arrow[{{0, 0, 1}, {0, 0, -1}}]}}}],
                Axes -> None, Boxed -> False, BoxRatios -> {2, 1, 1}, PlotRange -> All]

circular polarization


The common theme in both diagrams is the use of the Mesh option of the plotting functions, which generates Point[]s on the curve(s) at preset locations. From here, we replace each Point[] object generated with an Arrow[] whose head has the coordinates of the original Point[]; how the position of the tail is determined depends on the plot being done.

$\endgroup$
2
  • $\begingroup$ I think the E and B fields have the wrong direction in the top figure. The cross product k X E should point along B. $\endgroup$
    – pjg
    Feb 17 '20 at 16:15
  • $\begingroup$ @pjg, the figure was not intended to actually designate one wave as $\mathbf B$ and the wave orthogonal to it as $\mathbf E$; it merely demonstrates how to render two waves orthogonal to each other with arrows using Graphics3D[]. Of course, for actual figures where each wave in the depiction carries a physical meaning, more care is necessary. $\endgroup$
    – J. M.'s torpor
    Feb 27 '20 at 13:19
22
$\begingroup$

You've gotten answers to the specific problem you had, but here's another way of visualizing the EM wave. This is how I've always seen it depicted in my textbooks, and the advantage is that it prints neatly in black & white.

Module[{w1, w2, colors, plot, lines},
    w1[x_] := {x, 0, Sin[x]};
    w2[x_] := {x, Sin[x], 0};
    colors = Darker /@ {Blue, Green};

    {plot, lines} = ParametricPlot3D[{w1[x], w2[x]}, {x, 0, 4 \[Pi]},   
        Boxed -> False, AxesOrigin -> {0, 0, 0}, MaxRecursion -> 0, 
        PlotStyle -> {{Thick, Thick}, colors}\[Transpose], 
        EvaluationMonitor :> Sow[{Line[{w1[x], {x, 0, 0}}], Line[{w2[x], {x, 0, 0}}]}]
        ] // Reap;

    Show[plot, 
        Graphics3D[Insert[Flatten[lines, 1], colors, 1]\[Transpose]], 
        ViewPoint -> {3.009, -1.348, 0.759}, ViewVertical -> {0.406, -0.398, 5.732}, Ticks -> None, 
        AspectRatio -> 0.75
    ]
 ]

Mathematica graphics

$\endgroup$
2
  • 1
    $\begingroup$ Please see if my edit is okay (hope no visible colour fringing is present) $\endgroup$
    – Szabolcs
    Feb 19 '12 at 15:08
  • 3
    $\begingroup$ Oh that's sexy. +1 $\endgroup$
    – Mr.Wizard
    Feb 19 '12 at 15:45
18
$\begingroup$

If you use a full period for x you can get by with this cheap hack:

x = 2 Pi;

wave1 = ParametricPlot3D[{t (x/6.28), -strength Sin[
     frequency t (x/6.28)], 0}, {t, 0, 2 Pi}, 
  PlotStyle -> 
   Directive[Thickness[.007], Lighter[Red, .5], Filling -> Axis]];
wave2 = ParametricPlot3D[{t (x/6.28), 0, 
   strength Sin[frequency t (x/6.28)]}, {t, 0, 2 Pi}, 
  PlotStyle -> 
   Directive[Thickness[.007], Lighter[Blue, .5], Filling -> Axis]];

Adding /. Line -> Polygon

Show[wave1, wave2, Axes -> False, Boxed -> False, PlotRange -> All, 
  ImageSize -> {500, 400}] /. Line -> Polygon

Mathematica graphics


My take on the hatched shading version:

strength = 1; frequency = 3; x = 5;

pts1 =
 Table[
   {t (x/6.28), -strength Sin[frequency t (x/6.28)], 0},
   {t, 0, 2 Pi, 0.03}
 ];

pts2 = {#, 0, -#2} & @@@ pts1;

Graphics3D[{
  Thickness[0.007],
  {Lighter@Red, Line[pts1]},
  {Lighter@Blue, Line[pts2]},
  Thickness[0.002],
  Pink,
  Line[ {#, # {1, 0, 1}}& /@ pts1[[;; ;; 3]] ],
  RGBColor[0.7, 0.7, 1],
  Line[ {#, # {1, 1, 0}}& /@ pts2[[;; ;; 3]] ]
}]

Mathematica graphics


My take on arrows a la J. M.'s answer:

Table[{t/3, -Sin[t], Cos[t]}, {t, 0, 4 Pi, 0.05}] //
  Graphics3D[{
    {Orange, Lighting -> "Neutral", Tube@#},
    {RGBColor[0, .8, 1], Arrow@Tube[{{0, 0, 0}, 1.5 #}, 0.01] & /@
      {{3, 0, 0}, {0, 1, 0}, {0, -1, 0}, {0, 0, 1}, {0, 0, -1}}},
    Arrowheads[1/40, Appearance -> "Projected"],
    Opacity[0.3],
    Arrow[{# {1, 0, 0}, #}] & /@ #[[;; ;; 3]]
  }, Boxed -> False] &

Mathematica graphics

$\endgroup$
9
$\begingroup$

You could do something like

strength = 2; frequency = 3; x = 5;

wave1 = ParametricPlot3D[{t (x/6.28), -s strength Sin[
      frequency t (x/6.28)], 0}, {t, 0, 2 Pi}, {s, 0, 1}, 
   Mesh -> None, PlotStyle -> Lighter[Red, .5]];
wave2 = ParametricPlot3D[{t (x/6.28), 0, 
    s strength Sin[frequency t (x/6.28)]}, {t, 0, 2 Pi}, {s, 0, 1}, 
   Mesh -> None, PlotStyle -> Lighter[Blue, .5]];

Show[wave1, wave2, Axes -> False, Boxed -> False, PlotRange -> All, 
 ImageSize -> {500, 400}, Lighting -> "Neutral"]

Mathematica graphics

Note that you can also combine the two waves in one ParametricPlot3D:

waves = ParametricPlot3D[
  {{t (x/6.28), -s strength Sin[frequency t (x/6.28)], 0},
   {t (x/6.28), 0, s strength Sin[frequency t (x/6.28)]}},
  {t, 0, 2 Pi}, {s, 0, 1},
  Mesh -> None,
  PlotStyle -> {Lighter[Red, .5], Lighter[Blue, .5]},
  PlotPoints -> {50, 2},
  Boxed -> False, Axes -> False, PlotRange -> All, 
  Lighting -> "Neutral"
  ]
$\endgroup$
5
$\begingroup$

To get a cleaner output I would recommend taking control of the polygons in your plot more explicitly. If you rely on ParametricPlot3D, that control is harder to achieve.

Here is a function that plots an integer number of wavelengths with an arrow indicating the propagation direction, and blue face color for the electric field (red for magnetic field).

plotWave[λ_, nλ_, aspect_: 1/5] := 
  Module[{nStep = 40, amplitudes},
   amplitudes =
    Table[
     {aspect λ nλ Sin[2 Pi z/λ], 0, z},
     {z, 0, λ nλ, λ/nStep/2}
     ];
   Graphics3D[
    {
     {Black, Thick, 
      Arrow[{{0, 0, 0}, {0, 0, λ nλ*1.08}}]},
     {FaceForm[Red],
      Polygon[Partition[amplitudes, nStep + 1, nStep]]}, {FaceForm[
       Blue], Polygon[
       Partition[amplitudes.RotationMatrix[Pi/2, {0, 0, 1}], 
        nStep + 1, nStep]]
      }}]];
plotWave[1, 5]

Mathematica graphics

The first argument is the wavelength, the second argument the number of full wavelength to plot. An optional third argument can be given to specify what ratio of the longitudinal plot length should be assigned to the transverse amplitude.

The output looks pretty much the same as in the other answers, but I generate the wave from a discrete list of points at which the amplitude is calculated. It's important to do this symmetrically so that each half wave has a start and end point on the axis.

The trick then is to make a Polygon out of each half wave. To get the end points to lie on the axis, I partition the amplitude list (amplitudes) with the appropriate sub-list size (nStep +1). Since consecutive half waves share a point on the axis, I have to add an offset as the third argument in Partition.

Finally, I use the fact that Polygon can accept a list of lists, to make the first wave. The second wave is done the same way, except that a rotation matrix is first applied to the list amplitudes.

Edit

If you want other ideas for how to represent waves, you may want to take a look at my web page and the CDF called "PlaneWaveField.cdf" linked near the bottom of the section on 3D arrows.

$\endgroup$
2
  • $\begingroup$ You can consider using this palette for effortless image uploading. I added an image to the post. $\endgroup$
    – Szabolcs
    Feb 19 '12 at 15:28
  • $\begingroup$ Thanks - but in this case I didn't think the image adds much info. $\endgroup$
    – Jens
    Feb 19 '12 at 16:34
1
$\begingroup$

The approach of Clifford algebra. The electric field is represented by ordinary vector arrow. The magnetic field is represented by disk, the area of which represents magnitude of magnetic field. By the way, normal to the disk represents the direction of (not true, i.e. axial) vector, since the magnetic field is not an ordinary vector (you cannot add electric and magnetic vectors).

sin = Plot[2 Sin[t], {t, 0, 3 \[Pi]}, Axes -> False, 
   PlotStyle -> {AbsoluteThickness[2], Black}];

magn = Graphics[{Circle[{0, 0}, 0.03], Circle[{\[Pi]/4, 0}, 0.3], 
    Circle[{(2 \[Pi])/4, 0}, 0.45], Circle[{(3 \[Pi])/4, 0}, 0.3], 
    Circle[{\[Pi] + 0, 0}, 0.03], Circle[{\[Pi] + \[Pi]/4, 0}, 0.3], 
    Circle[{\[Pi] + (2 \[Pi])/4, 0}, 0.45], 
    Circle[{\[Pi] + (3 \[Pi])/4, 0}, 0.3], 
    Circle[{2 \[Pi] + 0, 0}, 0.03], 
    Circle[{2 \[Pi] + \[Pi]/4, 0}, 0.3], 
    Circle[{2 \[Pi] + (2 \[Pi])/4, 0}, 0.45], 
    Circle[{2 \[Pi] + (3 \[Pi])/4, 0}, 0.3]}];

elipsesDiskai = 
  Graphics[{Circle[{0, 0}, 0.03], Circle[{\[Pi]/4, 0}, 0.3], 
     Circle[{(2 \[Pi])/4, 0}, 0.45], Circle[{(3 \[Pi])/4, 0}, 0.3], 
     Circle[{\[Pi] + 0, 0}, 0.03], Circle[{\[Pi] + \[Pi]/4, 0}, 0.3], 
     Circle[{\[Pi] + (2 \[Pi])/4, 0}, 0.45], 
     Circle[{\[Pi] + (3 \[Pi])/4, 0}, 0.3], 
     Circle[{2 \[Pi] + 0, 0}, 0.03], 
     Circle[{2 \[Pi] + \[Pi]/4, 0}, 0.3], 
     Circle[{2 \[Pi] + (2 \[Pi])/4, 0}, 0.45], 
     Circle[{2 \[Pi] + (3 \[Pi])/4, 0}, 0.3]} /. 
    Circle[x__] :> {GrayLevel[0.85], Disk[x]}];

elek = Graphics[{Arrowheads[0.036], 
    Arrow[{{\[Pi]/4, 0}, {\[Pi]/4, 2 Sin[\[Pi]/4]}}], 
    Arrow[{{(2 \[Pi])/4, 0}, {(2 \[Pi])/4, 2 Sin[(2 \[Pi])/4]}}], 
    Arrow[{{(3 \[Pi])/4, 0}, {(3 \[Pi])/4, 2 Sin[(3 \[Pi])/4]}}], 
    Arrow[{{\[Pi] + \[Pi]/4, 0}, {\[Pi] + \[Pi]/4, 
       2 Sin[\[Pi] + \[Pi]/4]}}], 
    Arrow[{{\[Pi] + (2 \[Pi])/4, 0}, {\[Pi] + (2 \[Pi])/4, 
       2 Sin[\[Pi] + (2 \[Pi])/4]}}], 
    Arrow[{{\[Pi] + (3 \[Pi])/4, 0}, {\[Pi] + (3 \[Pi])/4, 
       2 Sin[\[Pi] + (3 \[Pi])/4]}}], 
    Arrow[{{2 \[Pi] + \[Pi]/4, 0}, {2 \[Pi] + \[Pi]/4, 
       2 Sin[2 \[Pi] + \[Pi]/4]}}], 
    Arrow[{{2 \[Pi] + (2 \[Pi])/4, 0}, {2 \[Pi] + (2 \[Pi])/4, 
       2 Sin[2 \[Pi] + (2 \[Pi])/4]}}], 
    Arrow[{{2 \[Pi] + (3 \[Pi])/4, 0}, {2 \[Pi] + (3 \[Pi])/4, 
       2 Sin[2 \[Pi] + (3 \[Pi])/4]}}]}];

tr[x_, y_] := 
  Polygon[{{x + 0, y - 0.1}, {x + 0.1, y + 0}, {x + 0, 
     y + 0.1}, {x + 0, y - 0.1}}];
magnArrow = 
  Graphics[{tr[\[Pi]/4, -0.29], tr[(2 \[Pi])/4, -0.45], 
    tr[(3 \[Pi])/4, -0.29], tr[\[Pi] + \[Pi]/4, 0.29], 
    tr[\[Pi] + (2 \[Pi])/4, 0.45], tr[\[Pi] + (3 \[Pi])/4, 0.29], 
    tr[2 \[Pi] + \[Pi]/4, -0.29], tr[2 \[Pi] + (2 \[Pi])/4, -0.45], 
    tr[2 \[Pi] + (3 \[Pi])/4, -0.29]}];

str = Graphics[{Arrowheads[0.036], Arrow[{{4.2, 1.2}, {5.2, 1.2}}]}];
kvec = Graphics[{Arrow[{{-0.1, 0}, {3 \[Pi] + 0.7, 0}}]}];
txt = Graphics[{Text[
     StyleForm["z", FontSize -> 9, 
      FontWeight -> Bold], {3 \[Pi] + 0.7, 0}, {1, 2}], 
    Text[StyleForm["k", FontWeight -> "Bold", FontSize -> 9], {4.8, 
      1.65}]}];

planeWave = 
 Show[{elipsesDiskai, kvec, sin, magn, elek, magnArrow, txt, str}, 
  AspectRatio -> Automatic]

plane wave in geometric algebra

Edit1 Since plain wave polarization was not specified, I added (except the text labels) the similar picture for elliptically polarized wave. It looks more interesting:

dydis = 1.6;
{h1 = 0.3*dydis, v1 = 0.7*dydis};
{h2 = 0.7*dydis, v2 = 0.3*dydis};
polinkis = 1;
poslinkis = 1.3;
tr = 0.0;

elipsesDiskai = 
  Graphics[{{GrayLevel[0.6], 
     Disk[{0, 0}, {h1 , v1}, {0, 2 \[Pi]}]}, {GrayLevel[0.9], 
     Disk[{1*poslinkis, 1*poslinkis/polinkis}, {h2 , v2}, {0, 
       2 \[Pi]}]}, {GrayLevel[0.9], 
     Disk[{2*poslinkis, 2*poslinkis/polinkis}, {h1 , v1}, {0, 
       2 \[Pi]}]}, {GrayLevel[0.6], 
     Disk[{3*poslinkis, 3*poslinkis/polinkis}, {h2 , v2}, {0, 
       2 \[Pi]}]}, {GrayLevel[0.6], 
     Disk[{4*poslinkis, 4*poslinkis/polinkis}, {h1 , v1}, {0, 
       2 \[Pi]}]}}];

elipse = ParametricPlot[{{-1/2 + t, (-1/2 + t)/
       polinkis}, {0*poslinkis + 
       h1 Cos[t], (0*poslinkis + v1 Sin[t])}, {1*poslinkis + 
       h2 Cos[t], 
      poslinkis*1/polinkis + v2  Sin[t]}, {poslinkis*2 + h1 Cos[t], 
      poslinkis*2/polinkis + v1 Sin[t]}, {poslinkis*3 + h2 Cos[t], 
      poslinkis*3/polinkis + v2 Sin[t]}, {poslinkis*4 + h1  Cos[t], 
      poslinkis*4/polinkis + 
       v1  Sin[t]}, {{-1/2 + t + 22, (-1/2 + t + 22)/polinkis}*0.12}},
     {t, 0, 2 \[Pi]}, AspectRatio -> Automatic, Axes -> False, 
    PlotRange -> All, 
    PlotStyle -> {Directive[AbsoluteThickness[1], Black, 
       Arrowheads[{{0.03, 0.2 - tr}, {0.03, 0.4 - tr}, {0.05, 
          0.6 - tr + 0.015}, {0.03, 0.8 - tr}, {0.03, 
          1 - tr}}]], {Directive[AbsoluteThickness[1], Black, 
        Arrowheads[{{-0.03, 0.1}, {-0.03, (4/(2 Pi))}}]]}, {Directive[
        AbsoluteThickness[1], Black, 
        Arrowheads[{{0.03, 0.2}, {0.03, (5/(2 Pi))}}]]}, {Directive[
        AbsoluteThickness[2], Black, 
        Arrowheads[{{0.05, 0.2}, {0.05, (4.3/(2 Pi))}}]]}, {Directive[
        AbsoluteThickness[1], Black, 
        Arrowheads[{{-0.03, 0.1}, {-0.03, (4/(2 Pi))}}]]}, {Directive[
        AbsoluteThickness[1], Black, 
        Arrowheads[{{-0.03, 0.1}, {-0.03, (4/(2 Pi))}}]]}, {Directive[
        AbsoluteThickness[2], Black]}}] /. Line[x_, ___] :> Arrow[x];

elecF = Graphics[{Directive[AbsoluteThickness[1]], Arrowheads[0.03], 
    Arrow[{{0, 0}, {0, v1}}], 
    Arrow[{{1*poslinkis, 
       poslinkis*1/polinkis}, {1*poslinkis + h2 Cos[t], 
        poslinkis*1/polinkis + v2  Sin[t]} /. t -> -0}], {Directive[
      AbsoluteThickness[2]], Arrowheads[0.05], 
     Arrow[{{2*poslinkis, 
        poslinkis*2/polinkis}, {2*poslinkis + h1 Cos[t], 
         poslinkis*2/polinkis + v1  Sin[t]} /. t -> -Pi/2}]}, 
    Arrow[{{3*poslinkis, 
       poslinkis*3/polinkis}, {3*poslinkis + h2 Cos[t], 
        poslinkis*3/polinkis + v2  Sin[t]} /. t -> Pi}], 
    Arrow[{{4*poslinkis, 
       poslinkis*4/polinkis}, {4*poslinkis + h1 Cos[t], 
        poslinkis*4/polinkis + v1  Sin[t]} /. t -> Pi/2}]}];

beteksto = Show[{elipsesDiskai, elipse, elecF}]

circularly polarized electromagnetic way in geometric algebra

$\endgroup$
2
  • $\begingroup$ Does the second plot get created with your code also? $\endgroup$ Jan 3 '20 at 22:45
  • $\begingroup$ No, I added the code for the second picture. The most important point here is the concept, not the visualization (which was optimized for white-black print) itself $\endgroup$
    – Acus
    Jan 5 '20 at 18:26

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.