Tom Moertel's Weblog

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):

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

--- 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) {

Posted in programming, perl, fun stuff
Tags code, countpaths, google, jam, perl, puzzles, wordpaths
2 comments
no trackbacks
 

Solving the Google Code Jam "countPaths" problem in Haskell

Posted by Tom Moertel Tue, 15 Aug 2006 21:01:00 GMT

Via the article on this year’s Google Code Jam on Slashdot earlier today, I found Hareesh Nagarajan’s write-up of a previous year’s Code-Jam problem. Since Google often comes up with interesting problems, I decided to give this one a go.

The problem: count the ways to find a word by walking on a grid

You are given a rectangular grid of letters and a word to find. You must compute the number of ways to find the word within the grid using the following rules:

• start at any cell within the grid
• from there, move to any of the cell’s eight neighboring cells
• continue moving from that neighbor to its neighbors, and so on, until you have spelled out the word
• you may visit cells more than once, but you cannot visit the same cell twice in a row (i.e., you must move for each turn)

For instance, consider the following grid, taken from the examples in the problem statement:

ABC
FED
GAI

If you were asked to find the word “AEA” on this grid, you could do it in four ways:

Way  --Move---
     1   2   3

1:  *BC ABC *BC
    FED F*D FED
    GAI GAI GAI

2:  *BC ABC ABC
    FED F*D FED
    GAI GAI G*I

3:  ABC ABC *BC
    FED F*D FED
    G*I GAI GAI

4:  ABC ABC ABC
    FED F*D FED
    G*I GAI G*I

If you were asked to find “ABCD”, you could do it in only one way:

Way  --Move-------- 
     1   2   3   4 

1:  *BC A*C AB* ABC
    FED FED FED FE*
    GAI GAI GAI GAI

If you were asked to find “AAB”, you could not: there are no “A” cells on the grid that have other “A” cells as neighbors.

The tricksy nature of the problem

As you might expect from Google, this puzzle was designed to see whether your solution can scale. A simple search will quickly bog down because each step in the search can expand into vastly more possibilities, as searching for “AAAA” on a seemingly harmless 2×2 grid of all “A” cells shows – there are 108 solutions.

The problem statement says that the grid may be up to 50×50 in size and the word to find may be up to 50 letters long. Imagine, then, that you are asked to find a word composed of 50 “A” letters within a 50×50 grid of “A” cells. All of the cells will be valid starting points, and each will have, on average, slightly less than 8 valid neighbors. Thus there will be about 50 × 50 × 8^49 = 4.5e47 ways to find the word¹. Tracing them all would take forever.

The trick is figuring out a more efficient way to solve the problem. Since that’s the fun part of this problem, I won’t spoil it for you by telling you how I did it. (If you truly want spoilers, you can study my code.)

My solution

Here is what I came up with. I’ll present the code first and then discuss how to use it.

Note: The code below is out of date but printed here for continuity. See Update 5 for the most-recent revision.

{-

Tom Moertel <tom@moertel.com>
2006-08-15

Haskell-based solution to the Google Code Jam problem "countPaths";
see http://www.cs.uic.edu/~hnagaraj/articles/code-jam/ for more.

-}

module Main (main) where

import Control.Monad
import Data.Array
import qualified Data.Map as M

main = do
    word:gridspec <- liftM words getContents
    print $ (countPaths word (toGridArray gridspec) :: Integer)

countPaths word@(p:_) gridArray =
    sum . M.elems $ foldl step state0 (zip word (tail word))
  where
    state0 = M.fromList [(cell, 1) | (cell, q) <- assocs gridArray, p == q]
    neighbors = toNeighborMap gridArray
    step state fromto = M.fromListWith (+) $ do
        steps <- M.lookup fromto neighbors
        (start, count) <- M.assocs state
        cells <- M.lookup start steps
        cell <- cells
        return (cell, count)

toGridArray gridspec@(l1:_) =
    listArray ((1,1), (length gridspec, length l1)) (concat gridspec)

toNeighborMap gridArray =
    M.fromListWith (M.unionWith (flip (++))) $ do
        (cell, p) <- assocs gridArray
        cell' <- neighbors8 cell
        guard $ inRange (bounds gridArray) cell'
        return ((p, gridArray!cell'), M.singleton cell [cell'])

neighbors8 (r,c) =
    [(r+h, c+v) | h <- [-1..1], v <- [-1..1], h /= 0 || v /= 0]

-- Local Variables:  ***
-- compile-command: "ghc -O2 -o wordpath --make WordPath.hs" ***
-- End: ***

My solution generalizes upon the problem statement in a few ways:

• the grid can be any size and the word any length
• the grid and word can be composed of any comparable data type, not just A–Z letters (if you use the stdin interface, the code will use Unicode characters)
• the code will compute exact counts instead of returning -1 for counts greater than 1e9

You can enter problems from the command line. Enter the word first and then the grid, each row separated by whitespace. For example:

$ ./wordpath
AAAAAAAAAAA

AAAAA
AAAAA
AAAAA
AAAAA
AAAAA
^D

2745564336

Give it a try

This was a fun problem to solve. If you have a little spare time, give it a try. I would love to compare results and talk about strategies.

countPaths word gridArray =
    sum [counts ! (length word, cell) | cell <- cells]
  where
    counts = listArray ((1, (1, 1)), (length word, gridSize)) $
             [countFrom i cell | i <- [1..length word], cell <- cells]

    countFrom i cell
        | i == 1 && match = 1
        | match           = sum [counts!((i-1),n) | n <- neighbors!cell]
        | otherwise       = 0
      where
        match = rword ! i == gridArray ! cell

    neighbors = listArray (bounds gridArray) $
        [filter (inRange (bounds gridArray)) (neighbors8 cell)
            | cell <- cells ]

    rword    = listArray (1, length word) (reverse word)
    cells    = indices gridArray
    gridSize = snd (bounds gridArray)

{-

Tom Moertel <tom@moertel.com>
2006-08-15 (revised 2006-09-01)

Haskell-based solution to the Google Code Jam problem "countPaths" 
See http://www.cs.uic.edu/~hnagaraj/articles/code-jam/ for more.

This implementation is based on the dynamic-programming strategy
mentioned by reddit.com user "psykotic":
http://programming.reddit.com/info/dni1/comments/cdp59.

-}

module Main (main) where

import Control.Monad
import Data.Array

main = do
    word:gridspec <- liftM words getContents
    print $ (countPaths word (toGridArray gridspec) :: Integer)

countPaths word grid =
    sum . elems $ foldl move counts0 (tail (reverse word))
  where
    move counts c  = step c $ sum . map (counts!) . neighbors
    counts0        = step (last word) (const 1)
    step c f       = listArray (bounds grid) $ map (match c f) cells
    match c f cell = if c == grid!cell then f cell else 0
    neighbors cell = filter (inRange (bounds grid)) (neighbors8 cell)
    cells          = indices grid

toGridArray gridspec@(l1:_) =
    listArray ((1,1), (length gridspec, length l1)) (concat gridspec)

neighbors8 (r,c) =
    [(h, v) | h <- [r-1..r+1], v <- [c-1..c+1], h /= r || v /= c]

-- Local Variables:  ***
-- compile-command: "ghc -O2 -o wordpathdp --make WordPathDP.hs" ***
-- End: ***

¹ I believe that the exact count is 303 835 410 591 851 117 616 135 618 108 340 196 903 254 429 200 (approx. 3.04e47). It takes about six seconds 0.75 second to compute on a 1.8-GHz AMD64 box running Linux.

Posted in programming, haskell, fun stuff
Tags code, countpaths, google, haskell, jam, puzzles, wordpaths
8 comments
no trackbacks