MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Joining points of ListPlot

  • To: mathgroup at smc.vnet.net
  • Subject: [mg117333] Re: Joining points of ListPlot
  • From: Daniel Lichtblau <danl at wolfram.com>
  • Date: Tue, 15 Mar 2011 06:06:08 -0500 (EST)

Antonio Mezzacapo wrote:
> Thank you for answering.
> 
> I don't have any functional form of this points. I have only this array of
> points. Points on this array should be distributed *like* two crossing
> functions as Sin[x] and Cos[x], but I don't know the functional form of
> these functions.
> 
> All that I have is an array of points!
> Because of the fact that these points distribute on the x-y cartesian plane
> like two crossing functions, I cannot use "joined->true" because it gives me
> strange results.
> 
> Thank you
> Antonio
> [...]

One approach is to use Nearest to find candidate neighbors, then apply a 
slope test to remove some contenders. For this purpose i adapted some 
code from a November thread.

Our example:

curves = Riffle[Table[{x, Sin[x]}, {x, 0., 2*Pi, .1}],
    Table[{x, Cos[x]}, {x, .05, 2*Pi, .1}]];

ListPlot[curves]

Here is the code, with no attempt made to package it nicely. It gives an 
imperfect rendering in this example. I think one could make more 
judicious of Nearest and also improve on the slope test, in a way that 
would give a more accurate picture of the two curves. But this is 
certainly a reasonable start.

Needs["GraphUtilities`"];

curvesmodif = curves /. {x_, y_} :> {x, y};
nf = Nearest[curvesmodif];
neighbors =
   Map[{#, Complement[nf[#, 4], {#}]} &,
     curvesmodif] /. {x_Real, y_Real} :> {x, y};

Do[{elem, trio} = neighbors[[i]];
  slopes = Map[(elem[[2]] - #[[2]])/(elem[[1]] - #[[1]]) &, trio];
  slopes = Join[slopes, {slopes[[1]]}];
  slopediffs = Differences[slopes];
  bestpair = Ordering[Abs[slopediffs], 1][[1]];
  neighbors[[i]] =
   Sort[{elem, trio[[Mod[bestpair, 3, 1]]],
     trio[[Mod[bestpair + 1, 3, 1]]]}];
  , {i, Length[neighbors]}]

graph = Union[
    Flatten[Map[{#[[1]] -> #[[2]], #[[2]] -> #[[3]], #[[2]] -> #[[1]], \
#[[3]] -> #[[1]]} &, neighbors]]];

Do[elem = graph[[i]];
  If[! MemberQ[graph, Reverse[elem]], graph[[i]] = Null];,
  {i, Length[graph]}]
graph = graph /. Null :> Sequence[];

pieces = WeakComponents[graph]

plots = Map[ListPlot[#, Joined -> True] &, pieces];


Daniel Lichtblau
Wolfram Research


  • Prev by Date: Re: determining boundary of a region in n-dimensional euclidean space
  • Next by Date: Re: $MaxNumber
  • Previous by thread: Re: Joining points of ListPlot
  • Next by thread: Re: Joining points of ListPlot