まわせ! Bouwkamp!! に挑戦したが、惜敗。90分かかった。
正攻法で挑むと楽しい良問ではあったが、意外に手数が多い。
package Bouwkamp;
use strict;
use warnings;
use Exporter qw(import);
our @EXPORT_OK = qw(solve);
sub decode_bouwkamp ($) {
my @result;
while ($_[0] =~ /\((\d+(?:,\d+)*)\)/g) {
push @result, [split /,/, $1, -1];
}
\@result;
}
sub sort_points (@) {
sort { $a->[1] <=> $b->[1] or $a->[0] <=> $b->[0] } @_;
}
sub rotate_point ($$$) {
my ($w, $h, $p) = @_;
[$w - $p->[1] - $p->[2], $p->[0], $p->[2]];
}
sub parse_bouwkamp ($) {
my $bouwkamp = $_[0];
my @results;
my ($w, $h) = (0,0);
my @next_points = ([0, 0]);
for my $edges (@$bouwkamp) {
@next_points = sort_points @next_points;
my $cur_point = shift @next_points;
for my $edge (@$edges) {
push @results, [$cur_point->[0], $cur_point->[1], $edge];
@next_points = grep { ! ($_->[1] == $cur_point->[1] and $cur_point->[0] <= $_->[0] and $_->[0] <= $cur_point->[0] + $edge) } @next_points;
push @next_points, [$cur_point->[0], $cur_point->[1] + $edge];
$cur_point = [$cur_point->[0] + $edge, $cur_point->[1]];
$w = $cur_point->[0] if $cur_point->[0] > $w;
$h = $cur_point->[1] + $edge if $cur_point->[1] + $edge > $h;
}
}
(\@results, $w, $h);
}
sub deparse_bouwkamp ($) {
my @points = @{$_[0]};
my @results;
while (@points) {
my $point = shift @points;
my @cur_group = $point->[2];
my $next_point = [$point->[0] + $point->[2], $point->[1]];
while (my ($x) = grep { $next_point->[0] == $_->[0] and $next_point->[1] == $_->[1] } @points) {
push @cur_group, $x->[2];
@points = grep { $next_point->[0] != $_->[0] or $next_point->[1] != $_->[1] } @points;
$next_point = [$next_point->[0] + $x->[2], $next_point->[1]];
}
push @results, \@cur_group;
}
\@results;
}
sub solve ($) {
my ($answer_num, $encoded_bouwkamp) = split /:/, $_[0], 2;
my $bouwkamps = decode_bouwkamp $encoded_bouwkamp;
my ($points, $w, $h) = parse_bouwkamp $bouwkamps;
my @new_points = map { rotate_point $w, $h, $_ } @$points;
@new_points = sort_points @new_points;
my $new_bouwkamp = deparse_bouwkamp \@new_points;
'(' . join(',', @{$new_bouwkamp->[$answer_num - 1] // []}) . ')';
}
1;
use strict;
use warnings;
use Bouwkamp qw(solve);
use Test::More import => [qw(is is_deeply done_testing)];
while (<DATA>) {
tr/\r\n//d;
my ($no, $input, $output, undef) = split /\s+/, $_;
is solve $input, $output, "Test #$no";
}
is_deeply Bouwkamp::decode_bouwkamp('(33,29,50)(4,25)(37)(15,35)(16,9)(7,2)(17)(42,18)(6,11)(8,27)(24)(19)'),
[[33,29,50], [4,25], [37], [15,35], [16,9], [7,2], [17], [42,18], [6,11], [8,27], [24], [19]];
is_deeply [Bouwkamp::sort_points([3, 4, undef], [2, 3, undef])],
[[2, 3, undef], [3, 4, undef]];
is_deeply [Bouwkamp::parse_bouwkamp [[2, 2, 2], [3, 3]]],
[[[0, 0, 2], [2, 0, 2], [4, 0, 2], [0, 2, 3], [3, 2, 3]], 6, 5];
is_deeply Bouwkamp::deparse_bouwkamp [[0, 0, 2], [2, 0, 2], [4, 0, 2], [0, 2, 3], [3, 2, 3]],
[[2, 2, 2], [3, 3]];
is_deeply Bouwkamp::rotate_point(6, 5, [0, 0, 3]),
[3, 0, 3];
done_testing;
1時間経過次点で残ってしまった問題は以下。それぞれ15分くらいかかった。
- 左上の頂点のみ保持する方針だったが、90度回転すると左上の頂点も変わるのだった
- しかもその計算に辺の長さが必要なので、頂点と辺の長さを両方持つ必要があった
- 次のグループの座標候補
@next_points
が、正方形の配置時に辺と重なったら消さねばならない
- 気がついていたけど、放置してもテスト一個くらい通るだろうと思ったら、一個も通らず
テストを真面目に書いたせいで時間を費やしたってのもあるけど、テストで手を抜いていたら後半のリカバリ時にかなりきつかった気がする。