Problem #1) Slider on incline 
(see hand written)

(see hand written)

Problem #2) Moment of Inertia

Clear["Global`*"]

location={
{1,0,0},
{0,1,2},
{0,2,1},
{3,1,0},
{1,3,0}
};
mass={1,2,2,3,3};
v={vx,vy,vz}={{1,0,0},{0,1,0},{0,0,1}};
nMax=5  (* Number of masses *)

Note, we program diagonal and off - diagonal with different formulas below!!!

Clear[term]
term[n_,i_,i_]:= +mass[[n]](location[[n]].location[[n]]- (location[[n]].v[[i]])^2)
term[n_,i_,j_]:= -mass[[n]] (location[[n]].v[[i]]*location[[n]].v[[j]])

mat=Table[ Sum[ term[n,i,j],{n,1,nMax}],{i,1,3},{j,1,3}];
mat //MatrixForm

Problem #3) Rotation Matrices

ANSWERS : 
M1: Yes, rotation by θ =π/3
M2:   No, need one negative and one positive Sinθ term
M3:  Yes, rotation by 180 Degrees
M4:  No, this flips all axes. (This is a parity transformation.)
M5:  No, this will stretch the y-axis. 
M6:  No, this will stretch x-axis and compress y-axis

Problem #4) EigenValues and EigenVectors

Clear["Global`*"]

m=(({{5, 0, 0}, {0, (27/3), (8/3)}, {0, (18/3), (27/3)}}));

(* Just a cross check on the below *)
Eigenvalues[m]

(* Just a cross check on the below *)
Eigenvectors[m]

one=DiagonalMatrix[{1,1,1}];
Det[m - λ one]

sol=Solve[Det[m - λ one]==0,λ]

eqs= (m -λ one).{a,b,c} ==0 //Thread

sol[[1]]

sol1=Solve[ eqs /.sol[[1]],{a,b,c}][[1]]

v1={a,b,c} /.sol1

v1={a,b,c} /.sol1 /.{a->1,b->0}

m.v1 == 5 v1

v2={a,b,c} /.sol1 /.{a->0,b->-1}

m.v2==5 v2

sol[[3]]

sol3=Solve[ eqs /.sol[[3]],{a,b,c}][[1]]

v3={a,b,c} /.sol3 /.{b->1}

m.v1==5 v1

m.v2== 5 v2

m.v3==13 v3

Problem #5) Tides

Clear["Global`*"]

distMoon=384000 (10^3);
distSun=150 (10^6) (10^3);
mSun=2 (10^30);
mMoon=7.3 (10^(22 ));
g=6.67 (10^(-11));
m0=1;

Part a)

fmoon=((g m0  mMoon)/(distMoon^2)) ;
fmoon//ScientificForm

fsun=((g m0 mSun)/(distSun^2));
fsun//ScientificForm

(fsun/fmoon)

Part b) Let’s look at the difference of the forces on opposite sides of the earth.

Note: this is extra and was not part of the required problem.
The key idea is the DIFFERENCE between the front and back face of the earth; hence, the SLOPE of the force.

rEarth=6400 (10^3);

fmoonNear=((g m0  mMoon)/(((distMoon-rEarth))^2));
fmoonFar=((g m0  mMoon)/(((distMoon+rEarth))^2));
(fmoonNear/fmoonFar)

fsunNear=((g m0  mSun)/(((distSun-rEarth))^2));
fsunFar=((g m0  mSun)/(((distSun+rEarth))^2));
(fsunNear/fsunFar)

Putting things on the same scale, the difference between the ffront and back of the earth is about 7 percent for the moon, and TINY for the sun!!!

p1=Plot[ (((g m0 mMoon)/r))/(((g m0 mMoon)/distMoon)),{r,distMoon-rEarth,distMoon+rEarth},AxesOrigin->{Automatic,0.95},
PlotStyle->Blue,
Ticks->{{{distMoon-0.8rEarth,"Near Side"},{distMoon,"Center"},{distMoon+0.9rEarth,"Far Side"}},Automatic}
]

p2=Plot[ (((g m0 mSun)/r))/(((g m0 mSun)/distSun)),{r,distSun-rEarth,distSun+rEarth},AxesOrigin->{Automatic,0.95},PlotStyle->Red,
Ticks->{{{distSun-0.8rEarth,"Near Side"},{distSun,"Center"},{distSun+0.9rEarth,"Far Side"}},Automatic}]

