Solving the Google Code Jam "countPaths" problem in Perl
Posted by Tom Moertel Thu, 17 Aug 2006 06:21:00 GMT
As promised, here’s a Perl version of a dynamic-programming-based solver for the Google Code Jam “countPaths” problem. It is a straight translation of my improved Ruby implementation. As you might expect, the Perl version was pretty fast. It proved faster than the other scripting-language implementations I tried (in this rather unscientific benchmark, not to be taken seriously):
| Implementation | Run time (s) |
|---|---|
| Haskell | 0.9 |
| Perl (code below) | 1.7 |
| Python | 2.8 |
| Ruby | 4.2 |
All timings were taken while solving the maximum-size, all-the-same-letter problem on my 1.8-GHz Opteron box.
Here’s the Perl implementation:
#!/usr/bin/perl
# Tom Moertel <tom@moertel.com>
# 2006-08-16
#
# Perl-based solution to the Google Code Jam problem "countPaths".
# See http://www.cs.uic.edu/~hnagaraj/articles/code-jam/ for more.
use strict;
use warnings;
use List::Util 'sum';
use Math::BigInt;
sub count_paths {
my ($grid, $word) = @_;
my $rword = reverse $word;
my $rowmax = $#$grid;
my $colmax = length($grid->[0]);
my ($slab, $sum);
for my $i (0 .. length($rword) - 1) {
my $char = substr $rword, $i, 1;
($slab, my $previous_slab) = ([], $slab);
for my $r (0 .. $rowmax) {
my ($row, $line) = ($grid->[$r], $slab->[$r] ||= []);
for my $c (0 .. $colmax) {
$line->[$c] = $char ne substr($row,$c,1) ? 0 : $i == 0 ? 1 : do {
$sum = 0;
my $clo = $c > 0 ? $c - 1 : $c;
my $chi = $c < $colmax ? $c + 1 : $c;
for my $nr (($r>0 ? $r-1 : $r) .. ($r<$rowmax ? $r+1 : $r)) {
for my $nc ($clo .. $chi) {
$sum += $previous_slab->[$nr][$nc]
if $nr != $r || $nc != $c;
}
}
$sum;
}
}
}
}
sum map @$_, @$slab;
}
print count_paths([("A"x50)x50], "A"x50), $/;
# 3.03835410591851e+47
$counts. Here’s a diff
if you’re curious about what’s changed:
--- countpaths.pl.orig 2006-08-18 00:16:56.000000000 -0400
+++ /countpaths.pl 2006-08-18 00:19:30.000000000 -0400
@@ -19,11 +19,11 @@
my $rword = reverse $word;
my $rowmax = $#$grid;
my $colmax = length($grid->[0]);
- my ($counts, $slab, $sum);
+ my ($slab, $sum);
for my $i (0 .. length($rword) - 1) {
my $char = substr $rword, $i, 1;
- ($slab, my $previous_slab) = ($counts->[$i] ||= [], $slab);
+ ($slab, my $previous_slab) = ([], $slab);
for my $r (0 .. $rowmax) {
my ($row, $line) = ($grid->[$r], $slab->[$r] ||= []);
for my $c (0 .. $colmax) {
Update 2: Augmented the introductory paragraph with a parenthetical comment that reminds readers that these single-fuzzy-data-point-style timings should not be taken seriously. Also removed the word “bested,” which might suggest that there is an optimization contest in play. Please, no wagering.
Update 3: Stripped another variable ($j), which was
completely unused and leftover from previous implementation. (See
why you shouldn’t code late at night?)
readers
“besting the other scripting languages”
Are you sure you’re using the fastest one on Ivan’s page (see the comments), and not his original one?
Anonymous, I just tried the new, faster Python implementation, and it averaged slightly faster than my Perl code in a ten-run trial, about 1.47 seconds to 1.57 seconds. Note, however, that those timings are crude: I made them from the command line via
/usr/bin/time; thus the timings incorporate the setup and teardown for the language runtimes, which may swamp the real differences between the implementations.In any case, the new Python version isn’t “isomorphic” to the Perl version anymore because it handles the initial, outermost iteration as a special case and thereby can eliminate a test from the innermost loop of all subsequent iterations. As such, it’s probably not a good idea to draw conclusions about the respective languages’ speeds from these comparisons.