lsort -unique -command for objects

Question

I have a list of rectangles, and, I need to report an error if there are overlapping ones.
So, I've decided to use lsort -command to sort my list and, then, compare new and old lists' lengths. If they're not equal, then, there are overlapping rectangles.

Here is the piece of code that does the work:

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}

Seems lsort -unique -command is not working correctly or I'm doing something wrong.
How can I fix this? Or maybe there are better solutions?

Thanks in advance!

Answer 1

The problem is in your comparison function. Comparison functions need to return three possible values: -1 (or in fact any integer less than zero) if the first value is larger, 0 if the values are equal, and 1 (really an integer greater than zero) if the second value is larger. But the expr operators you are using (<= and ||) give boolean results, i.e., produce just 0 or 1 as values. That's just not going to work.

We need a different approach to the comparisons:

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
}

Yes, this code is a bit long. Should work though.