Shaky Point[] objects in simple animation

Question

I'm making a simple animation of wave motion. Each point is supposed to be moving exactly along a circle, and for some reason the purple & orange points seem to shake as they rotate about their respective circles. All of the arguments that determine the position of the point are $\mathcal{O}(10)$ or less, so I have trouble thinking is a rounding error.

The gif I've attached is rendered at 300 frames for just one cycle (which ought to be more than enough), and I can't seem to figure out how to go about correcting this. Any help is appreciated.


k = 2 \[Pi]/3;
c = Sqrt[9.82/k];
X[a_, b_, t_, k_ : k] := a + Exp[k*b]/k Sin[k(a - ct)];
Y[a_, b_, t_, k_ : k] := b - Exp[kb]/k Cos[k(a - c*t)];
r[b_, k_ : k] := Exp[k*b]/k;
ymax = -.3
ny = 10;
ys = Table[b, {b, ymax, -2, -(ymax + 2)/ny}];
parts[t_] := 
  Flatten[Table[
    Point[{X[a, b, t], Y[a, b, t]}], {a, -4, 4, .4}, {b, 
     ymax, -2, -(ymax + 2)/ny}], 1];
surf[t_] := Table[{X[a, ymax, t], Y[a, ymax, t]}, {a, -4, 4, .1}];
bot[t_] := Table[{X[a, -2, t], Y[a, -2, t]}, {a, -4, 4, .4}];
ledge[t_] := 
  Table[{X[-4, b, t], Y[-4, b, t]}, {b, ymax, -2, -(ymax + 2)/ny}];
redge[t_] := 
  Table[{X[4, b, t], Y[4, b, t]}, {b, ymax, -2, -(ymax + 2)/ny}];
highlight[t_] := {RGBColor["#f9a428"], PointSize[Medium], 
   Point[{X[0, ymax, t], Y[0, ymax, t]}], 
   Circle[{0, ymax}, r[ymax, k]], 
   Point[{X[0, ys[[4]], t], Y[0, ys[[4]], t]}], 
   Circle[{0, ys[[4]]}, r[ys[[4]], k]]};
show[t_] := Show[
   Graphics[{RGBColor["#1fb4b8"], 
     Polygon[Join[surf[t], bot[t], ledge[t], redge[t]]]}],
   Graphics[{PointSize[Medium], Lighter[RGBColor["#47245e"], .1], 
     parts[t]}],
   Graphics[highlight[t]],
   PlotRange -> {2 {-1, 1}, 2 {-1, .1}}, ImagePadding -> 0];
Manipulate[show[t], {t, 0, 2 Pi/(k c)}]

Related: https://mathematica.stackexchange.com/questions/193480/animating-wave-motion-in-water — Michael E2, Dec 14 '20 at 22:15
Possibly related: https://mathematica.stackexchange.com/questions/134272/why-is-my-gif-shaky — Michael E2, Dec 14 '20 at 22:19

score 3 · Accepted Answer · answered Dec 14 '20 at 21:49

You could try using Show at a higher ImageSize and then use Rasterize to lower the image size like so:

k = 2 π/3;
c = Sqrt[9.82/k];
X[a_, b_, t_, k_ : k] := a + Exp[k*b]/kSin[k(a - ct)];
Y[a_, b_, t_, k_ : k] := b - Exp[kb]/kCos[k(a - c*t)];
r[b_, k_ : k] := Exp[k*b]/k;
ymax = -.3
ny = 10;
ys = Table[b, {b, ymax, -2, -(ymax + 2)/ny}];
parts[t_] := 
  Flatten[Table[
    Point[{X[a, b, t], Y[a, b, t]}], {a, -4, 4, .4}, {b, 
     ymax, -2, -(ymax + 2)/ny}], 1];
surf[t_] := Table[{X[a, ymax, t], Y[a, ymax, t]}, {a, -4, 4, .1}];
bot[t_] := Table[{X[a, -2, t], Y[a, -2, t]}, {a, -4, 4, .4}];
ledge[t_] := 
  Table[{X[-4, b, t], Y[-4, b, t]}, {b, ymax, -2, -(ymax + 2)/ny}];
redge[t_] := 
  Table[{X[4, b, t], Y[4, b, t]}, {b, ymax, -2, -(ymax + 2)/ny}];
highlight[t_] := {RGBColor["#f9a428"], PointSize[0.01], 
   Point[{X[0, ymax, t], Y[0, ymax, t]}], 
   Circle[{0, ymax}, r[ymax, k]], 
   Point[{X[0, ys[[4]], t], Y[0, ys[[4]], t]}], 
   Circle[{0, ys[[4]]}, r[ys[[4]], k]]};
show[t_] := 
  Rasterize[
   Show[Graphics[{RGBColor["#1fb4b8"], 
      Polygon[Join[surf[t], bot[t], ledge[t], redge[t]]]}], 
    Graphics[{PointSize[0.01], Lighter[RGBColor["#47245e"], .1], 
      parts[t]}], Graphics[highlight[t]], 
    PlotRange -> {2 {-1, 1}, 2 {-1, .1}}, ImageSize -> 1600, 
    ImagePadding -> 0], RasterSize -> 1600, ImageSize -> 800];
Manipulate[show[t], {t, 0, 2 Pi/(k c)}]

That works perfect, thanks! – InertialObserver Dec 15 '20 at 00:28 — InertialObserver, Dec 15 '20 at 00:28

Shaky Point[] objects in simple animation

1 Answers1