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

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%   --
[download]

Aaron B.
My Woefully Neglected Blog, where I occasionally mention Perl.

Comment on Re: The sum of absolute differences in the counts of chars in two strings. Download Code

Replies are listed 'Best First'.
Re^2: The sum of absolute differences in the counts of chars in two strings. by choroba (Cardinal) on Nov 19, 2011 at 22:08 UTC
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'; }` [download]	[reply] [d/l]
Re^2: The sum of absolute differences in the counts of chars in two strings. by trizen (Hermit) on Nov 19, 2011 at 21:55 UTC
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; }` [download]	[reply] [d/l]
Re^2: The sum of absolute differences in the counts of chars in two strings. by Anonymous Monk on Nov 20, 2011 at 01:03 UTC
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//); } [download] 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% --` [download] 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;` [download]	[reply] [d/l] [select]