Perl6でパズルの問題を再現してみた

 数学ガールの3冊目を月末に控えた10月のはじめに、結城先生が一つのパズルを出題した。

[結] 2009年10月 - 結城浩の日記

 こういうのが大好きな自分としては、解かない理由もなく、出題されてから1時間ほど(出題されたことは結城先生のtwitterでほぼリアルタイムに知った)うとうとしながら文字列を眺め、なんとか解答にたどり着くことができた。光栄な事に正解者紹介のところに名前を載せていただいている。

 このパズルにて記されていると同時に問題となっている文字列は、当然ながら何らかの法則に従っている(これがランダムであればパズルにならない)。もちろん、解答に至るまでに、僕はこの法則を理解した。そして、自分の解答が正しい事を、自分の計算ではなくプログラムに演算させる事で確認したいと思った。ひらめきから解答に至った場合、その後に検算によって解答の正しさを確認するのは当然の事だ。良い機会だったので、触ってみたいと思っていたPerl6で検算用のプログラムを書くことにした。簡単なプログラムなのだが、5以前のPerlとの違いも少なくなく、かなり時間をかけてしまった。

 紆余曲折あって(これについては後日記事を書く予定)、プログラムでの検算によって、自分のひらめいた法則が正しかったことが証明できた。

 しかし、このパズル、未だ出題者より解答が明かされていない。さすがにプログラムを公開するわけにもいかないかな、と思ったが、この件についてtwitterで呟いたところ、出題者本人からreplyをいただいた。


http://twitter.com/hyuki/status/4294967295/

 というわけで、出題者ご本人の許可もいただいたので、プログラムをさらしてみようと思う。ちなみに、ネタばれになるため、閲覧の際はご注意ください。

(追記:出題者の解説が公開されました。あちらの方が断然良いコードですね。http://www.hyuki.com/d/200910.html#i20091007090000

パズルの文字列を生成するプログラム

loop (my $i = 2; $i <= 98; $i++) {

    my $num = $i;
    my $firstPrime = Bool::False;

    loop (my $j = 2; $j <= sqrt($i); $j++) {

        if (($num % $j) == 0) {

            if ($firstPrime) {
                print "P ";
            } else {
                $firstPrime = Bool::True;
            }

            my $exponent = 0;
            do {
                $exponent++;
                $num /= $j;
            } while (($num % $j) == 0);

            if ($exponent > 1) {
                loop (my $k = 0; $k < $exponent.chars(); $k++) {
                    print substr($exponent, $k, 1), " ";
                }
            }

            print "L ";
            loop (my $k = 0; $k < $j.chars(); $k++) {
                print substr($j, $k, 1), " ";
            }

        }
    }
    if ($num > sqrt($i)) {
        if ($firstPrime) {
            print "P ";
        }

        print "L ";

        loop (my $k = 0; $k < $num.chars(); $k++) {
            print substr($num, $k, 1), " ";
        }
    }
    print "C ";

}
print "\n";

※Tab文字だと環境によって見え方が変わるため、spaceに変更。

 このコードは個人的にはPerlらしくないような気がしている。また、僕はPerl6についてしっかりと学んでいない(このコードを書きながら学んだ)ので、正しくない書き方や危険な処理が入っているかもしれない事もあわせて注意していただければと思う。正しくない書き方や危険な処理があった場合、コメントなどで正しい書き方を教えてくれるとありがたい。

 最後に、件のパズルの解答は、上のコードの一番外のループのインクリメント回数を1つ増やしてやることで得られる。

 パズルを解くのも楽しかったし、Perlのコードを書くのも楽しかった。満足です。