In an attempt to make learning Mathematica more interesting, I have over the years, introduced the programming language by way of examples. I have collected these in the notebook attached. If there are similar approaches, please let me know. Also, since this has been done a long while ago, some of it may be out of date; however I think the approach is still valuable and hope others will adopt it.

Preface


Introduction

Nobody can learn to play a decent game of tennis by watching tennis matches on TV. Similarly, we feel that nobody can learn Mathematica programming by just reading through a book on Mathematica programming. To be successful, requires constant practice in the basics of Mathematica programming; especially using Mathematica to solve problems. It is our belief that students should be exposed to problem solving right from the start. We have organized this book accordingly. We start each section with a problem to be solved and then introduce just enough of the Mathematica language to solve the problem at hand. We then show how to improve the programming solutions presented. Then on to the next problem, etc. In this way we are able to present, in an engaging way, a solid introduction to the Mathematica programming language. Students are, throughout, encouraged to think of similar problems that can be solved by the techniques already presented. Also, when students come across their own problems to solve they will have concrete examples of successful solutions for support and encouragement.

The Josephus Problem

Introduction

In this first investigation you will begin to learn the Mathematica language while learning some interesting mathematics at the same time. We begin by introducing a Mathematical problem, the Josephus Problem, and then show how Mathematica can represent and solve the problem. Then by gathering data, using the Mathematica tools we have developed, you will gain an increased understanding of the problem and see how to improve upon our first solution. We assume that you are familiar with the rudiments of the Mathematica language. If not there are some videos that can get you started. For example see the Wolfram videos at: http://www.wolfram.com/broadcast/screencasts/handsonstart/

The Josephus Problem

The Problem

Flavius Josephus was a Jewish Historian in the first century. He writes about a group of 40 Jews in a cave who, rather than surrender to the Romans, chose to commit suicide, one by one. They formed a circle and then, proceeding sequentially in the clockwise direction, each living member stabbed the next remaining survivor in the diminishing circle until only one survived. Who is the survivor? Who will be the survivor if the circle contained 2000 people?

The Solution

