Corn Storage

Data from Mathematica appendix, p. 410

Needs["Statistics`LinearRegression`"] Needs["Statistics`DescriptiveStatistics`"];

\(Clear\ [data, x]; 

    data = {81463, 43676\ , 24014\ , 10477\ , 83947, \ \ 42539, \ 20182, \ 
        7373, \ 104212, \ 87433, \ 36952, \ 17953, \ 80581, \ 46134, \ 24807, 
        \ 9028, \ 97936, \ 52217, \ 26415}\)quarters = Table[n, {n, 1, Length[data]}]

meanx = Mean[quarters]meany = Mean[data]sdx = StandardDeviation[quarters]\(sdy = StandardDeviation[data]
\)\(cov = 
      1/\((Length[data] - 1)\)*
        \(∑\+\(n = 1\)\%\(Length[data]\)\((quarters[\([n]\)] - meanx)\)*
            \((data[\([n]\)] - meany)\)\)
					\)\(cov/Variance[quarters]*1.0					\)cov/sdx/sdy*1.0

p0 = 
      ListPlot[data, PlotStyle -> {PointSize[.02]},  
        AxesLabel -> {"Quarter",  "Bushels"}, 
        DisplayFunction -> Identity];

g[x_] = Fit[data,  {1, x},  x]

p1 = Plot[g[x], {x, 0, 20}, DisplayFunction -> Identity];

Show[p0, p1, DisplayFunction -> $DisplayFunction];

Regress[data, {1, x}, x]

f1[x_] = 
      Fit[data,  {1,  Cos[((π x)/2)], Sin[((π x)/2)]},  x]\(p10 = Plot[f1[x], {x, 0, 20}, DisplayFunction -> Identity]; 

    Show[p0, p1, \ p10, DisplayFunction -> $DisplayFunction]; \)

Interpolating the Corn Storage data

corn = 
      Table[{quarters[[n]], data[[n]]}, {n, 1, Length[data]}]in1[x_] = Interpolation[corn,  InterpolationOrder -> 1][x]p2 = Plot[in1[x], {x, 1, 19}, DisplayFunction -> Identity]\(Show[p0, p2, DisplayFunction -> $DisplayFunction]; 


    in2[x_] = \(Interpolation[corn, \ InterpolationOrder -> 2]\)[x]\)p3 = Plot[in2[x], {x, 1, 19}, DisplayFunction -> Identity]\(Show[p0, p3, DisplayFunction -> $DisplayFunction]; 


    in3[x_] = \(Interpolation[corn, \ InterpolationOrder -> 3]\)[x]\)p4 = Plot[in3[x], {x, 1, 19}, DisplayFunction -> Identity]Show[p0, p4, DisplayFunction -> $DisplayFunction];

Interpolating Exercise #7, p. 226 data

No7 = {{0, 1}, {1, 0}, {2, 1}, {3, 1}}\(p0 = 
      ListPlot[No7, PlotStyle -> {PointSize[.02]}, \ 
        AxesLabel -> {"Quarter", \ "Bushels"}, 
        DisplayFunction -> Identity]; 


    in1[x_] = \(Interpolation[No7, \ InterpolationOrder -> 1]\)[x]\)p2 = Plot[in1[x], {x, 0, 3}, DisplayFunction -> Identity]\(Show[p0, p2, DisplayFunction -> $DisplayFunction]; 


    in2[x_] = \(Interpolation[No7, \ InterpolationOrder -> 2]\)[x]\)p3 = Plot[in2[x], {x, 0, 3}, DisplayFunction -> Identity]\(Show[p0, p3, DisplayFunction -> $DisplayFunction]; 


    in3[x_] = \(Interpolation[No7, \ InterpolationOrder -> 3]\)[x]\)p4 = Plot[in3[x], {x, 0, 3}, DisplayFunction -> Identity]Show[p0, p4, DisplayFunction -> $DisplayFunction];