(*^
::[	Information =

	"This is a Mathematica Notebook file.  It contains ASCII text, and can be
	transferred by email, ftp, or other text-file transfer utility.  It should
	be read or edited using a copy of Mathematica or MathReader.  If you 
	received this as email, use your mail application or copy/paste to save 
	everything from the line containing (*^ down to the line containing ^*)
	into a plain text file.  On some systems you may have to give the file a 
	name ending with ".ma" to allow Mathematica to recognize it as a Notebook.
	The line below identifies what version of Mathematica created this file,
	but it can be opened using any other version as well.";

	FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2";

	MacintoshStandardFontEncoding; 
	
	fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e8,  24, "Times"; 
	fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, bold, e6,  18, "Times"; 
	fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, center, M7, italic, e6,  14, "Times"; 
	fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M22, bold, a20,  18, "Times"; 
	fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M19, bold, a15,  14, "Times"; 
	fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, a12,  12, "Times"; 
	fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  14, "Times"; 
	fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  10, "Times"; 
	fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, L-5,  12, "Courier"; 
	fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5,  12, "Courier"; 
	fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, R65535, L-5,  12, "Courier"; 
	fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, L-5,  12, "Courier"; 
	fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, L-5,  12, "Courier"; 
	fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, groupLikeGraphics, M7, w289, h105,  12, "Courier"; 
	fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic,  10, "Geneva"; 
	fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = leftheader, inactive, L2,  12, "Times"; 
	fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7,  12, "Times"; 
	fontset = leftfooter, inactive, L2,  12, "Times"; 
	fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  10, "Times"; 
	fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7,  12, "Times"; 
	paletteColors = 128; currentKernel; 
]
:[font = section; inactive; Cclosed; preserveAspect; cellOutline; backColorRed = 58981; backColorGreen = 58981; backColorBlue = 58981; startGroup]
Example 1: Beats:
:[font = text; inactive; preserveAspect]
With Mathematica, we can not only visualize beats, but we can listen to them. 
;[s]
3:0,0;5,1;16,0;79,-1;
2:2,16,12,Times,0,14,0,0,0;1,16,12,Times,2,14,0,0,0;
:[font = input; preserveAspect; endGroup]
Play[  Sin[2 Pi 440 t]+ Sin[2 Pi 444 t],{t,0,1}]
:[font = section; inactive; Cclosed; preserveAspect; cellOutline; backColorRed = 58981; backColorGreen = 58981; backColorBlue = 58981; startGroup]
Example 2: Trumpet vs. Clarinet
:[font = text; inactive; preserveAspect]
Here, we compare the sound of a trumpet vs. a clairnet.  
The sound of a trumpet is essentially a harmonic series.  We just guess that the Fourier coefficients scale like 1/n.
:[font = input; preserveAspect]
trpt= Sum[ 1/n Sin[2 Pi 220 n t] ,{n,1,5,1}]
:[font = input; preserveAspect]
Plot[trpt ,{t,0,2/440}];
:[font = text; inactive; preserveAspect]
For a clarinet, the odd harmonics are suppressed relative to the trumpet. 
:[font = input; preserveAspect]
clair= Sum[ 1/n Sin[2 Pi 220 n t] ,{n,1,5,2}]
:[font = input; preserveAspect]
Plot[clair ,{t,0,2/440}];
:[font = text; inactive; preserveAspect]
Can you hear the difference? What qualities differ? 
:[font = input; preserveAspect]
Play[ trpt ,{t,0,1}]
:[font = input; preserveAspect; endGroup]
Play[ clair ,{t,0,1}]
:[font = section; inactive; Cclosed; preserveAspect; cellOutline; backColorRed = 58981; backColorGreen = 58981; backColorBlue = 58981; startGroup]
Example 3: Fit to a set of data
:[font = input; preserveAspect]
Clear["Global`*"]
:[font = input; preserveAspect]
data= Table[{i, i * Random[Real,{0.8,1.2}]},{i,0,20}]
:[font = input; preserveAspect]
plot1= ListPlot[data,PlotStyle->{PointSize[0.03]}];
:[font = input; Cclosed; preserveAspect; startGroup]
?Fit
:[font = print; inactive; preserveAspect; endGroup]
Fit[data, funs, vars] finds a least-squares fit to a list of data as a linear combination of the
   functions funs of variables vars. The data can have the form {{x1, y1, ..., f1}, {x2, y2, ..., f2},
   ...}, where the number of coordinates x, y, ... is equal to the number of variables in the list vars.
   The data can also be of the form {f1, f2, ...}, with a single coordinate assumed to take values 1, 2,
   .... The argument funs can be any list of functions that depend only on the objects vars.
:[font = input; preserveAspect]
fit[x_]= Fit[data,{1,x},x]
:[font = input; preserveAspect]
plot2= Plot[ fit[x],{x,0,20}];
:[font = input; preserveAspect; endGroup]
Show[plot1,plot2];
:[font = section; inactive; preserveAspect; cellOutline; backColorRed = 58981; backColorGreen = 58981; backColorBlue = 58981; startGroup]
Problem 4: Radioactive Decay Lab
:[font = text; inactive; Cclosed; preserveAspect; fontColorRed = 65535; startGroup]
This is an exercise the students work through. Give it a try.
:[font = section; inactive; initialization; Cclosed; preserveAspect; startGroup]
Initialization            (This will be automatically executed)
;[s]
2:0,0;26,1;64,-1;
2:1,19,14,Times,1,18,0,0,0;1,16,12,Times,1,14,0,0,0;
:[font = input; initialization; preserveAspect]
*)
Clear["Global`*"]
Off[General::spell];
Off[General::spell1];
(*
:[font = subsection; inactive; initialization; Cclosed; preserveAspect; startGroup]
Store rawData
:[font = input; initialization; preserveAspect; endGroup]
*)

