Google Code Jam 2009 Qualification Round

挑戦してみた。
http://code.google.com/intl/ja/codejam/
A,Bは解けてCのlargeを落として76点 orz
3201位だそうです。
時間を気にせずにゆっくり考えながら解いたはずなんだけどサッパリだった…まだまだ力が全然足りないなぁ。
解答速度が重要になる次のラウンド以降は勝てないだろうな…


今のところ最も得意な言語が何故か(?)Perlなので、3問ともPerlで挑戦した。
他の人のを見てるとやっぱりC++が多いようだ。あとはPython, Java, たまにRubyとか?

A. Alien Language

まぁ、ほぼ正規表現そのままだよね、ということで比較的簡単に。

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

my ($L, $D, $N) = split ' ', <>;
my @words;
for my $i (1..$D) {
    my $line = <>;
    chomp($line);
    push @words, $line;
}
for my $i (1..$N) {
    my $line = <>;
    chomp($line);
    $line =~ tr/\(\)/[]/;
    my $count = 0;
    for my $word (@words) {
        $count++ if $word =~ qr($line);
    }
    print "Case #$i: $count\n";
}

B. Watersheds

これはすごく苦労した。なかなか良い実装方法が思いつかず、悪戦苦闘。
それでも結局分岐や繰り返しの多いまま煩雑なコードになってしまった orz
今自分で見返してみてもワケ分からんw

#!/usr/bin/perl
use strict;
use warnings;
use List::Util 'min';

my $T = <>;
for my $i (1..$T) {
    my $cell = [];
    my ($H, $W) = split ' ', <>;
    for my $h (0..$H - 1) {
        $cell->[$h] = [map {
            [$_, undef];
        } split ' ', <>];
    }

    for my $row (0..$H - 1) {
        for my $col (0..$W - 1) {
            my $self = $cell->[$row][$col][0];
            my $n = $row > 0      ? $cell->[$row - 1][$col    ][0] : undef;
            my $w = $col > 0      ? $cell->[$row    ][$col - 1][0] : undef;
            my $e = $col < $W - 1 ? $cell->[$row    ][$col + 1][0] : undef;
            my $s = $row < $H - 1 ? $cell->[$row + 1][$col    ][0] : undef;

            my $minimum = min grep { defined } ($self, $n, $w, $e, $s);
            next if $minimum == $self;

            if (defined $s && $s == $minimum) {
                $cell->[$row][$col][1] = [$row + 1, $col    ];
            }
            if (defined $e && $e == $minimum) {
                $cell->[$row][$col][1] = [$row    , $col + 1];
            }
            if (defined $w && $w == $minimum) {
                $cell->[$row][$col][1] = [$row    , $col - 1];
            }
            if (defined $n && $n == $minimum) {
                $cell->[$row][$col][1] = [$row - 1, $col    ];
            }
        }
    }
    my @basins;
    for my $row (0..$H - 1) {
      LOOP:
        for my $col (0..$W - 1) {
            my %table;
            my $flow = [$row, $col];
            while (defined $flow) {
                my $key = join '-', @$flow;
                $table{$key}++;
                for my $basin (@basins) {
                    if (exists $basin->{$key}) {
                        @{$basin}{keys %table}++;
                        next LOOP;
                    }
                }
                $flow = $cell->[$flow->[0]][$flow->[1]][1];
            }
            push @basins, \%table;
        }
    }

    my $char = 'a';
    for my $basin (@basins) {
        for my $key (keys %$basin) {
            my @index = split /-/, $key;
            $cell->[$index[0]][$index[1]] = $char;
        }
        $char++;
    }

    print "Case #$i:\n";
    for my $row (0..$H - 1) {
        print join(' ', @{$cell->[$row]}), "\n";
    }
}

C. Welcome to Code Jam

問題の意味を理解するのに少々時間がかかり、実装はもう当然再帰関数で解くものかなーと思い込んで愚直に書いた。
あとで見てみたところ再帰とか使わずにループ回すだけでやっているヒトも結構いたっぽい。

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

use Readonly;
Readonly::Array my @welcome => split //, 'welcome to code jam';

my $N = <>;
for my $i (1..$N) {
    my $line = <>;
    printf "Case #%d: %04d\n", $i, count($line, @welcome);
}

sub count {
    my $line = shift;
    my @array = @_;

    if ($#array == 0) {
        return $line =~ s/$array[0]//g;
    }

    my $count = 0;
    my $char = shift @array;
    my $index = index($line, $char);
    while ($index != -1) {
        $line = substr($line, $index + 1);
        $index = index($line, $char);
        $count += count($line, @array);
    }

    return $count % 10000;
}

で、smallの方は解けたのだけどlargeの方は全然計算が終わらずタイムオーバー。
あとで見てみたところ同じ引数でのcountサブルーチンの呼び出しを繰り返していたのに気付いたので返り値をキャッシュするようにしたらサクッと解けるようになった。もっと早く気付けばよかった orz

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

use Readonly;
Readonly::Array my @welcome => split //, 'welcome to code jam';

my %cache;

my $N = <>;
for my $i (1..$N) {
    my $line = <>;
    %cache = ();
    printf "Case #%d: %04d\n", $i, count($line, @welcome);
}

sub count {
    my $line = shift;
    my @array = @_;

    my $key = $line . ':' . join('', @array);
    if (exists $cache{$key}) {
        return $cache{$key};
    }

    if ($#array == 0) {
        return $line =~ s/$array[0]//g;
    }

    my $count = 0;
    my $char = shift @array;
    my $index = index($line, $char);
    while ($index != -1) {
        $line = substr($line, $index + 1);
        $index = index($line, $char);
        $count += count($line, @array);
    }

    $cache{$key} = $count % 10000;
    return $count % 10000;
}