: Calculating slope of series of points I have a series of prices plotted against time. I'm trying to determine the slope of the line whereby all the prices fall below this slope but at least two prices need to be touching

Vote Up Vote Down   0 Reactions

Login to give Reaction!

Find all the two-point combinations and calculate lines. Find which lines have no points above it, then choose which one you want: the steepest, the shallowest or the one closest to the gradient of the line of best fit.

Here's a demo, coded in Mathematica.

pts = {
{0.605187, 0.70719}, {1.1902, 2.27393}, {1.79539, 1.78899},
{2.48127, 2.87079}, {3.30836, 3.87798}, {4.11527, 3.43034},
{4.88184, 4.77326}, {6.01153, 5.10899}, {6.49568, 4.54944}};

pairs = Subsets[pts, {2}];

Print[Length[pairs], " pairs of points"]

36 pairs of points

Clear[x]

line[{{x1_, y1_}, {x2_, y2_}}] := Module[{},
m = (y2 - y1)/(x2 - x1);
b = y1 - (m x1);
m x + b]

linefunctions = Map[line, pairs];

(* plot all lines passing through all the pairs of points *)
Show[Plot[linefunctions, {x, 0, 7}, PlotStyle -> Black],
ListPlot[pts, PlotMarkers -> Automatic, PlotStyle -> Yellow], Frame -> True]

(* initialise list *)
savedlines = {};

check[line_, pair_] := Module[{},
(* exclude pair from test points *)
testpoints = Complement[pts, pair];
(* calculate projected y for test points *)
projectedy = ReplaceAll[line, x -> Map[First, testpoints]];
(* if projected y is greater or equal to test points' y save line *)
If[Union@Thread[projectedy >= Map[Last, testpoints]] == {True},
AppendTo[savedlines, line], Nothing]]

MapThread[check, {linefunctions, pairs}];

Show[Plot[savedlines, {x, 0, 7}, PlotStyle -> Black],
ListPlot[pts, PlotMarkers -> Automatic, PlotStyle -> Red], Frame -> True]

So, several lines meeting your criterion to choose from.