File name:  pendulumwaves . nb

Code written by James Flaten, Luther College, Decorah, IA			flatja01@luther.edu
reference:  "Pendulum waves:  A lesson in aliasing," James A. Flaten and Kevin A. Parendo, Am. J. Phys. 69 (7), July 2001, pp. 778 – 782

This file simulates "pendulum waves" with colored dots that oscillate above and below a horizontal equilibrium line.  This simulation does not show the fit, just the "pendula."  Periods are selected so that in the time the leftmost dot undergoes 20 cycles, the next dot goes through 21, then next through 22, and so on.  Thus the dots which are started in phase eventually return to an in-phase condition but run through a fascinating series of intermediate patterns in the process.  After the full set of images has been generated, they may be animated by selecting them all then pressing Apple-y (on a Mac at least).  This was written in Mathematica 4 -- I'm not sure whether or not it will run with older versions of Mathematica.  When run, Mathematica typically complains a bit, then generates the expected images.  Once the images are generated, the file may either be saved with them (in which case they may be animated immediately upon loading) though this makes the file much larger.  Indeed, you may need to fiddle around with memory allocation for the front end and/or the kernel of Mathematica to get this to run.  Enjoy!

\(Here\ is\ the\ function\ derived\ in\ the\ paper\ \ used\ to\ move\ each\ dot\ back\ and\ forth\ at\ the\ appropriate\ frequency . \ \ The\ dot\ number\ "x"\ goes\ from\ 0\ to\ 14. \)

g[x_, t_] := 
      A*Cos[((2*Pi*x*t)/(T*d)) + ((2*Pi*t)/((T/NN)))]

\(Here\ are\ the\ parameters\ used\ in\ the\ simulation . 
		"A"\ is\ the\ amplitude . 
		"T"\ is\ the\ total\ cycling\ time, \ 
      called\ capital - 
        gamma\ in\ the\ paper . 
		"NN"\ is\ the\ number\ of\ oscillations\ of\ the\ left - 
        most\ dot\ in\ time\ T . 
		"d"\ is\ the\ spacing\ between\ \(\(dots\)\(.\)\)\)

A := 1
T := 20
NN := 20
d := 1

In the calculation,  
      the motion of each dot at each moment in time is placed in a table individually .   Then a series of images is generated from each table showing a single dot in oscillation .   At this point each dot is given a unique color .   Display of these individual one dot movies is suppressed .   Finally all 15 movies are shown at the same time .   See comments earlier about how to animate the series of images once they are generated.

