# Finding 25 points nearest to an approximation line

I have to find 25 points that lie nearest to a linear approximation of my data.

This is my source code:

xx = {250, 185, 265, 292, 258, 249, 233, 321, 314, 228, 214, 306, 320,
338, 345, 350, 349, 294, 284, 266, 244, 225, 205, 209, 202, 211,
218, 214, 201, 194, 186, 182, 194, 195, 190, 185, 180, 177, 173,
170, 173, 185, 190, 181, 181, 171, 174, 172, 172, 172, 174, 181,
174, 169, 167, 166, 165, 162, 159, 156, 153, 168, 174, 176, 177,
182, 184, 181, 182, 181, 180, 182, 215, 218, 238, 239, 242, 237,
231, 212, 208, 193, 198, 187, 192, 191, 187, 178, 176, 176, 184,
189, 180, 220, 218, 214, 206, 180, 178, 196, 214, 222, 233, 248,
254, 262, 274, 281, 279, 292, 292, 290, 210, 213, 207, 194, 203,
200, 186, 178, 170, 166, 162, 150, 164, 196, 208, 212, 208, 206,
208, 203, 200, 200, 203, 198, 194, 194, 192, 188, 174, 177, 182,
224, 210, 208, 202, 222, 218, 216, 222, 246, 286, 298, 308, 310,
311, 325, 301, 292, 284, 258, 216, 212, 224, 216, 220, 225, 227,
228, 229, 230, 243, 259, 262, 265, 266, 274, 270, 264, 258, 252,
252, 241, 238, 226, 211, 214, 237, 244, 244, 237, 222, 210, 218,
224, 225, 218, 230, 228, 208, 200, 196, 200, 206, 208, 214, 203,
204, 203, 194, 188, 184, 180, 174, 214, 210, 196, 192, 191, 192,
194, 186, 188, 194, 186, 186, 184, 188, 197, 190, 208, 218};
yy = {9.45, 3.48, 13.3, 16.5, 12.1, 10.2, 9.08, 26.2, 23.7, 7.4, 4.74,
20.04, 26.1, 29.9, 29.9, 29.9, 29.1, 14.8, 15.6, 13.4, 9.4, 6.8,
3.47, 6.76, 6, 5.81, 7.06, 6.09, 7.16, 5.97, 4.96, 4.08, 5.98, 4.5,
4.54, 3.82, 3.07, 2.06, 2.19, 2.84, 2.45, 3.81, 3.44, 3.25, 3.42,
2.71, 2.41, 2.49, 4.4, 3.66, 2.78, 5.08, 3.16, 3.66, 4.57, 2.48,
2.14, 1.69, 1.46, 1.21, 1.1, 2.96, 0.991, 2.57, 1.73, 2.17, 1.76,
2.5, 1.33, 1.44, 1.39, 3.16, 6.75, 7.06, 9.06, 10.2, 10.3, 9.82,
8.79, 4.87, 5.66, 4.58, 3.84, 2.04, 1.65, 1.38, 1.35, 1.5, 1.07,
2.42, 2.6, 2.14, 2.09, 8.88, 5.83, 5.52, 4.69, 1.59, 1.45, 2.9,
4.56, 5.88, 7.4, 9.33, 11.5, 12.6, 13.9, 15.4, 15.7, 15, 18.6,
17.9, 5.32, 5.72, 2.71, 5.29, 6.76, 4.8, 3.49, 2.88, 1.85, 1.63,
1.54, 0.903, 1.46, 5.37, 4.76, 7.33, 5.24, 6.9, 6.73, 6.4, 5.33,
6.14, 6.2, 5.17, 4.71, 4.67, 4.23, 4.37, 2.06, 3.09, 3.79, 5.04,
4.86, 5.21, 4.78, 5.52, 5.76, 6.34, 6.75, 12.6, 17.2, 19.6, 16.5,
18.3, 20.7, 19, 18.1, 17.9, 9.75, 8.1, 3.61, 3.58, 12, 5.52, 5.28,
8.68, 8.56, 7.42, 9.83, 9.59, 14.9, 16, 14.3, 13.2, 13.7, 16.7,
14.9, 12.5, 11.9, 12, 11.9, 10.6, 8.09, 8.4, 6.39, 5.98, 12.3,
11.1, 8.77, 10.9, 7.2, 7.56, 8.78, 9.18, 8.11, 8.5, 10.1, 9.32,
5.35, 5.22, 5.28, 5.34, 5.84, 6.88, 6.78, 5.16, 5.32, 5.06, 4.65,
3.94, 3.87, 3.2, 3.08, 5.48, 4.87, 4.81, 4.85, 4.5, 4.07, 4.37,
3.65, 3.95, 4.33, 4.14, 3.95, 3.8, 3.91, 4.07, 4.1, 7.01, 7.61};
ListPlot[Table[{yy[[n]], xx[[n]]}, {n, Length[xx]}]]


How can I do it? Please for help. I am beginner programmer and I can't do it.

