<< Miscellaneous`RealOnly`
<< Graphics`Colors`
<< Graphics`Legend`
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]\ ];
];\)\)
CreateAnimationOfDifferentVerticalLines[inData_, inF_] := 
        Module[
{data = inData, f, 
            m}, 
f[m_] = 
            inF[m]; 
model[x_, m_] = 
            m*x; 
CreateAnimationOfDifferentLines[data, f, 
            0, {1, 2}, 
            model];
];
CreateAnimationOfDifferentPerpendicularLines[inData_, inF_] := 
        Module[
{data = inData, f, 
            m}, 
f[m_] = 
            inF[m]; 
model[x_, m_] = 
            m*x; 
CreateAnimationOfDifferentLines[data, f, 
            2, {1, 2}, 
            model];
];
CreateAnimationOfDifferentHorizontalLines[inData_, inF_] := 
        Module[
{data = inData, f, 
            m}, 
f[m_] = 
            inF[m]; 
model[x_, m_] = 
            m*x; 
CreateAnimationOfDifferentLines[data, f, 
            1, {1, 2}, 
            model];
];
makeHorizontalResiduals[inData_, inModel_] := 
        Module[
{model, data = inData, xHats, 
            n = Length[inData], 
            graphicalResiduals}, 
model[x_] = 
            inModel[x]; 
xHats = 
            Table[x /. 
                FindRoot[
                  model[x] == data[[i, 2]], {x, data[[i, 1]]}], {i, 
                1, n}]; 
graphicalResiduals = 
            Table[Graphics[{Green, 
                  Line[{{xHats[[i]], data[[i, 2]]}, 
                      data[[i]]}]}], {i, 1, 
                n}]; 
Return[
              graphicalResiduals];
];
makeVerticalResiduals[inData_, inModel_] := 
        Module[
{model, data = inData, n = Length[inData], 
            graphicalResiduals}, 
model[x_] = 
            inModel[x]; 
graphicalResiduals = 
            Table[Graphics[{Green, 
                  Line[{{data[[i, 1]], model[data[[i, 1]]]}, 
                      data[[i]]}]}], {i, 1, 
                n}]; 
Return[
            graphicalResiduals];
];
makePerpendicularResiduals[inData_, inModel_] := 
        Module[
{model, dmodel, data = inData, a, xHats, 
            yHats, n = Length[inData], 
            graphicalResiduals}, 
model[x_] = 
            inModel[x]; 
dmodel[x_] = 
            D[model[x], x]; 
xHats = 
            Table[If[
                data[[i, 2]] == 
                  model[data[[i, 1]]], 
data[[i, 
                    1]], 
a /. 
                  FindRoot[(a - data[[i, 1]]) == 
                      dmodel[a]*(data[[i, 2]] - model[a]), {a, 
                      data[[i, 1]]}]]
, {i, 1, 
                n}]; 
yHats = 
            model[xHats]; 
graphicalResiduals = 
            Table[Graphics[{Green, 
Line[{{xHats[[i]], 
                        yHats[[i]]}, data[[i]]}]}], {i, 1, 
                n}]; 
Return[
            graphicalResiduals];
];
\(\(CreateAnimationOfDifferentLines[inData_, inF_, inTest_, inMRange_, 
          inModel_] := 
        Module[
{minM = inMRange[\([1]\)], 
            maxM = inMRange[\([2]\)], itM = 0.01, nm, test = inTest, 
            data = inData, graphicalPoints, i, n = Length[inData], 
            graphicalLines, model, maxX, m, graphicalResiduals, 
            graphicalText, V = inF, leftGraphs, graphicalV, graphicalDot, 
            rightGraphs, twinGraphs, frames}, 
nm = 
            Length[Range[minM, maxM, 
                itM]]; 
graphicalPoints = 
            Table[Graphics[{PointSize[0.018], Blue, 
                  Point[data[\([i]\)]]}], {i, 1, n}]; 
If[
            test == 0, 
            maxX = data[\([n, 1]\)], 
\(If[test == 1, 
                maxX = data[\([n, 
                      2]\)], 
maxX = \((data[\([n, 1]\)] + 
                        data[\([n, 2]\)])\)/2];\)]; 
model[
              x_, m_] = 
            inModel[x, m]; 
graphicalModelCurves = 
            Table[Plot[model[x, m], {x, data[\([1, 1]\)], maxX}, 
                PlotStyle -> {Red}, 
                DisplayFunction -> Identity], {m, minM, maxM, 
                itM}]; 
If[
            test == 
              0, 
\(graphicalResiduals = 
                Table[makeVerticalResiduals[data, 
                    Function[x, model[x, m]]], {m, minM, maxM, 
                    itM}];\), 
If[
              test == 
                1, 
\(graphicalResiduals = 
                  Table[makeHorizontalResiduals[data, 
                      Function[x, model[x, m]]], {m, minM, maxM, 
                      itM}];\), 
\(graphicalResiduals = 
                  Table[makePerpendicularResiduals[data, 
                      Function[x, model[x, m]]], {m, minM, maxM, 
                      itM}];\)]]; 
graphicalText = 
            Table[Graphics[{Purple, 
                  Text["m = " <> ToString[m] <> "
V = " <> 
                      ToString[N[V[m], 3]], {3, 0.2}, {\(-1\), \(-1\)}, 
                    Background -> LightPink, 
                    TextStyle -> {FontSize -> 16}]}], {m, minM, 
                maxM, itM}]; 
leftGraphs = 
            Table[Join[graphicalPoints, 
                graphicalResiduals[\([m]\)], {graphicalModelCurves[\([m]\)]}, {graphicalText[\([m]\)]}], {m, 1, nm}]; 
leftGraphs = 
            Table[Show[leftGraphs[\([m]\)], Axes -> True, 
                DisplayFunction -> Identity, 
                PlotRange -> {{0, 12}, {0, 12}}, 
                AspectRatio -> Automatic], {m, 1, 
                nm}]; 
maxrightY = 
            Max[{V[0.9*minM], V[1.1*maxM]}]; 
graphicalV = 
            Plot[V[m], {m, minM, maxM}, DisplayFunction -> Identity, 
              PlotRange -> {{0.9*minM, 1.1*maxM}, {\(-maxrightY\), 
                    maxrightY}}, 
              PlotStyle -> {Green}]; 
graphicalDot = 
            Table[Graphics[{PointSize[0.018], Magenta, 
                  Point[{m, V[m]}]}], {m, minM, maxM, 
                itM}]; 
rightGraphs = 
            Table[{graphicalV, graphicalDot[\([i]\)]}, {i, 1, 
                nm}]; 
rightGraphs = 
            Table[Show[rightGraphs[\([i]\)], 
                DisplayFunction -> Identity], {i, 1, 
                nm}]; 

twinGraphs = 
            Table[GraphicsArray[{leftGraphs[\([i]\)], 
                  rightGraphs[\([i]\)]}], {i, 1, 
                nm}]; 
frames = 
            Table[Show[twinGraphs[\([i]\)], 
                DisplayFunction -> DisplayString, 
                ImageSize -> {900, 500}], {i, 1, 
                nm}]; 
\(AnimateFrames[
              frames];\)
];\)\)

