(*********************************************************************** Mathematica-Compatible Notebook This notebook can be used on any computer system with Mathematica 4.0, MathReader 4.0, or any compatible application. The data for the notebook starts with the line containing 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[ 34371, 1052]*) (*NotebookOutlinePosition[ 35109, 1078]*) (* CellTagsIndexPosition[ 35065, 1074]*) (*WindowFrame->Normal*) Notebook[{ Cell["Karl Friedrich Finds a Pattern", "Title"], Cell["\<\ by David Park djmp@earthlink.net http://home.earthlink.net/~djmp/\ \>", "Subsubtitle"], Cell[CellGroupData[{ Cell["1. A young boy and a difficult teacher", "Section"], Cell["\<\ One of the great mathematicians of all times was Karl Friedrich Gauss. He \ took his first arithmetic class when he was seven years old. The teacher, a \ man named B\[UDoubleDot]ttner, loved to make life miserable for his students. \ He would even thrash them at every opportunity. This is a story Gauss himself \ liked to tell in his old age. Of course, he may have embellished it a bit \ over the years.\ \>", "Text"], Cell[TextData[{ "One day B\[UDoubleDot]ttner decided he would keep the students busy while \ he would attend to his own interests. He told the students to add all the \ numbers from 1 to 100. The students knew nothing about advanced arithmetic \ and had only one way of doing it. Let's see: 1 + 2 = 3, 3 + 3 = 6, 6 + 4 = \ 10, 10 + Oh, what was the last number we used? Well, you can see that it is a \ tedious calculation. And in those days there was no ", StyleBox["Mathematica", FontSlant->"Italic"], ". After all, it was only 1784. In those days all that the students had \ were slates which they could write on with chalk. When they had the answer, \ each would bring their slate up and lay it on the teacher's desk, one on top \ of the other. B\[UDoubleDot]ttner was full of glee with the misery he was \ causing the students." }], "Text"], Cell["\<\ But B\[UDoubleDot]ttner had no longer settled down than Karl Friedrich walked \ up, flung his slate onto the desk and said: \"Ligget se.\" - \"There it lies.\ \" He then sat down and folded his hands at his desk. It was a long time \ before another student brought up his slate, and then slowly, one by one, \ with a rush toward the end of the hour, the other students brought up their \ slates. B\[UDoubleDot]ttner looked at the top slate. The answer was wrong. \ The next one was wrong. Wrong, wrong, wrong! They were all wrong. Until he \ came to the bottom slate, Karl Friedrich's slate. It had the correct \ answer.\ \>", "Text"], Cell["\<\ Do you know how Karl Friedrich Gauss was able to solve the problem so quickly \ - and get the correct answer? He did it by finding a pattern. Do you know \ what the pattern is? Once you see the pattern, the problem is easy. Without \ the pattern, it is futile drudgery. Finding patterns is the very essence of \ good mathematics.\ \>", "Text"], Cell[TextData[{ "We are going to use ", StyleBox["Mathematica", FontSlant->"Italic"], " to help see the pattern. It also gives us the opportunity to learn a few \ tricks of ", StyleBox["Mathematica", FontSlant->"Italic"], "." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "2. Some ", StyleBox["Mathematica", FontSlant->"Italic"], " operations" }], "Section"], Cell[TextData[{ "Let's look at a few things in ", StyleBox["Mathematica", FontSlant->"Italic"], " that we will need to find Karl Friedrich's pattern. You may already know \ some of these commands. But if you are a beginner at ", StyleBox["Mathematica", FontSlant->"Italic"], " it never hurts to review them. First, we need a sequence of numbers. We \ can generate a sequence of numbers, starting at 1, very simply with the Range \ function. Say we want the numbers 1 to 10." }], "Text"], Cell[BoxData[ \(Range[10]\)], "Input"], Cell[TextData[{ "Here is a tip about using ", StyleBox["Mathematica", FontSlant->"Italic"], ". Whenever you are introduced to a new command, it pays to look at the \ Help for the command. Often the command is more versatile than the form you \ are introduced to. Help will also lead you to other similar commands which \ might be more appropriate. The extra capability might come in handy in the \ future. You can put the cursor after Range, or select Range, in the above \ statement and press F1. Or you can get a quick description this way." }], "Text"], Cell[BoxData[ \(\(?Range\)\)], "Input"], Cell["\<\ So, if we wanted to generate a list of even numbers, we can do this:\ \>", "Text"], Cell[BoxData[ \(Range[2, 20, 2]\)], "Input"], Cell["\<\ Suppose we wanted to generate a list of numbers in reverse order. We could \ try this...\ \>", "Text"], Cell[BoxData[ \(Range[10, 1, \(-1\)]\)], "Input"], Cell[TextData[{ "It works. But if we check the documentation and read it carefully, it \ never says that this should work. It clearly states that the list should go \ from imin to imax, and that it stops when it gets a value greater than imax \ (not less than). Neither does the documentation ever give an example of going \ backwards. So, at best, this is what is called an undocumented feature of ", StyleBox["Mathematica", FontSlant->"Italic"], ". It might not work that way in a future version. But there is another way \ to reverse the order of a list of numbers which is documented." }], "Text"], Cell[BoxData[ \(Reverse[Range[10]]\)], "Input"], Cell["\<\ Another operation that will be helpful to us is displaying arrays of numbers \ in table form. Here are two equal length lists of numbers.\ \>", "Text"], Cell[BoxData[ \({Range[10], Range[11, 20]}\)], "Input"], Cell["It is much neater to display them in a table.", "Text"], Cell[BoxData[ \(TableForm[{Range[10], Range[11, 20]}]\)], "Input"], Cell[TextData[{ "But it is often more convenient to do it this way because TableForm is \ more of an afterthought. Lookup Section 2.1.3, Special Ways to Input \ Expressions in the ", StyleBox["Mathematica", FontSlant->"Italic"], " Book. " }], "Text"], Cell[BoxData[ \({Range[10], Range[11, 20]} // TableForm\)], "Input"], Cell["\<\ With a much longer list the table extends far off screen and we have to use \ horizontal scrolling to see all of it.\ \>", "Text"], Cell[BoxData[ \({Range[50], Range[51, 100]} // TableForm\)], "Input"], Cell["\<\ Did you look up TableForm in Help? As you can see in Help, it is a somewhat \ complicated command with many options which are also somewhat complicated. \ Here we use the option TableSpacing to put 1 space between rows and only 1/2 \ space between columns. We use the option TableAlignments to align the \ elements in each row to the right and the elements in each column to the \ bottom. Since TableForm has extra arguments in it i.e., the options, we need \ to make it into a pure function. You already know about pure functions, \ right?\ \>", "Text"], Cell[BoxData[ \({Range[50], Range[51, 100]} // TableForm[#, TableSpacing \[Rule] {1, 0.5}, TableAlignments \[Rule] {Right, Bottom}] &\)], "Input"], Cell[TextData[{ "In ", StyleBox["Mathematica", FontSlant->"Italic"], ", if we want to add the corresponding elements in two list, we can simply \ add the lists." }], "Text"], Cell[BoxData[ \({a1, a2, a3} + {b1, b2, b3}\)], "Input"], Cell["So now we have what we need to find Gauss's pattern.", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["3. Gauss's pattern", "Section"], Cell["\<\ So, can you find a pattern that will help you quickly add the numbers from 1 \ to 100? Let's spread the numbers out. Here we have added yet another option \ to TableForm. TableHeadings allows us to specify headings for each row and \ column. Here we have just put a heading on the row.\ \>", "Text"], Cell[BoxData[ \({Range[100]} // TableForm[#, TableSpacing \[Rule] {1, 0.5}, TableAlignments \[Rule] {Right, Bottom}, TableHeadings \[Rule] {{sum}, None}] &\)], "Input"], Cell["\<\ Do you see a pattern? Each entry increases by 1, but does that help us? We \ want to make something that is complicated into something that is simple. \ Well, if you are stuck on a problem, it is good to examine it every which \ way. Let's look at the problem backwards.\ \>", "Text"], Cell[BoxData[ \({Reverse[Range[100]]} // TableForm[#, TableSpacing \[Rule] {1, 0.5}, TableAlignments \[Rule] {Right, Bottom}, TableHeadings \[Rule] {{sum}, None}] &\)], "Input"], Cell["\<\ Does it help us if we sum the numbers in reverse order? It doesn't seem to. \ Look at those last two outputs. Think! Think! Think! Maybe if we put them \ together.\ \>", "Text"], Cell[BoxData[ \({Range[100], Reverse[Range[100]]} // TableForm[#, TableSpacing \[Rule] {1, 0.5}, TableAlignments \[Rule] {Right, Bottom}, TableHeadings \[Rule] {{sum, sum}, None}] &\)], "Input"], Cell["\<\ Do you see the pattern? How can we make a pattern that will really simplify \ the problem? Suppose we add down each column.\ \>", "Text"], Cell[BoxData[ \({Range[100], Reverse[Range[100]], Range[100] + Reverse[Range[100]]} // TableForm[#, TableSpacing \[Rule] {1, 0.5}, TableAlignments \[Rule] {Right, Bottom}, TableHeadings \[Rule] {{sum, sum, 2 sum}, None}] &\)], "Input"], Cell["\<\ Now we have a simple pattern. The numbers are all the same! We don't have to \ do 99 additions. We can do one multiplication. How many 101's are there? If \ you are in doubt, the top row just counts them. There are 100 of them. But \ notice that the bottom row is twice the sum because it contains each number \ twice. So our final answer is...\ \>", "Text"], Cell[BoxData[ \(100*101/2\)], "Input"], Cell["\<\ So, \"There it lies.\" That's the answer that Karl Friedrich wrote on his \ slate.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["4. Generalize, Generalize", "Section"], Cell["\<\ But once we get a pattern like that, we can easily generalize. Suppose we \ want to add the numbers from 1 to n, where n is a positive integer. Can you \ figure out the answer?\ \>", "Text"], Cell[CellGroupData[{ Cell["Adding the numbers from 1 to n", "Subsection"], Cell[TextData[{ "Now we can't directly display the numbers because we don't know what n is. \ But still we will have the top row that goes from 1 to n. The second row will \ go from n to 1. If we sum the two rows then each entry in the third row will \ be ", Cell[BoxData[ \(n + 1\)]], ". How many numbers are there? There are ", Cell[BoxData[ \(n\)]], " of them. So the answer will be ", Cell[BoxData[ \(n \((n + 1)\)/2\)]], ". That is the general formula for summing the first n integers." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["A Real Proof", "Subsection"], Cell["\<\ There is always a trouble maker. He makes his appearance and declares that \ you can't actually write down the numbers from 1 to n, since you don't know \ what n is. So then why are you justified in using Gauss's construction? How \ do you know it will work if n is a number with a billion digits in it? You \ can't try if for every n.\ \>", "Text"], Cell[TextData[{ "Since the positive integers n have a definite order, we can prove that \ Gauss's formula is true for all n. It is called Proof by Induction. Gauss's \ formula is certainly true if ", Cell[BoxData[ \(n \[Equal] 1\)]], ". Here the sum has only one term." }], "Text"], Cell[BoxData[ \(1 \[Equal] 1 \((1 + 1)\)/2\)], "Input"], Cell[TextData[{ "Now we can show that ", StyleBox["if Gauss's formula is true for a number n", Background->RGBColor[0.792996, 0.983993, 0.925994]], ", ", StyleBox["then it will also be true for the number ", Background->RGBColor[1, 1, 0]], Cell[BoxData[ \(m \[Equal] n + 1\)], Background->RGBColor[1, 1, 0]], ". We add one extra term to what we assume is the correct formula for the \ sum of integers from 1 to n." }], "Text"], Cell[BoxData[ \(\(n \((n + 1)\)\)\/2 + \((n + 1)\)\)], "Input"], Cell["Then substitute m-1 for n...", "Text"], Cell[BoxData[ \(% /. n \[Rule] m - 1\)], "Input"], Cell["... and Simplify.", "Text"], Cell[BoxData[ \(% // Simplify\)], "Input"], Cell[TextData[{ "Hence if the Gauss formula holds for n, it also holds for ", Cell[BoxData[ \(m\ \[Equal] \ n\ + \ 1\)]], ". Since we have already shown that it is true for ", Cell[BoxData[ \(n \[Equal] 1\)]], ", we now know that it is true for every other n. It is just like knocking \ down a row of dominoes." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Another little brain teaser for the adventurous", "Subsection"], Cell["\<\ What is the sum of the 100 numbers starting at 165, where each succeeding \ number increases by 23? The first few numbers would be...\ \>", "Text"], Cell[BoxData[ \(Range[165, 395, 23]\)], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[TextData[{ "5. The many ways to add numbers in ", StyleBox["Mathematica", FontSlant->"Italic"], " " }], "Section"], Cell[TextData[{ "There are usually many ways to solve a problem. Let's look at some of the \ ways we can add things in ", StyleBox["Mathematica", FontSlant->"Italic"], ". " }], "Text"], Cell[CellGroupData[{ Cell["The big \[Sum]", "Subsection"], Cell[TextData[{ "This is how a sum of integers from 1 to n is represented in ", StyleBox["Mathematica", FontSlant->"Italic"], "." }], "Text"], Cell[BoxData[ \(\[Sum]\+\(i = 1\)\%n i\)], "Input"], Cell[TextData[{ "The \[Sum] sign is the Greek letter capital sigma, which is the same as \ our S. Since S stands for Sum, it is used to indicate a sum of things. In \ this case, the thing being summed is the integer ", Cell[BoxData[ \(i\)]], ". Below the \[Sum] we indicate that ", Cell[BoxData[ \(i\)]], " begins at ", Cell[BoxData[ \(1\)]], " and above the \[Sum] we indicate that it ends at ", Cell[BoxData[ \(n\)]], ". You can enter the complete symbol by using the BasicInput palette. This \ is the same as our generalized Gauss problem. Note that ", StyleBox["Mathematica", FontSlant->"Italic"], " knows the answer. Suppose we want to do the specific problem. Then we can \ write" }], "Text"], Cell[BoxData[ \(\[Sum]\+\(i = 1\)\%100 i\)], "Input"], Cell["\<\ We can also write these without using the fancy \[Sum] symbol.\ \>", "Text"], Cell[BoxData[ \({Sum[i, {i, 1, n}], Sum[i, \ {i, \ 1, 100}]}\)], "Input"], Cell["Did you look up Sum in Help?", "Text"] }, Open ]], Cell[CellGroupData[{ Cell["Changing a List to a sum.", "Subsection"], Cell["\<\ Here is another way to do a sum. Do you know how Plus works? Here is a sum of \ two numbers in symbolic form.\ \>", "Text"], Cell[BoxData[ \(a + b\)], "Input"], Cell["Let's look at the FullForm.", "Text"], Cell[BoxData[ \(a + b // FullForm\)], "Input"], Cell[TextData[{ "Since ", StyleBox["Mathematica", FontSlant->"Italic"], " does not know what a and b are it has to leave it in this form, but it \ displays it as ", Cell[BoxData[ \(a + b\)]], ". See what happens if we put in numbers." }], "Text"], Cell[BoxData[ \(Plus[2, 3]\)], "Input"], Cell["\<\ Now here is a list of the same two numbers. Let's look at the FullForm.\ \>", "Text"], Cell[BoxData[ \({2, 3} // FullForm\)], "Input"], Cell[TextData[{ "Now, if List was Plus, instead of being List, then we would have the same \ expression as above and ", StyleBox["Mathematica", FontSlant->"Italic"], " would add them. But it is easy to do that. Just use a rule to change List \ to Plus. (Highlight /. and press F1 to find out how rules work, if you have \ not been introduced to them.)" }], "Text"], Cell[BoxData[ \({2, 3} /. List \[Rule] Plus\)], "Input"], Cell[TextData[{ "So here is the problem Gauss solved. In this case ", StyleBox["Mathematica", FontSlant->"Italic"], " actually adds up the numbers." }], "Text"], Cell[BoxData[ \(Range[100] /. List \[Rule] Plus\)], "Input"] }, Closed]], Cell[CellGroupData[{ Cell["Another, and better, way to change a List to a sum", "Subsection"], Cell["If we have any expression that starts with a head, like...", "Text"], Cell[BoxData[ \({a, b} // FullForm\)], "Input"], Cell["\<\ which has the head List, then we can change the head to something else by \ \"applying\" a new head. This is done with the command Apply. \ \>", "Text"], Cell[BoxData[ \(Apply[Plus, {a, b}]\)], "Input"], Cell[TextData[{ "Apply is such a powerful and useful operation that ", StyleBox["Mathematica", FontSlant->"Italic"], " has made a special notation for it so it can be done in a more natural \ way. It uses @@ to stand for Apply." }], "Text"], Cell[BoxData[ RowBox[{"Plus", StyleBox["@@", FontColor->RGBColor[1, 0, 0]], \({a, b}\)}]], "Input"], Cell["\<\ Did you look up Apply in Help? So now let's do Gauss's problem with Apply.\ \>", "Text"], Cell[BoxData[ \(Plus @@ Range[100]\)], "Input"], Cell["\<\ Seems to work. Did you figure out that little brain teaser? Here is a way to \ check it out using Apply. First lets generate the numbers. They start at 165 \ and go in steps of 23. We have to take 99 steps from the starting position to \ get 100 numbers.\ \>", "Text"], Cell[BoxData[ \(numbers = Range[165, 165 + 99*23, 23]\)], "Input"], Cell["Did we get 100 numbers? Check the length of the list.", "Text"], Cell[BoxData[ \(Length[numbers]\)], "Input"], Cell["So let's sum them up...", "Text"], Cell[BoxData[ \(Plus @@ numbers\)], "Input"], Cell["\<\ Using Gauss's method we see that the sum in each column (the sum of the first \ and last numbers in the list of numbers) is...\ \>", "Text"], Cell[BoxData[ \(165 + 2442\)], "Input"], Cell[TextData[{ "There was a little extra work in calculating the last number in the list. \ It is ", Cell[BoxData[ \(165 + 99*23 \[Equal] 2442\)]], ". There are 100 numbers so our answer is..." }], "Text"], Cell[BoxData[ \(100*2607/2\)], "Input"], Cell["Gee, you guys are really getting good at mathematics! ", "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["6. A B\[UDoubleDot]ttner tries for revenge", "Section"], Cell["\<\ Gauss's quick answer forever rankled in the B\[UDoubleDot]ttner family. In \ the 7th generation after the original B\[UDoubleDot]ttner, a \ great-great-great-great-great-great-great grandson, Adolph Bombastus B\ \[UDoubleDot]ttner, thought he had figured out how to ensure misery for his \ students. He wouldn't just tell the students to add the numbers from 1 to \ 100, but to also provide a running sum. No B\[UDoubleDot]ttner would ever \ again be embarrassed by some upstart student. \ \>", "Text"], Cell[TextData[{ "But the year was now 1998 and B\[UDoubleDot]ttner's students all had ", StyleBox["Mathematica", FontSlant->"Italic"], ". They were no slouches and quickly, one by one, their notebooks flew over \ the Internet and lay one after the other on B\[UDoubleDot]ttner's hard disk. \ He looked at the first one. It was correct. The next one was correct. \ Correct, correct, correct. They all were correct. B\[UDoubleDot]ttner had to \ keep up pretenses. He made believe he was miserable, just because the \ students weren't miserable. But secretly, in his heart, he was glad that all \ the students had gotten the right answer." }], "Text"] }, Closed]], Cell[CellGroupData[{ Cell["7. How B\[UDoubleDot]ttner's students did it", "Section"], Cell[CellGroupData[{ Cell["This is the method that half of B\[UDoubleDot]ttner's students used", \ "Subsection"], Cell[TextData[{ "In adding the numbers 1 to n, let's look at how we get from one partial \ sum to another. We can make a little list that tells us where we stand. It \ will look like this: ", Cell[BoxData[ \({last\ number\ added, \ partial\ sum\ at\ that\ point}\)]], ". How do we get to the next partial sum? Simple, we add one to the last \ number added, and we add the result to the last partial sum. We can make out \ own little function to do this." }], "Text"], Cell[BoxData[ \(sumupdate[{num_, sum_}] := {num + 1, sum + num + 1}\)], "Input"], Cell[TextData[{ "Our starting point is ", Cell[BoxData[ \({0, 0}\)]], ". The last number we used was zero, and the sum at that point was also \ zero. Now let's take one step." }], "Text"], Cell[BoxData[ \(sumupdate[{0, 0}]\)], "Input"], Cell["Let's take another step...", "Text"], Cell[BoxData[ \(sumupdate[{1, 1}]\)], "Input"], Cell["And another...", "Text"], Cell[BoxData[ \(sumupdate[{2, 3}]\)], "Input"], Cell[TextData[{ "Now we have to do this 97 more times to get our answer, writing down the \ step number and the partial sum. Ugh! Sounds like work. We hate work! But ", StyleBox["Mathematica", FontSlant->"Italic"], " has a neat little command that will do just what we want in one fell \ swoop. It is another one of those very powerful functions that all the in \ people know about. This is the command..." }], "Text"], Cell[BoxData[ \(\(?Nest\)\)], "Input"], Cell[TextData[{ "Our function f is sumupdate, our starting expr is ", Cell[BoxData[ \({0, 0}\)]], ", and n is 100 if we want to sum the numbers from 1 to 100. So let's try \ it and see if we get the right answer. We already know the answer by now." }], "Text"], Cell[BoxData[ \(Nest[sumupdate, {0, 0}, 100]\)], "Input"], Cell[TextData[{ "Looks right. But wait, B\[UDoubleDot]ttner didn't want just the final \ answer; he wanted all the partial sums. No sweat. ", StyleBox["Mathematica", FontSlant->"Italic"], " can handle that also. Did you look up Nest in Help? If you had you would \ have found that it contained a link to this routine..." }], "Text"], Cell[BoxData[ \(\(?NestList\)\)], "Input"], Cell["Let's try again with NestList.", "Text"], Cell[BoxData[ \(NestList[sumupdate, {0, 0}, 100]\)], "Input"], Cell["\<\ That's what we want! We can even present all the partial sums neatly in table \ form.\ \>", "Text"], Cell[BoxData[ \(NestList[sumupdate, {0, 0}, 100] // TableForm[#, TableHeadings \[Rule] {None, {"\", "\"}}, TableAlignments \[Rule] {Center, Bottom}, TableSpacing \[Rule] {1, 0.5}] &\)], "Input"], Cell["Take that B\[UDoubleDot]ttner!", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["This is the method the other half used", "Subsection"], Cell[TextData[{ StyleBox["Mathematica", FontSlant->"Italic"], " contains another function which makes generating the partial sums even \ easier." }], "Text"], Cell[BoxData[ \(\(?FoldList\)\)], "Input"], Cell["There is a companion function Fold.", "Text"], Cell[BoxData[ \(\(?Fold\)\)], "Input"], Cell["\<\ FoldList is a little difficult to grasp at first. Even though the \ documentation is as clear as can be, it is still slightly arcane and \ difficult to follow. So I will say a number of things about Fold and FoldList \ which I hope will make it clearer for you. First, Fold, just like Nest \ applies the function repeatedly to x. Each time, x is updated and replaced by \ the new x. Where Nest has a parameter, n, which tells how many times to apply \ f, Fold has a list. The number of times the function is applied is the Length \ of the list. Why the list? Because Fold is a generalization of Nest which \ allows f to have two arguments. The first argument is taken from the current \ value of x. The second argument is taken from the next unused item in the \ list. Figuratively speaking, f, one by one, folds the items in the list into \ x.\ \>", "Text"], Cell["\<\ Gauss's problem is a perfect example to illustrate Fold and FoldList. x will \ be the partial sum. The partial sums start at zero. The list will be our list \ of numbers, 1 to 100. And what should f be? Simple. At each step we just want \ to add the next number on the list to the partial sum. So f should be Plus. \ Let's try it.\ \>", "Text"], Cell[BoxData[ \(Fold[Plus, 0, Range[100]]\)], "Input"], Cell["\<\ That's our answer. Now, to get all the partial sums, we just use FoldList.\ \>", "Text"], Cell[BoxData[ \(FoldList[Plus, 0, Range[100]]\)], "Input"], Cell["\<\ So there are all our partial sums. B\[UDoubleDot]ttner is foiled again. In \ this case we just have the partial sums without the indices of each sum. But \ we can still make a nice table, if we wish, by adding the indices.\ \>", "Text"], Cell[BoxData[ \(Transpose[{Range[0, 100], FoldList[Plus, 0, Range[100]]}] // TableForm[#, TableHeadings \[Rule] {None, {"\", "\"}}, TableAlignments \[Rule] {Center, Bottom}, TableSpacing \[Rule] {1, 0.5}] &\)], "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["8. Triangular numbers", "Section"], Cell["\<\ This section of the notebook uses some routines, in the initialization \ section below, and some statements that draw some graphical arrays. The \ emphasis here is not how these routines work. We just want to use them to \ look at some more patterns.\ \>", "Text"], Cell["\<\ There are even more patterns. If we sum the numbers from 1 to n, for various \ values of n we obtain a special set of numbers. Let's look at the first few \ of them again. Do you know how to use Drop? We use it to get rid of the \ leading 0 in the previous list we produced.\ \>", "Text"], Cell[BoxData[ \(Drop[FoldList[Plus, 0, Range[12]], 1]\)], "Input"], Cell["\<\ The Greeks had a special name for these numbers. They called them triangular \ numbers. Can you see why? This shows how the Greeks made a pattern out of the \ first 12 triangular numbers.\ \>", "Text"], Cell[BoxData[ \(\(\(diagram1\)\(\ \)\)\)], "Input"], Cell["\<\ It is not that we couldn't arrange the dots in some other pattern. We could. \ The point is: if the number of dots is not a triangular number, then we can't \ arrange them in this nice triangular pattern. This shows how each triangular \ number is partitioned into the sum of integers from 1 to n.\ \>", "Text"], Cell[BoxData[ \(diagram2\)], "Input"], Cell["\<\ Here is another interesting fact about triangular numbers. Every triangular \ number is either a multiple of 3, or is a multiple of 3 plus one. Here is a \ way to see that. We connect our dots together in a different pattern.\ \>", "Text"], Cell[BoxData[ \(diagram3\)], "Input"], Cell["\<\ Here, the dots have been connected in triangular groups. The number of dots \ in each triangular group is a multiple of three. Can you make a little \ pattern to convince yourself of that? Remember that there are an equal number \ of dots on each side of the triangle. If we sum all the dots in each \ triangular group we will also obtain a multiple of three. But some of the \ triangles, those in the left column, have an extra dot in the center. In \ those cases the number of points is a multiple of three plus one.\ \>", "Text"], Cell[TextData[{ "Now, can you see a pattern that tells for which values of n there will be \ an extra dot? Scan across each row. Do you see a pattern? Do you see how a \ point, which we might regard as a degenerate triangle with only one point on \ each side, grows into a triangle with two points on each side, and then a \ triangle with three points on each side? At the next step we are back to a \ one point triangle in the center. It looks like every third case has a single \ extra point. In fact, the rule is that if we divide n by 3 and get a \ remainder of 1, then there is an extra point. The ", StyleBox["Mathematica", FontSlant->"Italic"], " function which finds such remainders is the Mod function. For example, \ looking at the ", Cell[BoxData[ \(n \[Equal] 10\)]], " case..." }], "Text"], Cell[BoxData[ \(Mod[10, 3]\)], "Input"], Cell["\<\ Did you look up Mod in Help? Let's see if this works for our 12 cases.\ \>", "Text"], Cell[BoxData[ \(\({#, Mod[#, 3] \[Equal] 1} &\) /@ Range[12]\)], "Input"], Cell["\<\ This will produce an animation of the first 12 triangular numbers. After it \ is produced, close up the group of graphics cells and double click the one \ that is left. You can then slow down the animation, and better yet, use the \ down arrow key to step through the diagrams one by one.\ \>", "Text"], Cell[BoxData[ \(Animate[triangletriangles[i], {i, 1, 12, 1}]\)], "Input"], Cell["\<\ Can you see how the new points are added to the triangles at each step?\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["9. A final note", "Section"], Cell[TextData[{ "You can find out more about Gauss on the Internet at\n ", ButtonBox["http://www-groups.dcs.st-and.ac.uk/~history/Mathematicians/Gauss.\ html", ButtonData:>{ URL[ "http://www-groups.dcs.st-and.ac.uk/~history/Mathematicians/Gauss.html"]\ , None}, ButtonStyle->"Hyperlink"], " ." }], "Text"], Cell["\<\ The basic story comes from Eric Temple Bell's biography of Gauss \"The Prince \ of Mathematicians\" as published in \"The World of Mathematics, Volume 1\" \ edited by James R. Newman.\ \>", "Text"], Cell["\<\ The original B\[UDoubleDot]ttner was not entirely bad. Recognizing Gauss's \ ability he bought for Gauss the best mathematics book he could find, and B\ \[UDoubleDot]ttner's assistant Martin Bartels was able to introduce Gauss to \ other mathematicians and notables who gave him much help. \ B\[UDoubleDot]ttner's great-great.... grandson is a figment of my \ imagination.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Initialization Routines", "Section", InitializationCell->True], Cell[BoxData[ \(Needs["\"]\)], "Input", InitializationCell->True], Cell[BoxData[ \(f1[i_] := Flatten[Outer[List, Range[\(1 - i\)\/2, 1\/2\ \((\(-1\) + i)\)], {1\/2 - i\/2}], 1]\)], "Input", InitializationCell->True], Cell[BoxData[ \(text1[n_] := Text[StringForm["\", \ n, n \((n + 1)\)/2], {0, \(-7\)}]\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(trianglepoints[n_] := \[IndentingNewLine]Show[ Graphics[\n\t\t{AbsolutePointSize[4], Table[Point /@ \((f1[i])\), \ {i, n}], \[IndentingNewLine]text1[ n]}], \n\nAspectRatio \[Rule] Automatic, PlotRange \[Rule] {{\(-6\), 6}, {\(-7.5\), 1/2}}, \n{}];\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(trianglelines[n_] := \[IndentingNewLine]Show[ Graphics[\n\t\t{AbsolutePointSize[4], Table[Point /@ \((f1[i])\), \ {i, n}], \[IndentingNewLine]RGBColor[0, 0, 1], Table[Line[f1[i]], \ {i, n}], \[IndentingNewLine]GrayLevel[0], text1[n]}], \n\nAspectRatio \[Rule] Automatic, PlotRange \[Rule] {{\(-6\), 6}, {\(-7.5\), 1/2}}, \n{}];\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(\(triangletriangles[n_] := \[IndentingNewLine]Show[ Graphics[\n\t\t{AbsolutePointSize[4], Table[Point /@ \((f1[i])\), \ {i, n}], \[IndentingNewLine]RGBColor[0, 0, 1], Table[Line[{{0, 1 - k}, {\(-\((\((n + 2 - 3 k)\)/2)\)\), \((k - n)\)/ 2}, {\((\((n + 2 - 3 k)\)/2)\), \((k - n)\)/2}, {0, 1 - k}}], \ {k, 1, Floor[\((n + 2)\)/3]}], \[IndentingNewLine]GrayLevel[0], text1[n]}], \n\nAspectRatio \[Rule] Automatic, PlotRange \[Rule] {{\(-6\), 6}, {\(-7.5\), 1/2}}, \n{}];\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(diagram1 := \((Block[{$DisplayFunction = Identity}, \[IndentingNewLine]Clear[p]; \[IndentingNewLine]Do[ Evaluate[p[i]] = trianglepoints[i], {i, 12}]]; \[IndentingNewLine]Show[ GraphicsArray[Partition[Table[p[i], {i, 1, 12}], 3]], ImageSize \[Rule] 500];)\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(diagram2 := \((Block[{$DisplayFunction = Identity}, \[IndentingNewLine]Clear[p]; \[IndentingNewLine]Do[ Evaluate[p[i]] = trianglelines[i], {i, 12}]]; \[IndentingNewLine]Show[ GraphicsArray[Partition[Table[p[i], {i, 1, 12}], 3]], ImageSize \[Rule] 500];)\)\)], "Input", InitializationCell->True], Cell[BoxData[ \(diagram3 := \((Block[{$DisplayFunction = Identity}, \[IndentingNewLine]Clear[p]; \[IndentingNewLine]Do[ Evaluate[p[i]] = triangletriangles[i], {i, 12}]]; \[IndentingNewLine]Show[ GraphicsArray[Partition[Table[p[i], {i, 1, 12}], 3]], ImageSize \[Rule] 500];)\)\)], "Input", InitializationCell->True] }, Closed]] }, FrontEndVersion->"4.0 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 683}}, AutoGeneratedPackage->None, WindowSize->{881, 631}, WindowMargins->{{-1, Automatic}, {Automatic, 0}}, Magnification->1.5, StyleDefinitions -> "Classroom.nb" ] (*********************************************************************** 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[1717, 49, 47, 0, 81, "Title"], Cell[1767, 51, 96, 4, 138, "Subsubtitle"], Cell[CellGroupData[{ Cell[1888, 59, 57, 0, 83, "Section"], Cell[1948, 61, 429, 7, 119, "Text"], Cell[2380, 70, 855, 14, 223, "Text"], Cell[3238, 86, 644, 10, 171, "Text"], Cell[3885, 98, 353, 6, 119, "Text"], Cell[4241, 106, 255, 9, 67, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[4533, 120, 112, 5, 51, "Section"], Cell[4648, 127, 504, 11, 119, "Text"], Cell[5155, 140, 42, 1, 72, "Input"], Cell[5200, 143, 566, 10, 145, "Text"], Cell[5769, 155, 43, 1, 72, "Input"], Cell[5815, 158, 92, 2, 41, "Text"], Cell[5910, 162, 48, 1, 72, "Input"], Cell[5961, 165, 112, 3, 41, "Text"], Cell[6076, 170, 53, 1, 72, "Input"], Cell[6132, 173, 611, 10, 171, "Text"], Cell[6746, 185, 51, 1, 72, "Input"], Cell[6800, 188, 161, 3, 67, "Text"], Cell[6964, 193, 59, 1, 72, "Input"], Cell[7026, 196, 61, 0, 41, "Text"], Cell[7090, 198, 70, 1, 72, "Input"], Cell[7163, 201, 260, 7, 67, "Text"], Cell[7426, 210, 72, 1, 72, "Input"], Cell[7501, 213, 140, 3, 41, "Text"], Cell[7644, 218, 73, 1, 72, "Input"], Cell[7720, 221, 564, 9, 145, "Text"], Cell[8287, 232, 168, 3, 124, "Input"], Cell[8458, 237, 183, 6, 41, "Text"], Cell[8644, 245, 60, 1, 72, "Input"], Cell[8707, 248, 68, 0, 41, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[8812, 253, 37, 0, 51, "Section"], Cell[8852, 255, 309, 5, 93, "Text"], Cell[9164, 262, 201, 4, 150, "Input"], Cell[9368, 268, 294, 5, 93, "Text"], Cell[9665, 275, 210, 4, 150, "Input"], Cell[9878, 281, 187, 4, 67, "Text"], Cell[10068, 287, 227, 4, 150, "Input"], Cell[10298, 293, 147, 3, 67, "Text"], Cell[10448, 298, 269, 4, 176, "Input"], Cell[10720, 304, 368, 6, 119, "Text"], Cell[11091, 312, 42, 1, 72, "Input"], Cell[11136, 315, 106, 3, 41, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[11279, 323, 44, 0, 51, "Section"], Cell[11326, 325, 200, 4, 67, "Text"], Cell[CellGroupData[{ Cell[11551, 333, 52, 0, 68, "Subsection"], Cell[11606, 335, 535, 14, 119, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[12178, 354, 34, 0, 42, "Subsection"], Cell[12215, 356, 359, 6, 93, "Text"], Cell[12577, 364, 293, 7, 67, "Text"], Cell[12873, 373, 59, 1, 72, "Input"], Cell[12935, 376, 456, 12, 93, "Text"], Cell[13394, 390, 67, 1, 95, "Input"], Cell[13464, 393, 44, 0, 41, "Text"], Cell[13511, 395, 53, 1, 72, "Input"], Cell[13567, 398, 33, 0, 41, "Text"], Cell[13603, 400, 46, 1, 72, "Input"], Cell[13652, 403, 347, 9, 67, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[14036, 417, 69, 0, 42, "Subsection"], Cell[14108, 419, 157, 3, 67, "Text"], Cell[14268, 424, 52, 1, 72, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[14369, 431, 129, 5, 51, "Section"], Cell[14501, 438, 194, 6, 67, "Text"], Cell[CellGroupData[{ Cell[14720, 448, 36, 0, 68, "Subsection"], Cell[14759, 450, 151, 5, 41, "Text"], Cell[14913, 457, 55, 1, 104, "Input"], Cell[14971, 460, 748, 21, 145, "Text"], Cell[15722, 483, 57, 1, 107, "Input"], Cell[15782, 486, 86, 2, 41, "Text"], Cell[15871, 490, 77, 1, 72, "Input"], Cell[15951, 493, 44, 0, 41, "Text"] }, Open ]], Cell[CellGroupData[{ Cell[16032, 498, 47, 0, 68, "Subsection"], Cell[16082, 500, 133, 3, 41, "Text"], Cell[16218, 505, 38, 1, 72, "Input"], Cell[16259, 508, 43, 0, 41, "Text"], Cell[16305, 510, 50, 1, 72, "Input"], Cell[16358, 513, 266, 9, 67, "Text"], Cell[16627, 524, 43, 1, 72, "Input"], Cell[16673, 527, 95, 2, 41, "Text"], Cell[16771, 531, 51, 1, 72, "Input"], Cell[16825, 534, 374, 8, 93, "Text"], Cell[17202, 544, 60, 1, 72, "Input"], Cell[17265, 547, 170, 5, 41, "Text"], Cell[17438, 554, 64, 1, 72, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[17539, 560, 72, 0, 42, "Subsection"], Cell[17614, 562, 74, 0, 41, "Text"], Cell[17691, 564, 51, 1, 72, "Input"], Cell[17745, 567, 162, 3, 67, "Text"], Cell[17910, 572, 52, 1, 72, "Input"], Cell[17965, 575, 250, 6, 67, "Text"], Cell[18218, 583, 118, 3, 72, "Input"], Cell[18339, 588, 98, 2, 41, "Text"], Cell[18440, 592, 51, 1, 72, "Input"], Cell[18494, 595, 278, 5, 93, "Text"], Cell[18775, 602, 70, 1, 72, "Input"], Cell[18848, 605, 69, 0, 41, "Text"], Cell[18920, 607, 48, 1, 72, "Input"], Cell[18971, 610, 39, 0, 41, "Text"], Cell[19013, 612, 48, 1, 72, "Input"], Cell[19064, 615, 150, 3, 67, "Text"], Cell[19217, 620, 43, 1, 72, "Input"], Cell[19263, 623, 218, 6, 67, "Text"], Cell[19484, 631, 43, 1, 72, "Input"], Cell[19530, 634, 70, 0, 41, "Text"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[19649, 640, 61, 0, 51, "Section"], Cell[19713, 642, 512, 8, 119, "Text"], Cell[20228, 652, 658, 11, 145, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[20923, 668, 63, 0, 51, "Section"], Cell[CellGroupData[{ Cell[21011, 672, 91, 1, 68, "Subsection"], Cell[21105, 675, 478, 9, 145, "Text"], Cell[21586, 686, 84, 1, 72, "Input"], Cell[21673, 689, 199, 6, 67, "Text"], Cell[21875, 697, 50, 1, 72, "Input"], Cell[21928, 700, 42, 0, 41, "Text"], Cell[21973, 702, 50, 1, 72, "Input"], Cell[22026, 705, 30, 0, 41, "Text"], Cell[22059, 707, 50, 1, 72, "Input"], Cell[22112, 710, 428, 8, 119, "Text"], Cell[22543, 720, 42, 1, 72, "Input"], Cell[22588, 723, 272, 6, 67, "Text"], Cell[22863, 731, 61, 1, 72, "Input"], Cell[22927, 734, 342, 7, 93, "Text"], Cell[23272, 743, 46, 1, 72, "Input"], Cell[23321, 746, 46, 0, 41, "Text"], Cell[23370, 748, 65, 1, 72, "Input"], Cell[23438, 751, 109, 3, 41, "Text"], Cell[23550, 756, 259, 5, 124, "Input"], Cell[23812, 763, 46, 0, 41, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[23895, 768, 60, 0, 42, "Subsection"], Cell[23958, 770, 165, 5, 41, "Text"], Cell[24126, 777, 46, 1, 72, "Input"], Cell[24175, 780, 51, 0, 41, "Text"], Cell[24229, 782, 42, 1, 72, "Input"], Cell[24274, 785, 868, 13, 223, "Text"], Cell[25145, 800, 354, 6, 93, "Text"], Cell[25502, 808, 58, 1, 72, "Input"], Cell[25563, 811, 98, 2, 41, "Text"], Cell[25664, 815, 62, 1, 72, "Input"], Cell[25729, 818, 246, 4, 67, "Text"], Cell[25978, 824, 284, 5, 124, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[26311, 835, 40, 0, 51, "Section"], Cell[26354, 837, 274, 5, 93, "Text"], Cell[26631, 844, 298, 5, 93, "Text"], Cell[26932, 851, 70, 1, 72, "Input"], Cell[27005, 854, 211, 4, 67, "Text"], Cell[27219, 860, 55, 1, 72, "Input"], Cell[27277, 863, 321, 5, 93, "Text"], Cell[27601, 870, 41, 1, 72, "Input"], Cell[27645, 873, 249, 4, 67, "Text"], Cell[27897, 879, 41, 1, 72, "Input"], Cell[27941, 882, 542, 8, 145, "Text"], Cell[28486, 892, 822, 16, 197, "Text"], Cell[29311, 910, 43, 1, 72, "Input"], Cell[29357, 913, 94, 2, 41, "Text"], Cell[29454, 917, 77, 1, 72, "Input"], Cell[29534, 920, 312, 5, 93, "Text"], Cell[29849, 927, 77, 1, 72, "Input"], Cell[29929, 930, 95, 2, 41, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[30061, 937, 34, 0, 51, "Section"], Cell[30098, 939, 333, 10, 79, "Text"], Cell[30434, 951, 207, 4, 67, "Text"], Cell[30644, 957, 396, 7, 93, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[31077, 969, 70, 1, 51, "Section", InitializationCell->True], Cell[31150, 972, 93, 2, 72, "Input", InitializationCell->True], Cell[31246, 976, 181, 5, 95, "Input", InitializationCell->True], Cell[31430, 983, 166, 4, 98, "Input", InitializationCell->True], Cell[31599, 989, 381, 7, 228, "Input", InitializationCell->True], Cell[31983, 998, 494, 9, 254, "Input", InitializationCell->True], Cell[32480, 1009, 724, 13, 332, "Input", InitializationCell->True], Cell[33207, 1024, 380, 7, 176, "Input", InitializationCell->True], Cell[33590, 1033, 379, 7, 176, "Input", InitializationCell->True], Cell[33972, 1042, 383, 7, 176, "Input", InitializationCell->True] }, Closed]] } ] *) (*********************************************************************** End of Mathematica Notebook file. ***********************************************************************)