Index: third_party/sqlite/sqlite-src-3080704/ext/rtree/rtree_util.tcl |
diff --git a/third_party/sqlite/sqlite-src-3080704/ext/rtree/rtree_util.tcl b/third_party/sqlite/sqlite-src-3080704/ext/rtree/rtree_util.tcl |
new file mode 100644 |
index 0000000000000000000000000000000000000000..50a1b58065111013a8f2d066f0f9178936f47089 |
--- /dev/null |
+++ b/third_party/sqlite/sqlite-src-3080704/ext/rtree/rtree_util.tcl |
@@ -0,0 +1,192 @@ |
+# 2008 Feb 19 |
+# |
+# The author disclaims copyright to this source code. In place of |
+# a legal notice, here is a blessing: |
+# |
+# May you do good and not evil. |
+# May you find forgiveness for yourself and forgive others. |
+# May you share freely, never taking more than you give. |
+# |
+#*********************************************************************** |
+# |
+# This file contains Tcl code that may be useful for testing or |
+# analyzing r-tree structures created with this module. It is |
+# used by both test procedures and the r-tree viewer application. |
+# |
+ |
+ |
+#-------------------------------------------------------------------------- |
+# PUBLIC API: |
+# |
+# rtree_depth |
+# rtree_ndim |
+# rtree_node |
+# rtree_mincells |
+# rtree_check |
+# rtree_dump |
+# rtree_treedump |
+# |
+ |
+proc rtree_depth {db zTab} { |
+ $db one "SELECT rtreedepth(data) FROM ${zTab}_node WHERE nodeno=1" |
+} |
+ |
+proc rtree_nodedepth {db zTab iNode} { |
+ set iDepth [rtree_depth $db $zTab] |
+ |
+ set ii $iNode |
+ while {$ii != 1} { |
+ set sql "SELECT parentnode FROM ${zTab}_parent WHERE nodeno = $ii" |
+ set ii [db one $sql] |
+ incr iDepth -1 |
+ } |
+ |
+ return $iDepth |
+} |
+ |
+# Return the number of dimensions of the rtree. |
+# |
+proc rtree_ndim {db zTab} { |
+ set nDim [expr {(([llength [$db eval "pragma table_info($zTab)"]]/6)-1)/2}] |
+} |
+ |
+# Return the contents of rtree node $iNode. |
+# |
+proc rtree_node {db zTab iNode {iPrec 6}} { |
+ set nDim [rtree_ndim $db $zTab] |
+ set sql " |
+ SELECT rtreenode($nDim, data) FROM ${zTab}_node WHERE nodeno = $iNode |
+ " |
+ set node [db one $sql] |
+ |
+ set nCell [llength $node] |
+ set nCoord [expr $nDim*2] |
+ for {set ii 0} {$ii < $nCell} {incr ii} { |
+ for {set jj 1} {$jj <= $nCoord} {incr jj} { |
+ set newval [format "%.${iPrec}f" [lindex $node $ii $jj]] |
+ lset node $ii $jj $newval |
+ } |
+ } |
+ set node |
+} |
+ |
+proc rtree_mincells {db zTab} { |
+ set n [$db one "select length(data) FROM ${zTab}_node LIMIT 1"] |
+ set nMax [expr {int(($n-4)/(8+[rtree_ndim $db $zTab]*2*4))}] |
+ return [expr {int($nMax/3)}] |
+} |
+ |
+# An integrity check for the rtree $zTab accessible via database |
+# connection $db. |
+# |
+proc rtree_check {db zTab} { |
+ array unset ::checked |
+ |
+ # Check each r-tree node. |
+ set rc [catch { |
+ rtree_node_check $db $zTab 1 [rtree_depth $db $zTab] |
+ } msg] |
+ if {$rc && $msg ne ""} { error $msg } |
+ |
+ # Check that the _rowid and _parent tables have the right |
+ # number of entries. |
+ set nNode [$db one "SELECT count(*) FROM ${zTab}_node"] |
+ set nRow [$db one "SELECT count(*) FROM ${zTab}"] |
+ set nRowid [$db one "SELECT count(*) FROM ${zTab}_rowid"] |
+ set nParent [$db one "SELECT count(*) FROM ${zTab}_parent"] |
+ |
+ if {$nNode != ($nParent+1)} { |
+ error "Wrong number of entries in ${zTab}_parent" |
+ } |
+ if {$nRow != $nRowid} { |
+ error "Wrong number of entries in ${zTab}_rowid" |
+ } |
+ |
+ return $rc |
+} |
+ |
+proc rtree_node_check {db zTab iNode iDepth} { |
+ if {[info exists ::checked($iNode)]} { error "Second ref to $iNode" } |
+ set ::checked($iNode) 1 |
+ |
+ set node [rtree_node $db $zTab $iNode] |
+ if {$iNode!=1 && [llength $node]==0} { error "No such node: $iNode" } |
+ |
+ if {$iNode != 1 && [llength $node]<[rtree_mincells $db $zTab]} { |
+ puts "Node $iNode: Has only [llength $node] cells" |
+ error "" |
+ } |
+ if {$iNode == 1 && [llength $node]==1 && [rtree_depth $db $zTab]>0} { |
+ set depth [rtree_depth $db $zTab] |
+ puts "Node $iNode: Has only 1 child (tree depth is $depth)" |
+ error "" |
+ } |
+ |
+ set nDim [expr {([llength [lindex $node 0]]-1)/2}] |
+ |
+ if {$iDepth > 0} { |
+ set d [expr $iDepth-1] |
+ foreach cell $node { |
+ set shouldbe [rtree_node_check $db $zTab [lindex $cell 0] $d] |
+ if {$cell ne $shouldbe} { |
+ puts "Node $iNode: Cell is: {$cell}, should be {$shouldbe}" |
+ error "" |
+ } |
+ } |
+ } |
+ |
+ set mapping_table "${zTab}_parent" |
+ set mapping_sql "SELECT parentnode FROM $mapping_table WHERE rowid = \$rowid" |
+ if {$iDepth==0} { |
+ set mapping_table "${zTab}_rowid" |
+ set mapping_sql "SELECT nodeno FROM $mapping_table WHERE rowid = \$rowid" |
+ } |
+ foreach cell $node { |
+ set rowid [lindex $cell 0] |
+ set mapping [db one $mapping_sql] |
+ if {$mapping != $iNode} { |
+ puts "Node $iNode: $mapping_table entry for cell $rowid is $mapping" |
+ error "" |
+ } |
+ } |
+ |
+ set ret [list $iNode] |
+ for {set ii 1} {$ii <= $nDim*2} {incr ii} { |
+ set f [lindex $node 0 $ii] |
+ foreach cell $node { |
+ set f2 [lindex $cell $ii] |
+ if {($ii%2)==1 && $f2<$f} {set f $f2} |
+ if {($ii%2)==0 && $f2>$f} {set f $f2} |
+ } |
+ lappend ret $f |
+ } |
+ return $ret |
+} |
+ |
+proc rtree_dump {db zTab} { |
+ set zRet "" |
+ set nDim [expr {(([llength [$db eval "pragma table_info($zTab)"]]/6)-1)/2}] |
+ set sql "SELECT nodeno, rtreenode($nDim, data) AS node FROM ${zTab}_node" |
+ $db eval $sql { |
+ append zRet [format "% -10s %s\n" $nodeno $node] |
+ } |
+ set zRet |
+} |
+ |
+proc rtree_nodetreedump {db zTab zIndent iDepth iNode} { |
+ set ret "" |
+ set node [rtree_node $db $zTab $iNode 1] |
+ append ret [format "%-3d %s%s\n" $iNode $zIndent $node] |
+ if {$iDepth>0} { |
+ foreach cell $node { |
+ set i [lindex $cell 0] |
+ append ret [rtree_nodetreedump $db $zTab "$zIndent " [expr $iDepth-1] $i] |
+ } |
+ } |
+ set ret |
+} |
+ |
+proc rtree_treedump {db zTab} { |
+ set d [rtree_depth $db $zTab] |
+ rtree_nodetreedump $db $zTab "" $d 1 |
+} |