Physics 230 - Exam 2 - Winter 2014

The Rules:

• This exam covers material from Labs 6 - 10, although of course some knowledge of Labs 1-5 is also assumed. It is due at midnight of Mar 18 (for the Friday section), or midnight of Mar 21 (for the Monday section). Those dates give you an extra day compared to what’s written on the syllabus.

• 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 (Dr Colton) directly.

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

• 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 “exam1 - [your name].nb”, and email it to me when completed. My email address is john_colton@byu.edu.

• To grade your exam I (or a TA) will:
(1) quit the kernel (so the previous student’s exam won’t affect you).
(2) select Delete All Output under the Cell menu,
(3) select Evaluate Notebook under the Evaluation menu, 
(4) and then grade the output. 
Therefore, all solutions must be generated by the 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 when using %.

Problem 1 - Lab 6

Create a function which tests whether an integer is a palindrome (that is, if the number reads the same forward as backward). It should take an integer as input, return True if it is a palindrome, and return False otherwise. For example, “1365631” should return True but “136531” should return False. Test your function using those two numbers. Hint: The built-in functions IntegerDigits and Reverse will be helpful. Also, you should be able to do this without a Module, but you are welcome to use a Module if you like.

(* simplest way *)
ispalindrome[n_Integer]:= IntegerDigits[n] == Reverse[IntegerDigits[n]]
ispalindrome[1365631]
ispalindrome[136531]
(* took me 1:30 *)

(* alternate method *)
ispalindrome2[n_Integer]:= If[IntegerDigits[n] == Reverse[IntegerDigits[n]], True, False]
ispalindrome2[1365631]
ispalindrome2[136531]

Problem 2 - Lab 8

Use one or more string functions to count the number of vowels (a, e, i, o, and u) in the Gettysburg Address. Here’s the text:

    Four score and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal.
    
    Now we are engaged in a great civil war, testing whether that nation, or any nation so conceived and so dedicated, can long endure. We are met on a great battlefield of that war. We have come to dedicate a portion of that field, as a final resting place for those who here gave their lives that that nation might live. It is altogether fitting and proper that we should do this.
    
    But, in a larger sense, we can not dedicate, we can not consecrate, we can not hallow this ground. The brave men, living and dead, who struggled here, have consecrated it, far above our poor power to add or detract. The world will little note, nor long remember what we say here, but it can never forget what they did here. It is for us the living, rather, to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us—that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion—that we here highly resolve that these dead shall not have died in vain—that this nation, under God, shall have a new birth of freedom—and that government of the people, by the people, for the people, shall not perish from the earth.

text = "    Four score and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal.
    
    Now we are engaged in a great civil war, testing whether that nation, or any nation so conceived and so dedicated, can long endure. We are met on a great battlefield of that war. We have come to dedicate a portion of that field, as a final resting place for those who here gave their lives that that nation might live. It is altogether fitting and proper that we should do this.
    
    But, in a larger sense, we can not dedicate, we can not consecrate, we can not hallow this ground. The brave men, living and dead, who struggled here, have consecrated it, far above our poor power to add or detract. The world will little note, nor long remember what we say here, but it can never forget what they did here. It is for us the living, rather, to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us—that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion—that we here highly resolve that these dead shall not have died in vain—that this nation, under God, shall have a new birth of freedom—and that government of the people, by the people, for the people, shall not perish from the earth."

StringCount[text,{"a","e","i","o","u"}]
StringCount[text,{"a"}] + StringCount[text,{"e"}] + StringCount[text,{"i"}] + StringCount[text,{"o"}] + StringCount[text,{"u"}]  (* to double check *)
(* took me 1:10 *)

Problem 3 - Lab 10

In the following system of coupled masses, m = 0.4 kg, (Subscript[k, b])=10 N/m, and (Subscript[k, s])=13 N/m. 



Use the eigenvalue technique to determine the oscillation frequencies of the two normal modes. Hint: refer to the linear algebra lab for the matrix equation for this situation, and remember that the oscillation frequencies are ω=(Sqrt[λ/m])  for each λ.

m=0.4; kb=10; ks=13;
matrix={{kb+ks,-ks},{-ks,kb+ks}};
% //MatrixForm
lambdas=Eigenvalues[matrix]
omegas = Sqrt[lambdas/m]

(* took me 1:40 *)

Problem 4 - Lab 10

The arrows in the figure indicate currents flowing through wires in an electric circuit. The parallel line symbol near (for example) the “5 V” label indicates a battery, and the zig-zag symbol near (for example) the “2000 Ω” label indicates a resistor. There are three batteries and four resistors in the circuit. 
 


The currents in such circuits must often be solved for using simultaneous equations, using Kirchoff’s Laws. In this particular circuit, one way of writing the necessary simultaneous equations is as follows:

I1 + I2 + I3 = 0 					(from the top junction; obviously at least one current as drawn must be negative)
5 - (2000) I1 + (3000) I2 - 4 - (1000) I1 = 0  	(from the outer loop)
5 - (2000) I1 + (4000) I3 - 6 - (1000) I1 = 0  	(from the left hand loop)