rawData[1] = {0.939454, 0.542637, 0.608068, 0.455633, 0.363598, 0.357849, 0.246121, 0.233142, 
   0.175781, 0.161631, 0.127124, 0.079570, 0.079820, 0.057686, 0.054829, 0.047047, 0.034153, 
   0.031822, 0.026700, 0.017653};
 
rawData[2] = {0.844193, 0.769822, 0.537994, 0.566012, 0.438238, 0.308880, 0.361958, 0.286999, 
   0.219668, 0.172746, 0.176871, 0.109626, 0.102810, 0.094301, 0.082429, 0.072404, 0.054960, 
   0.048687, 0.049808, 0.041150};
 
rawData[3] = {0.960683, 0.677725, 0.694883, 0.453117, 0.458388, 0.364181, 0.337013, 0.263705, 
   0.276001, 0.211156, 0.200610, 0.174838, 0.148752, 0.150662, 0.106930, 0.091974, 0.104490, 
   0.065907, 0.074948, 0.047108};
 
rawData[4] = {0.808027, 0.659123, 0.648149, 0.509112, 0.468047, 0.442641, 0.345269, 0.374447, 
   0.343022, 0.314729, 0.246807, 0.259592, 0.194120, 0.139855, 0.164412, 0.143623, 0.109421, 
   0.112822, 0.101611, 0.078352};
 
rawData[5] = {0.778516, 0.943151, 0.778312, 0.547043, 0.661855, 0.542807, 0.481391, 0.492402, 
   0.312229, 0.287878, 0.297368, 0.212561, 0.264614, 0.179159, 0.155878, 0.167172, 0.153820, 
   0.114849, 0.133263, 0.110803};
 
rawData[6] = {1.030259, 0.710893, 0.771936, 0.671202, 0.684294, 0.520465, 0.459046, 0.449039, 
   0.369567, 0.391520, 0.381404, 0.340665, 0.270510, 0.279106, 0.253534, 0.233101, 0.178283, 
   0.163507, 0.164558, 0.131342};
 
rawData[7] = {0.799826, 0.715763, 0.808875, 0.748040, 0.740916, 0.567718, 0.473385, 0.413406, 
   0.519337, 0.378414, 0.318683, 0.299577, 0.266896, 0.322065, 0.260850, 0.220047, 0.237910, 
   0.203303, 0.194852, 0.171914};
 
rawData[8] = {1.030009, 0.820885, 0.680519, 0.855234, 0.784482, 0.717153, 0.663004, 0.563451, 
   0.398062, 0.384240, 0.428266, 0.314059, 0.300040, 0.288303, 0.283048, 0.235262, 0.260298, 
   0.261502, 0.209464, 0.222002};
 
rawData[9] = {1.104594, 0.882339, 0.705444, 0.713148, 0.652680, 0.555029, 0.494255, 0.441377, 
   0.555514, 0.491344, 0.503705, 0.333392, 0.299113, 0.366471, 0.337476, 0.249515, 0.320313, 
   0.272137, 0.203525, 0.202841};
 
