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: [mg55555] Re: [mg55515] Re: point in convex hull
  • From: DrBob <drbob at bigfoot.com>
  • Date: Tue, 29 Mar 2005 03:42:38 -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> <02a501c533ac$f76aa4c0$6400a8c0@Main>
  • Reply-to: drbob at bigfoot.com
  • Sender: owner-wri-mathgroup at wolfram.com

That's pretty much equivalent to my last solution, but using Split is a clever shortcut for some of the work.

Bobby

On Mon, 28 Mar 2005 10:44:00 -0500, Carl K. Woll <carl at woll2woll.com> wrote:

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



-- 
DrBob at bigfoot.com


  • Prev by Date: Re: Re: Re: Bug in Import?
  • Next by Date: Much faster ConvexHull implementation
  • Previous by thread: Re: Re: point in convex hull
  • Next by thread: Much faster ConvexHull implementation