LOWESS

Here is a complicated, osciallatory data set.

tfinal  =  100
SeedRandom[4]
data  =  
        Table[ {i, 
            Cos[3 i/10] +   Sin[i/10]  + Random[Real, {0, 0.5}]}, {i, 1, 
            tfinal}];
dataplot = ListPlot[data]

An eighth degree polynomial does not successfully capture the data.

func[t_] = 
      Fit[data, {1, t, t^2, t^3, t^4, t^5, t^6, t^7, t^8}, 
        t]
funcplot  =  
      Plot[func[t], {t, 0, 100}, 
        DisplayFunction -> Identity]
Show[dataplot, funcplot, Frame -> True, 
      FrameLabel -> {"t", "y"}]

lowess fit

To program loess into Mathematica requires an understanding of programming that is beyond the scope of this class. I went searching online, and found a Mathematica package that does loess fitting. The package is available for download at http://www.stats.uwo.ca/faculty/aim/courses/m/default.htm  

It is not hard to find loess implementations in fortran or C 
http://cm.bell-labs.com/cm/ms/departments/sia/software/
http://www.netlib.org/go/
and (I assume) java.

First, we load the package (you will need to download the package and change the directory if you use this):

<< "C:\Bear\Teaching\Modeling\bilo.m";

Here is the new command that the package provides us:

?LoessFit

Now, let's fit the data using loess:

loessfit = 
        Table[{t, LoessFit[t, data, 0.2, 2]}, {t, 1, 
            100}];
loessplot  =  
      ListPlot[loessfit, PlotJoined -> True, 
        DisplayFunction -> Identity]
Show[loessplot, dataplot, DisplayFunction -> $DisplayFunction, 
      Frame -> True, FrameLabel -> {"t", "y"}]

Changing the smoothing parameter changes the fit:

loessfit = 
        Table[{t, LoessFit[t, data, 0.4, 2]}, {t, 1, 
            100}];
loessplot  =  
      ListPlot[loessfit, PlotJoined -> True, 
        DisplayFunction -> Identity]
Show[loessplot, dataplot, DisplayFunction -> $DisplayFunction, 
      Frame -> True, FrameLabel -> {"t", "y"}]

What we've done in the above fit is oversmoothed the data. It is possible to smooth to the point of obsurdity.

loessfit = 
        Table[{t, LoessFit[t, data, 1.0, 2]}, {t, 1, 
            100}];
loessplot  =  
      ListPlot[loessfit, PlotJoined -> True, 
        DisplayFunction -> Identity]
Show[loessplot, dataplot, DisplayFunction -> $DisplayFunction, 
      Frame -> True, FrameLabel -> {"t", "y"}]

Also, you can undersmooth, and local fluctuations become apparent:

loessfit = 
        Table[{t, LoessFit[t, data, 0.05, 2]}, {t, 1, 
            100}];
loessplot  =  
      ListPlot[loessfit, PlotJoined -> True, 
        DisplayFunction -> Identity]
Show[loessplot, dataplot, DisplayFunction -> $DisplayFunction, 
      Frame -> True, FrameLabel -> {"t", "y"}]

loessfit1 = 
        Table[{t, LoessFit[t, data, 0.1, 1]}, {t, 1, 
            100}];
loessplot1  =  
      ListPlot[loessfit1, PlotJoined -> True, 
        DisplayFunction -> Identity]

    
loessfit2 = 
        Table[{t, LoessFit[t, data, 0.1, 2]}, {t, 1, 
            100}];
loessplot2  =  
      ListPlot[loessfit2, PlotJoined -> True, 
        DisplayFunction -> Identity]

    
loessfit3 = 
        Table[{t, LoessFit[t, data, 0.4, 2]}, {t, 1, 
            100}];
loessplot3  =  
      ListPlot[loessfit3, PlotJoined -> True, 
        DisplayFunction -> Identity]

    
Show[loessplot1, loessplot2, loessplot3, dataplot, 
      DisplayFunction -> $DisplayFunction, Frame -> True, 
      FrameLabel -> {"t", "y"}, 
      PlotRange -> {{15, 25}, {1, 2.5}}]