Enter the data, define:

rootData := {{0, 0}, {1, 1.2}, {2, 3.8}, {3, 4.2}, {4, 6.3}, {5, 
            7.2}, {6, 7.3}};

Show a model, with vertical residuals:

p1 = 
          ListPlot[rootData, PlotStyle -> {PointSize[0.02], Blue}, 
            AxesLabel -> {"Time (days)", "Growth (mm)"}, 
            PlotLabel -> "Root growth over time",  
            TextStyle -> {FontSize -> 18}, 
            ImageSize -> {900, 550}, DisplayFunction -> Identity];   
model[x_] = 1.25*x;  
p2 = 
          Plot[model[x], {x, -0.2, 6.5}, PlotStyle -> {Red}, 
            DisplayFunction -> Identity];  
p3 = makeVerticalResiduals[rootData, model];  
Show[{p1, p2, p3}, 
        AspectRatio -> Automatic, 
        DisplayFunction -> $DisplayFunction];

Show a model with horizontal residuals:

p4 = makeHorizontalResiduals[rootData, model];  
Show[{p1, p2, p4}, 
        AspectRatio -> Automatic, 
        DisplayFunction -> $DisplayFunction];

Show a model with perpendicular residuals:

p5 = makePerpendicularResiduals[rootData, model];  
Show[{p1, p2, p5}, 
        AspectRatio -> Automatic, 
        DisplayFunction -> $DisplayFunction];

