14
$\begingroup$

I have found some software that allows me to "data mine" the values from publication figures. I have a bunch of contours from papers that I've mined using this software, and am having some trouble plotting the points with the Joined command.

Unfortunately, the downloaded points are sorted by increasing x values, which makes the plotting of Gaussian-esque contours very difficult. I've searched around the forums and haven't found anyone mentioning this problem.

Here's an example on a very small, simpler distribution (note my other sets are much larger so brute force definitely won't work.)

data={{62.0774, 0.598737}, {62.2377, 0.619119}, {62.4048, 
0.580509}, {62.5466, 0.637818}, {62.9276, 0.654518}, {62.9668, 
      0.566973}, {63.3095, 0.671261}, {63.8137, 0.688518}, {63.8913, 
      0.565805}, {64.4067, 0.703821}, {64.8157, 0.568541}, {65.1005, 
      0.718671}, {65.7401, 0.573603}, {65.9282, 0.732056}, {66.6646, 
      0.580678}, {66.7973, 0.743456}, {67.6058, 0.589303}, {67.7571, 
      0.755602}, {68.5512, 0.599853}, {68.6815, 0.761419}, {69.4, 
      0.614478}, {69.6059, 0.76384}, {70.1679, 0.631668}, {70.5117, 
      0.759937}, {70.5514, 0.759266}, {70.7216, 0.649606}, {71.3609, 
      0.666955}, {71.3764, 0.751005}, {71.7909, 0.736308}, {71.8078, 
      0.687055}, {71.947, 0.702022}, {72.0491, 0.717738}}

Using ListPlot gives me this:

ListPlot[data]

points

While using ListLinePlot gives me this

ListLinePlot[data]

lines

because the points are ordered with increasing x-value.

So, is there any way to either join the points by nearest neighbor, or re-order the list such that the joined command will give me a neat line? This seems like a traveling-salesman type problem, which could quickly get slow as I increase the number of points too much.

Improve this question
$\endgroup$
6
  • 4
    $\begingroup$ Try FindShortestTour $\endgroup$
    – C. E.
    Commented Apr 15, 2019 at 13:48
  • 2
    $\begingroup$ Try something like ListLinePlot[data[[Last@FindShortestTour@data]]] but it is not perfect $\endgroup$
    – ZaMoC
    Commented Apr 15, 2019 at 14:39
  • 2
    $\begingroup$ Will your data always be in convex hulls? $\endgroup$
    – MikeY
    Commented Apr 15, 2019 at 18:22
  • $\begingroup$ @MikeY unfortunately not! They are the results of a Bayesian analysis and many have differing, strange, and non-analytical forms. $\endgroup$
    – zack
    Commented Apr 15, 2019 at 21:04
  • 1
    $\begingroup$ One thing to note. If your distributions are going to be in extremely abstract forms, it could be more beneficial to not connect-the-dots. If this is for presentation, the human mind is really great at inferring shapes from just points. Maybe consider just using ListPlot. $\endgroup$
    – Dylan
    Commented Apr 16, 2019 at 16:38

4 Answers 4

Reset to default
14
$\begingroup$

You can use FindCurvePath to reorder your data. However, FindCurvePath expects the scale of the two coordinates to be close, so you need to rescale first:

