15821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 2008 Feb 19 25821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 35821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# The author disclaims copyright to this source code. In place of 45821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# a legal notice, here is a blessing: 55821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 65821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# May you do good and not evil. 75821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# May you find forgiveness for yourself and forgive others. 85821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# May you share freely, never taking more than you give. 95821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#*********************************************************************** 115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# This file contains Tcl code that may be useful for testing or 135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# analyzing r-tree structures created with this module. It is 145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# used by both test procedures and the r-tree viewer application. 155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)#-------------------------------------------------------------------------- 195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# PUBLIC API: 205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# rtree_depth 225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# rtree_ndim 235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# rtree_node 245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# rtree_mincells 255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# rtree_check 265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# rtree_dump 275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# rtree_treedump 285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_depth {db zTab} { 315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) $db one "SELECT rtreedepth(data) FROM ${zTab}_node WHERE nodeno=1" 325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_nodedepth {db zTab iNode} { 355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set iDepth [rtree_depth $db $zTab] 365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set ii $iNode 385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) while {$ii != 1} { 395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set sql "SELECT parentnode FROM ${zTab}_parent WHERE nodeno = $ii" 405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set ii [db one $sql] 415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) incr iDepth -1 425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return $iDepth 455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Return the number of dimensions of the rtree. 485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_ndim {db zTab} { 505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nDim [expr {(([llength [$db eval "pragma table_info($zTab)"]]/6)-1)/2}] 515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# Return the contents of rtree node $iNode. 545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_node {db zTab iNode {iPrec 6}} { 565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nDim [rtree_ndim $db $zTab] 575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set sql " 585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) SELECT rtreenode($nDim, data) FROM ${zTab}_node WHERE nodeno = $iNode 595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) " 605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set node [db one $sql] 615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nCell [llength $node] 635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nCoord [expr $nDim*2] 645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for {set ii 0} {$ii < $nCell} {incr ii} { 655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for {set jj 1} {$jj <= $nCoord} {incr jj} { 665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set newval [format "%.${iPrec}f" [lindex $node $ii $jj]] 675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lset node $ii $jj $newval 685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set node 715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_mincells {db zTab} { 745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set n [$db one "select length(data) FROM ${zTab}_node LIMIT 1"] 755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nMax [expr {int(($n-4)/(8+[rtree_ndim $db $zTab]*2*4))}] 765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return [expr {int($nMax/3)}] 775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# An integrity check for the rtree $zTab accessible via database 805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# connection $db. 815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)# 825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_check {db zTab} { 835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) array unset ::checked 845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) # Check each r-tree node. 865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set rc [catch { 875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rtree_node_check $db $zTab 1 [rtree_depth $db $zTab] 885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } msg] 895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$rc && $msg ne ""} { error $msg } 905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) # Check that the _rowid and _parent tables have the right 925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) # number of entries. 935821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nNode [$db one "SELECT count(*) FROM ${zTab}_node"] 945821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nRow [$db one "SELECT count(*) FROM ${zTab}"] 955821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nRowid [$db one "SELECT count(*) FROM ${zTab}_rowid"] 965821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nParent [$db one "SELECT count(*) FROM ${zTab}_parent"] 975821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 985821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$nNode != ($nParent+1)} { 995821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) error "Wrong number of entries in ${zTab}_parent" 1005821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1015821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$nRow != $nRowid} { 1025821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) error "Wrong number of entries in ${zTab}_rowid" 1035821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1045821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1055821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return $rc 1065821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 1075821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1085821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_node_check {db zTab iNode iDepth} { 1095821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {[info exists ::checked($iNode)]} { error "Second ref to $iNode" } 1105821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set ::checked($iNode) 1 1115821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1125821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set node [rtree_node $db $zTab $iNode] 1135821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$iNode!=1 && [llength $node]==0} { error "No such node: $iNode" } 1145821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1155821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$iNode != 1 && [llength $node]<[rtree_mincells $db $zTab]} { 1165821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) puts "Node $iNode: Has only [llength $node] cells" 1175821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) error "" 1185821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1195821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$iNode == 1 && [llength $node]==1 && [rtree_depth $db $zTab]>0} { 1205821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set depth [rtree_depth $db $zTab] 1215821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) puts "Node $iNode: Has only 1 child (tree depth is $depth)" 1225821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) error "" 1235821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1245821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1255821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nDim [expr {([llength [lindex $node 0]]-1)/2}] 1265821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1275821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$iDepth > 0} { 1285821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set d [expr $iDepth-1] 1295821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) foreach cell $node { 1305821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set shouldbe [rtree_node_check $db $zTab [lindex $cell 0] $d] 1315821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$cell ne $shouldbe} { 1325821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) puts "Node $iNode: Cell is: {$cell}, should be {$shouldbe}" 1335821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) error "" 1345821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1355821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1365821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1375821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1385821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set mapping_table "${zTab}_parent" 1395821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set mapping_sql "SELECT parentnode FROM $mapping_table WHERE rowid = \$rowid" 1405821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$iDepth==0} { 1415821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set mapping_table "${zTab}_rowid" 1425821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set mapping_sql "SELECT nodeno FROM $mapping_table WHERE rowid = \$rowid" 1435821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1445821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) foreach cell $node { 1455821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set rowid [lindex $cell 0] 1465821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set mapping [db one $mapping_sql] 1475821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$mapping != $iNode} { 1485821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) puts "Node $iNode: $mapping_table entry for cell $rowid is $mapping" 1495821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) error "" 1505821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1515821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1525821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1535821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set ret [list $iNode] 1545821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) for {set ii 1} {$ii <= $nDim*2} {incr ii} { 1555821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set f [lindex $node 0 $ii] 1565821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) foreach cell $node { 1575821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set f2 [lindex $cell $ii] 1585821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {($ii%2)==1 && $f2<$f} {set f $f2} 1595821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {($ii%2)==0 && $f2>$f} {set f $f2} 1605821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1615821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) lappend ret $f 1625821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1635821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) return $ret 1645821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 1655821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1665821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_dump {db zTab} { 1675821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set zRet "" 1685821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set nDim [expr {(([llength [$db eval "pragma table_info($zTab)"]]/6)-1)/2}] 1695821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set sql "SELECT nodeno, rtreenode($nDim, data) AS node FROM ${zTab}_node" 1705821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) $db eval $sql { 1715821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) append zRet [format "% -10s %s\n" $nodeno $node] 1725821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1735821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set zRet 1745821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 1755821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1765821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_nodetreedump {db zTab zIndent iDepth iNode} { 1775821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set ret "" 1785821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set node [rtree_node $db $zTab $iNode 1] 1795821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) append ret [format "%-3d %s%s\n" $iNode $zIndent $node] 1805821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) if {$iDepth>0} { 1815821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) foreach cell $node { 1825821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set i [lindex $cell 0] 1835821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) append ret [rtree_nodetreedump $db $zTab "$zIndent " [expr $iDepth-1] $i] 1845821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1855821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) } 1865821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set ret 1875821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 1885821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) 1895821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)proc rtree_treedump {db zTab} { 1905821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) set d [rtree_depth $db $zTab] 1915821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles) rtree_nodetreedump $db $zTab "" $d 1 1925821806d5e7f356e8fa4b058a389a808ea183019Torne (Richard Coles)} 193