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

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 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 ...

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'); # ...

多分週刊チラシの裏 (Sep 28 - Oct 04, 2020)

Chrome Web Store が有料 Chrome 拡張の取扱を終了 Chrome Web Store で提供されている有料 Chrome 拡張及びアプリ内課金 API の両方が 2021 年 1 月いっぱいで廃止される。 開発者はそれまでに代替となるサードパーティの課金 API に移行し、購入済ライセンスの移行手段も用意する必要がある。 この決定の発表時点で新規の有料ないしアプリ内課金のある Chrome 拡張の新規登録は終了している。実際のところ 2020 年 3 月時点で既に「一時的に」停止されており、その措置が恒久化されただけとの由。 シェルスクリプティングには長いオプションを使え 「短いオプション (e.g., -x ) はコマンドライン上での略記である。スクリプトにおいては自分や将来の同僚のためにも長いオプション (e.g., ---do-something ) を与える方が理解が容易だろう」という主張。 異論の余地なく正論である。 CobWeb - COBOL to WebAssembly Compiler COBOL から WebAssembly へのコンパイラ。いやマジで。 Cloudflare が何を思ったか同社のサーバレス環境である Workers に COBOL 対応を追加した際 の成果物である。 COBOL から C へのトランスレータである GNU COBOL と C コードをコンパイルして WebAssembly を出力する Emscripten から成っており、他の言語に比べて軽量なバイナリを生成するとのこと。 「ウチではそんな風にはやらないんだ (“We don’t do that here”)」 昨今ソフトウェア開発のコミュニティでも Code of Conduct を用意するところが増えてきたが、コミュニティの文化を明文化するのは難しい。 長大な「べからず集」は息苦しいし、肯定的なガイドラインは時に抽象的で実効的に使えない。問題となるようなふるまいの動機が善意であった場合は特にそうだ。 仮に優れたガイドラインがあっても、それに基いて人を実際に咎めるのは骨が折れることである。初中やればコミュニティ内でも疎まれる。 話の分かる相手ならそれでもまだ説得する意義もあるが、Web 上の対話で当事者双方が納得し合っ...

Perl 5 to 6 - Perl5の演算子に対する変更

これはMoritz Lenz氏のWebサイト Perlgeek.de で公開されているブログ記事 "Perl 5 to 6" Lesson 11 - Changes to Perl 5 Operators の日本語訳です。 原文は 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 11 - Perl5の演算子に対する変更 SYNOPSIS # ビット演算子 5 +| 3; # 7 6 +^ 3 # 6 5 +& 3; # 1 "b" ~| "d" # 'f' # 文字列連結 'a' ~ 'b' # 'ab' # ファイルテスト if '/etc/passwd' ~~ :e { say "exists" } # 繰り返し 'a' x 3 # 'aaa' 'a' xx 3 # 'a', 'a', 'a' # 3項演算子 $a == $b ?? 2 * $a !! $b - $a # 連結比較 if 0 <= $angle < 2 * pi { ... } DESCRIPTION 数値演算子( + , - , / , * , ** , % )はすべて元のままです。 | 、 ^ 、 & はジャンクションの生成に使われるので、ビット演算子は構文が変更されました。 それらはデータプレフィクスを伴い、例えば ...