saito - 2022-12-25
Here is code that computes the convex hull of a given set of points. This is primarily based on the algorithm from the book "Introduction to Algorithms". The wiki had trouble with the link so I will just post it here as it is: https://www.amazon.com/Introduction-Algorithms-3rd-MIT-Press/dp/0262033844/ref=sr_1_1?crid=1J4MH8H1F4B0G&keywords=rivest&qid=1672008537&sprefix=rivest%2Caps%2C134&sr=8-1
I know there is another page here with a different implementation. A few of reasons for this new page:
Here is the code with all its related proc's:
proc point {id x y} { global tsp_points ;## get point's x set tsp_points($id,id) $id set tsp_points($id,x) $x set tsp_points($id,y) $y return $id } proc make_points {triplets} { global tsp_points ;## make point objects from a list of point number and its x,y coordinates set pList {} foreach tuple $triplets { lappend pList [point [lindex $tuple 0] [lindex $tuple 1] [lindex $tuple 2]] } return $pList } proc make_points_from_xy_only {xyList} { global tsp_points ;## make point objects from a list of (x,y) coordinates set i 0 set pList {} foreach pair $xyList { incr i lappend pList [point $i [lindex $pair 0] [lindex $pair 1]] } return $pList } proc pointGetX {p} { global tsp_points ;## get point's x return tsp_points($p,x) } proc pointGetY {p} { global tsp_points ;## get point's x return tsp_points($p,y) } proc pointIsSamePoint {p1 p2} { ;## given two points, ;## determine whether they are the same point ;## (either by their id's or by their coordinate values) if {([string compare $p1 $p2] == 0) || \ ( ([pointGetX $p1] == [pointGetX $p2]) && \ ([pointGetY $p1] == [pointGetY $p2]) )} { return 1 } else { return 0 } } proc pointGetDistanceToPoint {p1 p2} { ;## given two points, ;## compute the distance between them set x1 [pointGetX $p1] set y1 [pointGetY $p1] set x2 [pointGetX $p2] set y2 [pointGetY $p2] return [expr {sqrt (($x1 - $x2) * ($x1 - $x2) + \ ($y1 - $y2) * ($y1 - $y2))}] } proc convexHull_Theta {p1 p2} { ;## given two points, ;## compute the theta (in degrees) between them if {[pointIsSamePoint $p1 $p2]} { set result 361.0 } else { set dx [expr {[pointGetX $p2] - [pointGetX $p1]}] set ax [expr {abs($dx)}] set dy [expr {[pointGetY $p2] - [pointGetY $p1]}] set ay [expr {abs($dy)}] set absSum [expr {$ax + $ay}] if {$absSum == 0} { set t 0 } else { set t [expr {$dy / $absSum}] } if {$dx < 0} { set t [expr {2 - $t}] } elseif {$dy < 0} { set t [expr {$t + 4}] } set result [expr {$t * 90}] } return $result } proc computeConvexHull {pointList} { ;## given a list of points, ;## return a list of points that lie on the convex hull if {[llength $pointList] == 0} { ;## nothing to do return } ;## create a local array for efficient swap operations set pCount 0 foreach pointID $pointList { set pArray($pCount) $pointID incr pCount } ;## find the point with the minimum y-coordinate set min 0 for {set i 0} {$i < $pCount} {incr i} { set pi $pArray($i) set pmin $pArray($min) if {[pointGetY $pi] < [pointGetY $pmin]} { set min $i } } ;## duplicate the min-y point at the end as a safeguard set pArray($pCount) $pArray($min) ;## put the min-y point first ;## swap the 0-th and min-th elements set temp $pArray(0) set pArray(0) $pArray($min) set pArray($min) $temp set min 0 set prev -1 set hullSize -1 set changed 1 for {set i 0} {$i < $pCount} {incr i} { ;## swap the i-th and min-th elements set temp $pArray($i) set pArray($i) $pArray($min) set pArray($min) $temp set polar 360 set changed 0 for {set j [expr $i + 1]} {$j <= $pCount} {incr j} { set current [convexHull_Theta $pArray($i) $pArray($j)] if {($current > $prev) && ($current < $polar)} { set min $j set polar $current set changed 1 } elseif {$current == $polar} { set distI_J [pointGetDistanceToPoint $pArray($i) \ $pArray($j)] set distI_Min [pointGetDistanceToPoint $pArray($i) \ $pArray($min)] if {$distI_J > $distI_Min} { set min $j set polar $current set changed 1 } } } ;## convex hull complete? if {(! $changed) || [pointIsSamePoint $pArray(0) $pArray($min)]} { set hullSize [expr $i + 1] break } set prev $polar } if {$hullSize == -1} { ;## all points are on the convex hull ;## (did not break out of the above loop) set hullSize $pCount } ;## collect the convex hull points in a list set convexList {} for {set i 0} {$i < $hullSize} {incr i} { lappend convexList $pArray($i) } ;## destroy the temporary array for {set i 0} {$i < $pCount} {incr i} { unset pArray($i) } ;## return the list of convex hull points return $convexList }