rawData[10] = {0.873677, 0.894446, 0.884741, 0.676865, 0.614927, 0.575800, 0.543400, 0.615892, 
   0.504610, 0.449719, 0.524893, 0.347161, 0.378108, 0.350992, 0.277094, 0.334462, 0.245101, 
   0.303390, 0.270648, 0.194618};
(*
:[font = subsection; inactive; initialization; Cclosed; preserveAspect; startGroup]
Store rawData2
:[font = input; initialization; preserveAspect; endGroup; endGroup]
*)

rawData2[1] = {0.748350, 0.608280, 0.515187, 0.444564, 0.386747, 0.337616, 0.295159, 
   0.258199, 0.225927, 0.197709, 0.173024, 0.151424, 0.132521, 0.115979, 0.101502, 0.088831, 
   0.077743, 0.068038, 0.059545, 0.052113};
 
rawData2[2] = {0.717178, 0.566635, 0.470943, 0.400797, 0.344701, 0.297805, 0.257789, 
   0.223335, 0.193554, 0.167769, 0.145429, 0.126066, 0.109283, 0.094735, 0.082124, 0.071191, 
   0.061714, 0.053498, 0.046377, 0.040203};
 
rawData2[3] = {0.686070, 0.525209, 0.427129, 0.357692, 0.303548, 0.259109, 0.221736, 
   0.189961, 0.162816, 0.139578, 0.119667, 0.102600, 0.087969, 0.075424, 0.064669, 0.055447, 
   0.047541, 0.040762, 0.034949, 0.029966};
 
rawData2[4] = {0.655041, 0.484053, 0.383833, 0.315377, 0.263454, 0.221719, 0.187207, 
   0.158292, 0.133927, 0.113344, 0.095935, 0.081204, 0.068736, 0.058184, 0.049251, 0.041690, 
   0.035290, 0.029872, 0.025286, 0.021404};
 
rawData2[5] = {0.624110, 0.443230, 0.341172, 0.274016, 0.224622, 0.185866, 0.154447, 
   0.128580, 0.107133, 0.089297, 0.074442, 0.062063, 0.051744, 0.043141, 0.035969, 0.029989, 
   0.025003, 0.020847, 0.017381, 0.014491};
 
rawData2[6] = {0.593305, 0.402828, 0.299299, 0.233822, 0.187309, 0.151836, 0.123754, 
   0.101116, 0.082711, 0.067690, 0.055410, 0.045362, 0.037138, 0.030405, 0.024894, 0.020381, 
   0.016687, 0.013662, 0.011185, 0.009158};
 
rawData2[7] = {0.562666, 0.362966, 0.258421, 0.195074, 0.151843, 0.119982, 0.095484, 
   0.076240, 0.060969, 0.048791, 0.039058, 0.031271, 0.025038, 0.020049, 0.016053, 0.012855, 
   0.010293, 0.008242, 0.006600, 0.005285};
 
rawData2[8] = {0.532248, 0.323813, 0.218819, 0.158141, 0.118645, 0.090739, 0.070057, 
   0.054335, 0.042234, 0.032861, 0.025581, 0.019919, 0.015511, 0.012079, 0.009407, 0.007326, 
   0.005706, 0.004444, 0.003461, 0.002695};
 
rawData2[9] = {0.502139, 0.285619, 0.180892, 0.123522, 0.088258, 0.064643, 0.047960, 
   0.035814, 0.026829, 0.020131, 0.015117, 0.011356, 0.008532, 0.006411, 0.004818, 0.003620, 
   0.002720, 0.002044, 0.001536, 0.001154};
 
rawData2[10] = {0.472475, 0.248760, 0.145215, 0.091900, 0.061379, 0.042336, 0.029730, 
   0.021080, 0.015023, 0.010734, 0.007680, 0.005499, 0.003939, 0.002822, 0.002022, 0.001448, 
   0.001038, 0.000744, 0.000533, 0.000382};
