Physics 230 -- Lab 14 (Final Exam Practice Problems)

John Colton, Winter 2014

Based in part on an old final exam review by Branton Campbell

The final exam will be administered during the regularly-scheduled final exam period. It will be of the same format as the midterms, namely you will be able to use any resources you want except for other people. Your instructor and/or TA can clarify the meaning of the problem descriptions, but will not answer any other questions. As you complete problems, you can ask the instructor/TA to pass you off. They will either give you full credit for the problem or else tell you that your work is not quite correct. They will not tell you how/why your work is incorrect, nor give you suggestions on how to correct it. If you have not passed off all of the problems by the end of the exam, partial credit will be assigned for your unfinished problems.

This lab contains some sample exam problems so that you will have some idea of what to expect for the actual exam. The final exam problems won’t be just like these, but most of the final exam problems will have definite similarities to problems in this review. This lab will be ungraded--these problems are only for your own benefit to help you prepare for the final.

Work what you can of these review problems in the time available in this lab period, perhaps focusing on the problems that seem the most difficult for you. I suggest that you work the rest on your own. The solutions will be posted during reading days. If this exam review seems a bit long, don’t worry too much--the final will NOT be as long as this.

The problems are presented roughly in order of when the topics were covered in the course.

Clear["`*" ]
SetDirectory[NotebookDirectory[]]

Problem 1

Plot the function  f1(x)=(e^(-(x^2))), along with its first four derivatives, all on the same graph for the range -2 < x < 2.  Use a plot range option to make sure that none of the curves get cut off at the top or bottom.

(* Labs 1, 3, and 4 *)

