xxxxxC
ABrrrr
e_3_ee
xxxxxA
AArrrr
e_2_ee
xxxxxB
ACrrrr
e_1_ee
####
xxxxxC
AArrrr
e_1_ee
xxxxxB
ABrrrr
e_2_ee
xxxxxA
ACrrrr
e_3_ee
####
use strict;
use warnings;
my @array = qw(
xxxxxC
ABrrrr
e_3_ee
xxxxxA
AArrrr
e_2_ee
xxxxxB
ACrrrr
e_1_ee
);
my $sorted = sort_array( \@array );
print $_, "\n" for @$sorted;
exit 0;
use constant {
KEY => 0, # sort key
POS => 1, # position in array
};
sub get_sort_data {
my ($ary) = @_;
my %result;
for my $i ( 0 .. $#$ary ) {
my ( $elem, $key, $name ) = $ary->[$i];
if ( $elem =~ /r/ ) {
$key = $elem;
$name = 'Rs';
}
elsif ( $elem =~ /\Ae/ ) {
$key = substr $elem, 2, 1;
$name = 'Es';
}
else {
$key = substr $elem, -1;
$name = 'Os'; # others
}
push @{ $result{$name} }, [ $key, $i ];
}
return \%result;
}
sub sort_positions {
sort { $a <=> $b } map $_->[POS], @_;
}
sub sort_array {
my ($array) = @_;
my $data = get_sort_data($array);
my @rs =
sort { $a->[KEY] cmp $b->[KEY] } @{ $data->{Rs} };
my @es =
sort { $a->[KEY] cmp $b->[KEY] } @{ $data->{Es} };
my @os =
sort { $b->[KEY] cmp $a->[KEY] } @{ $data->{Os} };
my @result;
@result[
sort_positions(@rs),
sort_positions(@es),
sort_positions(@os),
] = map $array->[ $_->[POS] ], @rs, @es, @os;
return \@result;
}