Version 3 of Triangulation

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.

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 . <Escape> {exec wish $argv0 &; exit}
 bind . <F1> {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 ;) }