Problem #6) M and K matrices

Clear["Global`*"]

Tmat=(({{m, 2m, 0}, {2m, m, 0}, {0, 0, m}}));
Tmat //MatrixForm

Vmat=k{{2,1,-1},{1,2,1},{-1,1,2}};
Vmat //MatrixForm

mat= Vmat-Tmat ω2;
mat //MatrixForm

Det[mat] /.{k->1,m->1}//Expand

Det[mat] //Factor

sol=Solve[Det[mat] ==0,ω2] //Simplify

eq1=mat .{a,b,c} ==0 //Thread;
eq1 //Column

sol1=Solve[eq1 /.sol[[1]],{a,b,c}][[1]]   //Simplify

ev1={a,b,c} /.sol1 /.{a->1}//Simplify

mat.ev1 /.sol[[1]]

sol2=Solve[eq1 /.sol[[2]],{a,b,c}][[1]]   //Simplify //PowerExpand

ev2={a,b,c} /.sol2 /.{a->1,b->1} //Simplify

mat.ev2 /.sol[[2]]

ev3={a,b,c} /.sol2 /.{a->-1,b->1} //Simplify

mat.ev3 /.sol[[3]]

eVecs=Normalize /@ {ev1,ev2,ev3} //Simplify

Vdiag=eVecs.Vmat.Transpose[eVecs]  //FullSimplify ;
Vdiag//MatrixForm

Tdiag=eVecs.Tmat.Transpose[eVecs]  //FullSimplify ;
Tdiag //MatrixForm

Part B Look at motion
Note: this is extra and was not part of the required problem.

values={m->1,k->1};

sol /.values

mode1=ev1 Exp[I ω t] /.{ω->Sqrt[ω2]} /.sol[[1]]  /.values

mode1=ev1 (x0 + v0 t ) /.{ω->Sqrt[ω2]} /.sol[[1]]  /.values /.{x0->0,v0->1}

mode2=ev2 Exp[I ω t] /.{ω->Sqrt[ω2]} /.sol[[2]]/.values

mode3=ev3 Exp[I ω t] /.{ω->Sqrt[ω2]} /.sol[[3]]/.values

mode1 +{-1,0,1} /.values