f1[x_] = E^(-x^2);
Plot[{f1[x],f1'[x],f1''[x],f1'''[x],f1''''[x]},{x,-2,2},PlotRange->All]

(* alternate method *)
f1b=Exp[-x^2];
Table[D[f1b,{x,n}],{n,0,4}];
Plot[%,{x,-2,2},PlotRange->All]

Problem 2

Beginning with the names and ages below, use standard list-manipulation functions to obtain an alphabetically-ordered list of all the individuals who are 10-years-old or older.  Hint: the functions Select and Sort will likely be helpful.

nameagelist = {{"Tom",10},{"Dick",9},{"Harry",12},{"Larry",8},{"Mo",5},{"Curly",12}, {"Bill",17},{"Ted",11}};

(* lab 2 *)

nameagelist = {{"Tom",10},{"Dick",9},{"Harry",12},{"Larry",8},{"Mo",5},{"Curly",12}, {"Bill",17},{"Ted",11}};

Select[nameagelist,#[[2]]≥10&]  //Transpose   
%[[1]] //Sort

Problem 3

Vectors V1 and V2 are defined below.  Compute their sum, scalar product, vector product, and the angle between V1 and V2 (displayed as a floating-point number in degrees). Also determine the magnitude of V1 and obtain a unit vector that’s in the same direction as V1.

V1= {2,7,-3};
V2= {-1,0,5};

(* Lab 2 *)
V1= {2,7,-3};
V2= {-1,0,5};
V1+V2
V1.V2
Cross[V1,V2]
ArcCos[V1.V2/(Norm[V1] Norm[V2])] /Degree //N
VectorAngle[V1,V2]/Degree //N  (* alternate way of getting the angle *)
Norm[V1]
V1/Norm[V1]
Normalize[V1]  (* alternate way of getting the unit vector*)

Problem 4

Plot3D the function (Subscript[J, n])((Sqrt[(x^2)+(y^2)])) over the ranges {x, -10, 10} and {y, -10, 10} and Manipulate the plot so that n runs from 0 to 5 in increments of 1.  For plot options, use a PlotRange setting that will show the whole range, hide the Mesh, and use enough PlotPoints to get a reasonably smooth surface. Also use Background->White as an option for the plot command. Hint: Recall that the (Subscript[J, n])(x) Bessel functions are represented in Mathematica as BesselJ[n,x].

(* Lab 3 *)
Manipulate[Plot3D[BesselJ[n,Sqrt[ x^2+ y^2]],{x,-10,10},{y,-10,10},PlotRange->{-.5,1},Mesh->False,PlotPoints->30, Background->White],{ n,0,5,1}]

Problem 5

Find all xy points that simultaneously satisfy the pair of equations, (x^2)+(y^2)=1 and (x^2)-(y^2)=(1/2).  Also ContourPlot both equations on the same graph to visually verify the solutions.

(* Lab 3 *)
eqn1 = x^2+y^2 ==1;
eqn2 = x^2 - y^2 == 1/2;
Solve[{eqn1,eqn2},{x,y}]
ContourPlot[{x^2+y^2 ==1,x^2 - y^2 == 0.5},{x,-1,1},{y,-1,1}]

Problem 6

Find all of the minima and maxima of the function f6(x)=(x^4)-3(((x-0.1))^2) that occur in the range -2<x<2, not including the endpoints of the range. Start with a plot that will help you to visualize the results.  Use list extraction and variable-replacement techniques to return each result as a single number (rather than as e.g. a replacement rule), and combine the numbers into a list.

(*Labs 1, 2, and 4*)

f6[x_] = x^4-3(x-0.1)^2;
Plot[f6[x],{x,-2,2}]
FindRoot[f6'[x]==0,{x,-1.2}] ;
first= x /.  %[[1]]
FindRoot[f6'[x]==0,{x,0}];
second = x/.%[[1]]
FindRoot[f6'[x]==0,{x,1.2}]  ;
third= x /.  %[[1]]
{first, second, third}

(* one alternate approach *)
f6b = x^4-3(x-0.1) ^2;
x/.Solve[D[f6b,x] == 0,x]  //N

(* another alternate approach *)
results={FindMaximum[f6b,{x,0.01}],FindMinimum[f6b,{x,-1}],FindMinimum[f6b,{x,1}]};
x/.results[[All,2]]

Problem 7

Calculate the Taylor series expansion of f7(x)=(e^(-(x^2)))about x = 0, up to 9th order.  Plot this series approximation, together with f7(x), on the same graph for the range -2 < x < 2.

(*Lab 4*)
f7[x_] = E^(-x^2);
f7series[x_] = Series[f7[x],{x,0,9}] //Normal; (* "Normal" to chop off the "order" term *)
Plot[{f7[x],f7series[x]},{x,-2,2}]

Problem 8

Create a pure function of m, called f8(m), that returns tanh(m) when m<0, or (∫_0^m) (e^(-(x^2)))dx when m>0.  Then plot this function for the range -2 < m < 2.

(*Lab 5*)

f8[m_] := If[m<0,Tanh[m], NIntegrate[Exp[-x^2],{x,0,m}]];
Plot[f8[m],{m,-2,2}]

(* alternate *)
f8b[m_] := Piecewise[{{Tanh[m],m<0},{NIntegrate[Exp[-x^2],{x,0,m}],m>0}}]
Plot[f8b[m],{m,-2,2}]

Problem 9

Use a conditional function such as  If, Which, or Switch  to create a function of  r  that returns the color Red when r<(1/3), Green when (1/3)<r<(2/3), and Blue when r>(2/3).  Use this function to Manipulate a thick variable-color Circle of radius r in front of a solid black Disk of radius 1, both centered at the origin, as r varies from 0 to 1.

(*Labs 3 and 6*)

func[r_]:= Which[r<1/3, Red, 1/3< r<2/3, Green, True, Blue];
Manipulate[Graphics[{Black,Disk[],func[r],Circle[{0,0},r]}],{r,0,1}]

Problem 10

Consider the equation  x = (e^(-(x^2))).  Use an iterative fixed-point technique using either a procedural loop (e.g.  While) or functional recursions (e.g. NestWhile) to find a solution to this equation to within a tolerance of (10^(-6)).  Hints: Start with a plot that helps you to visualize the result. You can use a built-in function (e.g. FindRoot or FixedPoint or Solve) to check your result.

(*Lab 6*)

g[x_] :=Exp[-x^2]
Plot[{x,g[x]},{x,-2,2}]
NestWhile[Exp[-#^2]&,.6 , Abs[# - Exp[-#^2]]>10^-6 &]
(* to check answer *)
FindRoot[g[x]==x,{x,.6}] 

(* alternate *)
latest = 1.0;
While[Abs[latest-g[latest]]>0.000001,latest=g[latest]//N] 
latest

Problem 11

Use Module to create a function, wilddice[numdice_, numrolls_], that simulates numrolls rolls of a set of numdice 6-sided dice. The function should keep track of the highest die in each roll, and return the average value of all of those highest dice. Demonstrate it on the case of (10^6) rolls of a set of 4 dice.  Hint: You can use RandomInteger to simulate all of the rolls in one fell swoop, using it to create a 2D list of random numbers of dimensions {numrolls,numdice}. Also, if you do things right, given (10^6) rolls of a set of 4 dice your function should always spit out an answer in the range from 5.24-5.25.

(*Lab 7*)

wilddice[numdice_,numrolls_] := Module[{alldice,maxvals},
alldice=RandomInteger[{1,6},{numrolls,numdice}];
maxvals=Max[#]& /@ alldice;
Mean[maxvals]
]
wilddice[4, 10^6] //N

Problem 12

Import the data from http://www.physics.byu.edu/faculty/colton/courses/phy230-winter14/reviewdata.csv. It’s a set of (x,y) values. ListPlot the data. Then create a new set of (x,y) values such that all of the new y-values are the natural logs of all of the old y values, and replot. (The x-values are unchanged.) Finally, Export the new (x,y) values as a file named logdata.csv.

(*Lab 8*)

reviewdata=Import["http://www.physics.byu.edu/faculty/colton/courses/phy230-winter14/reviewdata.csv"];
ListPlot[reviewdata]
xs=Transpose[reviewdata][[1]];
ys=Transpose[reviewdata][[2]];
newdata = {xs,Log[ys]}//Transpose;
ListPlot[newdata]
SetDirectory[NotebookDirectory[]] 
Export["logdata.csv",newdata]

Problem 13

Do a nonlinear fit with this “Gaussian” function, A (e^(-(((x-(Subscript[x, 0])))^2)/2(σ^2))), for the data points given below in order to obtain optimal values of A, (Subscript[x, 0]) and σ.  Then show the data and the fitted curve on the same graph.

xydata = {{0.0,-0.761476},{0.1,-0.389413},{0.2,-0.119121},{0.3,0.254064},{0.4,-0.430805},{0.5,1.116298},{0.6,0.490214},{0.7,1.403165},{0.8,-1.601758},{0.9,0.619871},{1.0,0.442477},{1.1,-1.600008},{1.2,2.557217},{1.3,1.761273},{1.4,3.289209},{1.5,3.76326},{1.6,6.965403},{1.7,7.665031},{1.8,13.27485},{1.9,16.378819},{2.0,18.836586},{2.1,26.176823},{2.2,27.5628},{2.3,31.469843},{2.4,31.66615},{2.5,32.585918},{2.6,32.670335},{2.7,29.356804},{2.8,27.078932},{2.9,22.89584},{3.0,18.86661},{3.1,14.720821},{3.2,11.519845},{3.3,7.292007},{3.4,5.824593},{3.5,4.583305},{3.6,0.878014},{3.7,2.845936},{3.8,-1.543773},{3.9,-0.045952},{4.0,1.519232},{4.1,-0.557722},{4.2,-1.280743},{4.3,-0.084379},{4.4,-0.135634},{4.5,1.412747},{4.6,-0.027551},{4.7,0.629743},{4.8,1.468815},{4.9,-0.638792},{5.0,-0.467241}}

(*Lab 9*)
xydata = {{0.0,-0.761476},{0.1,-0.389413},{0.2,-0.119121},{0.3,0.254064},{0.4,-0.430805},{0.5,1.116298},{0.6,0.490214},{0.7,1.403165},{0.8,-1.601758},{0.9,0.619871},{1.0,0.442477},{1.1,-1.600008},{1.2,2.557217},{1.3,1.761273},{1.4,3.289209},{1.5,3.76326},{1.6,6.965403},{1.7,7.665031},{1.8,13.27485},{1.9,16.378819},{2.0,18.836586},{2.1,26.176823},{2.2,27.5628},{2.3,31.469843},{2.4,31.66615},{2.5,32.585918},{2.6,32.670335},{2.7,29.356804},{2.8,27.078932},{2.9,22.89584},{3.0,18.86661},{3.1,14.720821},{3.2,11.519845},{3.3,7.292007},{3.4,5.824593},{3.5,4.583305},{3.6,0.878014},{3.7,2.845936},{3.8,-1.543773},{3.9,-0.045952},{4.0,1.519232},{4.1,-0.557722},{4.2,-1.280743},{4.3,-0.084379},{4.4,-0.135634},{4.5,1.412747},{4.6,-0.027551},{4.7,0.629743},{4.8,1.468815},{4.9,-0.638792},{5.0,-0.467241}};

plot1= ListPlot[xydata];
eqn = a*Exp[-(x-x0)^2/2/s^2];
FindFit[xydata,eqn ,{a,x0,s},x]
bestfit = eqn /. %;
plot2=Plot[bestfit, {x,0,5}];
Show[plot1,plot2]

Problem 14

Next year, you (A) will be half the age of your mother (B).  Last year, you were half the age of your father (C).  Currently, your mother's and father's combined age is 100.  Turn these three statements into equations involving variables A, B and C.  Then use matrix techniques to solve the simultaneous equations.

(*Lab 10*)

(*  A - B/2       = -1/2
A       - C/2 = +1/2  
   B   + C   = 100 
*)
matrix = {{1,-1/2,0},{1,0,-1/2},{0,1,1}};
vector = {-1/2, 1/2, 100};
Inverse[matrix].vector

Problem 15

In the Linear Algebra lab, you tackled the problem of two coupled masses (mass m) connected by springs. The equations of motion were thus: 

m(((d^2)u)/(dt^2))=u(-(Subscript[k, b])-(Subscript[k, s])) + v((Subscript[k, s]))
m(((d^2)v)/(dt^2))=u((Subscript[k, s]))+v(-(Subscript[k, b])-(Subscript[k, s]))

The spring constants (Subscript[k, b]) and (Subscript[k, s]) described the springs connecting the masses to the boundaries and to each other, respectively. In the situation where all masses and k’s are equal to one (and ignoring units), that means:

(((d^2)u)/(dt^2))=-2u + v
(((d^2)v)/(dt^2))=+u-2v

which leads to this eigenvalue equation for the amplitudes (Subscript[u, 0]) and (Subscript[v, 0]) (with λ = (ω^2) because m=1):

λ(({{(Subscript[u, 0])}, {(Subscript[v, 0])}})) = (({{2, -1}, {-1, 2}}))(({{(Subscript[u, 0])}, {(Subscript[v, 0])}}))

Using the exact same sort of analysis, one can show that for SIX coupled masses (each mass attached to its left and right neighbors via a spring, all masses and spring constants equal to 1), the eigenvalue equation becomes:

λ (({{(Subscript[u, 1])}, {(Subscript[u, 2])
(Subscript[u, 3])
(Subscript[u, 4])
(Subscript[u, 5])
(Subscript[u, 6])}})) = (({{2, -1, 0, 0, 0, 0}, {-1, 2, -1, 0, 0, 0}, {0, -1, 2, -1, 0, 0}, {0, 0, -1, 2, -1, 0}, {0, 0, 0, -1, 2, -1}, {0, 0, 0, 0, -1, 2}})) (({{(Subscript[u, 1])}, {(Subscript[u, 2])
(Subscript[u, 3])
(Subscript[u, 4])
(Subscript[u, 5])
(Subscript[u, 6])}})) 
For simplicity I’ve used  (Subscript[u, 1]),..., (Subscript[u, 6]) to indicate the amplitudes of the 6 masses instead of (Subscript[u, 0]), (Subscript[v, 0]), (Subscript[w, 0]), etc.. 

Solve for the 6 eigenvalues and calculate the 6 allowed ω’s. Sort the list from low to high. Do a ListPlot of the 6 frequencies you obtain. Set the plot range to go from 0 to the maximum ω.

Hint: If you don’t want to type in all of the matrix elements by hand, there’s a shortcut trick given under the Examples->Scope section of the SparseArray help file, for nearly this exact same matrix. (A SparseArray acts in most respects like a regular matrix, but is computationally faster to work with.)

(*Lab 10*)

m = -1*SparseArray[{{i_,i_}->-2,{i_,j_}/;Abs[i-j]==1->1},{6,6}];
m //MatrixForm (* to make sure matrix looks right *)
evs = Eigenvalues[m] //N //Sort //Sqrt[#] &
ListPlot[evs, PlotRange->{0,Max[evs]}]
(*Plot[Sin[x],{x,0,Pi/2}]*)

Problem 16

Exam 1 had a problem involving the Riemann zeta function, Zeta[x], where you had to find the closest zero of the function (i.e. place where Zeta[x] = 0) to the left of the origin. The answer was the point x = - 2. The next zeroes as you move away from the origin are at x = -4, -6, -8, -10, etc.

When Zeta[x] is considered as a function of complex numbers, there are additional zeroes that do not follow any regular pattern. However, all of the additional zeroes known to exist lie on the line that has real part of 0.5. That’s a vertical line in the complex plane, 0.5 units to the right of the y-axis, as shown here: 



This is called the “critical line”, and some mathematicians believe that all additional zeroes MUST lie on that line. That is called the Riemann hypothesis, and is one of the great unsolved questions in mathematics. In fact, if you can prove or disprove that hypothesis, you win an automatic $1,000,000 prize. Through one of the marvels of number theory, this hypothesis has an intimate connection to prime numbers (namely, the Prime Number Theorem); I highly recommend the book Prime Obsession by John Derbyshire if you are interested in more details. 
 
(a) Make a plot of Zeta[z] along this line from the point (0.5,0) to (0.5,30). Because it’s a complex function you’ll need to plot the real and imaginary parts separately. Or you can plot them on the same graph, if you’d like. (Compare to the first plot in the Riemann hypothesis Wikipedia article.)

Because you can only use Plot with a real number variable, the x-axis of your plot will need to be some real number parameter that causes the left hand end of your plot to represent the point (0.5,0) and the right hand end of your plot to represent the point (0.5,30). The easiest way to do that is to use the y-coordinate (i.e. the imaginary value) of z as your plot’s x-axis. I.e. since x always equals 0.5 along this line, you can plug z into your function as z = 0.5 + i y  where y is always a real number.

(b) Then make an additional plot of the absolute value of the zeta function over that same domain (it’s a strictly real function) and determine what the y value is for the first zero along the critical line, to at least 10 decimal places. Hint: I used the FindRoot function operating on the absolute value of the zeta function; an  error message popped up but it produced the correct answer.

(*Lab 11*)

(* didn't time this *)
f16[y_] = Zeta[.5 + I y]
Plot[{Re[f16[y]], Im[f16[y]]},{y,0,30}]
Plot[Abs[f16[y]],{y,0,30}]
FindRoot[Abs[f16[y]],{y,14}, WorkingPrecision->20]