Re: The sum of absolute differences in the counts of chars in two strings.

[aaron_baugher]

I don't suppose there's anything particularly creative about my attempts, and I'm sure they won't compare to the speed of C. But I've been looking for a reason to learn to use Benchmark, so I thought I'd give this a try.

I tried three methods: counting the characters with tr inside an eval, counting with s///g, and splitting the strings into arrays and using grep. Somewhat surprisingly (to me, anyway, as someone who very rarely uses eval), the eval/tr method was by far the slowest. I assume that's from the overhead of eval, but as far as I know, that's necessary, since the variable has to be interpolated. Perhaps it would be faster, as someone upthread suggested, to put the whole thing into a single eval, rather than 52 separate eval calls, but I'm too attached to keeping eval usage as minimal as possible to feel good about that. The grep method was better, but not great, even though I split the strings outside the test. The easy winner was using an s///g regex to count the replacements like tr, but without the need for eval.

abaugher@bannor:~/work/perl/monks$ cat 938978.pl
#!/usr/bin/perl
use Modern::Perl;
use Benchmark qw(:all);;

my( $aa, $bb ) = ('','');

$aa .= chr(65 + rand(26)) for (1..50);
$bb .= chr(65 + rand(26)) for (1..50);
say $aa;
say $bb;

my @aa = split //, $aa;
my @bb = split //, $bb;

cmpthese(100000, {
    'grep' => \&usinggrep,
    'tr'   => \&usingtr,
    'sg'   => \&usingsg,
});

sub usinggrep {
    my $sum = 0;
    for my $l ('A'..'Z') {
        my $acount = grep /$l/, @aa;
        my $bcount = grep /$l/, @bb;
        $sum += abs($acount-$bcount);
    }
    return $sum;
}

sub usingtr {
    my $sum = 0;
    for my $l ('A'..'Z') {
        my $acount = eval "'$aa' =~ tr[$l][$l]";
        my $bcount = eval "'$bb' =~ tr[$l][$l]";
        $sum += abs($acount-$bcount);
    }
    return $sum;
}

sub usingsg {
    my $sum = 0;
    for my $l ('A'..'Z') {
        my $acount = $aa =~ s[$l][$l]g || 0;
        my $bcount = $bb =~ s[$l][$l]g || 0;
        $sum += abs($acount-$bcount);
    }
    return $sum;
}

abaugher@bannor:~/work/perl/monks$ perl 938978.pl
FHORAICOBMUCUMNYLRCUMVAMGXRRCADIZVTZTRENIEOBGNXSQT
JIPPTFERERTBOQOPNQSGWDTTOZOTHNXPEKJACSXEQBOAPIMSHI
       Rate   tr grep   sg
tr    924/s   -- -45% -88%
grep 1682/s  82%   -- -79%
sg   7849/s 749% 367%   --

[choroba]

to put the whole thing into a single eval

You should. Try this, on my machine, this beats your grep solution:

sub usingtr_1e {
    eval join '+',
              map qq{abs(('$aa' =~ y/$_//)-('$bb' =~ y/$_//))},
                  'A' .. 'Z';
}

[trizen]

You forgot about the match operator:

sub match {
    my $sum = 0;
    for my $l ('A'..'Z') {
        my $acount = 0;
        ++$acount while($aa =~ /$l/g);
        my $bcount = 0;
        ++$bcount while($bb =~ /$l/g);
        $sum += abs($acount-$bcount);
    }
    return $sum;
}

[Anonymous Monk]

Skip eval and hard-code tr///:

sub usingtr_d {
    my $a = $aa;
    my $b = $bb;
    # Delete ACGT first, assuming these are the
    # most common characters.
    abs($a =~ y/A//d - $b =~ y/A//d) +
    abs($a =~ y/C//d - $b =~ y/C//d) +
    abs($a =~ y/G//d - $b =~ y/G//d) +
    abs($a =~ y/T//d - $b =~ y/T//d) +
    abs($a =~ y/B// - $b =~ y/B//) +
    abs($a =~ y/D// - $b =~ y/D//) +
    abs($a =~ y/E// - $b =~ y/E//) +
    abs($a =~ y/F// - $b =~ y/F//) +
    abs($a =~ y/H// - $b =~ y/H//) +
    abs($a =~ y/I// - $b =~ y/I//) +
    abs($a =~ y/J// - $b =~ y/J//) +
    abs($a =~ y/K// - $b =~ y/K//) +
    abs($a =~ y/L// - $b =~ y/L//) +
    abs($a =~ y/M// - $b =~ y/M//) +
    abs($a =~ y/N// - $b =~ y/N//) +
    abs($a =~ y/O// - $b =~ y/O//) +
    abs($a =~ y/P// - $b =~ y/P//) +
    abs($a =~ y/Q// - $b =~ y/Q//) +
    abs($a =~ y/R// - $b =~ y/R//) +
    abs($a =~ y/S// - $b =~ y/S//) +
    abs($a =~ y/U// - $b =~ y/U//) +
    abs($a =~ y/V// - $b =~ y/V//) +
    abs($a =~ y/W// - $b =~ y/W//) +
    abs($a =~ y/X// - $b =~ y/X//) +
    abs($a =~ y/Y// - $b =~ y/Y//) +
    abs($a =~ y/Z// - $b =~ y/Z//);
}

Benchmarks, including roboticus' robo_1, trizen's match, and choroba's tr_1e:

           Rate     tr   grep  tr_1e     sg  match robo_1   tr_d
tr        843/s     --   -18%   -56%   -75%   -80%   -92%   -99%
grep     1022/s    21%     --   -47%   -70%   -76%   -90%   -99%
tr_1e    1915/s   127%    87%     --   -44%   -55%   -81%   -98%
sg       3419/s   306%   235%    79%     --   -20%   -66%   -97%
match    4291/s   409%   320%   124%    25%     --   -57%   -96%
robo_1   9984/s  1085%   877%   421%   192%   133%     --   -90%
tr_d   100985/s 11881%  9784%  5175%  2853%  2254%   911%     --

Tested against these strings, which are ~80% ACGT:

my @alpha = ('A'..'Z', qw[ A C G T ] x 20);
my $aa = join '', map $alpha[rand @alpha], 1..100;
my $bb = join '', map $alpha[rand @alpha], 1..100;