Update all new Tasks

Task/K-d-tree/Tcl/k-d-tree-1.tcl

@@ -0,0 +1,69 @@
+package require TclOO
+
+oo::class create KDTree {
+    variable t dim
+    constructor {points} {
+	set t [my Build 0 $points 0 end]
+	set dim [llength [lindex $points 0]]
+    }
+    method Build {split exset from to} {
+	set exset [lsort -index $split -real [lrange $exset $from $to]]
+	if {![llength $exset]} {return 0}
+	set m [expr {[llength $exset] / 2}]
+	set d [lindex $exset $m]
+	while {[set mm $m;incr mm] < [llength $exset] && \
+		[lindex $exset $mm $split] == [lindex $d $split]} {
+	    set m $mm
+	}
+	set s [expr {($split + 1) % [llength $d]}]
+	list 1 $d $split [my Build $s $exset 0 [expr {$m-1}]] \
+		[my Build $s $exset [expr {$m+1}] end]
+    }
+
+    method findNearest {p} {
+	lassign [my FN $t $p inf] p d2 count
+	return [list $p [expr {sqrt($d2)}] $count]
+    }
+    method FN {kd target maxDist2} {
+	if {[lindex $kd 0] == 0} {
+	    return [list [lrepeat $dim 0.0] inf 0]
+	}
+
+	set nodesVisited 1
+	lassign $kd -> pivot s
+
+	if {[lindex $target $s] <= [lindex $pivot $s]} {
+	    set nearerKD [lindex $kd 3]
+	    set furtherKD [lindex $kd 4]
+	} else {
+	    set nearerKD [lindex $kd 4]
+	    set furtherKD [lindex $kd 3]
+	}
+
+	lassign [my FN $nearerKD $target $maxDist2] nearest dist2 count
+	incr nodesVisited $count
+
+	if {$dist2 < $maxDist2} {
+	    set maxDist2 $dist2
+	}
+	set d2 [expr {([lindex $pivot $s]-[lindex $target $s])**2}]
+	if {$d2 > $maxDist2} {
+	    return [list $nearest $dist2 $nodesVisited]
+	}
+	set d2 0.0
+	foreach pp $pivot tp $target {set d2 [expr {$d2+($pp-$tp)**2}]}
+	if {$d2 < $dist2} {
+	    set nearest $pivot
+	    set maxDist2 [set dist2 $d2]
+	}
+
+	lassign [my FN $furtherKD $target $maxDist2] fNearest fDist2 count
+	incr nodesVisited $count
+	if {$fDist2 < $dist2} {
+	    set nearest $fNearest
+	    set dist2 $fDist2
+	}
+
+	return [list $nearest $dist2 $nodesVisited]
+    }
+}

Task/K-d-tree/Tcl/k-d-tree-2.tcl

@@ -0,0 +1,37 @@
+proc showNearest {heading tree point} {
+    puts ${heading}:
+    puts "Point:            \[[join $point ,]\]"
+    lassign [$tree findNearest $point] nearest distance count
+    puts "Nearest neighbor: \[[join $nearest ,]\]"
+    puts "Distance:         $distance"
+    puts "Nodes visited:    $count"
+}
+proc randomPoint k {
+    for {set j 0} {$j < $k} {incr j} {lappend p [::tcl::mathfunc::rand]}
+    return $p
+}
+proc randomPoints {k n} {
+    for {set i 0} {$i < $n} {incr i} {
+	set p {}
+	for {set j 0} {$j < $k} {incr j} {
+	    lappend p [::tcl::mathfunc::rand]
+	}
+	lappend ps $p
+    }
+    return $ps
+}
+
+KDTree create kd1 {{2 3} {5 4} {9 6} {4 7} {8 1} {7 2}}
+showNearest "Wikipedia example data" kd1 {9 2}
+puts ""
+
+set N 1000
+set t [time {KDTree create kd2 [randomPoints 3 $N]}]
+showNearest "k-d tree with $N random 3D points (generation time: [lindex $t 0] us)" kd2 [randomPoint 3]
+kd2 destroy
+puts ""
+
+set N 1000000
+set t [time {KDTree create kd2 [randomPoints 3 $N]}]
+showNearest "k-d tree with $N random 3D points (generation time: [lindex $t 0] us)" kd2 [randomPoint 3]
+puts "Search time:      [time {kd2 findNearest [randomPoint 3]} 10000]"