電気双極子

By 平野拓一

<< Graphics`Colors`

q = 1. ;
d = 
        1. ;
r[x_, y_, 
          z_] := (Sqrt[(x^2) + (y^2) + (z^2)]);
v[x_, y_, z_] := (q/r)[x, y - d/2, z] - (q/r)[x, y + d/2, z];
(* 電気力線 *)
f[x_, 
          y_, d_] := (y - d/2)/r[x, y - d/2, 0] - (y + d/2)/
            r[x, y + d/2, 0];

Plot3D[v[x, y, 0], {x, -1, 1}, {y, -1, 1}, 
      PlotRange -> {-9, 9}, PlotPoints -> 70, 
      Ticks -> None, Mesh -> False, 
      ViewPoint -> {1.957,  -1.099,  2.532}]

reg = 1;
ContourPlot[
      v[x, y, 0], {x, -reg, reg}, {y, -reg, 
        reg}, 
PlotPoints -> 
        50, 
ContourShading -> 
        False, 
ContourStyle -> {AbsoluteDashing[{10, 
              10}]}]

ContourPlot[
      f[x, y, d], {x, -reg, reg}, {y, -reg, 
        reg}, 
PlotPoints -> 
        200, 
ContourShading -> False]

Show[%, %%]

アニメ-ション準備

charges[
          d_] := {AbsoluteThickness[2], {{Red, Disk[{0, d/2}, 0.1]}, 
            Circle[{0, d/2}, 0.1]}, 
{{Green, 
              Disk[{0, -d/2}, 0.1]}}, 
          Circle[{0, -d/2}, 0.1]};
contrs = Table[c, {c, -2, 2, 0.1}];
ContourPlot[f[x, y, d], {x, -1, 1}, {y, -1, 1}, 
      PlotPoints -> 20, ContourShading -> False, FrameTicks -> None, 
      Epilog -> {charges[d]}]

Show[{%7, %11, Graphics[charges[d]]}]

Map[
      ContourPlot[f[x, y, #], {x, -1, 1}, {y, -1, 1}, 
          PlotPoints -> 40, ContourShading -> False, FrameTicks -> None, 
          Epilog -> {charges[#]}]  &, 
      Table[Sin[x], {x, Pi/2, 2 Pi + Pi/2, Pi/7}]]