Services & ResourcesWolfram ForumsMathGroup Archive

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

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 

• References:
  • Re: point in convex hull
    • From: "Carl K. Woll" <carlw@u.washington.edu>