1 # 2008 Feb 19 2 # 3 # The author disclaims copyright to this source code. In place of 4 # a legal notice, here is a blessing: 5 # 6 # May you do good and not evil. 7 # May you find forgiveness for yourself and forgive others. 8 # May you share freely, never taking more than you give. 9 # 10 #*********************************************************************** 11 # 12 # This file contains Tcl code that may be useful for testing or 13 # analyzing r-tree structures created with this module. It is 14 # used by both test procedures and the r-tree viewer application. 15 # 16 17 18 #-------------------------------------------------------------------------- 19 # PUBLIC API: 20 # 21 # rtree_depth 22 # rtree_ndim 23 # rtree_node 24 # rtree_mincells 25 # rtree_check 26 # rtree_dump 27 # rtree_treedump 28 # 29 30 proc rtree_depth {db zTab} { 31 $db one "SELECT rtreedepth(data) FROM ${zTab}_node WHERE nodeno=1" 32 } 33 34 proc rtree_nodedepth {db zTab iNode} { 35 set iDepth [rtree_depth $db $zTab] 36 37 set ii $iNode 38 while {$ii != 1} { 39 set sql "SELECT parentnode FROM ${zTab}_parent WHERE nodeno = $ii" 40 set ii [db one $sql] 41 incr iDepth -1 42 } 43 44 return $iDepth 45 } 46 47 # Return the number of dimensions of the rtree. 48 # 49 proc rtree_ndim {db zTab} { 50 set nDim [expr {(([llength [$db eval "pragma table_info($zTab)"]]/6)-1)/2}] 51 } 52 53 # Return the contents of rtree node $iNode. 54 # 55 proc rtree_node {db zTab iNode {iPrec 6}} { 56 set nDim [rtree_ndim $db $zTab] 57 set sql " 58 SELECT rtreenode($nDim, data) FROM ${zTab}_node WHERE nodeno = $iNode 59 " 60 set node [db one $sql] 61 62 set nCell [llength $node] 63 set nCoord [expr $nDim*2] 64 for {set ii 0} {$ii < $nCell} {incr ii} { 65 for {set jj 1} {$jj <= $nCoord} {incr jj} { 66 set newval [format "%.${iPrec}f" [lindex $node $ii $jj]] 67 lset node $ii $jj $newval 68 } 69 } 70 set node 71 } 72 73 proc rtree_mincells {db zTab} { 74 set n [$db one "select length(data) FROM ${zTab}_node LIMIT 1"] 75 set nMax [expr {int(($n-4)/(8+[rtree_ndim $db $zTab]*2*4))}] 76 return [expr {int($nMax/3)}] 77 } 78 79 # An integrity check for the rtree $zTab accessible via database 80 # connection $db. 81 # 82 proc rtree_check {db zTab} { 83 array unset ::checked 84 85 # Check each r-tree node. 86 set rc [catch { 87 rtree_node_check $db $zTab 1 [rtree_depth $db $zTab] 88 } msg] 89 if {$rc && $msg ne ""} { error $msg } 90 91 # Check that the _rowid and _parent tables have the right 92 # number of entries. 93 set nNode [$db one "SELECT count(*) FROM ${zTab}_node"] 94 set nRow [$db one "SELECT count(*) FROM ${zTab}"] 95 set nRowid [$db one "SELECT count(*) FROM ${zTab}_rowid"] 96 set nParent [$db one "SELECT count(*) FROM ${zTab}_parent"] 97 98 if {$nNode != ($nParent+1)} { 99 error "Wrong number of entries in ${zTab}_parent" 100 } 101 if {$nRow != $nRowid} { 102 error "Wrong number of entries in ${zTab}_rowid" 103 } 104 105 return $rc 106 } 107 108 proc rtree_node_check {db zTab iNode iDepth} { 109 if {[info exists ::checked($iNode)]} { error "Second ref to $iNode" } 110 set ::checked($iNode) 1 111 112 set node [rtree_node $db $zTab $iNode] 113 if {$iNode!=1 && [llength $node]==0} { error "No such node: $iNode" } 114 115 if {$iNode != 1 && [llength $node]<[rtree_mincells $db $zTab]} { 116 puts "Node $iNode: Has only [llength $node] cells" 117 error "" 118 } 119 if {$iNode == 1 && [llength $node]==1 && [rtree_depth $db $zTab]>0} { 120 set depth [rtree_depth $db $zTab] 121 puts "Node $iNode: Has only 1 child (tree depth is $depth)" 122 error "" 123 } 124 125 set nDim [expr {([llength [lindex $node 0]]-1)/2}] 126 127 if {$iDepth > 0} { 128 set d [expr $iDepth-1] 129 foreach cell $node { 130 set shouldbe [rtree_node_check $db $zTab [lindex $cell 0] $d] 131 if {$cell ne $shouldbe} { 132 puts "Node $iNode: Cell is: {$cell}, should be {$shouldbe}" 133 error "" 134 } 135 } 136 } 137 138 set mapping_table "${zTab}_parent" 139 set mapping_sql "SELECT parentnode FROM $mapping_table WHERE rowid = \$rowid" 140 if {$iDepth==0} { 141 set mapping_table "${zTab}_rowid" 142 set mapping_sql "SELECT nodeno FROM $mapping_table WHERE rowid = \$rowid" 143 } 144 foreach cell $node { 145 set rowid [lindex $cell 0] 146 set mapping [db one $mapping_sql] 147 if {$mapping != $iNode} { 148 puts "Node $iNode: $mapping_table entry for cell $rowid is $mapping" 149 error "" 150 } 151 } 152 153 set ret [list $iNode] 154 for {set ii 1} {$ii <= $nDim*2} {incr ii} { 155 set f [lindex $node 0 $ii] 156 foreach cell $node { 157 set f2 [lindex $cell $ii] 158 if {($ii%2)==1 && $f2<$f} {set f $f2} 159 if {($ii%2)==0 && $f2>$f} {set f $f2} 160 } 161 lappend ret $f 162 } 163 return $ret 164 } 165 166 proc rtree_dump {db zTab} { 167 set zRet "" 168 set nDim [expr {(([llength [$db eval "pragma table_info($zTab)"]]/6)-1)/2}] 169 set sql "SELECT nodeno, rtreenode($nDim, data) AS node FROM ${zTab}_node" 170 $db eval $sql { 171 append zRet [format "% -10s %s\n" $nodeno $node] 172 } 173 set zRet 174 } 175 176 proc rtree_nodetreedump {db zTab zIndent iDepth iNode} { 177 set ret "" 178 set node [rtree_node $db $zTab $iNode 1] 179 append ret [format "%-3d %s%s\n" $iNode $zIndent $node] 180 if {$iDepth>0} { 181 foreach cell $node { 182 set i [lindex $cell 0] 183 append ret [rtree_nodetreedump $db $zTab "$zIndent " [expr $iDepth-1] $i] 184 } 185 } 186 set ret 187 } 188 189 proc rtree_treedump {db zTab} { 190 set d [rtree_depth $db $zTab] 191 rtree_nodetreedump $db $zTab "" $d 1 192 } 193
