lsort -unique -command для объектов

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 (действительно целое число больше нуля), если второе значение больше. Но операторы 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 
} 

Да, этот код является немного долго. Должен работать, хотя.