スキップしてメイン コンテンツに移動

Project Euler - Problem 30

問題

  • 原文

    Find the sum of all the numbers that can be written as the sum of fifth powers of their digits.

  • 日本語訳

    各桁を5乗した和が元の数と一致するような数の総和を求めよ.

解答

まず探索範囲の上限を定める必要があります。n桁の最大の整数an = 9n-19n-2...90を考えると、その各桁の5乗の和はbn = 95nと表せます。

  • an+1 = 10an + 9
  • bn+1 = bn + 95

ですから、桁数nが大きくなるにつれてaがbよりも急激に大きくなるのが分かります。ある桁数nmaxを超えると、常にanmax > bnmaxが成立するので、両者が等しくなることはなくなります。 実際に調べるとnmaxは6なので、探索範囲は高々0から999,999までとなります。

各桁の乗数の和は、桁の並びに関わらず各桁の数のみによって決まります。例えば2501、5012、(0)215のいずれも同じbnを持つので、これを別々に計算するのは時間の無駄です。 そこで、このような数をすべて同値と見なす正規化を考えます。手っ取り早く桁の並べ替えで良いでしょう。各桁を昇順に並べ替え、その上で先頭に1個以上0があったら取り除くという処理です。先ほどの例に挙げた数字をこの方法で正規化すると、いずれも125となります。

この正規化された数のみを走査すれば良いわけですから、(0を含まない)n桁の数1つにつき同じ値をn!通り計算していたところが、1通りで済むことになります。

処理の手順をまとめると次のようになります:

  1. 全ての正規化された数に対してbnを計算し、連想配列に格納しておく。
  2. 連想配列に格納された値を1つ取り出し、anとする。
  3. anを正規化して連想配列から対応するbnを引く。
  4. an = bnであれば解に加える。
  5. 連想配列の値を全て走査するまで2.に戻って繰り返す。

下記のコードでは初期化の都合上、桁数ごとに連想配列を分けていますがアルゴリズム自体に違いはありません。

#!/usr/bin/env perl

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

sub regularize($) {
  join '', grep { $_ != 0 } sort { $a <=> $b } split //, shift;
}

my $max_digits = 0;
my ($upper_limit, $sum);
do {
  $max_digits++;
  $upper_limit = 9 x $max_digits;
  $sum = $max_digits * (9 ** 5);
} while $upper_limit < $sum;

my @powers = map { $_ ** 5 } 0 .. 9;
my @sum_dicts = ({ '' => 0 }, { map { ($_ => $powers[$_]) } 1 .. 9 });
while ($#sum_dicts < $max_digits) {
  push @sum_dicts, { map {
    my $prev_key = $_;
    my $last_digit = substr $prev_key, -1, 1;
    map {
      ("$prev_key$_" => $sum_dicts[-1]{$prev_key} + $powers[$_])
    } $last_digit .. 9;
  } keys %{ $sum_dicts[-1] } };
}
say sum grep {
  my $sorted = regularize $_;
  $_ == $sum_dicts[length $sorted]{$sorted};
} grep { $_ > 1 } map { values %$_ } @sum_dicts ;

コメント

このブログの人気の投稿

Perl 5 to 6 - コンテキスト

2011-02-27: コメント欄で既に改訂された仕様の指摘がありました ので一部補足しました。 id:uasi に感謝します。 これはMoritz Lenz氏のWebサイト Perlgeek.de で公開されているブログ記事 "Perl 5 to 6" Lesson 06 - Contexts の日本語訳です。 原文は Creative Commons Attribution 3.0 Germany に基づいて公開されています。 本エントリには Creative Commons Attribution 3.0 Unported を適用します。 Original text: Copyright© 2008-2010 Moritz Lenz Japanese translation: Copyright© 2011 SATOH Koichi NAME "Perl 5 to 6" Lesson 06 - コンテキスト SYNOPSIS my @a = <a b c> my $x = @a; say $x[2]; # c say (~2).WHAT # Str() say +@a; # 3 if @a < 10 { say "short array"; } DESCRIPTION 次のように書いたとき、 $x = @a Perl5では $x は @a より少ない情報—— @a の要素数だけ——しか持ちません。 すべての情報を保存しておくためには明示的にリファレンスを取る必要があります: $x = \@a Perl6ではこれらは反対になります: デフォルトでは何も失うことなく、スカラ変数は配列を単に格納します。 これは一般要素コンテキスト(Perl5で scalar と呼ばれていたもの)及びより特化された数値、整数、文字列コンテキストの導入によって可能となりました。無効コンテキストとリストコンテキストは変更されていません。 特別な構文でコンテキストを強制できます。 構文 コンテキスト ~stuff 文字列 ?stuff 真理値 +stuff ...

Perl 5 to 6 - サブルーチンとシグネチャ