Simplify the equations, then solve them simultaneously for I1, I2, and I3 using matrix multiplication. Give your answer in mA  (i.e. multiply the answers in amps by 1000). Hint: write each equation with all of the terms containing I’s on one side of the equation and the terms without I’s on the other side.

(*
I1 + I2 + I3 = 0 
-3000I1 + 3000I2 +  0I3= -1
-3000I1 + 0I2  + 4000I3 = 1
*)

m =  {{1,1,1},{-3000,3000,0},{-3000,0,4000}};
%//MatrixForm
v= {0,-1,1}

Inverse[m] . v
% * 1000 //MatrixForm//N   (* in mA *)

(* took me 3:50 *)

Problem 5 - Lab 7

Create a program (Module) which asks the user to input a number, then prints “Yes, [number] is a perfect square!” if it’s a perfect square (i.e. 1, 4, 9, 16, etc.), and “Sorry, [number] is not a perfect square.” if it’s not. The program should keep requesting numbers until the user inputs a negative number.  Hint: you may want to first create an “isSquare” function that returns True is the number is a perfect square and false otherwise.

squareQ[n_] :=  IntegerQ[Sqrt[n]]
squareQ[256] (* testing *)
program[]:=Module[{input=0,string},
input=Input["Enter a number (a negative number to quit):"];
While[input≥0 ,
If[squareQ[input], string="Yes, " <> ToString[input] <> " is a perfect square!", string="Sorry, " <> ToString[input] <> " is not a perfect square."];
Print[string];
input=Input["Enter a number (a negative number to quit):"];
]
]
program[]

(* took me 5:30 *)

Problem 6 - Lab 7

As you should probably know by now, Mathematica has a built-in prime number command: Prime[n] gives the nth prime number. For this assignment you need to create a function which returns a list of all the prime numbers that are less than or equal to a user-specified number (the input to the function). For example, if you call the function with an argument of 72, it should output this list: {2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71}  because those are all the prime numbers less than or equal to 72.  If a non-integer is used as the input, the function should still work the same way. Test out your function by creating a list of all the primes less than 2345.67. Hint: Feel free to use the Prime[n] command in your program--using that function in a similar manner to how most students solved the Fibonacci list problem in the Programming 2 lab is probably much easier than e.g. implementing the Sieve of Eratosthenes from scratch (if you’re familiar with that). 

Optional: The function you created, when combined with Total, should allow you to easily solve problem 10 at projecteuler.net, https://projecteuler.net/problems. It will involve a list of close to 150,000 numbers, though, so if you want to solve it you might need to optimize your list creation with Sow and Reap rather than using Append or AppendTo.

primelist[max_]:= Module[{n=1, workinglist={}},
While[Prime[n]≤max,
AppendTo [workinglist,Prime[n]];
n++;
];
workinglist
]
primelist[72]
primelist[2345.67]
(* took me 6:15, without looking at any of my Lab 7 code. Would have been much shorter otherwise. *)

