Physics 230 - Exam 2 - Winter 2014

The Rules:

• This exam covers material from Labs 6 - 10. It is due at midnight of Tues, Mar 24 for the Friday section (this is a day longer than indicated in the syllabus), or midnight of Thursday Mar 26 for the Monday section.

• The exam is completely open notes/books. You may use your old labs, Mathematica's help files, internet websites, etc.

• You may not consult with any person about the exam. That includes classmates, TAs, friends, relatives, other professors, Facebook, internet message boards or chat rooms, etc. If anything on the exam is unclear, please ask me directly.

• Do not speak to any of your fellow students about the exam until after the SECOND due date (i.e. midnight Mar 26).

• There is no partial credit, except in extraordinary circumstances. All problems are pass/fail, 1 pt each. Be sure to read each problem very carefully so that you are doing what is requested, and that you are doing EVERYTHING that is requested.

• The problems are listed roughly in order of difficulty--but only roughly, because what's hard for one student might not be hard for another.

• Enter your solutions directly in this notebook after each problem. Rename the notebook to be “exam2 - [your name].nb”, and email it to me when completed. My email address is john_colton@byu.edu.

• To grade your exam, the TA or I will:
(1) quit the kernel (so the previous student’s exam won’t affect you).
(1) select Delete All Output under the Cell menu,
(2) select Evaluate Notebook under the Evaluation menu, 
(3) and then grade the output. 
Therefore, all solutions must be generated by Mathematica commands in your notebook. I will not Clear variables or Quit/Start the kernel between your problems. Choose your variable names carefully so that there are no conflicts, and be very careful if you use “%”.

Sincerely,

Dr Colton

Problem 1

Solve these simultaneous equations: 

2a + 3b  + 4c + d = 0 
 a  - b   + c - d = -1
 a - 9b - 10c + d = 5
            c + d = 10

m = {{2,3,4,1},{1,-1,1,-1},{1,-9,-10,1},{0,0,1,1}};
v = {0,-1,5,10};
answers=Inverse[m].v
answers=Inverse[m].v //N  (* in numerical form, if you prefer *)

(* took me 0:40 *)

Problem 2

Create a function which returns text values of “one”, “two”, “three”, ..., “ten” for inputs of 1, 2, 3, ..., 10, respectively. If the input isn’t an integer in the range from 1-10 then it should return “” (an empty string).

textnumber[n_]:=Switch[n, 1, "one", 2, "two", 3, "three", 4, "four", 5, "five", 6, "six", 7, "seven", 8, "eight", 9, "nine", 10, "ten", _, ""]
textnumber[7]
textnumber[2.3]
(* took me 1:30 *)

Problem 3

Create an animated gif that depicts this function from times of t = 0 to t = 2π, using time steps of 0.1:  f(x,t) = sin(sin(t)*x - t).  Plot the x-axis from -10 to 10 and fix the y-axis plot range to be -1 to 1. Name the output file “p3output-[yourlastname].gif”.

SetDirectory[NotebookDirectory[]] ;
f[x_,t_] := Sin[Sin[t]*x - t];
ft = Table[Plot[f[x,t],{x,-10,10},PlotRange->{-1,1}],{t,0,2 Pi,0.1}];
Export["p3output-colton.gif",ft]
(* took me 1:40 *)

Problem 4

Use Module to create a function which returns the largest factor of a number. The built-in function Divisors could be very helpful. Remember that by definition a number is not its own factor. Test it out for the numbers 100 (which should return 50) and 135 (which should return 45).

largestfactor[n_] := Module[{divisors, length},
divisors=Divisors[n];
length=Length[divisors];
divisors[[length-1]]
]

largestfactor[100]
largestfactor[135]
(* took me 2:00 *)

Problem 5

Consider the transcendental equation (x^2)=sin(x) cos(x). As the Plot command below shows, it has two solutions (the left and right hand sides of the equation intersect in two spots), one at x = 0 and one that looks to me like it’s around x = 0.65. Find the second solution via iterative computation. Do this by recognizing that the solution to that equation is the same as the solution to this equation (square rooting both sides): x = sqrt(sin(x) cos(x)), so if you iteratively compute sqrt(sin(x) cos(x)) and it converges to an answer, that is the solution.

As was done in one of the lab assignments from the Programming I lab, I’d like you to do this using a While loop. (This can be outside of a Module.) Start with a global variable, latest = 0.65, and use While to recursively compute sqrt(sin(x) cos(x)) until the magnitude of the change between recursions is less than 10^-7. In other words, keep evaluating  latest = sqrt (sin(latest) cos(latest))   as long as abs(sqrt(sin(latest) cos(latest))  -  latest) > 10^-7.  Use a second global variable to count the number of iterations the loop goes through before the 10^-7 tolerance is reached. Display the answer along with the number of iterations. 