これはMoritz Lenz氏のWebサイト Perlgeek.de で公開されているブログ記事 "Perl 5 to 6" Lesson 04 - Subroutines and Signatures の日本語訳です。 原文は Creative Commons Attribution 3.0 Germany に基づいて公開されています。 本エントリには Creative Commons Attribution 3.0 Unported を適用します。 Original text: Copyright© 2008-2010 Moritz Lenz Japanese translation: Copyright© 2011 SATOH Koichi NAME "Perl 5 to 6" Lesson 04 - サブルーチンとシグネチャ SYNOPSIS # シグネチャなしのサブルーチン——Perl5風 sub print_arguments { say "Arguments:"; for @_ { say "\t$_"; } } # 固定引数の型指定付きシグネチャ sub distance(Int $x1, Int $y1, Int $x2, Int $y2) { return sqrt ($x2-$x1)**2 + ($y2-$y1)**2; } say distance(3, 5, 0, 1); # デフォルト引数 sub logarithm($num, $base = 2.7183) { return log($num) / log($base) } say logarithm(4); # 第2引数はデフォルトを利用 say logarithm(4, 2); # 明示的な第2引数 # 名前付き引数 sub doit(:$when, :$what) { say "doing $what at $when"; } doit(what => 'stuff', when => 'once'); # ...

Project Euler - Problem 27

問題 しばらく止まってましたが今日から再開。 原文 Considering quadratics of the form: n 2 + an + b, where |a| < 1000 and |b| < 1000 Find the product of the coefficients, a and b, for the quadratic expression that produces the maximum number of primes for consecutive values of n, starting with n = 0. 日本語訳 |a| < 1000, |b| < 1000 として以下の二次式を考える (ここで|a|は絶対値): n 2 + an + b n=0から始めて連続する整数で素数を生成したときに最長の長さとなる上の二次式の, 係数a, bの積を答えよ. 解答 最大探索範囲は-999 <= a <= 999、-999 <= b <= 999なので、およそ4,000,000通りの係数の組合せを試すことになります。組合せ毎に数列を生成して、それが素数か判定するわけですからたまりません。簡単な検討を加えて範囲を絞りましょう。 与えられた二次式をf(n)とおくと、f(0) = b、f(1) = a + b + 1です。 f(n)が長さ2以上の素数列を生成するならこれらは素数ですから、次のことがいえます: bは素数である a + b + 1は素数である b = 2のとき、aは偶数である それ以外のとき、aは奇数である 素数判定関数 is_prime には同じ引数が与えられることがよくあるのでメモ化しています。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; sub prime_seq_len($$) { my ($coeff_a, $coeff_b) = @_; my $len = 0; my $n = 0; $len++, $n++ while is_prime($n * ($n + $coeff_a) ...

Perl 5 to 6 - ツイジル

これはMoritz Lenz氏のWebサイト Perlgeek.de で公開されているブログ記事 "Perl 5 to 6" Lesson 15 - Twigils の日本語訳です。 原文は Creative Commons Attribution 3.0 Germany に基づいて公開されています。 本エントリには Creative Commons Attribution 3.0 Unported を適用します。 Original text: Copyright© 2008-2010 Moritz Lenz Japanese translation: Copyright© 2011 SATOH Koichi NAME "Perl 5 to 6" Lesson 15 - ツイジル SYNOPSIS class Foo { has $.bar; has $!baz; } my @stuff = sort { $^b[1] <=> $^a[1]}, [1, 2], [0, 3], [4, 8]; my $block = { say "This is the named 'foo' parameter: $:foo" }; $block(:foo<bar>); say "This is file $?FILE on line $?LINE" say "A CGI script" if %*ENV.exists('DOCUMENT_ROOT'); DESCRIPTION いくつかの変数にはツイジルという第2のシジルがあります。これは基本的にはその変数が「普通」ではないということです。違いはいくつかあり、例えばスコープの違いなどです。 オブジェクトのパブリックな属性とプライベートな属性がそれぞれ . と ! というツイジルを持つことは既に紹介しました; それらは通常の変数ではなく self に結びつけられています。 ツイジル ^ はPerl5で例外的に扱われていたケースを一般化します。次のように書けます # 注意: Perl5のコードです sort ...

Project Euler - Problem 18

問題 原文 Find the maximum total from top to bottom of the triangle 日本語訳 三角形を頂点から下まで移動するとき、その最大の合計値を求めよ。 解答 動的計画法 を使ってボトムアップで簡単に解くことができる問題です。 簡単のため、小さい三角形で考えることにします: 0: j 1: h i 2: e f g 3: a b c d 2行目の各点を頂点として、2行の小さい三角形が作れることが分かります。 上の例で言えば、(e, a, b)と(f, b, c)、(g, c, d)の3つです。 (e, a, b)の頂点eから末端(a、b、c、dのいずれか)に移動したとき、その数値の合計は最大でe + max(a, b)となります(maxは最大値を選ぶ関数)。同様に他の2つもf + max(b, c)、g + max(c, d)と表せます。 これらをE、F、Gとおくことにして、例を次のように書き換えます: 0: j 1: h i 2: E F G (h, E, F)からなる三角形の最大値はH = h + max(E, F)、(i, F, G)からなる三角形のそれはI = i + max(F, G)です。 Eは「頂点eから末端に至る経路の最大値」で、FやGも同様ですから、HとIは「頂点h(やi)から末端に至る経路の最大値」となります。 これを先ほどと同様に置き換えて: 0: j 1: H I 頂点jから末端に至る経路の最大値はJ = j + max(H, I)となり、これが解です。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use List::Util qw/max/; my @rows = map { [ split /\s+/ ] } <DATA>; until (@rows == 1) { my $curr_row = $rows[-2]; my $bigger_branch; for (my $i = 0; $i < @$curr_row; $i++) { $bigger_branch = ma...