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 comparedIn 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*[1]. For many types of data, equality and comparison operators will be transitive; inequality will not.

Arts and crafts of Tcl-Tk programming }