Annotation of embedaddon/sqlite3/ext/rtree/rtree_util.tcl, revision 1.1
1.1 ! misho 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: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to rtree_util.tcl CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [ELWIX - Embedded LightWeight unIX -] / embedaddon / sqlite3 / ext / rtree