• correct Length[xx] – J42161217 May 13 '17 at 0:14
• indeed xx, earlier I had x. My bad – criser May 13 '17 at 0:16
• A tip for you — there is a much simpler way to plot your data: ListPlot[Transpose[{xx, yy}]] – m_goldberg May 13 '17 at 7:54
• Are the 25 points supposed to be points in your data Table[{yy[[n]], xx[[n]]}, {n, Length[xx]}] or just any 25 points? And are they supposed to be closest to the best fit line? The currently accepted answer does none of these. – Michael E2 May 14 '17 at 14:57
• Do you mean "nearest" in the normal sense of best fit, that is, least residual? – Michael E2 May 14 '17 at 15:00

here you are

S = {};
For[i = 1, i <= 25, i++,
AppendTo[S, Nearest[Riffle[xx, yy], {i, 8*i + 155}]]];
S = Partition[Max /@ Flatten[S, 1], 2]
ListPlot[S]


these are the 25 points

{{0.991, 164}, {2.04, 171}, {2.96, 180}, {3.95, 187}, {5.04, 195}, {6, 203}, {7.01, 211}, {8.09, 220}, {9.06, 227}, {10.1, 237}, {11.1, 243}, {12, 252}, {13.2, 259}, {13.9, 266}, {15, 274}, {16, 284}, {17.2, 292}, {18.1, 298}, {19, 308}, {20.04, 314}, {20.7, 325}, {20.7, 325}, {23.7, 338}, {23.7, 349}, {26.1, 350}}

and this is the graph

• For and AppendTo are bad practice. You should replace the first three lines with S = Table[...]. – Michael E2 May 14 '17 at 14:41

Since the OP mentions linear approximation, I would measure "nearest" by the appropriate error, that is, the residual. It seems quite inappropriate to use the (Euclidean) distance between points, even though the second set of points $$(x, f(x))$$ correspond to the data points $$(x, y)$$, where $$f$$ gives the best-fit line. It is quite possible for the nearest point to $$(x_1, y_1)$$ to be $$(x_2, f(x_2))$$ for an $$x_2 \ne x_1$$ and not $$(x_1, f(x_1))$$. Unless you can show that such a thing cannot happen for the given data and calculated line, then you risk getting the wrong answer for a linear approximation problem. And even if you can show it, it seems a roundabout method to use, since it will raise questions for anybody reading the solution.

pp = Transpose@{yy, xx};               (* data *)
lmf = LinearModelFit[pp, {1, y}, y];   (* get linear approximation *)
indices = Take[Ordering@Abs@lmf["FitResiduals"], 25]; (* take least 25 positions *)
least25 = Sort@pp[[indices]]           (* get corresponding points *)
(* lmf /@ least25[[All, 1]] - least25[[All, 2]] (* optional: check residuals *)*)
(*
{{0.991, 174}, {1.5, 178},  {1.73, 177}, {2.09, 180}, {2.17, 182}, {2.6, 184},
{3.44, 190},  {4.07, 192}, {4.33, 194}, {4.37, 194}, {4.5, 195},  {4.8, 200},
{5.16, 203},  {5.22, 200}, {5.32, 204}, {5.84, 206}, {6.39, 211}, {6.78, 214},
{7.61, 218},  {8.68, 225}, {9.32, 228}, {9.59, 230}, {14.9, 270}, {17.9, 290},
{18.6, 292}}
*)

With[{plot = Plot[lmf[y], {y, Min@pp[[All, 1]], Max@pp[[All, 1]]}]},
Show[
Graphics@ Point@pp,
plot,
Graphics@ {Red, PointSize[Medium], Point@least25},
Frame -> True, Axes -> False, PlotRange -> All,
Options@plot]
]


Fitting the data,

data = Transpose[{yy, xx}];
line[x_] = Fit[data , {1, x}, x]


Generate a line using extreme points of the data, then compute distance between the points and the line, and finally sort the data.

a = Line@({#, line[#]} & /@ MinMax[yy])
b = SortBy[{#, RegionDistance[a, #]} & /@ data, Last]


b[[1;;25,1]] gives the first nearest points to the linear fit

{{7.61, 218}, {5.84, 206}, {2.09, 180}, {2.6, 184}, {8.68, 225}, {3.44, 190}, {1.73, 177}, {4.8, 200}, {17.9, 290}, {2.17, 182}, {6.39, 211}, {0.991, 174}, {18.6, 292}, {4.33, 194}, {5.22, 200}, {9.59, 230}, {6.78, 214}, {5.32, 204}, {4.5, 195}, {4.07, 192}, {5.16, 203}, {9.32, 228}, {4.37, 194}, {14.9, 270}, {1.5, 178}}

pts = Transpose[{xx, yy}];
f = LinearModelFit[pts, {x}, x];
linepts = Thread[{#, Function[x, f[x], Listable][#]}] &@(Range @@ MinMax[xx]);
distmat = DistanceMatrix[pts, linepts];
distance = MinimalBy[distmat~Flatten~1, EuclideanDistance[#, {0, 0}] &, 25];
selections = Extract[pts,
Position[distmat, Alternatives @@ distance][[All, 1]]~Partition~1];

Show[ListPlot[selections, PlotStyle -> Black], ListPlot[linepts, Joined -> True]]