[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 test
----
Nike 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 iteration
That 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...

----
[Arts and crafts of Tcl-Tk programming]