Standard Scheme
Vertical

Define and plot the total distance functions (using the Pythagorean scheme):

\(\(V2[
          m_] = \((\((1.2 - m)\)^2 + \((3.8 - 
                    2  m)\)^2 + 
	\ \ \ \ \ \ \ \((4.2 - 
                    3  m)\)^2 + \((6.3 - 
                    4  m)\)^2 + 
	\ \ \ \ \ \ \ \((7.2 - 
                    5  m)\)^2 + \((7.3 - 6  m)\)^2)\)^\((1/
              2)\);\)\)
\(\(Plot[V2[m], {m, 1, 2}, 
        PlotStyle -> {Green}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 18}, ImageSize -> {800, 550}];\)\)

Animate the slopes:

CreateAnimationOfDifferentVerticalLines[rootData, V2]

Find the critical point(s):

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

Second derivative test:

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

Horizontal

Define and plot the total distance functions (using the Pythagorean scheme):

H2[
          m_] = ((1 - 1.2/m)^2 + (2 - 
                    3.8/m)^2 + 
                 (3 - 4.2/m)^2 + (4 - 
                    6.3/m)^2 + 
                 (5 - 7.2/m)^2 + (6 - 7.3/m)^2)^(1/
              2);
\(\(Plot[H2[m], {m, 1, 2}, 
        PlotStyle -> {Green}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 18}, ImageSize -> {800, 550}];\)\)

Animate the slopes:

CreateAnimationOfDifferentHorizontalLines[rootData, H2]

Find the critical point(s):

diffH2[m_] = D[H2[m], m];
Solve[diffH2[m] == 0, m]

Second derivative test:

diff2H2[m_] = D[diffH2[m], m];
mh=;
diff2H2[mh]

Perpendicular

Define and plot the total distance functions (using the Pythagorean scheme):

P2[m_] = 
        1/Sqrt[m^2 + 
                1]*((1.2 - m)^2 + (3.8 - 
                      2  m)^2 + 
                                                       (4.2 - 3  m)^2 + (6.3 - 
                      4  m)^2 + 
                                                       (7.2 - 5  m)^2 + (7.3 - 6  m)^2)^(1/
                2);
\(\(Plot[P2[m], {m, 1, 2}, 
        PlotStyle -> {Green}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 18}, ImageSize -> {800, 550}];\)\)

Animate the slopes:

CreateAnimationOfDifferentPerpendicularLines[rootData, P2]

Find the critical point(s):

diffP2[m_] = D[P2[m], m];
Solve[diffP2[m] == 0, m]

Second derivative test:

diff2P2[m_] = D[diffP2[m], m];
mp=;
diff2P2[mp]

Compare the graphs of (Subscript[V, 2]), (Subscript[H, 2]), and (Subscript[P, 2]):

\(\(Plot[{V2[m], H2[m], P2[m]}, {m, 1, 
          2}, 
PlotStyle -> {Violet, HotPink, 
            Purple}, 
PlotLegend -> {"Vertical", "Horizontal", "Perpendicular"}, LegendShadow -> None, 
        LegendPosition -> {0.6, 0}, 
        LegendSize -> { .5,  .2}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 
              18}, 
ImageSize -> {900, 
            550}, 
PlotRange -> {0, 4}];\)\)

