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: Much faster ConvexHull implementation

  • To: mathgroup at smc.vnet.net
  • Subject: [mg55661] Re: Much faster ConvexHull implementation
  • From: koopman at sfu.ca (Ray Koopman)
  • Date: Fri, 1 Apr 2005 05:37:04 -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> <opsoc793kbiz9bcq@monster.ma.dl.cox.net> <d2b547$79l$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

"Carl K. Woll" <carl at woll2woll.com> wrote in message news:<d2b547$79l$1 at smc.vnet.net>...
> [...]
> At any rate, my version of convex hull can be found below. Any comments are 
> appreciated.
> 
> Carl Woll
> 
> It's best to make sure your default input format is InputForm when you copy 
> the function below to your notebook. At least on my machine, copying the 
> following code into a StandardForm input cell introduces invisible 
> multiplications so that executing the code results in Null^9 and the code 
> doesn't work.

Here is what I pasted as Plain Text into an Input cell whose default
FormatType is InputForm:

In[1]:=
convex[pts_] := Module[{spts, ss, toppts, bottompts},
 spts = Sort[Transpose[{N[pts], Range[Length[pts]]}]];
 ss = Drop[Split[spts[[All,1,1]]], {2, -2}];
 If[spts[[Length[ss[[1]]],1]] === spts[[1,1]],
  topleftindex = {};
  topleft = spts[[1,1]]; ,
  topleftindex = {spts[[Length[ss[[1]]],2]]};
  topleft = spts[[Length[ss[[1]]],1]];
 ];
 If[spts[[-Length[ss[[-1]]],1]] === spts[[-1,1]],
  bottomrightindex = {};
  bottomright = spts[[-1,1]]; ,
  bottomrightindex = {spts[[-Length[ss[[-1]]],2]]};
  bottomright = spts[[-Length[ss[[-1]]],1]];
 ];
 topline = Interpolation[{topleft, spts[[-1,1]]}, InterpolationOrder 
-> 1];
 bottomline = Interpolation[{spts[[1,1]], bottomright}, 
InterpolationOrder -> 1];
 toppts = Cases[spts, {{x_, y_}, _} /; y - topline[x] > 0];
 bottompts = Cases[spts, {{x_, y_}, _} /; y - bottomline[x] < 0];
 Join[
  Reverse[toppart[toppts, topline, Null, spts[[-1,2]]]],
  topleftindex,
  bottompart[bottompts, bottomline, spts[[1,2]], Null],
  bottomrightindex
 ]
]

toppart[pts_, line_, l_, r_] := Module[{newpt, leftline, rightline, 
leftpts, rightpts},
 newpt = Ordering[pts[[All,1,2]] - line[pts[[All,1,1]]], -1][[1]];
 leftline = Interpolation[{leftend[line], pts[[newpt,1]]}, 
InterpolationOrder -> 1];
 rightline = Interpolation[{pts[[newpt,1]], rightend[line]}, 
InterpolationOrder -> 1];
 leftpts = Cases[Take[pts, newpt - 1], {{x_, y_}, _} /; y - leftline[
x] > 0];
 rightpts = Cases[Drop[pts, newpt], {{x_, y_}, _} /; y - rightline[x]
 > 0];
 Join[ toppart[leftpts, leftline, l, pts[[newpt,2]]],
   toppart[rightpts, rightline, pts[[newpt,2]], r]
 ]
]

toppart[{{pt_, index_Integer}}, line_, l_, r_] := {index, r}
toppart[{}, line_, l_, r_] := {r}

bottompart[pts_, line_, l_, r_] := Module[{newpt, leftline, rightline,
leftpts, rightpts},
 newpt = Ordering[pts[[All,1,2]] - line[pts[[All,1,1]]], 1][[1]];
 leftline = Interpolation[{leftend[line], pts[[newpt,1]]}, 
InterpolationOrder -> 1];
 rightline = Interpolation[{pts[[newpt,1]], rightend[line]}, 
InterpolationOrder -> 1];
 leftpts = Cases[Take[pts, newpt - 1], {{x_, y_}, _} /; y - leftline[
x] < 0];
 rightpts = Cases[Drop[pts, newpt], {{x_, y_}, _} /; y - rightline[x]
 < 0];
 Join[ bottompart[leftpts, leftline, l, pts[[newpt,2]]],
   bottompart[rightpts, rightline, pts[[newpt,2]], r]
 ]
]

bottompart[{{pt_, index_Integer}}, line_, l_, r_] := {l, index}
bottompart[{}, line_, l_, r_] := {l}

leftend[interp_] := {#1, interp[#1]}&[interp[[1,1,1]]]
rightend[interp_] := {#1, interp[#1]}&[interp[[1,1,2]]]

Here is the hull for 9 random points in the unit square:

In[10]:= convex[pts = 
{{0.358243,0.363412},{0.105996,0.669358},{0.672295,0.0448138}, 
 {0.0124393,0.672149},{0.728004,0.311669},{0.90424,0.545403},
 {0.99939,0.160133},{0.749434,0.963945},{0.355428,0.0788455}}]

Out[10]= {7,6,8,4,4,9,3}

Such duplication occurs fairly often for random points.
Is anyone else getting this? Have I copied something wrongly?


  • Prev by Date: Fwd: Replacing an expression by an expression
  • Next by Date: transpose
  • Previous by thread: Re: plotting weighted graphs
  • Next by thread: Re: Re: Much faster ConvexHull implementation