Mathematica Conversations 2: Alternative Expressions for Sequences with Mathematica

One of Mathematica's strengths is its adaptibility to various programming styles.

by Robert Dickau

Mathematica gives us many ways to accomplish a task. This adaptibility gives authors the opportunity to use expressions that optimize different criteria. If the audience includes students who have had traditional procedural programming, then the author might use procedural structures. [Maeder]. On the other hand, the author might be writing to optimize speed. In any case, it's useful for authors and students to see variations on Mathematica code.

In Martin's sequence article, the author defines a function gaps as

\(\(gaps[s_List]\  := 
\ \ \ \ \ 
      Table[s[\([k]\)]\  - \ s[\([k\  - \ 1]\)], \ {k, \ 2, \ Length[s]}]; 
    \)\)

The author then defines a function to recursively apply gaps a given number of times.

\(recursiveGaps[s_List, \ 1] := gaps[s]; 

    recursiveGaps[s_List, \ m_]\  := \ gaps[recursiveGaps[s, m - 1]]; \)

Instead, what about

gaps[s_List] := Rest[s - RotateRight[s]];

or perhaps

gaps[s_List] := Drop[s, 1]  -  Drop[s, -1]

as a possible expression? And then, selecting one of the above, we can write a function fixedPointForGaps as a variation on the recursiveGaps function.

\(\(\ fixedPointForGaps[L_] := 
\ \ \ \ \ 
      FixedPointList[gaps, L, 25, 
		\ \ 
        SameTest\  -> \ \((Apply[SameQ, #]&)\)]\)\)

Let's follow Martin's use of the Mathematica function Table to generate a list.

seq1[n_]  :=  Table[(a (a + 1))/2,  {a,  1,  n}]

Then we apply the fixedPointForGaps function and arrange the results in a table.

fixedPointForGaps[seq1[9]] // TableForm

Parenthetically,  I prefer this expression:

seq1[n_]  :=  (a (a  +  1))/2  /.  a  ->  Range[n]

The Range function is often overlooked as a useful way of generating a list, or a list of powers as shown in the next expression:

fixedPointForGaps[Range[8]^5] // TableForm

Some of the Mathematica functions used above can also be combined to generate the polygonal, sometimes called "figurate" numbers. [http://www.astro.virginia.edu:80/~eww6n/math/PolygonalNumber.html]

\(\(\ \(polygonNumbers[n_, lvl_] := 
	\ 
      Rest[FoldList[Plus, 0, 
			Range[1, lvl*\((n - 2)\), n - 2]]]; 
    \)\)\)

Here are the first ten square numbers:

polygonNumbers[4, 10]

Here are the first ten hexagonal numbers:

polygonNumbers[6, 10]

Now let's try to find the polynomials that generate the numbers for a particular class.

\(polygonPolynomial[s_]\  := 
\ \ 
      \(\(Fit[polygonNumbers[s, 10], 
		\ \ \ \ \ \ \ \ {1, n, n^2}, n] // 
            
		Chop\) // Rationalize\) // Together\)

polygonPolynomial[3]

This works for triangular numbers. The formula for hexagonal numbers is given by

polygonPolynomial[6]

Exploration with various values should suggest to students that for an s-sided polygon, the polynomial is (1/2) ((s - 2) (n^2) - (s - 4) n).

Finally, using Mathematica code shown in the initialization cells at the end of the article, we can see the polygonal numbers using the showPolygon function. For example, the seventh triangular number:

showPolygon[3, 7];

Here is the fifth square number:

showPolygon[4, 5];

Here is the ninth pentagonal number:

showPolygon[5, 9];

And here is the tenth hexagonal number:

showPolygon[6, 10];

Mathematica code for showing polygonal numbers

\(verts[n_] := 
	
      Table[{Cos[t], Sin[t]}, {t, 0, 1.99  π, 2  π/n}]\)

dist[{{x1_, y1_}, {x2_, y2_}}] := 
      (Sqrt[(((x1 - x2))^2) + (((y1 - y2))^2)])

\(angle[{{x1_, y1_}, {x2_, y2_}}] := 
      With[{ang = N[ArcTan[x1 - x2, y1 - y2]]}, 
		
        If[ang < 0, ang + 2.0  π, ang]]\)

\(\(dots[n_, lvl_] := 
	
      Module[{allverts = verts[n], v, angs, ds, 

          			\ \ \ \ \ \ \ \ \ \ \ \ \ \ rays, forinterp, units}, 
		\ 
        v = Rest[allverts]; 
		ds = Map[dist[{{1.0, 0.0}, #}]&, v]; 
        angs = Map[angle[{#, {1.0, 0.0}}]&, v]; 
        rays = lvl*ds*Map[{Cos[#], Sin[#]}&, angs]; 
        rays = Chop@Map[{1, 0} + #&, rays]; 

        forinterp = Partition[rays, 2, 1]; 

        units = Map[Subtract@@#&, forinterp]/lvl; 

        Union[Flatten[
            Map[Transpose[#[\([1]\)] + #[\([2]\)]*

                      								{Range[0, lvl], Range[0, lvl]}]&, 

              					Transpose[{Last/@forinterp, units}]], 1]]
		]; 
    \)\)

\(\(showPolygon[sides_, lvl_] := 
	
      Show[Graphics[{PointSize[0.03], Hue[0], Point[{1, 0}], 
				
            Table[{Hue[n/lvl], Point/@dots[sides, n]}, {n, 1, lvl - 1}]}], 

        		AspectRatio -> Automatic]; \)\)

REFERENCE

Maeder, R. E. The Mathematica Programmer. AP Professional, London, 1994

ABOUT THE AUTHOR

Robert Dickau is a former member of the technical staff in the Mathematica Education group at Wolfram Research, Inc., whose four years of experience with Mathematica includes writing and teaching Mathematica training courses, delivering Mathemtica seminars and demonstrations worldwide, and providing technical and marketing support for authors of Mathematica-based books, articles, courseware, and packages. He received a Master's degree in actuarial science from the University of Illinois and a Bachelor's degree in mathematics from California Polytechnic University.

Robert Dickau
pops@prairienet.org