Compare Different Models with Data:

models = 
        Plot[{mv*x, mh*x, mp*x}, {x, 0, 
            7}, 
PlotStyle -> {Violet, HotPink, 
              Purple}, 
ImageSize -> {900, 
              550}, 
DisplayFunction -> 
            Identity];
data = 
        ListPlot[rootData, PlotStyle -> {PointSize[0.01], Blue}, 
          DisplayFunction -> Identity]; 
\(\(Show[{data, 
          models}, 
DisplayFunction -> $DisplayFunction, 
PlotLabel -> "Different Models", 
AxesLabel -> {"Time (days)", "Growth (mm)"}, 
TextStyle -> {FontSize -> 
              18}, \ 
ImageSize -> {900, 
            550}];\)\)

Plain Adding Scheme
Vertical

Define and plot the total distance functions :

\(\(V1[
          m_] = \((1.2 - m)\) + \((3.8 - 
              2  m)\) + 
	\ \ \ \((4.2 - 
              3  m)\) + \((6.3 - 
              4  m)\) + 
	\ \ \ \((7.2 - 
              5  m)\) + \((7.3 - 6  m)\);\)\)
\(\(Plot[V1[m], {m, 1, 2}, 
        PlotStyle -> {Green}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 18}, ImageSize -> {800, 550}];\)\)

Animate the slopes:

CreateAnimationOfDifferentVerticalLines[rootData, V1]

Find the root(s):

Solve[V1[m] == 0, m]

Horizontal

Define and plot the total distance functions:

H1[
          m_] = (1 - 1.2/m) + (2 - 
              3.8/m) + 
             (3 - 
              4.2/m) + (4 - 
              6.3/m) + 
             (5 - 
              7.2/m) + (6 - 7.3/m);
\(\(Plot[H1[m], {m, 1, 2}, 
        PlotStyle -> {Green}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 18}, ImageSize -> {800, 550}];\)\)

Animate the slopes:

CreateAnimationOfDifferentHorizontalLines[rootData, H1]

Find the root(s):

Solve[H1[m] == 0, m]

Perpendicular

Define and plot the total distance functions:

P1[m_] = 
        1/Sqrt[m^2 + 
                1]*((1.2 - m) + (3.8 - 
                  2  m) + 
                                                       (4.2 - 3  m) + (6.3 - 
                  4  m) + 
                                                       (7.2 - 5  m) + (7.3 - 6  m));
\(\(Plot[P1[m], {m, 1, 2}, 
        PlotStyle -> {Green}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 18}, ImageSize -> {800, 550}];\)\)

Animate the slopes:

CreateAnimationOfDifferentPerpendicularLines[rootData, P1]

Find the root(s):

Solve[P1[m] == 0, m]

Compare the graphs of (Subscript[V, 1]), (Subscript[H, 1]), and (Subscript[P, 1]):

\(\(Plot[{V1[m], H1[m], P1[m]}, {m, 1, 
          2}, 
PlotStyle -> {Violet, HotPink, 
            Purple}, 
PlotLegend -> {"Vertical", "Horizontal", "Perpendicular"}, LegendShadow -> None, 
        LegendPosition -> {0.6, 0}, 
        LegendSize -> { .5,  .2}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 
              18}, 
ImageSize -> {900, 
            550}, 
PlotRange -> {\(-4\), 4}];\)\)

Fourth Power Scheme
Vertical

Define and plot the total distance functions:

\(\(V4[
          m_] = \((\((1.2 - m)\)^4 + \((3.8 - 
                    2  m)\)^4 + 
	\ \ \ \ \ \ \ \((4.2 - 
                    3  m)\)^4 + \((6.3 - 
                    4  m)\)^4 + 
	\ \ \ \ \ \ \ \((7.2 - 
                    5  m)\)^4 + \((7.3 - 6  m)\)^4)\)^\((1/
              4)\);\)\)
