[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
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**
| |