lsort -unique -对象命令

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

问题出在你的比较函数上。比较函数需要 return 三个可能的值：如果第一个值较大，则为 -1（或实际上小于零的任何整数），如果值相等，则为 0，并且如果第二个值较大，则为 1（实际上是一个大于零的整数）。但是您使用的 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 -对象命令

lsort -unique -command for objects

sorting

tcl

rectangles

itcl