\(\(Plot[V4[m], {m, 1, 2}, 
        PlotStyle -> {Green}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 18}, ImageSize -> {800, 550}];\)\)

Animate the slopes:

CreateAnimationOfDifferentVerticalLines[rootData, V4]

Find the critical point(s):

diffV4[m_] = D[V4[m], m];
Solve[diffV4[m] == 0, m]

Second derivative test:

diff2V4[m_] = D[diffV4[m], m];
mv=;
diff2V4[mv]

Horizontal

Define and plot the total distance functions:

H4[
          m_] = ((1 - 1.2/m)^4 + (2 - 
                    3.8/m)^4 + 
                 (3 - 4.2/m)^4 + (4 - 
                    6.3/m)^4 + 
                 (5 - 7.2/m)^4 + (6 - 7.3/m)^4)^(1/
              4);
\(\(Plot[H4[m], {m, 1, 2}, 
        PlotStyle -> {Green}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 18}, ImageSize -> {800, 550}];\)\)

Animate the slopes:

CreateAnimationOfDifferentHorizontalLines[rootData, H4]

Find the critical point(s):

diffH4[m_] = D[H4[m], m];
Solve[diffH4[m] == 0, m]

Second derivative test:

diff2H4[m_] = D[diffH4[m], m];
mh=;
diff2H4[mh]

Perpendicular

Define and plot the total distance functions:

P4[m_] = 
        1/Sqrt[m^2 + 
                1]*((1.2 - m)^4 + (3.8 - 
                      2  m)^4 + 
                                                 (4.2 - 3  m)^4 + (6.3 - 
                      4  m)^4 + 
                                                 (7.2 - 5  m)^4 + (7.3 - 6  m)^4)^(1/
                4);
\(\(Plot[P4[m], {m, 1, 2}, 
        PlotStyle -> {Green}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 18}, ImageSize -> {800, 550}];\)\)

Animate the slopes:

CreateAnimationOfDifferentPerpendicularLines[rootData, P4]

Find the critical point(s):

diffP4[m_] = D[P4[m], m];
Solve[diffP4[m] == 0, m]

Second derivative test:

diff2P4[m_] = D[diffP4[m], m];
mp=;
diff2P4[mp]

Compare the graphs of (Subscript[V, 4]), (Subscript[H, 4]), and (Subscript[P, 4]):

\(\(Plot[{V4[m], H4[m], P4[m]}, {m, 1, 
          2}, 
PlotStyle -> {Violet, HotPink, 
            Purple}, 
PlotLegend -> {"Vertical", "Horizontal", "Perpendicular"}, LegendShadow -> None, 
        LegendPosition -> {0.6, 0}, 
        LegendSize -> { .5,  .2}, 
AxesLabel -> {"Slope (days/mm)", "Total Distance (mm)"}, 
TextStyle -> {FontSize -> 
              18}, 
ImageSize -> {900, 
            550}, 
PlotRange -> {0, 4}];\)\)

Compare Different Models with Data:

models = 
        Plot[{mv*x, mh*x, mp*x}, {x, 0, 
            7}, 
PlotStyle -> {Violet, HotPink, 
              Purple}, 
ImageSize -> {900, 
              550}, 
DisplayFunction -> 
            Identity];
data = 
        ListPlot[rootData, PlotStyle -> {PointSize[0.01], Blue}, 
          DisplayFunction -> Identity]; 
\(\(Show[{data, 
          models}, 
DisplayFunction -> $DisplayFunction, 
PlotLabel -> "Different Models", 
AxesLabel -> {"Time (days)", "Growth (mm)"}, 
TextStyle -> {FontSize -> 
              18}, \ 
ImageSize -> {900, 
            550}];\)\)