読者です 読者をやめる 読者になる 読者になる

初代Masteries

きっとモヒカンにもなれないお前たちに告げる!!!

2013年5月のProject Euler [最終更新: 5月27日(月)]

perl euler

アルゴリズムを考える能力を付ける, というよりは, 「定期的にコツコツ作業する」事に慣れるのと, コードを書く力を伸ばす*1為に挑戦を続けているProject Eulerですが, 先日お伝えしました通り, 解答を月ごとに, 1つの記事にまとめることにしました.

というわけで5月分の解答はこの記事に, 最新の解答が上になるようにストックされていく予定です.
ひとまず50問を目指して, 今月も頑張っていきます.

5月31日(金)

Problem 47

4つの異なる素因数を持つ, 連続する4つの数を求める問題.

use strict;
use warnings;

use Math::Factor::XS qw/prime_factors/;
use List::MoreUtils qw/uniq/;

my $n = 2;
my $count = 0;

while (1) {
    if (uniq(prime_factors($n)) == 4) {
        $count++;
        if ($count == 4) {
            printf "%d\n", $n-3;
            last;
        }
    } else {
        $count = 0;
    }

    $n++;
}

Math::Factor::XSが便利すぎる...!
この調子で6月も頑張っていきます.

5月29日(水)

Problem 46

「平方数の2倍と素数の和で表せない最小の奇合成数」を求める問題.

use strict;
use warnings;

my @primes = (2);
my $n = 2;

while (1) {
    if (! is_prime($n) && $n % 2 == 1) {
        last unless goldbach($n);
    }
    $n++;
}

print "$n\n";

sub goldbach {
    my $n = shift;

    my $goldbach;
    for my $prime (@primes) {
        for my $square (1..$n) {
            $goldbach = $prime + 2 * $square ** 2;
            last if $goldbach > $n;
            return 1 if $goldbach == $n;
        }
    }
    return 0;
}

sub is_prime {
    my $n = shift;

    for my $prime (@primes) {
        return 0 if $n % $prime == 0;
    }
    push @primes, $n;
    return 1;
}

以前, 会社のプログラミング部で解いていたので, そのまま流用という手抜き.
ここのところ頭痛気味だったので, 丁度良かったです.

5月27日(月)

Problem 45

三角数かつ五角数かつ六角数である数を求める問題.

use strict;
use warnings;

sub is_pentagonal {
    my $n = shift;

    if (((sqrt(24 * $n + 1) + 1) / 6) =~ /^\d+$/) {
        return 1;
    } else {
        return 0;
    }
}

sub hexagonal {
    my $n = shift;

    return $n * (2 * $n - 1);
}

my $n = 144;
while (1) {
    my $hexagonal = hexagonal($n);
    if (is_pentagonal($hexagonal)) {
        print "$hexagonal\n";
        last;
    }
    $n++;
}

六角数であるならば常に三角数なので, 六角数かつ五角数な値を求めればよい.

5月24日(金)

Problem 44

2つの五角数について, その和と差も五角数になるときの差を求める問題.

use strict;
use warnings;

my %pentagonal;

my $i = 2;

LAST: while (1) {
    my $p = pentagonal_number($i);
    $pentagonal{$p} = 1;

    for my $i (keys %pentagonal) {
        if (exists $pentagonal{$p-$i} && exists $pentagonal{$p-$i*2}) {
            print "" . ($p - $i * 2) . "\n";
            last LAST;
        }
    }
    $i++;
}

sub pentagonal_number {
    my $n = shift;

    return ($n * ( 3 * $n - 1)) / 2
}

ここは $p が五角数の和, $p - $i が大きい方の五角数, $i が小さい方の五角数に該当します.
なので, 2つの五角数の差は $p - $i - $i = $p - 2 * $i となる感じです.

$p, $iは五角数であることが明らかなので,$p - $i と $p - $i * 2 が五角数であれば, $p - $i * 2 が求める答えとなります.

そろそろ苦しくなってきました. 50問を越えた辺りで, 方針を少し変えようかなー, と考えています.

5月22日(水)

Problem 43

0から9のPandigital数(0から9が1度ずつ現れる数)について, 2〜4桁目が2で, 3〜5桁目が3で, 4〜6桁目が5で, 5〜7桁目が7で, 6〜8桁目が11で, 7〜9桁目が13で, 8〜10桁目が17で割り切れる数を求める問題.

use strict;
use warnings;

use Set::Object qw/set/;
use List::Util qw/sum/;

my @primes = qw/2 3 5 7 11 13 17/;

sub solution {
    my ($n, $object) = @_;

    $n //= '';
    $object //= set(0 .. 9);

    my $length = length $n;

    return () if $length >= 4 && (substr($n, -3, 3) % $primes[$length - 4]) != 0;
    return () if $n =~ /^0/;
    return ('') if $object->is_null;

    my @solutions;
    for my $i ($object->members) {
        $object->remove($i);
        push @solutions, map { $i . $_ } solution($n . $i, $object);
        $object->insert($i);
    }
    return @solutions;
}

print sum solution();

結果としてはお手上げ.
最終的には, ググって見つけた@さんのブログを見て「ほう...」と唸っていま
した.

上記のコードは, @さんのブログ記事のコードを模写(?)したものです.
Set::Objectというモジュールが, Project Eulerを解く上で結構役立ちそうですね.

5月20日(月)

Problem 42

英単語のそれぞれのアルファベットを数値に変換した値の和と, 三角数 (n * (n + 1) ) / 2 が一致する英単語は何個存在するか探索する問題.
但し, 英単語は別ファイルで与えられるものとする.

use strict;
use warnings;

my $filename = $ARGV[0];
open my $fh, '<', $filename or die "Can't open $filename: $!";
my @words = map { $_ =~ s/^"(.+)"$/$1/ ; $_ } split /,/, do { local $\; <$fh> };

my %triangle_numbers;
my $n = 1;

while (1) {
    my $triangle_number = triangle_number($n);
    $triangle_numbers{$triangle_number} = 1;

    last if $triangle_number >= 364;
    $n++;
}

my $answer;
for my $word (@words) {
    $answer++ if exists $triangle_numbers{word_value($word)};
}

print $answer;

sub triangle_number {
    my $n = shift;

    return ( $n * ($n + 1) ) / 2
}

sub word_value {
    my $word = shift;
    my $word_value;

    for my $w (split //, $word) {
        $word_value += ord($w) - ord('@');
    }
    return $word_value;
}

テキストファイル中の最長英単語から必要な三角数の範囲がわかるので, 三角数を先に計算してから調査しています.

5月17日(金)

Problem 41

1からnまでの数を各桁に持つn桁のPandigital数において, 素数になる最大の数を求める問題.

use strict;
use warnings;

use Math::Prime::XS qw/is_prime/;

for my $i (reverse 1..7654321) {
    if (is_pandigital($i) && is_prime($i)) {
        print "$i\n";
        last;
    }
}

sub is_pandigital {
    my @number = sort split//, shift;

    for my $i (1..scalar @number) {
        return 0 if $i != $number[$i-1];
    }
    return 1;
}

各桁の和が3の倍数なら, その数自身も3の倍数になる, という法則より, 8桁・9桁は答えの候補から外れます(1〜8の和は36で3の倍数, 1〜9の和は45で, これまた3の倍数).

5月15日(水)

Problem 40

1, 2, 3, 4, ... と, 整数を1から順番につなげた数(12345678910111213...)において, 1桁, 10桁, 100桁, 1000桁, 10000桁, 100000桁, 1000000桁の積を求める問題.

use strict;
use warnings;

my $answer = 1;
my $n = '';
my $i = 1;

while(length $n <= 1000000) {
    $n .= $i;
    $i++;
}

$answer *= $_ for (split //, $n)[0, 9, 99, 999, 9999, 99999, 999999];
print $answer;

こんな感じで, ちゃちゃっと.

5月13日(月)

Problem 39

辺の長さが {a, b, c} という整数の組み合わせになる直角三角形を考え, その総和(周囲の長さ)を p とする. p <= 1000 のとき, {a, b, c} の組み合わせが最大になる p を求める問題.

use strict;
use warnings;

my $pattern = 0;
my $answer = 0;

for my $n (3..1000) {
    my $count = 0;
    for my $i (1..$n-2) {
        for my $j ($i..($n-1-$i)/2) {
            my $k = $n - $i - $j;
            my @triangle = sort { $a <=> $b } ($i, $j, $k);
            if ($triangle[0] ** 2 + $triangle[1] ** 2 == $triangle[2] ** 2) {
                $count++;
            }
        }
    }
    if ($count >= $pattern && $n > $answer) {
        $answer = $n;
        $pattern  = $count;
    }
}

print "$answer\n";

とりあえず力技で.
だいたい20秒前後かかるので, もう少し高速化したいですね...

5月10日(水)

Problem 38

以前出てきたPandigital(1から9までが1回ずつ出てくる数字)についての問題.

ある整数と, (1, 2, ... n (但しn > 1))を掛けあわせた積を連結したもののうち, 最大のPandigital数を求める問題.

use strict;
use warnings;

my $result = 0;

for my $n (1..9999) {
    my $i = $n;
    for my $mul (2..9) {
        $i .= $n * $mul;
        if (length $i == 9) {
            $result = is_pandigital($i) ? $i : $result;
            last;
        }
        last if length $i > 9;
    }
}

print "$result\n";

sub is_pandigital {
    my $n = shift;

    return 1 if 123456789 == join '', sort split //, $n;
    return 0;
}

nは2以上なので, 1から9999まで走査すればOK. 後は総当りで.

5月8日(水)

Problem 37

左から切り詰めても(例えば3797なら, 797, 97, 7), 右から切り詰めても(例えば3797なら, 379, 37, 3), 常に素数である数が11個しか存在しないので, その総和を求める問題.

Problem 35を参考に, とりあえず100万以下に11個存在する... と仮定して書いてみたところいい感じに答えが求まりました.

use strict;
use warnings;
use strict;

use Math::Prime::XS qw/is_prime primes/;

my $answer;
my $answer_num = 0;

my @primes = (grep { length != 1 && ( $_ % 2 == 1 || $_ =~ /^[25]/ ) } primes(1_000_000));

for my $i (@primes) {
    if (is_truncatable_prime($i)) {
        $answer += $i;
        $answer_num++;
    }
    if ($answer_num == 11) {
        print "$answer / $answer_num / $i\n";
        last;
    }
}

sub is_truncatable_prime {
    my $n = shift;

    my @number = split //, $n;

    for my $i (reverse 0..$#number) {
        return 0 unless is_prime(join '', @number[0..$i]);
        return 0 unless is_prime(join '', @number[$i..$#number]);
    }
    return 1;
}

5月6日(月)

Problem 36

100万未満の数について, 10進数としても, 2進数としても回文数となる数の総和を求める問題です.

use strict;
use warnings;

my $answer;

for my $i (1..999_999) {
    $answer += $i if is_reverse($i) && is_reverse(sprintf("%b", $i));
}

print "$answer\n";

sub is_reverse {
    my $i = shift;

    if ($i eq reverse $i) {
        return 1;
    } else {
        return 0;
    }
}

素直に実装するとこんな感じでしょうか.

5月3日(金)

Problem 35

100万未満の巡回素数(桁を回転させて生成できる数がすべて素数な数)を求める問題.

use warnings;
use strict;

use Math::Prime::XS qw/is_prime primes/;

my $answer;
my @primes = (2, grep { $_ % 2 == 1 } primes(999_999));

for my $i (@primes) {
    $answer++ if is_circular_prime($i);
}

print "$answer\n";

sub is_circular_prime {
    my $n = shift;

    my @nums = split //, $n;

    for (1..length $n) {
        return 0 unless is_prime(join '', @nums);
        my $i = pop @nums;
        unshift @nums, $i;
    }
    return 1;
}

'is_circular_prime'では, 入力値をローテートして素数判定し続ける事で, 入力値が循環素数か否かを判定しています.
なんというか, Math::Prime::XSを使うのはかなり卑怯な感じがありますね...

5月1日(水)

Problem 34

ある数について, その数自身とその数の各桁の階乗の和が一致するような数の和求める問題.

use strict;
use warnings;
use List::Util qw/ sum /;

my @facts = map { factorial($_) } (0..9);
my $answer;

for my $n (10 .. 2540160) {
    my $f = sum_of_facts($n);
    $answer += $n if $f == $n;
}
print "$answer\n";

sub sum_of_facts {
    my $n = shift;
    return sum(map { $facts[$_] } split //, $n);
}

sub factorial {
    my $n = shift;

    return 1 if $n <= 1;

    my $answer = 1;
    $answer *= $_ for (2..$n);

    return $answer;
}

10^7 = 10000000 <= 9! * 7 = 2540160なので, 上限を2540160と置いて探索しました.

*1:これまでも, 「これ, どうやればいいんだろう...?」という疑問から, いろいろ学ぶことができています!