phy1610: hw5rootmin

ClearAll[ a, b, c, d, f, g, m, e, x ]

a=1(*J energy scale*) ;
b=0.1(*m length scale*) ;
c=100(*N/m spring constant*) ;
d=0.5(*m maximum spring extension*) ;
f=2500 (*stiffness at maximum extension*) ;
g=9.8(*m/s 2 gravitational accelleration.*) ;

(*E[x, m]*)
e := a ( b/#1 + d^2/f/(#1-d)^2 - Exp[ -c(#1-b)^2/2/a]) - #2 g #1 & ;
massValues = 0.5/(25-1) (Range[25] -1) ;
fMinOne[ m_, r1_, r2_ ] :=  Minimize[ {e[x, m], {x > r1, x< r2}},x] ;

fMinAll[m_] := Module[{min1, min2, x1, x2},
min1 = fMinOne[ m, 0, d/2 ] ;
min2 = fMinOne[ m, d/2,d ] ;
x1 = x /. (min1 //Last) ;
x2 = x /. (min2 //Last) ;
r = {} ;
If [ x1 ≠ d/2, AppendTo[r, min1], ] ;
If [ x2 ≠ d/2, AppendTo[r, min2], ] ;
{#// First, (x /.(#//Last))} &/@ r
] ;

fMinGlob[m_] := Module[{min, xx},
min = fMinOne[ m, 0, d ] ;

{min// First, (x /.(min//Last))}
] ;


eps := 0.01 ;
plotAndShowMins[m_] := Module[{r},
r = fMinAll[ m ] ;
{
Plot[ e[x,m] , {x, eps, d-eps}],
r
}
] ;


{massValues, fMinAll[ # ] &/@ massValues} // Transpose

plotAndShowMins[ massValues // First] 
plotAndShowMins[ massValues[[10]]] 
plotAndShowMins[ massValues // Last] 
Plot[ Evaluate[e[x,#] &/@ massValues], {x, eps, d-eps}]

globalMins = fMinGlob[#] &/@ massValues ;

(*These are the values of the energy function at the min points for each mass value: *)
(*(#// First )&/@globalMins*) 

(*These are the x-positions where the global minimums are found at for each mass value: *)
minLocations  =(#// Last )&/@globalMins ;

(* As pairs {m, x_glmin} :*)
globalMinLocations ={massValues, minLocations} // Transpose ;

ListPlot[ globalMinLocations, PlotRange -> {Automatic,{0,0.5}} ]

globalMinLocations // TableForm