\(For[p = 0, 
      p < \((80*5)\), \(p++\), 
{t0 = 
          Table[x, {x, 0, 0}], 
ta0 = 
          Table[g[x, p*T/\((80*5)\)], {x, 0, 
              0}], 
tb0 = {}, 
For[q = 1, 
          q < 2, \(q++\), 
{tb0 = 
              Append[tb0, 
                List[t0[\([q]\)], 
                  ta0[\([q]\)]]]}], 

t1 = Table[x, {x, 1, 1}], 
ta1 = 
          Table[g[x, p*T/\((80*5)\)], {x, 1, 
              1}], 
tb1 = {}, 
For[q = 1, 
          q < 2, \(q++\), 
{tb1 = 
              Append[tb1, 
                List[t1[\([q]\)], 
                  ta1[\([q]\)]]]}], 

t2 = Table[x, {x, 2, 2}], 
ta2 = 
          Table[g[x, p*T/\((80*5)\)], {x, 2, 
              2}], 
tb2 = {}, 
For[q = 1, 
          q < 2, \(q++\), 
{tb2 = 
              Append[tb2, 
                List[t2[\([q]\)], 
                  ta2[\([q]\)]]]}], 

t3 = Table[x, {x, 3, 3}], 
ta3 = 
          Table[g[x, p*T/\((80*5)\)], {x, 3, 
              3}], 
tb3 = {}, 
For[q = 1, 
          q < 2, \(q++\), 
{tb3 = 
              Append[tb3, 
                List[t3[\([q]\)], 
                  ta3[\([q]\)]]]}], 

t4 = Table[x, {x, 4, 4}], 
ta4 = 
          Table[g[x, p*T/\((80*5)\)], {x, 4, 
              4}], 
tb4 = {}, 
For[q = 1, 
          q < 2, \(q++\), 
{tb4 = 
              Append[tb4, 
                List[t4[\([q]\)], 
                  ta4[\([q]\)]]]}], 

t5 = Table[x, {x, 5, 5}], 
ta5 = 
          Table[g[x, p*T/\((80*5)\)], {x, 5, 
              5}], 
tb5 = {}, 
For[q = 1, 
          q < 2, \(q++\), 
{tb5 = 
              Append[tb5, 
                List[t5[\([q]\)], 
                  ta5[\([q]\)]]]}], 

t6 = Table[x, {x, 6, 6}], 
ta6 = 
          Table[g[x, p*T/\((80*5)\)], {x, 6, 
              6}], 
tb6 = {}, 
For[q = 1, 
          q < 
            2, \(q++\), 
{tb6 = 
              Append[tb6, 
                List[t6[\([q]\)], 
                  ta6[\([q]\)]]]}], 

t7 = Table[x, {x, 7, 7}], 
ta7 = 
          Table[g[x, p*T/\((80*5)\)], {x, 7, 
              7}], 
tb7 = {}, 
For[q = 1, 
          q < 2, \(q++\), 
{tb7 = 
              Append[tb7, 
                List[t7[\([q]\)], 
                  ta7[\([q]\)]]]}], 

t8 = Table[x, {x, 8, 8}], 
ta8 = 
          Table[g[x, p*T/\((80*5)\)], {x, 8, 
              8}], 
tb8 = {}, 
For[q = 1, 
          q < 2, \(q++\), 
{tb8 = 
              Append[tb8, 
                List[t8[\([q]\)], 
                  ta8[\([q]\)]]]}], 

t9 = Table[x, {x, 9, 9}], 
ta9 = 
          Table[g[x, p*T/\((80*5)\)], {x, 9, 
              9}], 
tb9 = {}, 
For[q = 1, 
          q < 2, \(q++\), 
{tb9 = 
              Append[tb9, 
                List[t9[\([q]\)], 
                  ta9[\([q]\)]]]}], 

t10 = Table[x, {x, 10, 10}], 
ta10 = 
          Table[g[x, p*T/\((80*5)\)], {x, 10, 
              10}], 
tb10 = {}, 
For[
          q = 1, q < 
            2, \(q++\), 
{tb10 = 
              Append[tb10, 
                List[t10[\([q]\)], 
                  ta10[\([q]\)]]]}], 

t11 = 
          Table[x, {x, 11, 11}], 
ta11 = 
          Table[g[x, p*T/\((80*5)\)], {x, 11, 
              11}], 
tb11 = {}, 
For[
          q = 1, q < 
            2, \(q++\), 
{tb11 = 
              Append[tb11, 
                List[t11[\([q]\)], 
                  ta11[\([q]\)]]]}], 

t12 = 
          Table[x, {x, 12, 12}], 
ta12 = 
          Table[g[x, p*T/\((80*5)\)], {x, 12, 
              12}], 
tb12 = {}, 
For[
          q = 1, q < 
            2, \(q++\), 
{tb12 = 
              Append[tb12, 
                List[t12[\([q]\)], 
                  ta12[\([q]\)]]]}], 

t13 = 
          Table[x, {x, 13, 13}], 
ta13 = 
          Table[
            g[x, p*T/\((80*5)\)], {x, 13, 
              13}], 
tb13 = {}, 
For[
          q = 1, q < 
            2, \(q++\), 
{tb13 = 
              Append[tb13, 
                List[t13[\([q]\)], 
                  ta13[\([q]\)]]]}], 

t14 = 
          Table[x, {x, 14, 14}], 
ta14 = 
          Table[g[x, p*T/\((80*5)\)], {x, 14, 
              14}], 
tb14 = {}, 
For[
          q = 1, q < 
            2, \(q++\), 
{tb14 = 
              Append[tb14, 
                List[t14[\([q]\)], ta14[\([q]\)]]]}], 


        t0plot = 
          ListPlot[tb0, {PlotStyle -> {RGBColor[1, 0, 0], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t1plot = 
          ListPlot[
            tb1, {PlotStyle -> {RGBColor[0.8, 0.2, 0], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t2plot = 
          ListPlot[
            tb2, {PlotStyle -> {RGBColor[0.6, 0.4, 0], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t3plot = 
          ListPlot[
            tb3, {PlotStyle -> {RGBColor[0.4, 0.6, 0], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t4plot = 
          ListPlot[
            tb4, {PlotStyle -> {RGBColor[0.2, 0.8, 0], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t5plot = 
          ListPlot[tb5, {PlotStyle -> {RGBColor[0, 1, 0], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t6plot = 
          ListPlot[
            tb6, {PlotStyle -> {RGBColor[0, 0.8, 0.2], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t7plot = 
          ListPlot[
            tb7, {PlotStyle -> {RGBColor[0, 0.6, 0.4], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t8plot = 
          ListPlot[
            tb8, {PlotStyle -> {RGBColor[0, 0.4, 0.6], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t9plot = 
          ListPlot[
            tb9, {PlotStyle -> {RGBColor[0, 0.2, 0.8], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t10plot = 
          ListPlot[
            tb10, {PlotStyle -> {RGBColor[0, 0, 1], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t11plot = 
          ListPlot[
            tb11, {PlotStyle -> {RGBColor[0.2, 0, 0.8], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t12plot = 
          ListPlot[
            tb12, {PlotStyle -> {RGBColor[0.4, 0, 0.6], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t13plot = 
          ListPlot[
            tb13, {PlotStyle -> {RGBColor[0.6, 0, 0.4], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> Identity], 
t14plot = 
          ListPlot[
            tb14, {PlotStyle -> {RGBColor[0.8, 0, 0.2], PointSize[0.035]}}, 
            Background -> GrayLevel[0.9], 
            DisplayFunction -> 
              Identity], 

Show[t0plot, 
          t1plot, t2plot, t3plot, t4plot, 
t5plot, t6plot, 
          t7plot, t8plot, t9plot, 
t10plot, t11plot, 
          t12plot, t13plot, 
          t14plot, 
PlotRange -> {\(-1.1\), 1.1}, 
          Frame -> True, 
          DisplayFunction -> $DisplayFunction]
}]\)