Introduction to Mathematica - Version 6
By Steven J Miller
Department of Mathematics and Statistics
Williams College
email Steven.J.Miller@williams.edu if you have any Qs
for more demos, see http://demonstrations.wolfram.com/

The various sections are
1. General Commands
2.Defining Functions
3. Making Histograms
4. Probability Distributions and Plotting
5. Sample Programs 
	a. eigenvalues of Toeplitz matrices 
	b. 3x+1 and Benford 
	c. Josephus problem 
	d. Magic squares
6. Saving and reading information
7. Manipulating Plots
8. Finding Minimums
9. Solving Differential Equations
10. The Blink Problem - variable for loops

1. General Commands

"Putting stuff in quotes allows you to write comments. To compile a line, you need to press SHIFT-ENTER. Do not compile the instruction lines unless you want to see these lines printed again."
(* anything between these is commented out and not displayed *)
(* to change how text is displayed, highlight, right click and go to style *)
(* sometimes the code is correct but mathematica doesn't work -- exit the program and restart -- that often fixes it! *)

num = 4 *5; (* this multiplies 4 and 5 and stores the result in num; not we do not need to have previously defined the variable num, it defines it immediately. also it is okay for comments to go on for several lines. the semi-colon means calculate the answer, but do not display it when you compile the line. if we type num on the next line and compile, we get 20. *)

num

num = 4 * 5 (* this calculates 4 * 5, stores in num and prints num *)

(* Mathematica automatically multiplies two quantities separated by a space. If we have a b / c d then it does ((a * b) / c) * d; thus it does multiplication and division in the order it reads them. To be safe it is best to put in extra parentheses. *)
num = 4 5 / 2 3

num = 4 5 / (2 3)

(* Many standard functions start off with a capital letter and then the name; the argument is in braces. We can have many things in one input block, just hit return after each. *)
(* Note E is 2.71828..., Pi is 3.14159..., I is the sqrt(-1), ... *)
a = Cos[1.0]
b = Sin[1.0]
c = Sqrt[a-b]
d = Log[10,100]
e = Exp[-10.0]
E
Pi
I

?Log

Fibonacci[2011]

gm[n_] :=  1.0 Fibonacci[n] / Fibonacci[n-1]

gm[2010]

(* here is how to input a 3x3 matrix *)
M = { {1,2,3}, {4,5,6}, {0,8,9}}

MatrixForm[M] (* this displays a matrix in matrix form *)

M2 = M.M

"The above multiplies two matrices. We'll now calculate some basic quantities."

?Inverse

InvM = Inverse[M]
MatrixForm[InvM]

c = Eigenvalues[M]

"On some versions of mathematica, when you compile the above it gives Root[blah]. This is because the answer is 
not exact. To get an exact answer, we use the Numerical Command, N. We first give an example. If we type Pi, we get the exact
answer (a symbol). If we type N[Pi], it gives us a few digits. If we need more digits, do N[Pi,numdigitsneed]"

Pi

N[Pi]

N[Pi, 20]

c = N[ Eigenvalues[M], 10 ]

"Notice we now have numerical values of the eigenvalues (to 10 digits). These values are stored, and we can pull off entries
one at a time."

c[1]

c[[1]]

N[ c[[1]] ]

"Note how we were able to store the eigenvalues in a vector, and then read off the components. Sometimes we need single brackets, sometimes we need double brackets.
Using N[ ... ] gives numerical values."

bob = {{1,2,3},{3,4},{444,44}}

bob[[1]][[2]]
bob[[1,2]]

MM=Table[m+n,{m,4},{n,4}]

MatrixForm[MM]

"The above generates a random 4x4 matrix with entries chosen from the uniform distribution."

Plot[ Sin[x], {x,0,2 Pi}]

Plot[{Sin[x], Cos[x]}, {x,0,2 Pi}]

Plot3D[ Sin[x] Cos[y], {x,0,Pi}, {y, 0, Pi}]

Integrate[ t Exp[-t^2], {t,0,x}]

NIntegrate[ t Exp[-t^2], {t,0,2}]

Here is some code to work with vectors. We input two three dimensional vectors then take 3 times the first plus 4 times the second. We then take the dot product, the cross product, and then try to find a unit vector in the direction of the cross product. The problem is that Length[] does not return the length of the vector, but rather the number of components (in this case, 3). We need to use the Norm command to find the length of a vector.

v = {1,2,3};
w = {4,5,6};
3 v + 4 w
v.w
Cross[v,w]
Cross[v,w] / Length[Cross[v,w]]
Cross[v,w] / Norm[Cross[v,w]]
Norm[v]
Norm[w]

2. Defining Functions

(* we now show how to define functions. We use underscore by the variable names *)
nthprime[n_] := Prime[n]; (* this gives the nth prime *)

nthprime[10]
nthprime[2011]

diffnthprime[n_] := nthprime[n] - nthprime[n-1]; (* this gives the difference b/w the nth and (n-1)st prime *)

diffnthprime[10]

powersum[n_,k_] := Sum[ i^k, {i,0,n}]

powersum[100,2]

(* we now show how to define functions. We use underscore by the variable names, and then Module followed by braces. Whatever is inside the braces are local variables, known only to this procedure or function. If we write something equals {} then we've initialized it to be the empty array. *)
(* this function counts the number of solutions to x^2 + y^2 = a modulo n; it has two inputs, n and a. *)
(* we find all solutions and store it in an array; as we want to be able to access this array afterwards, we do not have it as a local but rather global variable, ie, not inside the braces inside the module. *)
NumSolns[n_,a_] := Module[{x,y,count}, (* we put the local variables in braces after module *)
Print["We are looking for solutions to x^2 + y^2 = ", a, " mod ", n, "."];
count = 0; (* we initialize count, the number of solns, to zero *)
Clear[ListOfSolns]; (* if we had used ListOfSolns before, this clears it *)
ListOfSolns = {}; (* we set ListOfSolns to the empty array *)
For [x = 0, x ≤   n-1, x++, (* how we do a for loop *)
{  (* starting brace of the for loop *)
For [y = 0, y≤ n-1, y++,
{
If[ Mod[x^2 + y^2 - a,n] ==  0, 
{ 
Print["We found a solution: (x,y) = (", x, ", ", y, ")."]; (* prints the found solution *)
 count = count+1; (* increases count by 1 to indicate found a soln *)
ListOfSolns = Append[ListOfSolns, {x,y}]; (* adds to list of solns *)
}
]; (* end of If loop *)
}]; (* end of y For loop *)
} ];(* end of x For loop *)
Print["The number of solutions when the modulus = ", n, ", a = ", a, " is equal to ", count];
Print["The solutions are ", ListOfSolns, "."];
];

(* we compile the above when n=5 and a=1; since count is a local variable, when we print count AFTER running the program it is not related to the value from the program; however, the value of ListOfSolns IS related to its value from running the program. *)
NumSolns[5,1]

ListOfSolns[[1]] (* this access the first entry of the soln, a pair *)
ListOfSolns[[1,1]] (* accesses the first entry of the first entry of the solns *)
ListOfSolns[[1]][[1]] (* same as above, alternate way to access it *)

3. Making Histograms

(* we first load in some packages to do histograms *)
(* if you write Options[something] it gives you the various options for what's inside*)
<<"BarCharts`";<<"Histograms`" ;
<<"PieCharts`"
Options[Histogram]

{ApproximateIntervals->Automatic,BarEdges->True,BarEdgeStyle->GrayLevel[0],BarOrientation->Vertical,BarStyle->Automatic,FrequencyData->False,HistogramCategories->Automatic,HistogramRange->Automatic,HistogramScale->Automatic,AlignmentPoint->Center,AspectRatio->(1/GoldenRatio),Axes->True,AxesLabel->None,AxesOrigin->Automatic,AxesStyle->{},Background->None,BaselinePosition->Automatic,BaseStyle->{},ColorOutput->Automatic,ContentSelectable->Automatic,Epilog->{},Frame->False,FrameLabel->None,FrameStyle->{},FrameTicks->Automatic,FrameTicksStyle->{},GridLines->None,GridLinesStyle->{},ImageMargins->0.`,ImagePadding->All,ImageSize->Automatic,LabelStyle->{},Method->Automatic,PlotLabel->None,PlotRange->All,PlotRangeClipping->True,PlotRangePadding->Automatic,PlotRegion->Automatic,PreserveImageOptions->Automatic,Prolog->{},RotateLabel->True,Ticks->Automatic,TicksStyle->{},DisplayFunction:>$DisplayFunction,FormatType:>TraditionalForm}

UniformDiff[numdo_]:=Module[{i},
ValueList={};
DiffList={};
(* we first put in ValueList a total of numdo random numbers uniformly distributed on [0,1]*)
For[i=1,i≤numdo,i++,ValueList=Append[ValueList,RandomReal[]];];
(* we now sort that list *)
ValueList=Sort[ValueList];
(* we form a new list of differences of adjacent sorted elements. Nice theorem that this converges to an exponential distribution *)
For[i=1,i≤numdo-1,i++,{DiffList=Append[DiffList,(ValueList[[i+1]]-ValueList[[i]]) numdo];}];
(* we first print a standard histogram *)
(* must remember to surround command with print inside a module, don't need print if at the prompt*)
Print[Histogram[DiffList]];
Print[" "]; (* generates blank line *)
(* we reprint the histogram, with the y-axis scaled so that the total area is 1 *)
Print[Histogram[DiffList,Automatic, "ProbabilityDensity", PlotLabel -> "Differences b/w Order Statistics of Unif Distr RVs", AxesLabel -> {difference, percentage}]];
]; (* end of module *)

UniformDiff[1600]

4. Probability Distributions and Plotting

"In older versions of Mathematica we would type <<Statistics`ContinuousDistributions` to load in some continuous distributions, but in verison 6 seems like we're okay."

gdist = NormalDistribution[0,1]

NN = MatrixForm[  Table[Random[gdist], {m, 4}, {n,4} ]  ]

"This allows us to load in a statistics package and generate matrices with entries from a normal distribution. Watch what happens to the entries as we change the standard deviation."

gdist2 = NormalDistribution[0,10]

NN = MatrixForm[  Table[Random[gdist2], {m,4}, {n,4} ]  ]

Det[NN]

"Notice we do NOT get the determinant. The problem is that NN is NOT a matrix, but a DISPLAYED matrix."

NNN = Table[Random[gdist2], {m,4}, {n,4} ]

Det[NNN]

NNNN = {{1,2,3},{4,5,6},{7,8,9}}
Det[NNNN]

"To define a function, one needs to do an underscore after each variable, and := instead of ="

f[x_,y_,z_] := Sin[x + y] * z^2

f[1,2,3]

"To get numerical values, one can use 1.0 instead of 1"

f[1.0,2,3]

"you can do multiple statements on one line if you separate with a semi-colon. Only the output of the last is displayed. Here, g[n] is the nth prime number."

g[n_] := Prime[n]

g[2];  g[3]  
g[4]

G[x_] := Sum[ n, {n,1,Floor[x]}]

Plot[ G[x], {x,1,10}]

"You can also plot several functions at once."

Plot[ {G[x], .5*x * (x+1) + 0* x*Sin[6 x]}, {x, 1, 25} ]

"Mathematica also supports IF and FOR statements"

Mod[12,7]

"The above is the mod function: 12 mod 7 is 5"

h[x_] := If[ Mod[ Floor[x], 2] == 1, 5, -5]

Plot[ h[x], {x,-5,5}]

"If statements work by IF[Condition, Then This, Else This]. You can have nested IF statements"

h[x_] := If[ Mod[ Floor[x], 3] == 0, 0, 
		      If[ Mod[ Floor[x], 3] == 1, 1, 2]
                      ]

Plot[ h[x], {x,0,9}]

IntegerQ[Sqrt[21222079685]]

5. Sample Programs
5a. Eigenvalues of Toeplitz Matrices

"We now include a quick program to calculate eigenvalues of Toeplitz Matrices. This code can easily be 
modified for other investigations."

"First we make sure we have loaded in the packages we need."

<<"BarCharts`";<<"Histograms`";<<"PieCharts`"

ndist = NormalDistribution[0,1];

"In the program below, we calculate num matrices, each is n x n. we choose the entries randomly from the standard normal
distribution subject to being a real symmetric toeplitz matrix with zeros on the main diagonal. remember a toeplitz matrix is constant along diagonals. we normalize the eigenvalues by
sqrt[n]. we also have some if statements that print based on where we are -- the point is to know how much longer the program
will have to run. we then create a histogram."

TopMatnodiag[n_,num_]:=Module[{aa,b},
Clear[temp];
temp={};
For[aa=1,aa≤num,aa++,
{
Clear[a];
For[i=1,i≤n,i++,a[i,i]=0];
For[k=2,k≤n,k++,
{
ran1=Random[ndist];
For[i=1,i≤n-k+1,i++,
{
a[i,k-1+i]=a[k-1+i,i]=ran1;
}]; (* end of i loop *)
}]; (* end of k loop *)
mat=Array[a,{n,n}];
tempev=N[Eigenvalues[mat] / Sqrt[1.0 n]]; 
If[Mod[aa,20]==0,Print["We're at aa = ",aa]];For[b=1,b≤n,b++,temp=Append[temp,tempev[[b]]];];
}]; (* end of aa loop *)

(* first histogram is un-normalized. second rescaled to have unit area and labels added. remember to use PRINT around histograms inside modules. *)
Print[Histogram[temp]];
Print[Histogram[temp,Automatic, "ProbabilityDensity", PlotLabel -> "Enter Name Here", AxesLabel -> {"x-axis label","y-axis label"}]];
(*Print[MatrixForm[mat]];*)
]; (* end module *)

TopMatnodiag[10,100]

5b. 3x+1 and Benford

"Below is some code for investigating 3x+1 and its generalizations"

RemoveTwo[x_] := Module[{i}, i = x; While[  Mod[i,2] == 0, i = i / 2]; Return[i]]

F3[x_] := RemoveTwo[ 3*RemoveTwo[x] + 1];
F5[x_] := RemoveTwo[ 5*RemoveTwo[x] + 1];

"We now give a code to check the first digits of the 3x+1 problem"

ben3[start_, num_] := Module[ {d,m,j,x},
For[m=1, m≤ 9, m++, numdig[m] = 0];
x = start;
count = 0;
For[j = 1, j ≤ num, j++,
{
(* Print["x = ", x, " at j = ", j]; *)
numdig[   Mod[  Floor[x*1.0 / 10^Floor[Log [10, x]] ], 10 ] ]++;
count = count+1;
x = F3[x];
If[x == 1, j = num + 5];
}];
bF[y_] := numdig[Floor[y + .5]] /count;
ben[y_] := Log[10, 1 + (1.0/y)];
Plot[ {bF[y], ben[y]}, {y,.5,9.5}];
Print["Count (the number of terms before we hit one) = ", count];
Print["The number is approximately 10^", Floor[Log[10,1.0 start]]];
];

ben3[4543534664576457754636456464754385784375987684937639847649837698374457457745,1000]

"The following compares the terms of 5x+1 to a geometric brownian motion and the first digits of the
terms to Benford's law."

glog[x_,end_]:=Module[{numat,tempplot,numdig,lognumdig,m,y,temp},Clear[tempplot];Clear[temp];For[m=1,m≤9,m++,{lognumdig[m]=0;numdig[m]=0;}];tempplot={{0,0}};numat=RemoveTwo[x];For[j=1,j≤end,j++,{If[Mod[j,1000]==0,Print["j = ",j," x = ",numat," and goes to ",F[numat]];];AppendTo[tempplot,{j,Log[E,numat]}];AppendTo[tempplot,{j,Log[E,1.25`] j+Log[E,x]}];numdig[Mod[Floor[((numat 1.`)/(10^(Floor[Log[10,numat]])))],10]]++;temp=(E^(Log[10,numat]-j Log[10,1.25`]));lognumdig[Mod[Floor[((temp 1.`)/(10^(Floor[Log[10,temp]])))],10]]++;numat=5 numat+1;}] ListPlot[tempplot,Joined->False];Clear[tempplot];tempplot={{0,0}};For[m=1,m≤9,m++,AppendTo[tempplot,{m,((1.` numdig[m])/end)}]];ListPlot[tempplot];Clear[tempplot];bF[y_]:=((numdig[Floor[y+0.5`]])/end);ben[y_]:=Log[10,1+((1.`)/y)];Plot[{bF[y],ben[y]},{y,0.5`,9.5`}];tempplot={{0,0}};For[m=1,m≤9,m++,AppendTo[tempplot,{m,((1.` lognumdig[m])/end)}]];logbF[y_]:=((lognumdig[Floor[y+0.5`]])/end);Plot[{logbF[y],ben[y]},{y,0.5`,9.5`}]]

glog[421,1500]

5c. The Josephus Problem

(* does the josephus problem for k <= 4 *)
(* you have n people in a circle, person one starts with a gun and kills the k-1st person from him and then passes the gun to the next person on the circle. this continues until only 1 person is left. *)
josp[n_, k_] := Module[{},
nlist = {};
count = 0;
For[i = 1, i ≤ n, i++, nlist = AppendTo[nlist,i]];
listlength = Length[nlist];
Print[nlist];
While[listlength ≥ k && count ≤ n,
{
count = count+1; (* makes sure coding error doesn't have program run 4ever*)
newlist = {};
tempnewlist = {};
last = 0;
If[Mod[listlength,k] == 0,
{
For[i = 1, i ≤ listlength, i++,
If[Mod[i,k] ≠ 0, newlist = AppendTo[newlist,nlist[[i]]];];];
}];

If[Mod[listlength,k] != 0, 
{
tempnewlist = {};
For[i = 1, i ≤ k*Floor[listlength/k], i++,
If[Mod[i,k] ≠ 0, tempnewlist = AppendTo[tempnewlist,nlist[[i]]];];];
newlist = {};
remainder = listlength - k* Floor[listlength/k];
For[i = k* Floor[listlength/k]+1, i <= listlength, i++, newlist = AppendTo[newlist, nlist[[i]]]];
For[i = 1, i ≤ Length[tempnewlist], i++,
newlist = AppendTo[newlist,tempnewlist[[i]]]];
}];

nlist = newlist;
Print[nlist];
listlength = Length[nlist];

}];

If[k == 3, Print["{",nlist[[2]],"}"]];
If[k  == 4 && Length[nlist] == 2, Print["{",nlist[[1]],"}"]];
If[k == 3 && Length[nlist] == 3,Print["{",nlist[[2]],"}"]];

];

josp[10,3]

5d. Magic Squares

(* this program will find all 3 x 3 magic squares with rows and columns and diagonals summing to 15. *)
ninelist = {1,2,3,4,5,6,7,8,9};
permninelist = Permutations[ninelist];
count = 0;
For[j = 1, j ≤ 9!, j++,
{
For[i = 1, i ≤ 9, i++,
{
matrix[i] = permninelist[[j]][[i]];
}];
rows = 0;
columns = 0;
diag = 0;
count = count+1;
If[Mod[count, Floor[9!/10]] == 0, Print["We are at ", Floor[100. count / 9!], "%."]];
If[ matrix[1] + matrix[2] + matrix[3] == 15 && matrix[4] + matrix[5] + matrix[6] == 15 && matrix[7] + matrix[8] + matrix[9] == 15, rows = 1];

If[ matrix[1] + matrix[4] + matrix[7] == 15 && matrix[2] + matrix[5] + matrix[8] == 15 && matrix[3] + matrix[6] + matrix[9] == 15, columns = 1];

If[ matrix[1] + matrix[4] + matrix[9] == matrix[3] + matrix[4] + matrix[7], diag = 1];

If[rows == 1 && columns == 1 && diag == 1,
Print[MatrixForm[{{matrix[1],matrix[2],matrix[3]},{matrix[4],matrix[5],matrix[6]},{matrix[7],matrix[8],matrix[9]}}]];];

}];

6. Saving and Reading Information

Clear[a];
For[i = 1, i ≤ 5, i++,
For[j = 1, j ≤ 5, j++,
For[k = 1, k ≤ 5, k++,
a[i][j][k] =i*j*k; ]]];
tablelist = Table[a[i][j][k],{i,1,5},{j,1,5},{k,1,5}];
MatrixForm[tablelist]
Put[tablelist,"pleaseworksave"]
(* clear these two lines to test that it really is saving and reading *)
Clear[tablelist]
Clear[readlist]
Print[tablelist];
Print[readlist];
readlist = Get["pleaseworksave"];
Print["Now that we've read it in, readlist = ", readlist];

7. Manipulating Plots

(* here is a simple way to modify functions *)
(* this allows us to vary c and B. To see there values click + *)
Manipulate[Plot[Abs[x]^c *Sin[1/x], {x,-B,B}], {c,1,2},{B,-.1,.1}]

(* this shows how to manipulate graphs with LOTS of options! *)
(* here we construct the graph of a function and its tangent line *)
cubic[x_] := (x^3-2x^2 -2 x + 1)/8;
quartic[x_] := 1+(x^4 + 3 x^3 - 20 x^2 + x + 3)/100;
cauchy[x_] := -2 +4 / (1+(x/2)^2);
g[x_] := Sin[x];
h[x_] := x^3;
chain[x_] := h[g[x]];
Manipulate[Plot[{f[x], f[x1]+f'[x1]*(x-x1)},{x,-2 Pi, 2Pi},PlotRange -> {-3,3}, Epilog -> {PointSize[.025], Point[{x1,f[x1]}]}],{x1,-2 Pi, 2 Pi}, {f, {Sin,Cos,Tan,Sec,Csc,Cot,Exp,cubic,quartic,cauchy,g,h,chain}}]

8. Finding Minimums

Below is some code to solve a system of equations. Sometimes you can use NSolve, but that can break down for complicated systems. A nice trick is to rewrite your equations as (f(x) - g(x))^2 + ... + (u(x) - v(x))^2, as the minimum of this will solve the system f(x) = g(x), ..., u(x) = v(x).

(* here is a system of equations from Professor Morgan *)
f1[L0_,X_,T1_,T2_,T3_] := ((T1+T2) - L0*(T3/Sin[T3])*Sin[T1])^2;
f2[L0_,X_,T1_,T2_,T3_] := (Sin[T2] - (L0-1)*Sin[T1])^2;
f3[L0_,X_,T1_,T2_,T3_] := (4X*Sin[T1]*Sin[T1] - (T1-.5*Sin[2T1] + T2 -.5*Sin[2T2]))^2;
f4[L0_,X_,T1_,T2_,T3_] := (4X -L0*((T3-.5*Sin[2T3])/ (Sin[T3]*Sin[T3])) )^2;
f[L0_,X_,T1_,T2_,T3_] := f1[L0,X,T1,T2,T3] + f2[L0,X,T1,T2,T3]+f3[L0,X,T1,T2,T3]+f4[L0,X,T1,T2,T3];

(* here's the above four equations with L0 = 0 and trying to use NSolve. WARNING: IT MAY HANG UP, AND YOU MAY NEED TO ABORT THE CALCULATION *)
NSolve [{(T1+T2)*Sin[T3]==2*T3*Sin[T1], Sin[T2] == (2-1)*Sin[T1], 4X*Sin[T1]*Sin[T1] == T1-.5*Sin[2T1] + T2 -.5*Sin[2T2], 4X*Sin[T3]*Sin[T3] == 2*(T3-.5*Sin[2T3])}, {X,T1,T2,T3}]

(* this function takes as input a value of L0 and starting values for X,T1, T2 and T3 and looks for a minimum. *)
minimizer[L0start_,xstart_,t1start_,t2start_,t3start_] := Module[{},
Print["Starting values: (L0,X1,T1,T2,T3) =  (", L0start, ",", xstart, ",", t1start, ",", t2start, ",", t3start,")."];Print["FindMinimum found ",FindMinimum[{f[L0start,X,T1,T2,T3],X ≤ Pi/2,T1 ≥ Pi/2, T2 ≤ Pi/2, T3 ≤ Pi/2,X ≥ 0, T1 ≤ Pi, T2 ≥ 0, T3 ≥ 0}, {{X,xstart},{T1,t1start}, {T2,t2start},{T3,t3start}}, MaxIterations -> 1000]];
Print["f[Pi/4,Pi/2,Pi/2,Pi/2] = ", f[Pi/4,Pi/2,Pi/2,Pi/2], "."];
Print["Pi/ 8 = ", Pi/8., ", Pi/4 = ", Pi/4., " and Pi/2 = ", Pi/2.0, "."];
Print[" "];
];

minimizer[1.002,Pi/3,Pi/3,Pi/3,Pi/3]

(* here's a simpler example using NSolve *)
NSolve[ {3 x^4 y + 4 x^2 y^2 - 2x + y == 0, x^2 + y^2 == 2}, {x,y}]
NSolve[ 3 x^5 + 4 x^2 - 2x + 1 == 0, x]

8. Solving Differential Equations

Below is some code to solve differential equations and how to

(* here's how to define a function and then take the derivative of it *)
y[x_] := 3x^4 + 2x - 1
derivy[x_] := y'[x]

(* this prints the function, and shows that we have taken the derivative correctly*)
derivy[x]

(* here is another way to take derivatives of functions *)
D[3x^4 + 2x - 1, x]

(* we show how to solve a differential equation *)
(* note C[1] and C[2] are the free coefficients *)
Clear[y];
DSolve[ y''[x] + 3 y'[x] +  2y[x]== 0, y[x],x]

(* we show how to solve a differential equation with boundary coefficients*)
Clear[y];
DSolve[ {y''[x] + 3 y'[x] +  2y[x]== 0, y[0] == 4, y'[0] == 2}, y,x]

(* here we only give two boundary conditions, so there is still an undertermined coefficient *)
Clear[y];
DSolve[{y'''[x]+4y[x]==0,y[0]==1,y'[0]==4},y,x]

9. The BLINK Problem

Consider N people. Everyone closes their eyes and randomly chooses
someone to look at other than themselves.What is the probability
at least two people are looking at each other?A nice application
is to a Doctor Who episode from 2007,  Blink.

Hyperlink["http://en.wikipedia.org/wiki/Blink_(Doctor_Who)"]

The following command is very useful. It takes an integer n and writes it in base B. It then outputs the digits in a string, padding on the left so that the string has a fixed length. We don't really need to isolate this as a function, but as this is so important for looping on an arbitrary number of variables, it is worth isolating.

stringforloop[number_, base_, totallength_] := IntegerDigits[number,base,totallength]
stringforloop[1341,3,10]
stringforloop[1342,3,10]

The code below solves the Blink problem. I have NOT programmed the efficiencies we discussed, such as 1 is matched with 2, 2 with 3 et cetera. It does give a good idea of how to handle problems such as these.

(* Here is how you create a program in mathematica. You underscore the variable. The {} in Module lists the local variables -- I never really bother making things local. *)
blink[n_] := Module[{},
(* numpossibles is how many possible outcomes we have *)
numpossibles = (n-1)^n;
(* numwork will be how many of these we have where two people are not looking at each other *)
numwork = 0;

(* Below is my favorite part of the code -- it is a REALLY efficient way to loop through the possible values of n random variables -- what makes it so nice is that the number of random variables is itself variable! *)
For[m = 0, m ≤ numpossibles-1, m++, 
{
(* as mentioned above, the IntegerDigits[m,B,pad] takes three inputs. The first, m, is our number; the second, B, is the base; the third, pad tells us how many entries we want in our list. It works as follows. It takes the base B expansion of m and saves that in a list, where each element of the list is a different digit. It then pads the list with zeros in the beginning so that it is a certain length. If m loops from 0 to B^n - 1, then this has {x1,...,xn} loop from {0,...,0} to {B-1,...,B-1}. *)
tempdigits = IntegerDigits[m,n-1,n];(* note here we are using the base as n-1. *)
(* we now want to transfer our list to the digits. we initialize digits to be an empty list *)
digits = {};
(* we now construct our number -- we don't allow i to look at i, so the easiest way to ensure that is to add the number to it modulo n; as the number is at most n-1, this makes sure i doesn't look at i. *)
For[i = 1, i ≤ n, i++, digits = AppendTo[digits, Mod[i+tempdigits[[i]],n]]];
(* we sent tempwork to 1; if it stays as 1 we found another thing that works *)
tempwork = 1;
(* this is a simple way to check if anyone is looking at someone looking back *)
For[i = 1, i ≤ n, i++, If[i == digits[[digits[[i]]]], tempwork = 0]];
numwork = numwork + tempwork;
}];
(* this prints out the results *)
Print["Number of possibles is ", numpossibles];
Print["Number that work is ", numwork];
Print["Percentage that works is ", numwork 1.0 / numpossibles];
Print[" "];
];

(* this prints the results for various n, and tells us how long it took to run *)
Timing[blink[3]]
Timing[blink[4]]
Timing[blink[5]]
Timing[blink[6]]

g={1->2,2->4,3->6,4->8,5->10,6->12,1->3,2->5,3->7,4->9,5->11,6->13};

h = {Start -> Pia, Start-> Muriel, Start -> Ephelia}

h = {Start->Pia,Start->Muriel,Start->Ephelia, Ephelia -> "Muriel" , Ephelia -> "Pia", Muriel -> " Ephelia", Muriel -> " Pia", Pia -> "  Ephelia", Pia -> " Muriel", "Pia" -> " Muriel ", "Muriel" -> " Pia  ", " Pia" -> " Ephelia ", " Ephelia" ->  " Pia ", " Muriel" -> " Ephelia  ", "  Ephelia" -> " Muriel  "}

TreePlot[h,Left,VertexLabeling->True]

num = 100000;
success = 0;
list = {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};
For[n = 1, n ≤ num, n++,
{
temp = RandomSample[list,13];
found = 0;
For[k = 1, k ≤ 5, k++, If[MemberQ[temp,k] == True, found = found + 1]];
If[found == 5 || found == 0, success = success + 1];
}];
Print[100. success / num];

scat[num_,size_] := Module[{},
success = 0;
list = {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,41,42,43,44,45,46,47,48,49,50,51,52};
For[n = 1, n ≤ num, n++,
{
templist = RandomSample[list,size];

For[k =1, k ≤ 4, k++,
{ace[k] = 0; ten[k] = 0;}];
For[m = 1, m ≤ size, m++,
{
temp = templist[[m]];
If[temp == 1, ace[1] = 1];
If[temp == 14, ace[2] = 1];
If[temp == 27, ace[3] = 1];
If[temp == 40, ace[4] = 1];
If[temp ≥ 10 && temp ≤ 13, ten[1] = ten[1] + 1];
If[temp ≥ 23 && temp ≤ 26, ten[2] = ten[2] + 1];
If[temp ≥ 36 && temp ≤ 39, ten[3] = ten[3] + 1];
If[temp ≥ 49 && temp ≤  52, ten[4] = ten[4] + 1];
}];
If[ace[1] * ten[1] ≥ 2 || ace[2] * ten[2] ≥ 2 || ace[3]* ten[3] ≥ 2 || ace[4] * ten[4] ≥ 2, success = success+1];
}];
(*Print[100. success / num];*)
Return[100. success / num];
];

CREATING MATCHING GRAPHS

S. J. Miller and W. Xiong

This program is to create the matching diagrams needed for some random matrix theory papers. To do so, we have modified some of the Mathematica commands, and built functions around them. For convenience I start with a circle of radius 5. I then use circ to draw a very small circle on the circle of radius 5 (thus take 5 as the argument for rad) at the angle of ang degrees on the circle. The line function draws a line from two points on the circle -- we specify the circle has radius rad, and the two angles are ang1 and ang2. The next lines do the same but do not draw the initial circle of radius 5. The label function is to place the label with large, readable text in the right place. Remember you need to move the anchor point of the text a bit so it doesn't overlap with the image!

circ[rad_, ang_, size_] := Circle[{rad Cos[ang 2 Pi / 360] , rad Sin[ang 2 Pi / 360]}, size];
line[rad_, ang1_,ang2_] := Line[{{rad Cos[ang1 2 Pi / 360] , rad Sin[ang1 2 Pi / 360]}, {rad Cos[ang2 2 Pi / 360] , rad Sin[ang2 2 Pi / 360]}}];
label[text_, rad_, ang_] := Text[Style[text,Large], {rad Cos[ang 2 Pi / 360] , rad Sin[ang 2 Pi / 360]}];
Graphics[{Circle[{0,0},5], circ[5,0,.2], circ[5,60,.2],circ[5,120,.2],circ[5,180,.2],circ[5,240,.2],circ[5,300,.2]}]

Graphics[{Circle[{0,0},5], circ[5,0,.2], circ[5,60,.2],circ[5,120,.2],circ[5,180,.2],circ[5,240,.2],circ[5,300,.2], line[5,0,120], line[5,60,300], line[5,180,240]}]

Graphics[{Circle[{0,0},5], circ[5,0,.2], circ[5,60,.2],circ[5,120,.2],circ[5,180,.2],circ[5,240,.2],circ[5,300,.2], line[5,0,120], line[5,60,300], line[5,180,240],label["ij", 5.6,0] }]

?Line

Graphics[{ circ[5,0,.2], circ[5,60,.2],circ[5,120,.2],circ[5,180,.2],circ[5,240,.2],circ[5,300,.2],line[5,0,120], line[5,60,300], line[5,180,240],label["ij", 5.6,0]}]

Graphics[{Circle[{0,0},5], Circle[{7,0},5], label[x,0,0], label[y,3.6,0], label[z,7.2,0], label[w,6.2,55]}]

Superimposing plot of function on histogram

Here are a few different ways of doing plots over histograms.

f[x_] := (1/Sqrt[2 Pi]) Exp[-x^2/2];

Plot[f[x],{x,-3,3}]

Show together with Histogram of random data:

Show[Histogram[RandomReal[NormalDistribution[0,1],500],Automatic,"ProbabilityDensity"],%]

temp = {};
For[n=1, n ≤ 10000, n++, temp = AppendTo[temp, RandomReal[NormalDistribution[0,1]]]];

Plot[f[x],{x,-3,3}]

Show[Histogram[temp, Automatic, "ProbabilityDensity"], %]

gaussplot = Plot[f[x],{x,-3,3}];

Show[Histogram[temp, Automatic, "ProbabilityDensity"], gaussplot]