#!perl
use strict;
use warnings;
use Benchmark qw/cmpthese/;

my $testing = @ARGV;
my @master=("a_1","b_1","a_2","a_3","a_4","b_2","a_5","b_3","a_6","b_4
+");


# samy_kumar
sub original {
    my (@a, @b) ;
    my @temp = @master;
    foreach my $value (@temp) {
    push @a, $1 if ($value =~ /a_(.*)/) ;
    push @b, $1 if ($value =~ /b_(.*)/) ;
    }
    print "@a <==> @b\n" if $testing;
}


# dragonchild
sub hash_style {
    my %values;
    my @temp = @master;
    foreach (@temp) {
        push @{$values{$1}}, $2 if /^([ab])_(.*)/;
    }
    print "@{$values{a}} <==> @{$values{b}}\n" if $testing;
}

sub switch_style {
    my (@a, @b);
    my @temp = @master;
    foreach (@temp) {
    my $prefix = substr( $_, 0, 1 );
    
    if ( $prefix eq 'a' ) {
        push @a, substr( $_, 2 );
    } else {
        push @b, substr( $_, 2 );
    }
    }
    print "@a <==> @b\n" if $testing;
}

sub map_style {
    my @temp = @master;
    my @a = map {/a_(.*)/ ? $1 : ()} @temp;
    my @b = map {/b_(.*)/ ? $1 : ()} @temp;
    print "@a <==> @b\n" if $testing;
}

sub new_map {
    my @temp = @master;
    my @a = map {/a_(.*)/} @temp;
    my @b = map {/b_(.*)/} @temp;
    print "@a <==> @b\n" if $testing;
}

sub grep_style {
    my @temp = @master;
    my @a_arr = grep { s/^a_(.*)/$1/} @temp;
    my @b_arr = grep { s/^b_(.*)/$1/} @temp;
    print "@a_arr <==> @b_arr\n" if $testing;
}

sub new_grep {
    my @temp = @master;
    my @a = grep { s/^a_//} @temp;
    my @b = grep { s/^b_//} @temp;
    print "@a <==> @b\n" if $testing;
}


sub trinary {
  my @temp = @master;
  my (@a, @b) ;
  m[^([ab])_(.*)$] and push @{$1 eq 'a' ? \@a : \@b}, $2 for @temp;
  print "@a <==> @b\n" if $testing;
}

sub tri_substr {
    my @temp = @master;
    my (@a, @b) ;
    push @{substr($_,0,1) eq 'a' ? \@a : \@b}, substr($_,2) for @temp;
    print "@a <==> @b\n" if $testing;
}

sub tri_substr2 {
    my @temp = @master;
    my (@a, @b) ;
    (substr($_,0,1) eq 'a')
      ? push @a , substr($_,2)
      : push @b , substr($_,2)
    for @temp;
    print "@a <==> @b\n" if $testing;
}

my %contenders = (
   Original    => \&original,
   Hash        => \&hash_style,
   Map        => \&map_style,
   New_Map    => \&new_map,
   Grep        => \&grep_style,
   New_Grep    => \&new_grep,
   Switch    => \&switch_style,
   Trinary    => \&trinary,
   Tri_Substr    => \&tri_substr,
   Tri_Substr2    => \&tri_substr2,
);

if ($testing) {
    while (my ($k,$v) = each %contenders) {
    print "$k: ";
    &$v;
    print "---\n";
    }
}
else {
    cmpthese( -3, \%contenders);
}
[download]