new = FindCurvePath[data . {{1, 0}, {0, 100}}]
ListLinePlot[data[[#]]& /@ new]

{{2, 1, 3, 6, 9, 11, 13, 15, 17, 19, 21, 23, 26, 27, 30, 31, 32, 29, 28, 25, 24, 22, 20, 18, 16, 14, 12, 10, 8, 7, 5, 4, 2}}

enter image description here

Update

Roman suggested automating the scaling of the data. Here is one possibility for rescaling the data:

rescale = RescalingTransform[CoordinateBounds[data]] @ data;

Then, using FindCurvePath on the rescaled data:

new = FindCurvePath @ rescale

{{2, 1, 3, 6, 9, 11, 13, 15, 17, 19, 21, 23, 26, 27, 30, 31, 32, 29, 28, 25, 24, 22, 20, 18, 16, 14, 12, 10, 8, 7, 5, 4, 2}}

produces the same result.

Improve this answer
$\endgroup$
5
  • 1
    $\begingroup$ Why not just the closely related ListCurvePathPlot? $\endgroup$
    – Roman
    Commented Apr 15, 2019 at 15:32
  • 1
    $\begingroup$ @Roman Did you try using ListCurvePathPlot? Because the data has such a small variation in the y coordinate, ListCurvePathPlot doesn't work well. That's why I scaled the data and used FindCurvePath to reorder the data, and then plotted the reordered data. $\endgroup$
    – Carl Woll
    Commented Apr 15, 2019 at 16:25
  • 1
    $\begingroup$ Ah yes, brilliant! Maybe even easier for automation would be a hands-free rescaling by the covariance matrix of the data, something like path = First[FindCurvePath[data.(Transpose[#[[2]]]/Sqrt[#[[1]]] &@ Eigensystem[Covariance[data]])]], which tries to map the given data onto a unit circle before applying FindCurvePath. What do you think? $\endgroup$
    – Roman
    Commented Apr 15, 2019 at 17:34
  • 1
    $\begingroup$ @Roman Adding automatic rescaling is a good idea. I added a simple version based on RescalingTransform. You can add an answer using Eigensystem/Covariance if you want. $\endgroup$
    – Carl Woll
    Commented Apr 15, 2019 at 17:58
  • $\begingroup$ Thank you very much for your multiple solutions @CarlWoll! These worked perfectly for all my datasets other than the ones with kinks, those of which I can manually edit. $\endgroup$
    – zack
    Commented Apr 15, 2019 at 21:03
10
$\begingroup$

Since your data can form a star convex polygon, we can sort by the angle with respect to a certain point:

center = Mean[data];
ListLinePlot[ArrayPad[SortBy[data, ArcTan @@ (# - center) &], {{0, 1}}, "Periodic"]]

enter image description here

Improve this answer
$\endgroup$
7
$\begingroup$

By scaling the data into the covariance ellipsoid, we can achieve hands-free auto-scaling before calculating a FindCurvePath along @CarlWoll 's solution:

path = First@FindCurvePath[
  data.Transpose[#[[2]]/Sqrt[#[[1]]]&@Eigensystem[Covariance[data]]]]

{2, 1, 3, 6, 9, 11, 13, 15, 17, 19, 21, 23, 26, 27, 30, 31, 32, 29, 28, 25, 24, 22, 20, 18, 16, 14, 12, 10, 8, 7, 5, 4, 2}

ListPlot[data[[path]]]

enter image description here

Alternatively, if the data points are meant to describe a closed loop, the path can be found with

path = Last@FindShortestTour[
  data.Transpose[#[[2]]/Sqrt[#[[1]]]&@Eigensystem[Covariance[data]]]]

{1, 2, 4, 5, 7, 8, 10, 12, 14, 16, 18, 20, 22, 24, 25, 28, 29, 32, 31, 30, 27, 26, 23, 21, 19, 17, 15, 13, 11, 9, 6, 3, 1}

The transformed data that are fed into FindCurvePath or FindShortestTour have a unit covariance matrix, which makes it easier to find a good path:

Sdata = data.Transpose[#[[2]]/Sqrt[#[[1]]]&@Eigensystem[Covariance[data]]];
Chop@Covariance[Sdata]

{{1., 0}, {0, 1.}}

We can see that these scaled points nearly lie on a circle:

ListPlot[Sdata, AspectRatio -> Automatic]

enter image description here

Improve this answer
$\endgroup$
3
  • 1
    $\begingroup$ You're missing the plot command for your first image and the command shown for it should be with the second image. $\endgroup$
    – Bob Hanlon
    Commented Apr 15, 2019 at 20:35
  • 1
    $\begingroup$ Thanks @BobHanlon , for some reason the formatting got scrambled when I added the second image. $\endgroup$
    – Roman
    Commented Apr 15, 2019 at 20:50
  • $\begingroup$ Thank you for this solution @Roman! It also works excellently. $\endgroup$
    – zack
    Commented Apr 15, 2019 at 21:05
4
$\begingroup$

Sorta lame, but rescaling and Nearest can be used to get triples, with Line to connect the triples (each has a point and its two closest neighbors which in this case will do what you want).

data2 = Map[{1, 100}*# &, data];
nf = Nearest[data2];
triples0 = Map[RotateRight, nf[data2, 3]];
triples = Map[Line, Map[{1, 1/100}*# &, triples0, {2}]];

Show[{ListPlot[data, ColorFunction -> (Black &)], 
  Graphics[{Green, triples}]}]

enter image description here

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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