gistfile1.pl

#!/usr/bin/perl
use warnings;
use strict;

use Benchmark qw(cmpthese);
use Test::More;

my $String = "ATGC" x 1000;
my @Genes = qw(A T G C);
my %Count;

my %d;
$d{$_} = eval "sub{ \$_[0] =~ tr/$_// }" for qw( A C G T );

is_deeply([ map $d{$_}->('ACCTTTGGGG'), qw(A C T G) ], [1, 2, 3, 4], 'ok');
done_testing();

cmpthese -5, {
                  "eval_tr" => sub {
                      for my $gene (@Genes) {
                          $Count{$gene} += eval "\$String =~ tr/$gene//";
                          die $@ if $@;
                      }
                  },
                  "match" => sub {
                      for my $gene (@Genes) {
                          $Count{$gene} += () = $String =~ /$gene/g;
                      }
                  },
                  "unrolled_tr" => sub {
                      $Count{A} += $String =~ tr/A//;
                      $Count{T} += $String =~ tr/T//;
                      $Count{G} += $String =~ tr/G//;
                      $Count{C} += $String =~ tr/C//;
                  },
                  "unrolled_match" => sub {
                      $Count{A} += () = $String =~ /A/g;
                      $Count{T} += () = $String =~ /T/g;
                      $Count{G} += () = $String =~ /G/g;
                      $Count{C} += () = $String =~ /C/g;
                  },
                  eval_sub => sub {
                      for my $g (@Genes) {
                          $Count{$g} += $d{$g}->($String)
                      }
                  }
                 };

__END__
                  Rate      match unrolled_match   eval_tr  eval_sub unrolled_tr
match            539/s         --            -1%      -94%      -99%        -99%
unrolled_match   546/s         1%             --      -94%      -99%        -99%
eval_tr         9698/s      1698%          1676%        --      -76%        -78%
eval_sub       40267/s      7365%          7273%      315%        --         -9%
unrolled_tr    44331/s      8118%          8017%      357%       10%          --