title: mathematica envelope detection data smoothing
body: <p>The following Mathematica code generates a highly oscillatory plot.  I want to plot only  the lower envelope of the plot but do not know how. Any suggestions wouuld be appreciated.</p>
  
  <pre><code>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 -&gt; {True, True, False, False}, 
   FrameLabel -&gt; {"t", "Frequency"}, 
   FrameStyle -&gt; Directive[FontSize -&gt; 15], Axes -&gt; False]
  </code></pre>
  
  <p><img src="https://i.stack.imgur.com/4LPje.png" alt="Mathematica graphics"></p>