Richard Suchenwirth 2002-09-03 - The lsort command allows many useful ways of sorting, but sometimes one needs other ways. For instance, to sort strings according to their length; or alphabetically, but reversed (whole dictionaries are produced for this, e.g for finding rhymes). lsort takes a -command option, but see that page for why it is "a pig in performance".
The recommended way is rather to produce from the original input a list of pairs consisting of sorting key and original element; sort using -index according to the key; and extract the original elements from the result. Here is a little wrapper for this approach, which takes as first argument a sorting function name (possibly multi-word like string length) and then the usual arguments of lsort, the last of which is the list to be sorted:
proc lsortby {sortf args} {
set list [lindex $args end] ;# list ot be sorted is last
set args [lrange $args 0 end-1]
set t {}
foreach element $list {
lappend t [list [eval $sortf [list $element]] $element]
}
set res {}
foreach i [eval lsort $args -index 0 [list $t]] {
lappend res [lindex $i 1]
}
set res
}
#----------- testing (and usage examples):
puts [lsortby {string length} -int {long longer short shorter {very long} x}]
proc reverse s {
set i [string length $s]
set res {}
while {$i} {append res [string index $s [incr i -1]]}
set res
}
puts [lsortby reverse -unique {this is the rest of the best test beast}]if 0 {results in:
x long short longer shorter {very long}
the of is this beast best rest testNike 8.12.2002
Today i needed new way of sorting, shortest first in alphabetical order.
My version:
proc nsort {list} {
set final "" ; # for empty lists
foreach temp $list { lappend length([string length $temp]) $temp }
foreach temp [lsort -integer [array names length]] { lappend final [lsort $length($temp)] }
return [join $final]
}Death wrote:
proc sortlength {wordlist} {
set l 0;foreach word $wordlist {lappend words([set s [string length $word]]) $word;if {$s>$l} {set l $s}}
for {set c 0} {$c<=$l} {incr c} {if {[info exists words($c)]} {lappend newlist [lsort $words($c)]}}
return [join $newlist]
}Death's version seems to be almost 10% slower
RS: ...and my proposal takes more than double of your time:
% time {nsort {fool foo bart bar grill grillroom}} 1000
91 microseconds per iteration
% time {lsortby {string length} [lsort {fool foo bart bar grill grillroom}]} 1000
228 microseconds per iterationThat goes to show that custom implementations can be tuned for best performance. But if runtime is not the bottleneck, using lsortby is more convenient at coding time...
Lars H: The comparison is not quite correct, as you should do integer comparison (not the default string comparison) on the results of the string length. Furthermore you can speed up lsortby even more by making sure that the "sort function" is a list, i.e., say
lsortby [list string length] -integer ...
instead of
lsortby {string length} ...as above. For me, this cuts away 35% of the running time!
A convenient alternative to having special "sort functions" would be to have a foreach-like syntax, i.e.,
proc forsort {options body list} {
set L [list]
foreach item $list {
lappend L [list $item [if 1 then $body]]
}
set res [list]
foreach item [eval [list lsort] [lrange $options 0 end] [list -index 1 $L]] {
lappend res [lindex $item 0]
}
set res
}using which one could write
forsort {-integer} {string length $item} [lsort {fool foo bart bar grill grillroom}]I time this as being a bit faster still, probably due to the [if 1 then $body] instead of [eval $body] to force byte-compilation.