Question

我有一个矩形列表，如果有重叠，我需要报告错误所以，我决定使用lsort -command对我的列表进行排序，然后比较新旧列表的长度。如果它们不相等，那么就会有重叠的矩形。

以下是完成工作的代码段：

package require Itcl

    ::itcl::class Region {

        public method print { name } {
            puts "$name: $x1_ $y1_ $x2_ $y2_"
        }

        public method X1     { } { return $x1_ }
        public method Y1     { } { return $y1_ }
        public method X2     { } { return $x2_ }
        public method Y2     { } { return $y2_ }

        # The x1 coordinate of the region
        public variable x1_ ""

        # The y1 coordinate of the region
        public variable y1_ ""

        # The x2 coordinate of the region
        public variable x2_ ""

        # The y2 coordinate of the region
        public variable y2_ ""

    }

    # two regions will be equal <=> when they overlap each other
    proc compareRegs { region1 region2 } {
        return [ expr {[$region1 X2] <= [$region2 X1] || [$region1 Y2] <= [$region2 Y1] } ]
    }

    # reg1 and reg2 don't overlap
    Region reg1
    reg1 configure -x1_ 5.5 -y1_ 5.5014 -x2_ 6.5 -y2_ 5.7014

    Region reg2
    reg2 configure -x1_ 3.567 -y1_ 5.5014 -x2_ 3.767 -y2_ 5.7014

    # reg2 = reg3
    Region reg3
    reg3 configure -x1_ 3.567 -y1_ 5.5014 -x2_ 3.767 -y2_ 5.7014


    # create a usual list
    set myList { reg1 reg2 reg3 }

    # sort the list
    set mySortedList [lsort -unique -command compareRegs $myList]

    puts "start mySortedList"
    foreach reg $mySortedList {
        $reg print "reg"
    }
    puts "end mySortedList"
    # mySortedList = {reg2}

    if { [llength $mySortedList] != [llength $myList] } {
        puts "ERROR: Regions must not overlap"
    }

    # let's see what's going on
    # reg2 < reg1 is true
    puts "result of reg1 < reg2: [compareRegs reg1 reg2]"
    puts "result of reg2 < reg1: [compareRegs reg2 reg1]"
    # reg2 = reg3 is true
    puts "result of reg2 < reg3: [compareRegs reg2 reg3]"
    puts "result of reg3 < reg2: [compareRegs reg3 reg2]"
    # i.e, in sorted list we should have {reg2 reg1}

似乎lsort -unique -command工作不正常或我做错了什么我怎样才能解决这个问题？或者可能有更好的解决方案？

提前致谢！

Answer 1

问题在于您的比较功能。比较函数需要返回三个可能的值：-1（或实际上任何小于零的整数）如果第一个值更大，如果值相等则为0，并且1（实际上是大于0的整数）零）如果第二个值更大。但是您使用的expr运算符（<=和||）会给出布尔结果，即只生成0或1作为值。那是行不通的。

我们需要一种不同的比较方法：

proc compareRegs { region1 region2 } {
    # Compare the X values by subtracting them from each other
    set cmp [expr {[$region2 X1] - [$region1 X2]}]
    if {$cmp != 0.0} {
        # Convert to an integer (-1 or 1)
        return [expr {$cmp < 0.0 ? -1 : 1}]
    }
    # Compare the Y values by subtracting them from each other
    set cmp [expr {[$region2 Y1] - [$region1 Y2]}]
    if {$cmp != 0.0} {
        # Convert to an integer (-1 or 1)
        return [expr {$cmp < 0.0 ? -1 : 1}]
    }
    # Both equal; return an integer zero
    return 0
}

是的，这段代码有点长。应该工作。

lsort -unique -command for objects

1 个答案: