0

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 the slope. Im not sure if there is a way to calculate this easily? It would be similar to best line of fit but best line of fit, prices can be above and below the slope which doesn't match what I require.

user172839
  • 149
  • 4
  • 4
    I'm voting to close this question as off-topic because it is a math question. – BrenBarn Jul 19 '17 at 08:00
  • 1
    You may be using the answer to do personal finance, but as asked this is purely a math question. That said, I don't think the question has a well-defined answer. There may be more than one line meeting your criteria, so there is no such thing as "the" line. – BrenBarn Jul 19 '17 at 08:01
  • You're right. I'll post this is in the appropriate StackExchange section – user172839 Jul 19 '17 at 12:34

1 Answers1

2

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]

enter image description here

(* 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]

enter image description here

So, several lines meeting your criterion to choose from.

Chris Degnen
  • 9,797
  • 1
  • 20
  • 36