Annotation of embedaddon/sqlite3/ext/rtree/rtree_util.tcl, revision 1.1.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