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:
1. It is a different algorithm.
2. This uses a new structure to represent points. It includes a point id/name in addition x/y coordinates.
3. A quick glance showed some comments about buggy behavior on certain inputs.
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 i 0
set pList {}
foreach tuple $triplets {
incr i
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
}
======