7
$\begingroup$

The following data produces a distribution as shown. However I want that black-line to be highlighted that is kind of bounding these points from above. How can one do this in Mathematica?

enter image description here

data=Uncompress[FromCharacterCode[
  Flatten[ImageData[Import["https://i.stack.imgur.com/FtJS8.png"],"Byte"]]]]
$\endgroup$
1

2 Answers 2

4
$\begingroup$

See if this does what you want:

data={...};
findslope[{x_,y_}]:=y/x;
allslopes=Map[findslope,data];
maxslope=Last[Sort[allslopes]];
Show[ListPlot[data],Plot[maxslope*x,{x,0,1}]]

Then you can fiddle with the display details to make your line bold and black

$\endgroup$
5
  • 1
    $\begingroup$ You could probably use Max[s] instead of Last[Sort[s]] $\endgroup$
    – Lukas Lang
    Aug 9 at 20:46
  • 1
    $\begingroup$ @LukasLang Agreed. For what seem to be very new users I try to write very simple very methodical code and do things in the smallest most deliberate steps. If they can understand it and use it and even "optimize" it for themselves then I hope they have learned more. More experienced users might have written all that in a single line consisting of at least half punctuation characters But they wouldn't have asked this. ;} $\endgroup$
    – Bill
    Aug 9 at 20:51
  • $\begingroup$ Thanks @Bill. That works! But how can I known the equation of that line? $\endgroup$
    – seeker
    Aug 10 at 7:49
  • 1
    $\begingroup$ @seeker From your data and from your graph it looks like your bound is y=max*x+0. That max*x was what I plotted in the code. I urge you to study each line of that code I wrote. Look up each of those function names in the help system. Look at all the examples. Try to figure out what I was thinking when I wrote each of those lines. There are several ideas and methods in that code that will really help you in the future if you can figure out how each of those works. I hope it works for you. $\endgroup$
    – Bill
    Aug 10 at 15:28
  • 1
    $\begingroup$ Thanks a ton!!! It really helped. $\endgroup$
    – seeker
    Aug 10 at 15:55
1
$\begingroup$

Since the data not always looks contain the original {0,0},we consider to use ConvexHullMesh or ConvexHullRegion to get the flat boundary of data and use HighlightMesh to view the index of such line.

reg = ConvexHullMesh[data];
HighlightMesh[reg, {Style[2, Black], Style[1, Orange], 
  Style[0, Blue, AbsolutePointSize[6]], 
  Table[Labeled[{1, i}, 
    Style[i, White, FontFamily -> "Times", 20]], {i, 
    Length@MeshPrimitives[reg, 1]}]}, AspectRatio -> 1, 
 Epilog -> {Opacity[.5], Green, AbsolutePointSize[1.5], Point[data]}, 
 Background -> Gray]

enter image description here

7.

reg = ConvexHullMesh[data];
ListPlot[data, 
 Epilog -> {{Green, 
    MeshPrimitives[reg, Drop[MeshCellIndex[reg, 1], {7}]] /. 
     Line -> InfiniteLine, Red, 
    MeshPrimitives[reg, {1, 7}] /. Line -> InfiniteLine, 
    AbsolutePointSize[8], Point[{0, 0}]}}, PlotRange -> All]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.