We will write a surprisingly short program to calculate the result. The input to the program will be the list of 40 numbers: {1,2,3,...,40}. Mathematica has a neat way of generating such lists with the function, Range. In a new cell, type: Range[40] then hold down the shift key while pressing the return key. Try putting in some values other than 40 in this function.
In[]:=
Range[40]
Out[]=
{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40}
Another function we shall need is: RotateLeft. If, in a new cell, you type: ?RotateLeft, Mathematica will explain briefly what this function does and if you mouse-click on the continuation symbol, ">>," you will be taken via your browser to the Mathematica website for a more extensive explanation with examples (This is true for all Mathematica functions and we encourage the reader to do this for each new function encountered). After creating a new cell, try evaluating RotateLeft[Range[10], 3] or RotateLeft[Range[12], 5].
In[]:=
RotateLeft[Range[10],3]
Out[]=
{4,5,6,7,8,9,10,1,2,3}
For our problem we only need RotateLeft[x] (which is the same as RotateLeft[x, 1]). The idea is to "save" the person who heads the list, by moving this person to the end of the list with RotateLeft, and after we "rotate", we eliminate the new head of the list(the one who was stabbed by the former head of the list); this is done with the function Rest. Given a list, the Rest function deletes the head of the list and retains the rest of the list. Try out: Rest[RotateLeft[Range[40]]] in a new cell. Did it do what you expected? We plan to use this rotate/delete combo over and over again, until only 1 person remains.
In[]:=
Rest[RotateLeft[Range[40]]]
Out[]=
{3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,1}
Since we might want to use other numbers besides 40 here, why don't we replace 'Range[40]' with a variable, that is, let's define a function, Rest[RotateLeft[x]], by opening a new cell and typing: f[x_]:=Rest[RotateLeft[x]]. Then enter it into Mathematica using shift/return.
In[]:=
f[x_]:=Rest[RotateLeft[x]]
First note the underscore after the variable being introduced on the left side of the the definition; each variable introduced in the definition of a function must be followed by an underscore. Also note the use of ":= "rather than just "=". The ":=" indicates that this is the definition of a function that will be newly evaluated whenever "x_" is replaced by calculable value, such as Range[40].
​
Evaluate f[Range[40]]. Note who is the first to go. Next evaluate f[f[Range[40]]]. We have eliminated 2 of the forty from the circle; each time we apply f, we are first rotating, then eliminating the new first in line.
In[]:=
f[f[Range[40]]]
Out[]=
{5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,1,3}
It should now be apparent that we have to apply f to Range[40] thirty-nine times.
Of course we would prefer not to do this by “hand.” (Think about the circle with 2000 people!) Fortunately, Mathematica has a built in function that accomplishes this for us, the function Nest. (Type: ?Nest in a new cell and enter to get more information). Nest allows us to easily compute expressions like: g[g[g[g[a]]]]. We just tell Nest what the function is (“g,” in this example), what it is applied to (“a,” in this example), and how many times to apply it (“4” times, in this example). Thus, we can write Nest[g, a, 4] instead of g[g[g[g[a]]]]. Try it.
In[]:=
Nest[g,a,4]
Out[]=
g[g[g[g[a]]]]
We need to apply the function f to Range[40] thirty-nine times, thus we want to evaluate: Nest[f, Range[40], 39]. Evaluate this expression to see who survives!
In[]:=
Nest[f,Range[40],39]
Out[]=
{17}
In[]:=
First[Nest[f,Range[2000],1999]]
Out[]=
1953
More generally, we define the following function:
survivor[n_]:=First[Nest[f,Range[n],n-1]
] . The function "First" is employed to get rid of the brackets; so instead of “{17}” as an output, we simply get “17.” (In general, applying First to the head of a list, gives the first element of the list.)
In[]:=
survivor[n_]:=First[Nest[f,Range[n],n-1]]
Do some investigating with this survivor function; how does it behave as the number in the circle increases? Can you find a pattern here? Learn how to use the function Table in order to get and display results "wholesale." For example, try entering: Table[{n,survivor[n]},{n,1,100}].
In[]:=
Table[{n,survivor[n]},{n,1,100}]//TableForm
Out[]//TableForm=
1
1
2
1
3
3
4
1
5
3
6
5
7
7
8
1
9
3
10
5
11
7
12
9
13
11
14
13
15
15
16
1
17
3
18
5
19
7
20
9
21
11
22
13
23
15
24
17
25
19
26
21
27
23
28
25
29
27
30
29
31
31
32
1
33
3
34
5
35
7
36
9
37
11
38
13
39
15
40
17
41
19
42
21
43
23
44
25
45
27
46
29
47
31
48
33
49
35
50
37
51
39
52
41
53
43
54
45
55
47
56
49
57
51
58
53
59
55
60
57
61
59
62
61
63
63
64
1
65
3
66
5
67
7
68
9
69
11
70
13
71
15
72
17
73
19
74
21
75
23
76
25
77
27
78
29
79
31
80
33
81
35
82
37
83
39
84
41
85
43
86
45
87
47
88
49
89
51
90
53
91
55
92
57
93
59
94
61
95
63
96
65
97
67
98
69
99
71
100
73
A better format can be obtained by using Mathematica' s TableForm function, as in : TableForm[Table[{n, survivor[n]}, {n, 1, 100}]]. Try it!
Can you see a pattern in these results? If you can't immediately identify a pattern, it might help to "graph" them. Enter, t = Table[{n,survivor[n]},{n,1,100}]; (the “;” serves to suppress the output) and then enter: ListPlot[ t ].
In[]:=
t=Table[{n,survivor[n]},{n,1,100}];
In[]:=
ListPlot[t]
Out[]=
20
40
60
80
100
10
20
30
40
50
60
70
Exercise. Try to formulate a conjecture about how the survivor function can be calculated; in particular can you figure out by hand what survivor[2000] will be.

A Better Solution of the Josephus Problem

If you studied the data from the Josephus problem for various size circles in the previous section you may have noticed that at powers of 2 the survivor was always 1 and then, in between powers of 2, the values go up by 2's; that is, starting with a circle of size 1, the survivors are: 1,1,3,1,3,5,7,1,3,5,7,9,11,13,15,1,.... Thus to obtain the survivor for a circle of size 10, first note that 10 is two more than 8 (which has as its survivor, 1); thus the survivor is the third odd number, 5. Since the nth odd number can be represented as 2(n-1)+1, we could just calculate 2(10-8)+1=5. In general for a circle of size n, we calculate 2(n-b)+1, where b is the largest power of 2 ≤ n.
​
Now that we know the pattern we can write a faster function which we shall call survive.
First we used Module to enclose our “program”; this serves to “localize” all variables to avoid possible confusion with previously defined objects. Variables to be used locally are enclosed in braces and given initial values if desired; we set the sole variable b = 1, initially, with “{b=1}.” A comma follows and after the comma the steps of the program are listed, separated by semicolons. The last instruction determines the output of the function. (Enter ?Module for more information on Module.) We wish to find the biggest power of 2 that is less than or equal to x; we do this by starting with b=1 and keep doubling while the double is less than or equal to x; this is accomplished in our program by:While[2b ≤ x, b = 2b], which checks if the double is less than or equal to x and while it is, replaces b by its double (b = 2b). When 2b > x, this "loop" stops and the program goes on to the next and final instruction : 2(x-b)+1, and this is the output. Here (x-b) is the excess over the largest power of 2 less than x and then 2(x-b)+1 is the the corresponding odd number.
1. Try the survive function to find the survivor for 2000 people and compare it with our old survivor function. It will be much faster than the original survivor function. In fact if you enter Timing[survive[2000]] or Timing[survivor[2000]]), using Mathematica’s Timing function, you can find out exactly how long these calculations take on your computer. Note that the Timing function gives a list with two entries, the time being the first entry, the second being the function value.
Exercise. Using the Mathematica function, Log[2, x], together with the Floor function write a fast survivor function without using a While loop.
Exercise. Suppose instead of skipping one and removing the next as we go around the circle, two are skipped and the next is removed. Write a survivor function for this procedure. Can you find a much faster survive function for this case as well?