(*optimizing things with Sow and Reap to be able to solve Project Euler #10*)
primelist2[max_]:= Module[{n=1, workinglist={}},
workinglist = Reap[
While[Prime[n]≤max,
Sow[Prime[n]];
n++;
]][[2,1]];
workinglist
]
primelist2[72];
primelist2[2345.67];
primelist2[2000000]//Total;  (* only takes a second *)

Problem 7 - Lab 8

I have created a few animated gifs for various Wikipedia articles. One that I’m particularly fond of can be found here: http://en.wikipedia.org/wiki/Group_velocity. It is the second animation on the right, whose caption reads “This shows a wave with the group velocity and phase velocity going in different directions...”.  That means that while the wave itself (i.e. the envelope) is going to the right, the ripples inside the wave are going to the left! Look closely, it’s mesmerizing. :-)  (Actually, now that I look at it, I think someone may have replaced my original animation with one that animates faster than mine used to.)

The function I used to create the animation was something like this:

f(x,t)=(∑_(k=0.9)^1.1)cos(kx + t/(k^2)),  where k is summed from 0.9 to 1.1 in increments of 0.05. 

Create an animated gif of that function yourself using these guidelines: Use Plot to display the function for x between -25 and 25, with a fixed PlotRange in order to preserve the y-axis scale from plot to plot. Create a table of plots with t going from 0 to 15, using time steps of 0.25, then use Export to create the animated gif. (On my computer my code for this problem took about 25 seconds to run.)

Cause the gif that gets created to be named “firstname_lastname.gif”, where those are your own names, of course. Make sure it exports to the same directory your exam is saved to.

Have the last command of your solution be  SystemOpen[“firstname_lastname.gif”], so that your animation automatically opens up when your code is run.

SetDirectory[NotebookDirectory[]]

f[x_,t_] = Sum[Cos[k x + t/k^2],{k,0.9,1.1, 0.05}]
Plot[f[x,0],{x,-25,25},PlotRange->{-5,5}] (* testing one graph *)
tableofplots = Table[Plot[f[x,t],{x,-25,25},PlotRange->{-5,5}],{t,0,15,.25}];  
Export["john_colton.gif",tableofplots]
SystemOpen["john_colton.gif"]
(* took me 3:20 ish to write. takes ~25 sec to run *)

Problem 8 - Lab 9

In the Optimization lab, you learned how to fit a periodic function using a linear combination of sines and/or cosines. In a very similar fashion you can always fit a section of any function f(x) with a linear combination of Legendre polynomials if you restrict the range from  -1 < x < 1. In other words, if (Subscript[P, n])(x) represents the nth Legendre polynomial LegendreP[n,x], then 

f(x)=(Subscript[c, 0])(Subscript[P, 0])(x) +(Subscript[c, 1])(Subscript[P, 1])(x)+(Subscript[c, 2])(Subscript[P, 2])(x)+(Subscript[c, 3])(Subscript[P, 3])(x)+... 

for some set of coefficients (Subscript[c, 0]), (Subscript[c, 1]), (Subscript[c, 2]), etc.

Consider this particular function:  y(x)=cos(6π x) exp(-((πx)^2))

(a) Create a list of {x,y} data by “sampling” the function y(x) from -1 to 1 in steps of 0.01. 
(b) Create a list of Legendre polynomial basis functions:  {(Subscript[P, 0])(x), (Subscript[P, 1])(x),(Subscript[P, 2])(x), ...}
(c) Do a linear fit of your sampled data over the set of basis functions. Plot the original function and your fitted representation together on the same graph (using different colors), in the range from  -1 < x < 1. 

Be sure to choose enough basis functions that your fit does a good job of reproducing the y(x) function, but not so many that the fit takes too long to complete.

y[x_] = Cos[6 Pi x] Exp[-Pi x^2]
plot1=Plot[y[x],{x,-1,1},PlotStyle->Red];
sampleddata=Table[{x,y[x]},{x,-1,1,.01}];
ListPlot[sampleddata];
basisfunctions = Table[LegendreP[n,x],{n,1,30}];  (* trial and error: 30 functions worked well *)
linearfit = Fit[sampleddata,basisfunctions,x];
plot2 = Plot[linearfit,{x,-1,1}];
Show[plot1,plot2]
(* took me 4:45 *)

Problem 9 - Lab 9

Consider the situation where an object is heated with a constant power P, while simultaneously being connected to a cold reservoir at a lower temperature.  When Newton’s Law of Cooling,   dQ/dt = -γ(T-(Subscript[T, ∞])) is combined with the definition of heat capacity,  dQ = C dT, and the constant heating power P is added in, the combined equation takes the following form: CdT/dt=-γ(T-(Subscript[T, ∞]))+P. In that equation C is the heat capacity (specific heat times mass),  γ is the cooling coefficient and (Subscript[T, ∞]) is the temperature of the cold reservoir (i.e. the temperature the object would reach if P = 0). The solution to that differential equation describes how the temperature will vary with time: T(t)=(P+γ (Subscript[T, ∞]))/γ + β exp(-γ t/C) .  (β is an unknown coefficient that depends on initial conditions.)

Use that equation, with P = 83.4 W and (Subscript[T, ∞])=288 K, and γ, β, and C as fit parameters, to fit this experimental data taken by one of the TAs (Jacob) for his Physics 240 class: http://www.physics.byu.edu/faculty/colton/courses/PHY230-Winter14/heatingcurvewitherrors.csv. The data was taken while heating an aluminum block for approximately 10 mins with a heater (83.4 W) while connected to a 288 K ice-water bath via a copper rod. The first column is the time (in seconds), the second column is the measured temperature (Kelvin), and the third column is the standard deviation of each temperature measurement (also in Kelvin). Fit the curve using NonlinearModelFit, with the three specified parameters and with time as the variable. Have Mathematica display the fitted values of the parameters and their uncertainties, and then plot the fitted function along with the data (in different colors). Don’t worry about error bars or anything like that. For the fit, make sure to use the  Weights->1/uncertainty^2  option, where uncertainty is the list of standard deviations from the data.

SetDirectory[NotebookDirectory[]];
heatingdata=Import["heatingcurvewitherrors.csv"];
model[t_] := (83.4 + γ  288)/γ + β Exp[-γ t/C];
xydata = heatingdata /. {x_,y_,s_}-> {x,y};
uncertainty = heatingdata /. {x_,y_,s_}-> s;
nlm=NonlinearModelFit[xydata,model[t],{γ,β, C},t, Weights->1/uncertainty^2]
nlm["BestFit"]
nlm["BestFitParameters"]
nlm["ParameterErrors"]
Show[ListPlot[xydata, PlotStyle->Red], Plot[nlm["BestFit"],{t,0,695}]]
(* took me 6:52 *)

Problem 10

Which of the labs from 6-10 took you the longest? If you could get rid of one section or one assignment from that lab, what would it be and why? Or, if you would prefer not to get rid of a section of THAT lab, specify a section/assignment from another lab that was also long.  Put your answer in a cell that uses the Text format style. (Select the cell, then use the Format->Style menu to specify text format.)

[answer here]

Problem 11 (ungraded)

If you don’t mind saying, approximately how much time did you spend on this exam? It won’t affect your grade at all, but may help me judge difficulty/length of exams in the future.

[answer here]