通过Tcl中的坐标进行有效的网格查找

Question

我试图在Tcl中实现简单的网格查找。您可以将网格项视为网格中的框。像下面这样的东西。

我有一个名为boxcoordinates的字典中显示的坐标空间内每个蓝色框的边界（左，右，顶部）的x和y坐标

给定一个任意的X和Y点，识别哪一个（如果有的话）蓝色框被X，Y对截获的最有效方法是什么？

我目前正在检查每个方框，条件是Left＆lt; X＆lt;右下角＆lt; Y＆lt;顶部以查看哪个盒子符合这些条件。

像

这样的东西

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
  }
}

但这似乎非常低效，因为有很多盒子需要扫描。有没有更有效的方法来做到这一点？

Answer 1

如果您以常规方式对坐标列表进行排序，则可以进行二分查找以查找您要查找的坐标。下面的例子只有9个条目，但应该给你一个想法。此示例中使用的坐标按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"

输出：

bll-tecra:bll$ tclsh z.tcl
A:2 
B:8 
C:0
D:-1

参考文献：wikipedia: Binary Search Algorithm