# Find the best parallel lines to a given data set

I have a set of data in an uptrend. I would like to find two BEST parallel lines to contain all the data but I don't know how to approach it, anyone can help ? Thanks. • Please provide the data to work on. Is this homework? – Kuba Dec 16 '13 at 8:37
• Hi, yes, it is a programming problem from college project. i just randomly pick some data to show what my problem is. – user11169 Dec 16 '13 at 9:07
• I'm not sure what is the policy about homeworks but this might be usefull so I suspect it will not be deleted. However it is also good to provide the data set, even randomly generated, it will focus more attention. Moreover it may be important, here for example we do not know if we have to work on list of values or list of points. – Kuba Dec 16 '13 at 9:15
• Thanks for your suggestion. The problem is not directly related to college project, but I come up with something and wanted to prove it using programming but I stuck here. Yes, I can share the data but it is my a newbie here so I don't know how to upload my sample data. – user11169 Dec 16 '13 at 9:28
• You don't have to because it is about Mathematica :) – Kuba Dec 16 '13 at 9:31

This is a computational geometry problem. I'll illustrate a solution using some sample data:

Needs["ComputationalGeometry"]
pts = Table[{x, Sin[x*3] + x/2. + RandomReal[.5]}, {x, 0, 10, .1}];
ListPlot[pts] You want to find 3 "support points" in your data, that touch these two lines. Now imagine you had a "convex hull", i.e. the smallest convex polygon that contains all your data points. Calculating a convex hull is cheap (at least in 2D) and it eliminates most of the points in your data:

hull = ConvexHull[pts];

ListPlot[pts,
Epilog -> {Red, Point[pts[[hull]]], Opacity[0.2],
Line[pts[[Append[hull, hull[]]]]]}] Obviously, the support points you're looking for are all on the convex hull. And two of them are next to each other on the convex hull.

EDIT: I'll shamelessly copy @Kuba's idea to minimize m first, as it makes the solution so much simpler:

(* find the possible value for m - the slopes between each adjacent \
pair of points on the convex hull *)
possibleMs =
Divide @@@ Differences[Reverse /@ pts[[Append[hull, hull[]]]]];
(* find the m with the smallest c2-c1 difference *)
m = SortBy[possibleMs, Max[#] - Min[#] &[pts[[hull]].{-#, 1}] &][];
(* find c1 and c2 *)
{c1, c2} = {Max[#], Min[#]} &[pts[[hull]].{-m, 1}];

ListPlot[pts,
Epilog -> {Red, Dashed, Line[{{0, c1}, {10, 10 m + c1}}],
Line[{{0, c2}, {10, 10 m + c2}}]}] Solution with NMinimize:

data = Table[Sin[15 x] + 3 x + RandomReal[] + 5, {x, 0, 1, .005}];

ListPlot[data, AxesOrigin -> {0, 0}] The basic idea is to reduce the data so that lines we are looking for are going to be parallel to OX axis with (data - m ran). Then Max-Min value of such data set is the exactly equal to |c1-c2|.

ran = Range[1, Length@data];
ClearAll[m];
sol = NMinimize[Max[#] - Min[#] &[data - (m ran)], m]

{2.86863, {m -> 0.0152302}}

{a, c1, c2} = {m, Max[#], Min[#]} &[data - (m ran)] /. sol[[ 2]]

{0.0152302, 6.84349, 3.97486}

Plot[{a x + c1, a x + c2}, {x, 0, 200}, Epilog -> Point[Transpose[{ran, data}]]] Just another data set:

data = Table[Sin[x/10]/(x/200) + x/50 + RandomReal[] + 5, {x, 50, 200}];
(*calculations*) An easy, no brain used, direct approach:

pts = Table[{x, Sin[x*3] + x/2. + RandomReal[.5]}, {x, 0,  10, .1}];
sol = Minimize[{c2 - c1,
And @@ (m #[] + c1 <= #[] <= (m #[] + c2) & /@ pts)},
{c1, c2, m}]

Show[Plot[{(m x + c1), (m x + c2)} /. sol[], {x, 0, 10}], ListPlot[pts]] With the other Kuba's example:

pts = Table[{x, Sin[x/10]/(x/200) + x/50 + RandomReal[] + 5}, {x, 50,  200}]; Edit

If you want to minimize the distance between the two lines, the results are slightly different:

pts = Table[{x, Sin[x/10]/(x/200) + x/50 + RandomReal[] + 5}, {x, 50, 200}];
sol = Quiet@ NMinimize[{Abs[(c2 - c1)] Cos[ArcTan[m]],
m > 0 &&
FullSimplify[ And @@ (m #[] + c1 <= #[] <= (m #[] + c2) & /@ pts)]},
{c1, c2, m}]
Show[Plot[{(m x + c1), (m x + c2)} /. sol[], {x, 0, 200}], ListPlot[pts]]
` 