#! perl -sw
use strict;
use Benchmark 'cmpthese';

#! A couple of utilities
sub genData{
    my ($len, $size) = @_;
    map{ join',',map{ chr 65+rand(26); }1 .. rand($len) } 1..$size;
}
sub display{ local $"=$/; print shift||'array', "\n@_\n\n"; } #"

#! the sorts
sub TRsort{ sort { $b=~tr/,// <=> $a=~tr/,// } @_ }
sub STsort{ map{$_->[1]} sort{$b->[0] <=> $a->[0]} map{[ tr/,// , $_ ]
+} @_ }

#! Some data
my @unsorted         = genData( 50,10 );

#! Check they work
display 'Unsorted', @unsorted;
display 'TRsorted', TRsort @unsorted;
display 'STsorted', STsort @unsorted;

#! more data various lengths, various size arrays
@::fewShort = genData( 10,10 );
@::fewLong    = genData( 100,10 );
@::lotsShort= genData( 10,100 );
@::lotsLong    = genData( 100,100 );

cmpthese( 1000, {
    TRfewShort    => sub{ @_ = TRsort( @::fewShort ) },
    STfewShort    => sub{ @_ = STsort( @::fewShort ) },
});
cmpthese( 1000, {
    TRfewLong    => sub{ @_ = TRsort( @::fewLong ) },
    STfewLong    => sub{ @_ = STsort( @::fewLong ) },
});
cmpthese( 1000, {
    TRlotsShort    => sub{ @_ = TRsort( @::lotsShort ) },
    STlotsShort    => sub{ @_ = STsort( @::lotsShort ) },
});
cmpthese( 1000, {
    TRlotsLong    => sub{ @_ = TRsort( @::lotsLong ) },
    STlotsLong    => sub{ @_ = STsort( @::lotsLong ) },
});

__DATA__
C:\test>202761.pl
Unsorted
Z,K
Y,D,K,N,K,P,M,H,C,G,D,J,N,C,T,J,N,O,T,S,D,A,P,T,X,D,D,U,F,A,Y,Q,L,T,Q,
+W,O,K,U,R,T,G,K,U,M,Y,G
U,J,Y,P,T,N,V,J,Z
R,I,I,E,B,N,N,E,Y,W,Q,B,Y,O,U,D,R,C,O,Q,V,S,T,S,Q,U,Y,A,D
R,L,K,D,W,K,H,D,T,Y,V,A,J,O,C,U,F,H,G,N,Z,O,O,C,C,W,E,Q,T,N,P,L,N,G,X,
+Y,W,P,E,J,V,D,I,O,D,A,I,H
M,U,G,T,E,J
P,S,E,I,X,C,F,A,G,D,A,F,E,S,B,I,Q,K,V,Q,Z,L,O,L,V,D,M,D,J,Z,B,V,E,Q,V,
+W,V,X,Z,C,T,T,C,H
T,E,L,G,X,D,Z,R
T,V
E,V,V,E,L,J,Y,A,N,N,Y,O,A,S,M,Z,F,W,E,Y,S,U,I,U,G,L,I,N,X,P,J,P,Z,U,U,
+A,C,Z,O

TRsorted
R,L,K,D,W,K,H,D,T,Y,V,A,J,O,C,U,F,H,G,N,Z,O,O,C,C,W,E,Q,T,N,P,L,N,G,X,
+Y,W,P,E,J,V,D,I,O,D,A,I,H
Y,D,K,N,K,P,M,H,C,G,D,J,N,C,T,J,N,O,T,S,D,A,P,T,X,D,D,U,F,A,Y,Q,L,T,Q,
+W,O,K,U,R,T,G,K,U,M,Y,G
P,S,E,I,X,C,F,A,G,D,A,F,E,S,B,I,Q,K,V,Q,Z,L,O,L,V,D,M,D,J,Z,B,V,E,Q,V,
+W,V,X,Z,C,T,T,C,H
E,V,V,E,L,J,Y,A,N,N,Y,O,A,S,M,Z,F,W,E,Y,S,U,I,U,G,L,I,N,X,P,J,P,Z,U,U,
+A,C,Z,O
R,I,I,E,B,N,N,E,Y,W,Q,B,Y,O,U,D,R,C,O,Q,V,S,T,S,Q,U,Y,A,D
U,J,Y,P,T,N,V,J,Z
T,E,L,G,X,D,Z,R
M,U,G,T,E,J
T,V
Z,K

STsorted
R,L,K,D,W,K,H,D,T,Y,V,A,J,O,C,U,F,H,G,N,Z,O,O,C,C,W,E,Q,T,N,P,L,N,G,X,
+Y,W,P,E,J,V,D,I,O,D,A,I,H
Y,D,K,N,K,P,M,H,C,G,D,J,N,C,T,J,N,O,T,S,D,A,P,T,X,D,D,U,F,A,Y,Q,L,T,Q,
+W,O,K,U,R,T,G,K,U,M,Y,G
P,S,E,I,X,C,F,A,G,D,A,F,E,S,B,I,Q,K,V,Q,Z,L,O,L,V,D,M,D,J,Z,B,V,E,Q,V,
+W,V,X,Z,C,T,T,C,H
E,V,V,E,L,J,Y,A,N,N,Y,O,A,S,M,Z,F,W,E,Y,S,U,I,U,G,L,I,N,X,P,J,P,Z,U,U,
+A,C,Z,O
R,I,I,E,B,N,N,E,Y,W,Q,B,Y,O,U,D,R,C,O,Q,V,S,T,S,Q,U,Y,A,D
U,J,Y,P,T,N,V,J,Z
T,E,L,G,X,D,Z,R
M,U,G,T,E,J
T,V
Z,K

Benchmark: timing 1000 iterations of STfewShort, TRfewShort...
             Rate STfewShort TRfewShort
STfewShort 1468/s         --       -35%
TRfewShort 2268/s        54%         --

Benchmark: timing 1000 iterations of STfewLong, TRfewLong...
            Rate TRfewLong STfewLong
TRfewLong 1368/s        --       -1%
STfewLong 1387/s        1%        --

Benchmark: timing 1000 iterations of STlotsShort, TRlotsShort...
             Rate STlotsShort TRlotsShort
STlotsShort 145/s          --        -24%
TRlotsShort 191/s         32%          --

Benchmark: timing 1000 iterations of STlotsLong, TRlotsLong...
             Rate TRlotsLong STlotsLong
TRlotsLong 79.9/s         --       -29%
STlotsLong  112/s        40%         --

C:\test>
[download]