(***********************************************************************
Mathematica-Compatible Notebook
This notebook can be used on any computer system with Mathematica 3.0,
MathReader 3.0, or any compatible application. The data for the notebook
starts with the line of stars above.
To get the notebook into a Mathematica-compatible application, do one of
the following:
* Save the data starting with the line of stars above into a file
with a name ending in .nb, then open the file inside the application;
* Copy the data starting with the line of stars above to the
clipboard, then use the Paste menu command inside the application.
Data for notebooks contains only printable 7-bit ASCII and can be
sent directly in email or through ftp in text mode. Newlines can be
CR, LF or CRLF (Unix, Macintosh or MS-DOS style).
NOTE: If you modify the data for this notebook not in a Mathematica-
compatible application, you must delete the line below containing the
word CacheID, otherwise Mathematica-compatible applications may try to
use invalid cache data.
For more information on notebooks and Mathematica-compatible
applications, contact Wolfram Research:
web: http://www.wolfram.com
email: info@wolfram.com
phone: +1-217-398-0700 (U.S.)
Notebook reader applications are available free of charge from
Wolfram Research.
***********************************************************************)
(*CacheID: 232*)
(*NotebookFileLineBreakTest
NotebookFileLineBreakTest*)
(*NotebookOptionsPosition[ 9247, 347]*)
(*NotebookOutlinePosition[ 10148, 378]*)
(* CellTagsIndexPosition[ 10104, 374]*)
(*WindowFrame->Normal*)
Notebook[{
Cell[CellGroupData[{
Cell[TextData[{
StyleBox["Mathematica",
FontSlant->"Italic"],
" Conversations 1: Sequences and ",
StyleBox["Mathematica",
FontSlant->"Italic"]
}], "Title",
Evaluatable->False,
AspectRatioFixed->True],
Cell["\<\
Students and teachers using Mathematica can immediately begin to \
explore patterns in sequences.\
\>", "Subsubtitle"],
Cell[TextData[StyleBox["by William B. Martin III",
FontSize->14]], "Section"],
Cell[TextData[{
"Since the invention of the counting numbers, sequences have been an \
important part of mathematics. Although many of the simplest problems in \
mathematics have to do with sequences, the study of sequences leads to \
results with significant implications. ",
StyleBox["Mathematica,",
FontSlant->"Italic"],
" with its easily defined recursive functions and ability to handle lists, \
is admirably suited to the study of sequences. In this article, I will show \
how to generate sequences and how to write ",
StyleBox["Mathematica",
FontSlant->"Italic"],
" functions to analyze them."
}], "Text"],
Cell["SEQUENCES GENERATED BY POLYNOMIALS", "Subsection"],
Cell[TextData[{
"Many simple sequences, such as the triangular numbers: 1, 3, 6, 10, . . \
., are generated with polynomials. In this case ",
Cell[BoxData[
\(TraditionalForm\`t\_n\)]],
" = ",
StyleBox["n",
FontSlant->"Italic"],
"(",
StyleBox["n",
FontSlant->"Italic"],
"+1)/2, ",
StyleBox["n",
FontSlant->"Italic"],
" = 1,2,3,... where ",
Cell[BoxData[
\(TraditionalForm\`t\_n\)]],
" is the ",
StyleBox["n",
FontSlant->"Italic"],
"th triangular number. In",
StyleBox[" Mathematica",
FontSlant->"Italic"],
":"
}], "Text"],
Cell[CellGroupData[{
Cell[BoxData[
\(seq1\ = \ Table[1\/2\ n\ \((n + 1)\), {n, 1, 10}]\)], "Input"],
Cell[BoxData[
\({1, 3, 6, 10, 15, 21, 28, 36, 45, 55}\)], "Output"]
}, Open ]],
Cell[TextData[{
"This is a list of the first 10 triangular numbers. (Unless otherwise \
stated, all of our polynomial-generated sequences will start with ",
StyleBox["n",
FontSlant->"Italic"],
" = 1, and ",
StyleBox["n",
FontSlant->"Italic"],
" will be incremented by 1.) \n\nSuppose we did not know the generating \
polynomial for the triangular numbers and were simply presented with the \
numbers 1,3,6,10,... . One of the basic tools of sequence analysis is to take \
differences between successive terms. The ",
StyleBox["gaps",
FontFamily->"Courier"],
" function will do this."
}], "Text"],
Cell[BoxData[
\(\(gaps[s_List] :=
Table[s\[LeftDoubleBracket]k + 1\[RightDoubleBracket] -
s\[LeftDoubleBracket]k\[RightDoubleBracket], {k, 1,
Length[s] - 1}]; \)\)], "Input"],
Cell[TextData[{
"Apply ",
StyleBox["gaps",
FontFamily->"Courier"],
" to our first output:"
}], "Text"],
Cell[CellGroupData[{
Cell[BoxData[
\(gaps[seq1]\)], "Input"],
Cell[BoxData[
\({2, 3, 4, 5, 6, 7, 8, 9, 10}\)], "Output"]
}, Open ]],
Cell[TextData[{
"We have an obvious pattern! Apply ",
StyleBox["gaps",
FontFamily->"Courier"],
" again."
}], "Text"],
Cell[CellGroupData[{
Cell[BoxData[
\(gaps[%]\)], "Input"],
Cell[BoxData[
\({1, 1, 1, 1, 1, 1, 1, 1}\)], "Output"]
}, Open ]],
Cell[TextData[{
"The differences become constant. In general, the ",
StyleBox["n",
FontSlant->"Italic"],
"th order differences of a sequence generated by an ",
StyleBox["n",
FontSlant->"Italic"],
"th degree polynomial are constants. Thus we have a test for the degree of \
the generating polynomial. It would be convenient to have a recursive ",
StyleBox["gaps",
FontFamily->"Courier"],
" function that would apply ",
StyleBox["gaps",
FontFamily->"Courier"],
" any number of times. We can define ",
StyleBox["recursiveGaps",
FontFamily->"Courier"],
" with the two commands:"
}], "Text"],
Cell[BoxData[
\(recursiveGaps[s_List, \ 1] := gaps[s]; \n
recursiveGaps[s_List, \ m_]\ := \ gaps[recursiveGaps[s, m - 1]]; \)],
"Input"],
Cell[TextData[{
"Now we can do two successive applications of ",
StyleBox["gaps",
FontFamily->"Courier"],
" to {1,3,6,...55}:"
}], "Text"],
Cell[CellGroupData[{
Cell[BoxData[
\(recursiveGaps[seq1, 2]\)], "Input"],
Cell[BoxData[
\({1, 1, 1, 1, 1, 1, 1, 1}\)], "Output"]
}, Open ]],
Cell[TextData[{
"The question remains of finding the generating polynomial. There are at \
least two ways of doing it. Assuming a second-degree polynomial, we could use \
the general quadratic\n\n ",
StyleBox["a",
FontSlant->"Italic"],
" ",
Cell[BoxData[
\(TraditionalForm\`n\^2\)]],
" + ",
StyleBox["b",
FontSlant->"Italic"],
" ",
StyleBox["n",
FontSlant->"Italic"],
" + ",
StyleBox["c",
FontSlant->"Italic"],
" = ",
Cell[BoxData[
\(TraditionalForm\`t\_n\)]],
",\n\nWe can substitute three pairs of values (",
StyleBox["n",
FontSlant->"Italic"],
", ",
Cell[BoxData[
\(TraditionalForm\`t\_n\)]],
") to get three equations in the three unknowns ",
StyleBox["a",
FontSlant->"Italic"],
", ",
StyleBox["b",
FontSlant->"Italic"],
" and ",
StyleBox["c",
FontSlant->"Italic"],
". This method is good practice for our students in solving systems of \
equations. "
}], "Text"]
}, Open ]],
Cell[TextData[{
"Students should also be encouraged to pursue more elegant methods for \
studying integer sequences. For example, the following expression gives the ",
StyleBox["n",
FontSlant->"Italic"],
"th term of the ",
StyleBox["k",
FontSlant->"Italic"],
"th-order differences for the sequence {",
Cell[BoxData[
\(TraditionalForm\`s\_n\)]],
"}:"
}], "Text"],
Cell["diffTerm[s_List, n_, l_] := recursiveGaps[s, l][[n]]; ", "Input"],
Cell[TextData[{
"The next expression (Sloane 1973) gives the (",
StyleBox["n",
FontSlant->"Italic"],
StyleBox[" + 1)",
FontSize->13],
" term of a quadratic sequence {",
Cell[BoxData[
\(TraditionalForm\`s\_n\)]],
"} for which a formula is not known:"
}], "Text"],
Cell[BoxData[
\(\(nTerm[s_List, n_]\ := \
s[\([1]\)]\ + \ diffTerm[s, \ 1, 1]\ Binomial[n, \ 1]\n\t\t + \
diffTerm[s, \ 1, 2]\ Binomial[n, \ 2]; \)\)], "Input"],
Cell["Take, for example, the sequence of triangular numbers.", "Text"],
Cell[BoxData[
\(\(tn10\ = \ {1, 3, 6, 10, 15, 21, 28, 36, 45, 55}; \)\)], "Input"],
Cell[CellGroupData[{
Cell[BoxData[
\(nTerm[tn10, \ 4]\)], "Input"],
Cell[BoxData[
\(15\)], "Output"]
}, Open ]],
Cell[TextData[{
"Substituting ",
StyleBox["n",
FontSlant->"Italic"],
" - 1 to get the general ",
StyleBox["n",
FontSlant->"Italic"],
"th term:"
}], "Text"],
Cell[CellGroupData[{
Cell[BoxData[
\(nTerm[tn10, \ n - 1] // Together\)], "Input"],
Cell[BoxData[
\(1\/2\ \((n + n\^2)\)\)], "Output"]
}, Open ]],
Cell["\<\
Students can create arbitrary quadratic expressions and test them \
with this formula. They can be encouraged to explore a generalization of the \
formula and test it on higher-order expressions, including square and \
pentagonal numbers. The Fibonacci numbers also provide an interesting test.\
\
\>", "Text"],
Cell["ABOUT THE AUTHOR", "Subsubsection"],
Cell["\<\
William B. Martin III is a mathematics instructor at Pima Community \
College, Arizona.
William B. Martin III
Pima Community College
8181 East Irvington Road
Tucson, Arizona 85709-4000
wmartin@pcc.edu
\
\>", "Text"]
},
FrontEndVersion->"NeXT 3.0",
ScreenRectangle->{{0, 1053}, {0, 832}},
WindowToolbars->{},
CellGrouping->Manual,
WindowSize->{571, 451},
WindowMargins->{{18, Automatic}, {Automatic, -2}},
PrivateNotebookOptions->{"ColorPalette"->{RGBColor, 128}},
ShowCellLabel->True,
ShowCellTags->False,
RenderingOptions->{"ObjectDithering"->True,
"RasterDithering"->False},
CharacterEncoding->"MacintoshAutomaticEncoding"
]
(***********************************************************************
Cached data follows. If you edit this Notebook file directly, not using
Mathematica, you must remove the line containing CacheID at the top of
the file. The cache data will then be recreated when you save this file
from within Mathematica.
***********************************************************************)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[1731, 51, 217, 8, 174, "Title"],
Cell[1951, 61, 128, 3, 67, "Subsubtitle"],
Cell[2082, 66, 79, 1, 48, "Section"],
Cell[2164, 69, 630, 13, 94, "Text"],
Cell[2797, 84, 56, 0, 43, "Subsection"],
Cell[2856, 86, 588, 24, 46, "Text"],
Cell[CellGroupData[{
Cell[3469, 114, 83, 1, 42, "Input"],
Cell[3555, 117, 71, 1, 26, "Output"]
}, Open ]],
Cell[3641, 121, 621, 15, 112, "Text"],
Cell[4265, 138, 207, 4, 26, "Input"],
Cell[4475, 144, 112, 5, 31, "Text"],
Cell[CellGroupData[{
Cell[4612, 153, 43, 1, 26, "Input"],
Cell[4658, 156, 62, 1, 26, "Output"]
}, Open ]],
Cell[4735, 160, 126, 5, 31, "Text"],
Cell[CellGroupData[{
Cell[4886, 169, 40, 1, 26, "Input"],
Cell[4929, 172, 58, 1, 26, "Output"]
}, Open ]],
Cell[5002, 176, 628, 18, 81, "Text"],
Cell[5633, 196, 148, 3, 41, "Input"],
Cell[5784, 201, 148, 5, 31, "Text"],
Cell[CellGroupData[{
Cell[5957, 210, 55, 1, 26, "Input"],
Cell[6015, 213, 58, 1, 26, "Output"]
}, Open ]],
Cell[6088, 217, 980, 38, 128, "Text"]
}, Open ]],
Cell[7083, 258, 392, 13, 46, "Text"],
Cell[7478, 273, 71, 0, 24, "Input"],
Cell[7552, 275, 287, 10, 48, "Text"],
Cell[7842, 287, 182, 3, 37, "Input"],
Cell[8027, 292, 70, 0, 30, "Text"],
Cell[8100, 294, 87, 1, 24, "Input"],
Cell[CellGroupData[{
Cell[8212, 299, 49, 1, 24, "Input"],
Cell[8264, 302, 36, 1, 24, "Output"]
}, Open ]],
Cell[8315, 306, 173, 8, 30, "Text"],
Cell[CellGroupData[{
Cell[8513, 318, 65, 1, 25, "Input"],
Cell[8581, 321, 54, 1, 41, "Output"]
}, Open ]],
Cell[8650, 325, 320, 6, 62, "Text"],
Cell[8973, 333, 41, 0, 40, "Subsubsection"],
Cell[9017, 335, 226, 10, 142, "Text"]
}
]
*)
(***********************************************************************
End of Mathematica Notebook file.
***********************************************************************)