Plot[mode1 +{-1,0,1}/.values //Re,{t,0,10}]

Plot[mode2 +{-2,0,2}/.values //Re,{t,0,10}]

Plot[mode3 +{-2,0,2}/.values //Re,{t,0,10}]

Problem #7) Mass and pulley

Clear["Global`*"]

Problem 1: Mass and pulley

Clear["Global`*"]

Tenergy=(1/2)m1 ((x1'[t])^2) +(1/2)m2 ((x2'[t])^2) + (1/2)Inertia ((θ'[t])^2) /.{Inertia->κ m3 (r^2)}

Vpot=-m1 g  x1[t] Sin[α]- m2 g x2[t];

Without Lagrange multipliers [as a cross check]
Note: this is extra and was not part of the required problem.

constraint1=x1[t]+x2[t]- len==0;
dsol1=DSolve[constraint1,x2,t][[1]]

constraint2= r θ[t]-x1[t]==0;
dsol2=DSolve[constraint2,θ,t][[1]]

Lag= Tenergy - Vpot  /.dsol1/.dsol2

Variables[Lag]

eq1= D[D[Lag,x1'[t]],t] - D[Lag,x1[t]]==0

check= Solve[eq1,x1''[t]][[1]] //Simplify

With Lagrange multipliers

constraint1= x1[t] +x2[t]-len==0;
constraint1[[1]]

constraint2= r θ[t]-x1[t]==0;
constraint2[[1]]

qlist1=λ1 D[constraint1[[1]],#]& /@ {x1[t],x2[t],θ[t]}

qlist2=λ2 D[constraint2[[1]],#]& /@ {x1[t],x2[t],θ[t]}

qlist=qlist1+qlist2

Lag= Tenergy - Vpot

Variables[Lag]

eq1= D[D[Lag,x1'[t]],t] - D[Lag,x1[t]]== qlist[[1]]

eq2= D[D[Lag,x2'[t]],t] - D[Lag,x2[t]]== qlist[[2]]

eq3= D[D[Lag,θ'[t]],t] - D[Lag,θ[t]]== qlist[[3]]

eq4=D[constraint1,{t,2}]

x2sol=Solve[ D[constraint1,{t,2}],x2''[t]][[1]]

eq5=D[constraint2,{t,2}]

Solve[{eq1,eq2,eq3,eq4,eq5},{x1''[t],x2''[t],θ''[t],λ1,λ2}] //Simplify

check

Problem #8)Non-Intertial Frames

See handwritten for full solution

Ω = Ω0{0,0,1};
r=r0{0,Sin[θ],Cos[θ]};
v=v0{0,-Sin[θ],-Cos[θ]};

values ={θ->57 Degree,v0->100, t->100,Ω0->((2π)/(24 60 60)),r0->6400 (10^3)};

(* Direction:east:   -x direction *)
coriolis= 2 m Cross[v,Ω]

(* East is negative x axis *)
eastForce = {-1,0,0}.coriolis

(* Direction:   +y direction *)
centrifugal= m Cross[Cross[Ω,r],Ω]

(* Project component of centrifugal tangent to the earth's surface *)

tangent={0,Cos[θ],-Sin[θ]};
(* Check it is perpendicular to v (and r) and points south *)
{tangent.v,tangent.r}

southForce = centrifugal.tangent

eastAcc=(eastForce/m)

southAcc = (southForce/m)

(* x=x0+v0 t + (1/2)(at^2)*)
southDisplacement = (1/2)southAcc (t^2)

southDisplacement //.values //N

(* x=x0+v0 t + (1/2)(at^2)*)
eastDisplacement = (1/2)eastAcc (t^2)

eastDisplacement //.values //N

Part c: let v be East (negative x direction)

Ω = Ω0{0,0,1};
r=r0{0,Sin[θ],Cos[θ]};
v=v0{-1,0,0};

(* Direction: +y direction *)
coriolis= 2 m Cross[v,Ω]

(* Direction:   +y direction *)
centrifugal= m Cross[Cross[Ω,r],Ω]

Problem #9) Without gravity

Clear["Global`*"]

T=(1/2) m1 (r^2) ((ϕ1'[t])^2)+(1/2) m2 (r^2) ((ϕ2'[t])^2);

V=(1/2)k(((r  ϕ1[t]-r  ϕ2[t]))^2);

lag=T-V

D[D[lag,ϕ1'[t]],t] - D[lag,ϕ1[t]]  //Expand

D[D[lag,ϕ2'[t]],t] - D[lag,ϕ2[t]] //Expand

Tmat={{m1 (r^2),0},{0,m2 (r^2)}};
Tmat //MatrixForm

Vmat=k (r^2){{1,-1},{-1,1}};
Vmat //MatrixForm

mat= Vmat-Tmat ω2;
mat //MatrixForm

mrule={m1->m,m2->m};
mat = mat /.mrule;
mat //MatrixForm

(* without gravity, the symmetric mode will just spin, so w=0 *)
sol=Solve[Det[mat] ==0,ω2] //Simplify

eq1=mat .{a,b} ==0 //Thread;
eq1 //Column

sol1=Solve[eq1 /.sol[[1]],{a,b}][[1]]   //Simplify

ev1={a,b} /.sol1 /.{a->1}//Simplify

sol2=Solve[eq1 /.sol[[2]],{a,b}][[1]]   //Simplify //PowerExpand

ev2={a,b} /.sol2  /.{a->1} //Simplify

eVecs=Normalize /@ {ev1,ev2} //Simplify

Vdiag=eVecs.Vmat.Transpose[eVecs]  //FullSimplify ;
Vdiag//MatrixForm

Tdiag=eVecs.Tmat.Transpose[eVecs]   /.mrule//FullSimplify ;
Tdiag //MatrixForm

Part B Look at motion
Note: this is extra and was not part of the required problem.

values={m->1,k->1,r->1};

sol /.values

mode1=ev1 Exp[I ω t] /.{ω->Sqrt[ω2]} /.sol[[1]]  /.values

mode1=ev1 (x0 + v0 t ) /.{ω->Sqrt[ω2]} /.sol[[1]]  /.values /.{x0->0,v0->1}

mode2=ev2 Exp[I ω t] /.{ω->Sqrt[ω2]} /.sol[[2]]/.values

Plot[mode1 +{-2,2}/.values //Re,{t,0,10}]

Plot[mode2 +{-2,2}/.values //Re,{t,0,10}]

Problem #9) With gravity 
Note: this is extra and was not part of the required problem.

Clear["Global`*"]

T=(1/2) m1 (r^2) ((ϕ1'[t])^2)+(1/2) m2 (r^2) ((ϕ2'[t])^2);

V=(1/2)k(((r  ϕ1[t]-r  ϕ2[t]))^2);

Vgravity1=m1 g r (1-Cos[ϕ1[t]]);
Vgravity2= m2 g r (1-Cos[ϕ2[t]]);

(* Expand for small angles *)
Vgravity1= Series[Vgravity1,{ϕ1[t],0,2}] //Normal

(* Expand for small angles *)
Vgravity2= Series[Vgravity2,{ϕ2[t],0,2}] //Normal

lag=T-(V+Vgravity1 +Vgravity2)

D[D[lag,ϕ1'[t]],t] - D[lag,ϕ1[t]]  //Expand

D[D[lag,ϕ2'[t]],t] - D[lag,ϕ2[t]] //Expand

Tmat={{m1 (r^2),0},{0,m2 (r^2)}};
Tmat //MatrixForm

Vmat=k (r^2){{1,-1},{-1,1}}+DiagonalMatrix[{m1 g r, m2 g r}];
Vmat //MatrixForm

mat= Vmat-Tmat ω2;
mat //MatrixForm

mrule={m1->m,m2->m};
mat = mat /.mrule;
mat //MatrixForm

(* With gravity there is no zero frequency *)
sol=Solve[Det[mat] ==0,ω2] //Simplify

eq1=mat .{a,b} ==0 //Thread;
eq1 //Column

sol1=Solve[eq1 /.sol[[1]],{a,b}][[1]]   //Simplify

ev1={a,b} /.sol1 /.{a->1}//Simplify

sol2=Solve[eq1 /.sol[[2]],{a,b}][[1]]   //Simplify //PowerExpand

ev2={a,b} /.sol2  /.{a->1} //Simplify

eVecs=Normalize /@ {ev1,ev2} //Simplify

Vdiag=eVecs.Vmat.Transpose[eVecs]  /.mrule//FullSimplify ;
Vdiag//MatrixForm

Tdiag=eVecs.Tmat.Transpose[eVecs]   /.mrule//FullSimplify ;
Tdiag //MatrixForm

Part B Look at motion
Note: this is extra and was not part of the required problem.

values={m->1,k->1,r->1,g->1};

sol /.values

mode1=ev1 Exp[I ω t] /.{ω->Sqrt[ω2]} /.sol[[1]]  /.values

mode2=ev2 Exp[I ω t] /.{ω->Sqrt[ω2]} /.sol[[2]]/.values

Plot[mode1 +{-2,2}/.values //Re,{t,0,10}]

Plot[mode2 +{-2,2}/.values //Re,{t,0,10}]

Problem #10) Relativity:

Part a)

x=0.5 (10^(-6))s 3 (10^8)(m/s)

Part b)

γ=((10 (10^3)m)/x)

Part c)

bSol=Solve[g==(1/(Sqrt[1-(β^2)])),β][[2]]

β /.bSol /.{g->γ}

Part d)

((β1+β2)/(1+β1 β2))//.{β1->β2,β2->0.8}

Relativity: EIC

values={p1->275,p2->18,mp->1,me->(1/2000)};

g=DiagonalMatrix[{1,-1,-1,-1}];

Part e

proton={p1,0,0,p1};
electron={p2,0,0,-p2};
p12=proton+electron

eq=s==p12.g.p12 //Simplify

sol1=Solve[eq,s][[1]]

Sqrt[s] /.sol1

Sqrt[s] /.sol1 /.values //N

Part f

proton={mp,0,0,0};
electron={p2,0,0,-p2};
p12=proton+electron

eq=s==p12.g.p12 //Simplify

sol1=Solve[eq,s][[1]]

Sqrt[s] /.sol1

(* a smaller number *)
Sqrt[s] /.sol1 /.values //N

Part g

proton={p1,0,0,p1};
electron={me,0,0,0};
p12=proton+electron

eq=s==p12.g.p12 //Simplify

sol1=Solve[eq,s][[1]]

Sqrt[s] /.sol1

(* a very small number *)
Sqrt[s] /.sol1 /.values //N