(*
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Part 1: 
:[font = subsection; inactive; preserveAspect]
Given a data set, plot the data set, and estimate the decay constant from the plot, Then fit the data, and compare the fit with the data. 
:[font = text; inactive; preserveAspect]
Each lab bench will use a different data set. 
Mathematica will prompt you for you lab bench number.
 (This must be an integer from 1 to 10)
:[font = input; preserveAspect]
groupNumber=Input["Input your lab bench number"]
:[font = text; inactive; preserveAspect]
Your data set will be determined by your group number.
:[font = input; preserveAspect]
data=rawData[groupNumber]
:[font = input; preserveAspect]
p1= ListPlot[data, PlotStyle->{PointSize[0.03]}];
:[font = text; inactive; preserveAspect]
Plot the Natural Log of the data; this should be a straight line. The slope of the line is the decay constant. Compute the slope of the line. 
:[font = input; preserveAspect]
p2= ListPlot[Log[data], PlotStyle->{PointSize[0.03]}];
:[font = text; inactive; preserveAspect]
We can Fit a curve to find the slope. This gives us the exponent of the decay function. 
:[font = input; preserveAspect]
exp[t_]= Fit[Log[data],{t},t]
:[font = text; inactive; preserveAspect]
This gives us the experimentally extracted decay constant, tau.
:[font = input; preserveAspect]
tau=-1/exp[1]
:[font = text; inactive; preserveAspect]
And, this is the functional form of the decay.
:[font = input; preserveAspect]
f[t_]=E^(-t/tau)
:[font = text; inactive; preserveAspect]
The half-life is defined by:
:[font = input; preserveAspect]
halfLife=Log[2] tau //N
:[font = text; inactive; preserveAspect]
and we verify that the function has half its value at time equals the half-life. 
:[font = input; preserveAspect]
{f[0],f[halfLife],f[halfLife]/f[0]}
:[font = text; inactive; preserveAspect]
We can see on this plot that the function obtains half its value at time equals approximately 3.4 seconds. 
:[font = input; preserveAspect]
Plot[{f[t],1/2},{t,0,10}];
:[font = text; inactive; preserveAspect]
Now lets overlay the fit to the exponential 
:[font = input; preserveAspect]
p3= Plot[exp[t],{t,0,20}];
:[font = text; inactive; preserveAspect]
with the data. 
:[font = input; preserveAspect]
Show[p2,p3];
:[font = text; inactive; preserveAspect]
Not a bad fit.  Now let's try the function
:[font = input; preserveAspect]
p4= Plot[f[t],{t,0,20}];
:[font = text; inactive; preserveAspect]
and compare this with the data. 
:[font = input; preserveAspect]
Show[p1,p4];
:[font = text; inactive; preserveAspect; endGroup]
Again, a good fit. 
:[font = section; inactive; Cclosed; preserveAspect; startGroup]
Part 2: 
:[font = subsection; inactive; preserveAspect]
You are given a new data set which is taken from a combination of two materials. The materials have a different decay constant, and the quantity of the materials is different. Your mission is to estimate the fraction of each material, and the decay constant. 
:[font = text; inactive; preserveAspect]
Again, each lab bench will use a different data set  determined by your group number.
:[font = input; preserveAspect]
data2=rawData2[groupNumber]
:[font = text; inactive; preserveAspect]
Let us look at the data.
:[font = input; preserveAspect]
p1= ListPlot[data2, PlotStyle->{PointSize[0.03]}];
:[font = text; inactive; preserveAspect]
Plot the Natural Log of the data; this should be a straight line if there was only a single decay.
:[font = input; preserveAspect]
p2= ListPlot[Log[data2], PlotStyle->{PointSize[0.03]}];
:[font = text; inactive; preserveAspect]
We can try Fit a curve to find the slope as we did before. 
:[font = input; preserveAspect]
exp[t_]= Fit[Log[data2],{t},t]
tau=-1/exp[1]
f[t_]=E^(-t/tau)
p3= Plot[exp[t],{t,0,20}];
Show[p2,p3];
:[font = text; inactive; preserveAspect]
Not such a good fit. Let us try again with the assumption that there are two decays.  I have given you the functional form below. Try varying {frac,tau1,tau2} by hand to fit the data. We plot the Log so we can see the fit better.
(I have done a poor job of this below. You do better by trial and error.)
;[s]
2:0,0;230,1;304,-1;
2:1,16,12,Times,0,14,0,0,0;1,16,12,Times,2,14,0,0,0;
:[font = input; preserveAspect]
frac=0.7;
tau1=3;
tau2=8;
functionalForm= frac E^(-t/tau1) + (1-frac) E^(-t/tau2);

p3= Plot[ Log[functionalForm] ,{t,0,20}
         ,DisplayFunction->Identity];
         
Show[p2,p3, DisplayFunction->$DisplayFunction];
:[font = text; inactive; preserveAspect]
[I have added some fancy Mathematica stuff (DisplayFunction->...) to suppress the intermediate plots. 
You can ignore this.]
;[s]
1:0,1;125,-1;
2:0,16,12,Times,0,14,0,0,0;1,16,12,Times,2,14,0,0,0;
:[font = subsection; inactive; preserveAspect; endGroup; endGroup; endGroup]
EXTRA CREDIT: For amusement, can you construct a 3 parameter fit to determine {frac,tau1,tau2}?
:[font = section; inactive; preserveAspect; cellOutline; backColorRed = 58981; backColorGreen = 58981; backColorBlue = 58981; startGroup]
Problem 5: Monte Carlo Calculation of Pi
Compute the value of Pi by throwing darts at the unit circle, and computing the ratio that falls inside the unit circle vs. the unit square. 
;[s]
2:0,0;41,1;183,-1;
2:1,19,14,Times,1,18,0,0,0;1,16,12,Times,1,14,0,0,0;
:[font = text; inactive; preserveAspect; plain; italic; fontColorRed = 65535; endGroup]
Your Challenge: choose your own algorithm. 
:[font = section; inactive; Cclosed; preserveAspect; cellOutline; backColorRed = 58981; backColorGreen = 58981; backColorBlue = 58981; startGroup]
Example 6: Proof by Picture
:[font = text; inactive; preserveAspect]
An important result in scattering theory is Rayleigh's formula which allows us to describe a plane wave in both Cartesian and Spherical coordinates.  For students, this is a very imposing formula, but with Mathematica  we can make the proof quite obvious. 
;[s]
3:0,0;206,1;217,0;257,-1;
2:2,16,12,Times,0,14,0,0,0;1,16,12,Times,2,14,0,0,0;
:[font = input; preserveAspect]
term[n_,r_,theta_]= I^n (2 n + 1) BesselJ[n,r] LegendreP[ n,Cos[theta] ]
:[font = input; preserveAspect]
tmp= Sum[term[n,r,theta],{n,0,8,2}]  (* Only take real terms *)
:[font = input; preserveAspect]
CylindricalPlot3D[tmp //Re //Evaluate
     ,{r, 0,10}
     ,{theta,0, 2 Pi}
     ,PlotPoints->Automatic
     ];
:[font = input; preserveAspect; endGroup]
Plot3D[ Exp[ I x] //Re ,{x,-10,10},{y,-10,10}];
:[font = section; inactive; Cclosed; preserveAspect; cellOutline; backColorRed = 58981; backColorGreen = 58981; backColorBlue = 58981; startGroup]
Problem 7: Spherical Harmonics
:[font = text; inactive; preserveAspect]
This is an example where the graphics are far superior to what one can draw on the blackboard.  
The structure of electron orbitals is based on Spherical Harmonics. This simple function give the students a chance to experiment on their own. 
:[font = input; dontPreserveAspect]
Needs["Graphics`ParametricPlot3D`"]
:[font = input; dontPreserveAspect]
Clear[doit];
doit[el_,m_,points_:8]:=
ParametricPlot3D[{Abs[SphericalHarmonicY[el,m,theta,phi]] Sin[theta] Cos[phi],
                  Abs[SphericalHarmonicY[el,m,theta,phi]] Sin[theta] Sin[phi],
                  Abs[SphericalHarmonicY[el,m,theta,phi]] Cos[theta]},
           {theta, Pi/30, Pi-Pi/30, (Pi-Pi/30)/points}, 
           {phi, 0, 2 Pi, (2 Pi)/points}] /; m <=el;
:[font = text; inactive; preserveAspect]
Note, the condition  /; m <=el ensures that our doit function only applies to the physical case.
;[s]
5:0,0;21,1;30,0;48,1;52,0;97,-1;
2:3,16,12,Times,0,14,0,0,0;2,15,11,Courier,1,14,0,0,0;
:[font = input; preserveAspect]
doit[3,4]
:[font = text; inactive; preserveAspect]
Try your own values. 
;[s]
2:0,1;21,0;22,-1;
2:1,16,12,Times,0,14,0,0,0;1,16,12,Times,0,14,65535,0,0;
:[font = input; preserveAspect; endGroup]
doit[3,1]
^*)