efficient grid lookup by coordinate in Tcl - tcl

Question

I'm trying to implement a simple grid lookup in Tcl. You can think of the grid items as boxes within a grid. Something like the following.
I have the x and y coordinates of the boundaries (left, right , top bottom) of each of the blue boxes within the coordinate space shown in a dictionary called boxcoordinates
given an arbitrary X and Y point, what is the most efficient way to identify which (if any) of the blue boxes are intercepted by the X,Y pair?
I'm currently doing a check for each box, on the conditions where Left < X < Right and Bottom < Y < Top to see which box satisfies those conditions.
Something like
foreach boxid [dict keys boxcoordinates] {
if {([dict get $boxcoordinates $boxid LEFT] < $x) && ([dict get $boxcoordinates $boxid RIGHT] > $x) && ([dict get $boxcoordinates $boxid BOTTOM] < $y) && ([dict get $boxcoordinates $boxid TOP] > $y)} {
set selected $boxid
break
}
}
But that seems very inefficient since there are a lot of boxes to scan through. Is there a more efficient way to do this?

Answer 1

If you sort the coordinate list in a regular fashion, you can do a binary search to find the coordinates you are looking for. The example below only has 9 entries, but should give you the idea. The coordinates used in this exampled are ordered as x1, x2, y1, y2.
global vars
proc init { } {
global vars
set vars(d) {
0 {1 4 1 4}
1 {1 4 6 8}
2 {1 4 10 12}
3 {6 8 1 4}
4 {6 8 6 8}
5 {6 8 10 12}
6 {10 12 1 4}
7 {10 12 6 8}
8 {10 12 10 12}
}
}
proc lCompare { a b } {
lassign $a ax1 ax2 ay1 ay2
lassign $b bx1 bx2 by1 by2
if { $bx1 < $ax1 } {
return -1
} elseif { $bx2 > $ax2 } {
return 1
} elseif { $by1 < $ay1 } {
return -1
} elseif { $by2 > $ay2 } {
return 1
}
return 0
}
proc bsearch { mx my } {
global vars
set target [list $mx $mx $my $my]
set low 0
set high [expr {[dict size $vars(d)]-1}]
while { $low <= $high } {
set mid [expr {($low+$high)/2}] ; # integer division
set lrc [lCompare [dict get $vars(d) $mid] $target]
if { $lrc > 0 } {
set low [expr {$mid+1}]
} elseif { $lrc < 0 } {
set high [expr {$mid-1}]
} else {
return $mid
}
}
return -1
}
init
set idx [bsearch 3 10]
puts "A:$idx"
set idx [bsearch 10 10]
puts "B:$idx"
set idx [bsearch 3 3]
puts "C:$idx"
set idx [bsearch 5 9]
puts "D:$idx"
Output:
bll-tecra:bll$ tclsh z.tcl
A:2
B:8
C:0
D:-1
References: wikipedia: Binary Search Algorithm