Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2005
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2005

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

Search the Archive

Re: Re: point in convex hull

  • To: mathgroup at smc.vnet.net
  • Subject: [mg55547] Re: [mg55515] Re: point in convex hull
  • From: "Carl K. Woll" <carl at woll2woll.com>
  • Date: Tue, 29 Mar 2005 03:42:30 -0500 (EST)
  • References: <d1tvc0$rli$1@smc.vnet.net> <200503270742.CAA06233@smc.vnet.net> <opsoa9q5xpiz9bcq@monster.ma.dl.cox.net> <011401c53310$74dde680$6400a8c0@Main> <opsob4uhh3iz9bcq@monster.ma.dl.cox.net>
  • Sender: owner-wri-mathgroup at wolfram.com

DrBob wrote

> I'd already realized minPosition == Length@ch was OK, and I was unable to 
> concoct an example in which minPosition == 1. I don't see any 
> documentation to guarantee this, however, so even if it's true, it may not 
> be true in the next version.
>
> Without that assumption, I thought this would do it:
>
> membership[pts_] := Module[{ch, min, max},
>    ch = ConvexHull[pts];
>    max = Position[ch, Ordering[pts, -1][[1]]][[1,1]];
>    ch = RotateLeft[ch, max - 1];
>    min = Position[ch, Ordering[pts, 1][[1]]][[1,1]];
>    AppendTo[ch, ch[[1]]];
>    al = Interpolation[pts[[Take[ch, min]]],
>      InterpolationOrder -> 1];
>    bl = Interpolation[pts[[Drop[ch, min - 1]]],
>      InterpolationOrder -> 1];
>    includedQ[{x_, y_}] :=
>      al[[1,1,1]] <= x <= al[[1,1,2]] &&
>       (y - al[x])*(y - bl[x]) <= 0
>  ]
>
> But then I realized all these Interpolation methods fail on the following 
> example:
>
> pts=Distribute[{Range@2,Range@2},List]
>
> {{1,1},{1,2},{2,1},{2,2}}
>
> because of duplicated x values.
>
> A fix isn't conceptually hard -- just TEDIOUS. I admit I haven't tested it 
> with a convex hull that defies our expectations:
>
> membership[data_] := Block[
>     {pts = Union@data,
>       mod = Mod[#, Length@ch, 1] &,
>       pos = Position[ch, pts[[#]]][[-1, 1]] &,
>       x = First@ch[[mod@#]] &,
>       pair = With[{k = pos@#}, If[x[k] == x[k - 1],
>               {ch, k},
>               {Insert[ch, pts[[#]], k], k + 1}]] &,
>       first, last, ch},
>     ch = pts[[ConvexHull@pts]];
>     {ch, first} = pair[1];
>     {ch, last} = pair[-1];
>     ch = RotateLeft[ch, last - 1];
>     first = pos[1] - 1;
>     al = Interpolation[Take[ch, first], InterpolationOrder -> 1];
>     bl = Interpolation[Drop[ch, first], InterpolationOrder -> 1];
>     includedQ[{x_, y_}] := al[[1,1,1]] <= x <= al[[1,1,2]] &&
>           (y - al[x])*(y - bl[x]) <= 0
> ]
>
> Bobby
>

<snip>

DrBob,

Good point about the possibility of vertical lines at the left and right 
ends of the convex hull. I see you also included a Union command to get rid 
of duplicate points. However, I would have approached the solution in a 
different way (I confess that I haven't spent the time to figure out what 
you did). The above interpolation line would consist of the points from the 
top most left end to the top most right end, and similarly for the below 
interpolation line. If you apply Union to the data, then the position of the 
top (bottom) most points on the left and right is easy to determine. I end 
up with the following membership function:

membership[pts_] :=
Module[{spts, ss},
 spts = Union[pts];
 ss = Split[spts[[All,1]]];

 aboveleft = Length[ss[[1]]];
 aboveright = Length[spts];
 belowleft = 1;
 belowright = Length[spts] - Length[ss[[-1]]] + 1;

 ch = ConvexHull[spts];

 abovefirst = RotateLeft[ch, Position[ch, aboveright][[1,1]] - 1];
 abovepts = spts[[Take[abovefirst, Position[abovefirst, 
aboveleft][[1,1]]]]];
 al = Interpolation[abovepts, InterpolationOrder -> 1];

 belowfirst = RotateLeft[ch, Position[ch, belowleft][[1,1]] - 1];
 belowpts = spts[[Take[belowfirst, Position[belowfirst, 
belowright][[1,1]]]]];
 bl = Interpolation[belowpts, InterpolationOrder -> 1];

 includedQ[{x_, y_}] := al[[1,1,1]]<=x<=al[[1,1,2]] && (y - al[x])(y - 
bl[x])<=0;
]

Carl Woll 



  • Prev by Date: work with graphics and output in a different notebook from the one containing your code
  • Next by Date: Re: Re: Re: Bug in Import?
  • Previous by thread: Re: Re: point in convex hull
  • Next by thread: Re: Re: point in convex hull