#!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); }