You can use FindRoot to check your answer if you’d like.

Plot[{x^2,Sin[x] Cos[x]},{x,-2,2}]

latest = 0.65; ni=0;
While[Abs[Sqrt[Sin[latest] Cos[latest] ]-latest]> 1.0*^-7,latest=Sqrt[Sin[latest] Cos[latest] ];ni++]
latest
ni
FindRoot[xr^2 == Sin[xr] Cos[xr],{xr,0.65}]  (* to check the answer *)
(* took me 2:40 *)

Problem 6

This file contains three columns of data:  http://www.physics.byu.edu/faculty/colton/courses/phy230-winter15/exam2p6.csv.  Let’s call the columns x, y, and z.  Write some Mathematica code that imports the data, manipulates it, and exports a new csv file with two data columns whose values are x and y*z, meaning the new second column values are the product of the y and z values for a given x value. Call the output file “p6output-[yourlastname].csv”, and it should output the file into the same directory as your exam solutions notebook.

Hint: if you’d like to, you can ListPlot your data. It should look something like sin(x)*cos(x) with some added noise.

SetDirectory[NotebookDirectory[]] ;
data=Import["http://www.physics.byu.edu/faculty/colton/courses/phy230-winter15/exam2p6.csv"];
{x,y,z} = data//Transpose;
newdata = {x,y*z}//Transpose;
ListPlot[newdata]
Plot[Sin[x] Cos[x],{x,0,5}]  (* to check the answer *)
Export["p6output-colton.csv", newdata]

(* took me 3:20 *)

Problem 7

Use Module to create a function named “allOddQ” that returns true if all of the digits of a number are odd, and false otherwise.

Hint: the built-in functions IntegerDigits and OddQ will be useful. I also used MemberQ in my own solution but I’m sure there are many other ways to do it without using that function.

