Multiple comparisons

if 0 {Richard Suchenwirth 2003-03-18 - I needed a way for testing whether the elements in a list were all equal. Not a hard nut to crack - just compare the first with all the others. But then I thought on how to generalize this approach, so besides equality, it could also be used for testing monotonous ascension/descension, etc by comparing each two neighboring elements. Here's what I came up with, allowing the one-liner "luxury" of calling either with flat args, or a list (to avoid the need for eval ;-). Note that in order to pass the operator in as an argument, the if in the loop has an explicit expr invocation: }

 proc multicompare {op args} {
    if {[llength $args]==1} {set args [lindex $args 0]}
    set first [lindex $args 0]
    foreach i [lrange $args 1 end] {
       if {![expr $first $op $i]} {return 0}
       set first $i
    }
    return 1
 }

if 0 {#--------------------------- Testing:

 % multicompare == 1 1 1 1
 1
 % multicompare == 1 1 1 1 0
 0
 % multicompare == 1 1 1 1 1.0
 1
 % multicompare == {1 1 1 1 1.0}
 1
 % multicompare < {1 2 3 4 5}
 1
 % multicompare < {1 2 3 4 5 0}
 0
 % multicompare < {1 2 3 4 5 6}
 1
 % multicompare <= {1 2 2 3 4 5 6}
 1
 % multicompare <= {1 21 2 3 4 5 6}
 0

Note however that the comparison of neighboring elements would not work right in tests for inequality, i.e. that no two elements are equal:

 multicompare != {1 2 1} => 1, which is wrong - the two 1's are never compared

In this case we need the list of all pairs that can be formed from the list - basically a half matrix LxL minus the main diagonal. This code is factored out into a pairs function:

 % pairs {a b c d e}
 {a b} {a c} {a d} {a e} {b c} {b d} {b e} {c d} {c e} {d e}
 ----}
 proc pairs list {
    set res {}
    set last [llength $list]
    for {set i 0} {$i < $last-1} {incr i} {
       for {set j [expr {$i+1}]} {$j < $last} {incr j} {
          lappend res [list [lindex $list $i] [lindex $list $j]]
       }
    }
    set res
 }
 proc multiNotEqual list {
    foreach pair [pairs $list] {
       if {[lindex $pair 0] == [lindex $pair 1]} {return 0}
    }
    return 1
 }

if 0 { This custom comparison can be integrated into multiCompare above, by adding the line

 if {$op == "!="} {return [multiNotEqual $args]}

below the llength $args check.

escargo - The success of the testing requires that the comparison operator be correct in the case of transitivity[L1 ]. For many types of data, equality and comparison operators will be transitive; inequality will not.

Arts and crafts of Tcl-Tk programming }