The Best Solution

Exercise. Experiment with this new function and compare it with the previously defined functions.

The 3x + 1 Problem

Introduction

In this chapter we shall investigate a seemingly simple problem. However, a solution to this “simple” problem has so far eluded the entire Mathematical community! The problem is known as “The Collatz Problem,” after Luthar Collatz who proposed it in 1937 or, more simply, it is known as, “the “3x + 1 problem.” Here is the problem. Start with any positive integer. If this number is even, divide it by 2; if it is odd, multiply it by 3 and then add 1. Repeat this procedure with the result you obtained and keep repeating as long as you avoid the number 1 . For example, if we start with 13, we get the sequence: 13, 40 ( 3 × 13 + 1), 20 (40 / 2), 10, 5, 16, 8, 4, 2, 1. Try some other numbers and formulate a conjecture based on your results. Collatz conjectured that no matter what number is chosen first, the sequence will always hit 1, and then it cycles: 1,4,2,1. As we stated, no one has ever settled this conjecture. Perhaps you will be the first.

Mathematica functions for the 3x +1 problem

Our first task is to “automate” the calculations using Mathematica. We shall define a function, txpo, the three x plus one function that will form the basis of our investigations. We need the Mathematica functions, EvenQ, and If. EvenQ tests a number to determine whether it is even or odd; if it is even it outputs “True” while if it is odd, it outputs “False.” If[x, y, z] will output y if x is True, otherwise it outputs z. Thus we define our function as follows:
We want to apply txpo over and over again, starting with a positive integer. We saw in Chapter 1, that the Mathematica function Nest could be employed to do this; in fact a variant of Nest, called NestList is even more useful here. NestList not only gives the final result, but also gives all previous results. Thus, if we want to apply txpo to the number 23, 30 times, we enter the following.
On the other hand if we attempt to verify the conjecture for 27 with the same number of iterations, we obtain:
So perhaps we haven’t run the computation enough times. experiment with running it more times. How much is enough?
It would be nice if we could run the computation until the desired result appears; of course this would mean that if the desired result never appears the computation wouldn’t terminate or if it takes too long, we might not have the patience to wait. Oh well! Nothing is perfect. Mathematica does have a Nest function that runs as long as an imposed condition holds, called NestWhileList. Here the condition we want to impose is that the number is not equal to 1. In Mathematica this can be rendered by: (# ≠ 1) &. The “&” tells Mathematica that “# ≠ 1” is to be treated like a function with “#” as the variable. This often provides a quick way to define a function, “on the fly.” This time our evaluation will be exact.
Our success with the above calculation suggest that we define a function g[x] as follows:
The reader is encouraged to experiment with the function, g[x].
To verify that the 3 x + 1 conjecture is true for all numbers up to 10,000, we can run the following computation:
Recall that semicolons are used to separate steps in a computation in Mathematica and that the last step is the output; ending with a “;” tells Mathematica that there will be no output -- after all we don’t want to see the 10,000 results, it is enough to know that they all finish, that is, eventually reach 1 (and in less than 5 seconds on our computer!).
Exercise. Verify the 3x + 1 conjecture for all numbers up to 100,000. Note that it is only necessary to check the odd numbers (why?)
It is also interesting to study the length of “time” it takes before a number reaches 1. Starting with 27, it takes 112 steps before 1 is reached, but if we start with 29, it only takes 19 steps, as the following computations show. Of course it is easy to see that there is no upper bound to the number of steps required to reach 1---just take higher and higher powers of 2!
Nonetheless, we claim that, for its size, 27 seems exceptional. If we "normalize" these length calculations by dividing them by the size of the starting number, this becomes apparent. So we first define a function, h below, and then use DiscretePlot to show this phenomena. We choose the range {i, 5, 100} arbitrarily; experiment with other choices. Also we added the Option, “PlotRangeAll”; otherwise the higher values are truncated. This graph shows that, in the indicated range, 27 is indeed exceptional. You can easily explore other ranges as well.

Some analogous problems

Suppose now we vary the initial problem by replacing “3x + 1” by “3x + 5.” So we must replace txpo by txpf and g by k where txpf and k defined as follows
It is uncertain what the behavior of this new function will be. Does it also “go to” one fixed value and is that value also 1?
Exercise. Formulate a conjecture based on your experiments.
Exercise. Investigate the analogous problems for 5x + 1 and 5x + 3.

CITE THIS NOTEBOOK

Introduction to Mathematica programming ​
by Robert Cowen​
Wolfram Community, STAFF PICKS, July 16, 2026
https://community.wolfram.com/groups/-/m/t/3761691