if 0 {[Richard Suchenwirth] 2003-08-09 - Given a set of points in a plane, one can construct a planar graph so that all points (vertices) are connected, directly or indirectly, with edges, such that no two edges cross. A maximum planar graph is called a triangulation of the vertex set. [http://mini.net/files/triangu.jpg] My playing with triangulations starts with an experimental UI, where you can seed vertices by left-clicking (right-click on one to remove it). Click on "Complete" to see the complete graph, each vertex connected with every other (gray edges); "Triangulate" to test the code below and see the triangulation in red. Vertices in the graph are just named $x/$y by their coordinates; edges are named $from/$to where from and to are vertices. } proc demo {} { canvas .c -bg white frame .f button .f.c -text Clear -command {.c delete all} button .f.co -text Complete -command {showComplete .c} button .f.tr -text Triangulate -command {showTriangulate .c} eval pack [winfo children .f] -side left pack .c .f -fill x -expand 1 bind .c <1> {addVertex %W %x %y} .c bind vertex <3> {%W delete current} } proc showComplete w { $w delete edge foreach edge [completeGraph [get vertex $w]] { showEdge $w $edge } } proc showEdge {w edge {fill gray}} { regexp {(.+)/(.+),(.+)/(.+)} $edge -> x0 y0 x1 y1 set ::length($edge) [expr {hypot($x1-$x0,$y1-$y0)}] $w create line $x0 $y0 $x1 $y1 -tags "edge $edge" -fill $fill } proc get {tag w} { set res {} foreach v [$w find withtag $tag] { lappend res [lindex [$w gettags $v] 1] } set res } proc completeGraph vertices { set graph {} foreach i $vertices { foreach j $vertices { if {$i<$j} {lappend graph $i,$j} } } set graph } proc showTriangulate w { $w delete edge showComplete $w wm title . Wait... set t0 [clock clicks -milliseconds] foreach edge [triangulate [get edge $w]] { showEdge $w $edge red } wm title . [expr {[clock clicks -milliseconds] - $t0}] } if 0 {My idea of triangulation is to iterate over all pairs of edges and see if they cross - then remove the longer of them; until no more crossing edges are found. However, sometimes it deletes one edge too many... at least the convex hull is always kept right.} proc triangulate graph { while 1 { set found 0 foreach i $graph { foreach j $graph { if {$i!=$j && [crossing $i $j]} { lremove graph [longer $i $j] set found 1 break } } if $found break } if {!$found} break } set graph } if 0 {To detect whether two line segments cross each other took me a bit of heavy math:} proc crossing {edge1 edge2} { regexp {(.+)/(.+),(.+)/(.+)} $edge1 -> x0 y0 x1 y1 regexp {(.+)/(.+),(.+)/(.+)} $edge2 -> x2 y2 x3 y3 if [adjacent $x0/$y0 $x1/$y1 $x2/$y2 $x3/$y3] {return 0} set m1 [slope $x0 $y0 $x1 $y1] set b1 [expr {$y0-$m1*$x0}] set m2 [slope $x2 $y2 $x3 $y3] set b2 [expr {$y2-$m2*$x2}] set x [slope $m2 $b1 $m1 $b2] expr {[between $x0 $x $x1] && [between $x2 $x $x3]} } proc adjacent args { expr {[llength [lsort -unique $args]]<[llength $args]} } proc slope {x0 y0 x1 y1} { # slightly "bend" a vertical line, to avoid division by zero if {$x1==$x0} {set x1 [expr {$x1+0.00000001}]} expr {double($y1-$y0)/($x1-$x0)} } proc between {a b c} { expr {$b==[lindex [lsort -real [list $a $b $c]] 1]} } proc longer {edge1 edge2} { global length expr {$length($edge1) > $length($edge2)? $edge1: $edge2} } proc addVertex {w x y} { $w create rect [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] \ -tags "vertex $x/$y" -fill blue } proc lremove {varName element} { upvar 1 $varName var set pos [lsearch $var $element] set var [lreplace $var $pos $pos] } demo bind . {exec wish $argv0 &; exit} bind . {console show} ---- if 0 {Please comment if you know better (more reliable) ways of triangulation! I originally wanted to play with the Travelling Salesman problem on the triangulated graph, but then it was so hot, and soon the weekend was over... [DGP] Use qhull, http://www.thesa.com/software/qhull/ [RS] Hm, yes, thanks, but I wanted to do it in [pure-Tcl] to find out how it can be done ;) }