Mathematica plot envelope data smoothing

[carey1000]

The following Mathematica code generates a highly oscillatory plot. I would like to plot only the lower envelope of the plot but do not know how. Any suggestions wouuld be appreciated.

tk0 = \[Theta]'[t]*\[Theta]'[t] - \[Theta][t]*\[Theta]''[t]
tk1 = \[Theta]''[t]*\[Theta]''[t] - \[Theta]'[t]*\[Theta]'''[t]
a = tk0/Sqrt[tk1]
f = Sqrt[tk1/tk0]
s =
NDSolve[{\[Theta]''[t] + \[Theta][t] - 0.167 \[Theta][t]^3 ==
0.005 Cos[t - 0.5*0.00009*t^2], \[Theta][0] == 0, \[Theta]'[0] ==
0}, \[Theta], {t, 0, 1000}]

Plot[Evaluate [f /. s], {t, 0, 1000}, Frame -> {True, True, False, False},
FrameLabel -> {"t", "Frequency"}, FrameStyle -> Directive[FontSize -> 15], Axes -> False]

Thank you, Carey

 

[FunkyDwarf]

Offhand the easiest way i can think of is to bin the data and take the min of each bin.