<< Graphics`Colors`
Off[General::"spell1"];
Off[General::"spell"];
\(\(AnimateFrames[
          inFrames_] := 
Module[{frames = inFrames, cells, 
            i}, 
cells = 
            Table[Cell[
		GraphicsData[\ \ "PostScript", 
                  frames[\([i]\)]\ \ ], 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ "Graphics", 
		AnimationDisplayTime -> If[i == Length[frames], 1000000, 0.2]], 
{i, 
                1, Length[frames]}]; 
\ \ \ NotebookWrite[\ 
            EvaluationNotebook[], 
            CellGroupData[cells, 
              Closed]\ ];
];\)\)
\(\(AnimateLinearModels[inData_, inMRange_] := 
        Module[
{minM = inMRange[\([1]\)], 
            maxM = inMRange[\([2]\)], itM = 0.01, maxX, nm, data = inData, 
            graphicalPoints, i, n = Length[inData], graphicalLines, m, 
            frames}, 
nm = 
            Length[Range[minM, maxM, 
                itM]]; 
graphicalPoints = 
            Table[Graphics[{PointSize[0.018], Blue, 
                  Point[data[\([i]\)]]}], {i, 1, 
                n}]; 
maxX = 
            data[\([n, 1]\)]; 
maxY = 
            data[\([n, 2]\)]; 
graphicalModelCurves = 
            Table[Plot[m*x, {x, 0, maxX}, PlotStyle -> {Red}, 
                DisplayFunction -> Identity], {m, minM, maxM, 
                itM}]; 
graphicalText = 
            Table[Graphics[{Purple, 
                  Text["m = " <> ToString[m], {3, 0.2}, {\(-1\), \(-1\)}, 
                    Background -> LightPink, 
                    TextStyle -> {FontSize -> 16}]}], {m, minM, 
                maxM, itM}]; 
leftGraphs = 
            Table[Join[
                graphicalPoints, {graphicalModelCurves[\([m]\)]}, {graphicalText[\([m]\)]}], {m, 1, nm}]; 
leftGraphs = 
            Table[Show[leftGraphs[\([m]\)], Axes -> True, 
                DisplayFunction -> Identity, 
                PlotRange -> {{0, maxX}, {0, maxY}}, 
                AspectRatio -> Automatic], {m, 1, 
                nm}]; 
frames = 
            Table[Show[leftGraphs[\([i]\)], 
                DisplayFunction -> DisplayString, 
                ImageSize -> {900, 500}], {i, 1, 
                nm}]; 
AnimateFrames[
            frames];
];\)\)

Enter the data:

testData = {{20, 95}, {27, 90}, {30, 98}, {35, 103}, {41, 112}, {44, 
            109}, {46, 115}};

Plot the data plus a sample y = m x model:

p1 = 
        ListPlot[testData, PlotStyle -> {PointSize[0.02], Blue}, 
          DisplayFunction -> Identity];
p2 = 
        Plot[1*x, {x, 0, 50}, PlotStyle -> {Red}, 
          DisplayFunction -> Identity];
Show[{p1, p2}, 
        DisplayFunction -> $DisplayFunction];

Animate a range of y = m x models

AnimateLinearModels[testData, {2, 4.5}]

Not looking good. Define a total distance function:

V2[m_] = ((95 - 20  m)^2 + (90 - 27  m)^2 + (98 - 
                  30  m)^2 + (103 - 35  m)^2 + (112 - 
                  41  m)^2 + (109 - 44  m)^2 + (115 - 
                  46  m)^2)^(1/2)

Locate critical point(s):

diffV2[m_] = D[V2[m], m];
Solve[diffV2[m] == 0.0, m]

Second derivative test:

diff2V2[m_] = D[diffV2[m], m];
mv = 2.843329253365973`;
diff2V2[mv]

Plot the optimal y  =  m x model:

p2 = 
        Plot[mv*x, {x, 0, 50}, PlotStyle -> {Red}, 
          DisplayFunction -> Identity];
Show[{p1, p2}, 
        DisplayFunction -> $DisplayFunction];

This is clearly not valid. We will look for an optimal model of the form y = m x  +  b, instead. One possible objective function is:

Clear[V2];
\(\(V2[m_, 
          b_] = \((\((95 - 20  m - b)\)^2 + \((90 - 27  m - 
                    b)\)^2 + 
		\((98 - 30  m - 
                    b)\)^2 + \((103 - 35  m - 
                    b)\)^2 + 
		\((112 - 41  m - 
                    b)\)^2 + \((109 - 44  m - 
                    b)\)^2 + 
		\((115 - 46  m - 
                    b)\)^2)\)^\((1/2)\);\)\)

We plot the graph (a surface) of (Subscript[V, 2]):

Plot3D[{V2[m, b], Hue[V2[m, b]/300]}, {m, 0.1, 4}, {b, 0, 
          150}, 
PlotPoints -> 
          40, 
ImageSize -> {800, 
            550}];

A contour plot will show the region of lowest level in the darkest color:

ContourPlot[
        V2[m, b], {m, 0.5, 1.5}, {b, 50, 
          100}, 
PlotPoints -> 
          80, 
Contours -> 
          18, 
ImageSize -> {800, 550}];

To find exactly where the minimum of (Subscript[V, 2])(m, b) is we must, simultaneously solve (∂_m) (Subscript[V, 2])(m, b) = 0 and (∂_b) (Subscript[V, 2])(m, b) = 0

diffV2m[m_, b_] = D[V2[m, b], m];
diffV2b[m_, b_] = D[V2[m, b], b];

Solve[{diffV2m[m, b] == 0, diffV2b[m, b] == 0.0}, {m, 
        b}]

Plot the optimal y  =  m x + b model:

mv=;
bv=;
f[x_] = mv*x + bv;
p2 = 
        Plot[f[x], {x, 0, 50}, PlotStyle -> {Red}, 
          DisplayFunction -> Identity];
Show[{p1, p2}, 
        DisplayFunction -> $DisplayFunction];

For horizontal residuals:

\(\(H2[m_, 
          b_] = \((\((20 - \((95 - b)\)/m)\)^2 + \((27 - \((90 - b)\)/
                      m)\)^2 + 
		\((30 - \((98 - b)\)/
                      m)\)^2 + \((35 - \((103 - b)\)/
                      m)\)^2 + 
		\((41 - \((112 - b)\)/
                      m)\)^2 + \((44 - \((109 - b)\)/
                      m)\)^2 + 
		\((46 - \((115 - b)\)/
                      m)\)^2)\)^\((1/2)\);\)\)

We plot the surface:

Plot3D[{H2[m, b], Hue[H2[m, b]/300]}, {m, 0.1, 4}, {b, 0, 150}, 
        PlotPoints -> 40, 
        ImageSize -> {800, 
            550}];

A contour plot will show the region of lowest level in the darkest color:

ContourPlot[
        H2[m, b], {m, 0.5, 2.0}, {b, 30, 
          100}, 
PlotPoints -> 
          40, 
Contours -> 
          20, 
ImageSize -> {800, 
            550}];

To find the exact location of the local minimum:

diffH2m[m_, b_] = D[H2[m, b], m];
diffH2b[m_, b_] = D[H2[m, b], b];

Solve[{diffH2m[m, b] == 0, diffH2b[m, b] == 0.0}, {m, 
        b}]

Then we plot the model with the data to visually validate the model:

mh=;
bh=;
f[x_] = mh*x + bh;
p2 = 
        Plot[f[x], {x, 0, 50}, PlotStyle -> {Red}, 
          DisplayFunction -> Identity];
Show[{p1, p2}, 
        DisplayFunction -> $DisplayFunction];

For Perpendicular residuals:

\(\(P2[m_, 
          b_] = \((1/
              Sqrt[m^2 + 
                  1])\)*\((\((95 - 20  m - b)\)^2 + \((90 - 27  m - 
                      b)\)^2 + 
		\((98 - 30  m - 
                      b)\)^2 + \((103 - 35  m - 
                      b)\)^2 + 
		\((112 - 41  m - 
                      b)\)^2 + \((109 - 44  m - 
                      b)\)^2 + 
		\((115 - 46  m - 
                      b)\)^2)\)^\((1/2)\);\)\)

We plot the surface:

Plot3D[{P2[m, b], Hue[P2[m, b]/200]}, {m, 0, 2}, {b, 50, 
          100}, 
PlotPoints -> 
          40, 
ImageSize -> {800, 
            550}];

A contour plot will show the region of lowest level in the darkest color:

ContourPlot[
        P2[m, b], {m, 0.5, 1.5}, {b, 50, 
          100}, 
PlotPoints -> 
          60, 
Contours -> 
          20, 
ImageSize -> {800, 550}];

Find the exact location of the critical points:

diffP2m[m_, b_] = D[P2[m, b], m];
diffP2b[m_, b_] = D[P2[m, b], b];

Solve[{diffP2m[m, b] == 0, diffP2b[m, b] == 0.0}, {m, 
        b}]

The minimum appears to be at m=, b=, to visually validate this we plot the model with the data:

mp=;
bp=;
f[x] = mp*x + bp;
p2 = 
        Plot[f[x], {x, 0, 50}, PlotStyle -> {Red}, 
          DisplayFunction -> Identity];
Show[{p1, p2}, 
        DisplayFunction -> $DisplayFunction];
Clear[m, b];

The other real solution corresponds to a worst possible model (an anti-model?):

badm=;
badb=;
f[x_] = badm*x + badb;
p2 = 
        Plot[f[x], {x, 0, 50}, PlotStyle -> {Red}, 
          DisplayFunction -> Identity];
Show[{p1, p2}, 
        DisplayFunction -> $DisplayFunction];

Plain Adding Scheme
Vertical Residuals

\(\(V1[m_, 
          b_] = \((\((95 - 20  m - b)\) + \((90 - 27  m - 
                b)\) + 
		\((98 - 30  m - b)\) + \((103 - 
                35  m - b)\) + 
		\((112 - 41  m - 
                b)\) + \((109 - 44  m - 
                b)\) + 
		\((115 - 46  m - 
                b)\))\);\)\)

Plot the surface:

Plot3D[{V1[m, b], Hue[V1[m, b]/2000]}, {m, -5, 10}, {b, 0, 200}, 
        PlotPoints -> 40, ImageSize -> {800, 550}];

Clearly there is no minimum, but the distance between the model and the data can take the value zero.

Solve[V1[m, b] == 0.0, {m, b}]

This means that there multipule answers. Try one:

bv = 100;
mv = 
        2.97119341563786` - 
          0.02880658436213992` bv;
p2 = 
        Plot[mv*x + bv, {x, 0, 50}, PlotStyle -> {Red}, 
          DisplayFunction -> Identity];
Show[{p1, p2}, DisplayFunction -> $DisplayFunction, 
        PlotRange -> {80, 120}];

The model is invalid but the residuals below the line balance the residuals above the line.
The moral is "always check the validity of the model".

Example of contour plot of a saddle point

Plot3D[{x^2 - y^2, Hue[(x^2 - y^2)/10]}, {x, -2, 
          2}, {y, -2, 2}, PlotPoints -> 40];

ContourPlot[
        x^2 - y^2, {x, -2, 2}, {y, -2, 2}];

Example of contour plot of a maximum point

Plot3D[{-x^2 - y^2, Hue[(-x^2 - y^2)/10]}, {x, -2, 
          2}, {y, -2, 2}, PlotPoints -> 40];

ContourPlot[-x^2 - y^2, {x, -2, 
          2}, {y, -2, 2}];

Example of a contour plot with many critical points close together

Plot3D[{Sin[x^2] Cos[y^2], Hue[Sin[x^2] Cos[y^2]]}, {x, -Pi, 
          Pi}, {y, -Pi, Pi}, PlotPoints -> 80];

The moral of this picture is that you should always check the nature of the critical point.