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; }