allOddQ[n_] := Module[{listofdigits, boolarray},
listofdigits = IntegerDigits[n];
boolarray = OddQ[#]& /@ listofdigits ;
MemberQ[boolarray,False] //Not
]
allOddQ[1357]  (* to test the function, should return True *)
allOddQ[1358] (* to test the function, should return False *)
(* took me 3:40 *)

Problem 8

Use the eigenvalue method to solve for the normal mode frequencies for two coupled masses with unequal masses (m1 = 1 and m2 = 2, listed from left to right) and unequal spring constants (k1 = 4, k2 = 5, and k3 = 6, listed from left to right).  Use the eigenvectors to describe the motion for the two normal modes, being clear which motion corresponds to which frequency. 
  
I’ll set you up with the equations like I did in the lab... using the same techniques as done in the Linear Algebra lab, the equations for the situation of unequal masses and unequal springs become  the following:

(Subscript[m, 1])(((d^2)u)/(dt^2))=(Subscript[k, 2])(v-u)-(Subscript[k, 1])u
(Subscript[m, 2])(((d^2)v)/(dt^2))=-(Subscript[k, 3])v-(Subscript[k, 2])(v-u)



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


(Subscript[m, 1]) (ω^2)(Subscript[u, 0])=(Subscript[u, 0])((Subscript[k, 1])+(Subscript[k, 2])) + (Subscript[v, 0])(-(Subscript[k, 2]))
(Subscript[m, 2]) (ω^2)(Subscript[v, 0])=(Subscript[u, 0])(-(Subscript[k, 2]))         +(Subscript[v, 0])((Subscript[k, 2])+(Subscript[k, 3]))


(ω^2)(Subscript[u, 0])=(Subscript[u, 0])((Subscript[k, 1])+(Subscript[k, 2]))/(Subscript[m, 1])+ (Subscript[v, 0])(-(Subscript[k, 2])/(Subscript[m, 1]))
(ω^2)(Subscript[v, 0])=(Subscript[u, 0])(-(Subscript[k, 2])/(Subscript[m, 2]))         +(Subscript[v, 0])((Subscript[k, 2])+(Subscript[k, 3]))/(Subscript[m, 2])


Or, in matrix form, with λ= (ω^2): 

λ(({{(Subscript[u, 0])}, {
(Subscript[v, 0])}})) = (({{(((Subscript[k, 1])+(Subscript[k, 2]))/(Subscript[m, 1])), -((Subscript[k, 2])/(Subscript[m, 1]))}, {-((Subscript[k, 2])/(Subscript[m, 2])), (((Subscript[k, 2])+(Subscript[k, 3]))/(Subscript[m, 2]))}}))(({{(Subscript[u, 0])}, {
(Subscript[v, 0])}}))

Note that I needed to divide the two equations by m1 and m2 respectively in order for the matrix equation to have the proper form for an eigenvalue equation, so λ has a slightly different meaning here than in the lab (where it was  λ= m (ω^2)).

m1 = 1;
m2 = 2;
k1 = 4;
k2 = 5;
k3 = 6;

matrix = {{(k1+k2)/m1, -k2/m1},{-k2/m2, (k2+k3)/m2}};
% //MatrixForm //N
Eigensystem[matrix]//N //MatrixForm
freqs = Sqrt[Eigenvalues[matrix] ]// N

(* Here are the answers from the output
 first mode: freq w = 3.34588, m1 and m2 are out of phase with m1 having 2.27797 times the amplitude of m2.
second mode: freq w = 1.81798, m1 and m2 are in phase with m1 having 0.877973 times the amplitude of m2. *)

(* took me 3:50 seconds*)

Problem 9

This file contains two columns of experimental data:  http://www.physics.byu.edu/faculty/colton/courses/phy230-winter15/exam2p9.csv. Fit the data to a Gaussian peak, which is related to the Normal Distribution, of the form: f(x) = (Subscript[y, 0])  +  (A/(w sqrt(π/2)))exp(-((2 (((x-(Subscript[x, 0])))^2))/(w^2))) , where (Subscript[x, 0]), w, (Subscript[y, 0]), and A are fitting parameters corresponding to the peak center, peak width, y-offset, and peak area (as measured from the y-offset), respectively. For each of the four parameters report their best fit values and their uncertainties (you don’t have to create any special output here, just make sure those eight values are all output in some form).


Hint: if you’d like to, you can Plot your fit on top of a ListPlot of the data. They should overlap nicely.

Another hint: if you used “x” as a variable name above, you might need to Clear it.

p9data = Import["http://www.physics.byu.edu/faculty/colton/courses/phy230-winter15/exam2p9.csv"];
plot9a=ListPlot[p9data]
Clear[x]
p9nlm = NonlinearModelFit[p9data, y0 + A/(w Sqrt[Pi/2]) Exp[-2 (x-x0)^2/w^2], {x0,w,y0,A},x]
p9nlm["BestFit"]
p9nlm["BestFitParameters"]
p9nlm["ParameterErrors"]
plot9b=Plot[p9nlm["BestFit"], {x,1,8}, PlotStyle->Red];
Show[plot9a,plot9b]


(* took me 4:30 *)

Problem 10

(a) How long did you spend working on this exam? (This is for my own assessment purposes only.)
(b) If you could eliminate or modify one assignment from labs 6-10, what would it be and why? As long as you answer the question and give a reasonable explanation for your choice you will get credit for this. Also, please use proper English grammar and spelling.

Blah blah blah

Problem 11 - Extra Credit

For the same situation as the coupled harmonic oscillator problem above, figure out how to modify the time dependent code from the Linear Algebra lab to be appropriate for this situation, and demonstrate the oscillations of the two normal modes as you did for Assignment 8 in the lab. Show that their periods are as predicted by the eigenvalue technique. Also demonstrate at least one situation that is not a normal mode.

Clear[m1,m2,k1,k2,k3,u,v,matrix]
m1 = 1;
m2 = 2;
k1 = 4;
k2 = 5;
k3 = 6;

matrix = {{(k1+k2)/m1, -k2/m1},{-k2/m2, (k2+k3)/m2}};

unknowns ={u[t],v[t]};    (* This is the vector x, containing u(t) and v(t) *)
equations = (#==0&)/@ ( D[unknowns,{t,2}]+matrix.unknowns);
initialconditions = {u[0]==u0,u'[0]==uvel0,v[0]==v0,v'[0]==vvel0};  (* u0 and uvel0 are initial position and velocity for mass 1; v0 and vvel0 are same thing for mass 2 *)
positions = unknowns/.DSolve[{equations,initialconditions},unknowns,t][[1]]

(* first normal mode *)
timedep = positions /.{u0->-2.27797, v0->1,uvel0->0,vvel0->0}//Re//ComplexExpand//Chop;
Plot[timedep,{t,0,12},PlotStyle->{{Thick,Red},{Thick,Blue}}]
(* First mode: freq w = 3.34588, m1 and m2 are out of phase with m1 having 2.27797 times the amplitude of m2.  Period should be T=2π/ω= 1.878. And it is!  *)


(* second normal mode *)
timedep = positions /.{u0->0.877973, v0->1,uvel0->0,vvel0->0}//Re//ComplexExpand//Chop;
Plot[timedep,{t,0,18},PlotStyle->{{Thick,Red},{Thick,Blue}}]
(* Second mode: freq w = 1.81798, m1 and m2 are in phase with m1 having 0.877973 times the amplitude of m2. Period should be T=2π/ω= 3.456. And it is! *)


(* not a normal mode *)
timedep = positions /.{u0->1, v0->0,uvel0->0,vvel0->0}//Re//ComplexExpand//Chop;
Plot[timedep,{t,0,18},PlotStyle->{{Thick,Red},{Thick,Blue}}]

(* took me 6:10 *)