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

Project Euler - Problem 29

こんばんはSekia the Liarです。更新頻度についての釈明はさておきえーとP.E. 29でしたね。はい、すいません。

問題

  • 原文

    Consider all integer combinations of a^(b) for 2 ≤ a ≤ 5 and 2 ≤ b ≤ 5: (引用者による省略) How many distinct terms are in the sequence generated by ab for 2 ≤ a ≤ 100 and 2 ≤ b ≤ 100?

  • 日本語訳

    2 ≤ a ≤ 5 と 2 ≤ b ≤ 5について, abを全て考えてみよう: (引用者による省略) 2 ≤ a ≤ 100, 2 ≤ b ≤ 100 で同じことをしたときいくつの異なる項が存在するか?

解答

値の重複を取り除くにはハッシュを使うのが定石です。

use strict;
use warnings;
use feature qw/say/;
use Math::BigInt;

my %pows;
for my $n (2 .. 100) {
  for my $i (2 .. 100) {
    $pows{ Math::BigInt->new($n) ** $i } = 1;
  }
}
say scalar keys %pows;

しかしPerlのメソッド解決オーバヘッドは結構でかいので、10,000個のMath::BigIntインスタンス生成は割と時間を食います。毎回Math::BigIntというのも芸がないし、少し頭を使って解いてみることにしました。

ab = (an)b/nであることに着目しましょう。これは中学だか高校だかで習った通りです。ただし問題の範囲は整数なので、指数は2 ≤ b/n ≤ 100なる整数でなければなりません。つまりnはbの約数(ただしb自身を除く)です。

この等号で結ばれたべき乗は同じ(つまり重複した)値を持ちます。

例えば212 = 4(=22)6 = 8(=23)4 = 16(=24)3 = 64(=26)2 = 4,096であり、他に4,096となるようなべき乗は整数の範囲ではなさそうです(証明してないので間違ってたら教えてください)。

これをふまえると、等式が成り立つa、bの組のうちaが最小のもの(ここでa0、b0とおきましょう)が分かれば、残りのものはすべてa = a0n、b = b0/nの形をしているはずです。したがって同じ値を持つa、bの組はすべてa0、b0から求められます。

よってa0、b0のみを数えて、残りは重複として印をつけてスキップするようにすれば、重複のないべき乗の個数を数えることができます。

ところで2 ≤ an ≤ 100、2 ≤ b/n ≤ 100という拘束条件にちょっとした注意が必要です。というのも、n = 1のときにこの条件を満足せず、nがある程度大きくなれば満足するa、bが存在するからです。 このような数を取りこぼさないためにはb/n ≤ 100 × floor(logn100)(floorは床関数)までを探索し、b/n ≤ 100である間はnに1加えて何もせずスキップする、というような処理が必要になります。

#!/usr/bin/env perl

use strict;
use warnings;
use feature qw/say/;
use POSIX qw/floor/;

{
  my %memos;
  #returns divisors of $n (except $n itself) in numeric order
  sub divisors($) {
    my $n = shift;
    return @{ $memos{$n} } if exists $memos{$n};

    my @early = grep { $n % $_ == 0 } 2 .. floor sqrt $n;
    my @later = reverse map { $n / $_ } @early;
    shift @later if @later != 0 and $later[0] ** 2 == $n;

    return @{ $memos{$n} = [1, @early, @later] };
  }
}

sub logn($$) { my ($b, $n) = @_; (log $n) / (log $b) }

my %passed;
my $num_distincts = 0;
for my $n (2 .. 100) {
  my $max_i = 100 * floor logn($n, 100);
  for my $i (2 .. $max_i) {
    my $is_dist = 0;
    for my $d (divisors $i) {
      my ($m, $j) = ($n ** $d, $i / $d);
      next if $passed{$m, $j};
      next if $j > 100;
      last if $m > 100;

      $passed{$m, $j} = $is_dist = 1;
    }
    $num_distincts++ if $is_dist;
  }
}
say $num_distincts;

蛇足な補足

実装にちょっと珍しい多次元配列のエミュレート機能を使っています。$passed{$m, $j}という部分です。 ぱっと見ハッシュ・スライスのようですが、シジルが$なことから分かるようにスカラ値を返します。

これは次のように解釈されます:

$passed{ join($;, $m, $j) }

Perl 5のハッシュが文字列しかキーにできないという制約からこのような形になっているのでしょう。$;use Englishすると$SUBSEP)は特殊変数で、デフォルトでは"¥034"が入っています。これはUS-ASCIIではFS(File Separator)という制御文字なので、キーの値と混同されることはまずありません。

Pythonなどのタプルをキーとする方法に比べると美しくありませんが、使い勝手に差はないので案外と重宝します。疎な多次元配列を作るときなどは配列リファレンスよりこちらの方がいいでしょう。

コメント

このブログの人気の投稿

Perl 5 to 6 - 列挙型

これはMoritz Lenz氏のWebサイト Perlgeek.de で公開されているブログ記事 "Perl 5 to 6" Lesson 16 - Enums の日本語訳です。 原文は 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 16 - 列挙型 SYNOPSIS enum bit Bool <False True>; my $value = $arbitrary_value but True; if $value { say "Yes, it's true"; # 表示される } enum Day ('Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat', 'Sun'); if custom_get_date().Day == Day::Sat | Day::Sun { say "Weekend"; } DESCRIPTION 列挙型は用途の広い獣です。定数の列挙からなる低レベルのクラスであり、定数は典型的には整数や文字列です(が任意のものが使えます)。 これらの定数は派生型やメソッド、あるいは通常の値のようにふるまいます。 but 演算子でオブジェクトに結びつけることができ、これによって列挙型を値に「ミックスイン」できます: my $x = $today but Day::Tue; 列挙型の型名を関数のように使うこともでき、引数として値を指定できます: $x = $today but Day($weekday); ...

Project Euler - Problem 25

問題 原文 What is the first term in the Fibonacci sequence to contain 1000 digits? 日本語訳 1000桁になる最初の項の番号を答えよ. 解答 Gaucheのストリームライブラリを使ってみました。 (use util.stream) (define fibonacci-sequence (iterator->stream (lambda (yield end) (let loop ((a 1) (b 1)) (yield a) (loop b (+ a b)))))) (define (digits n) (define (digits-1 m acc) (if (< n m) acc (digits-1 (* m 10) (+ acc 1)))) (digits-1 1 0)) (define (solve) (+ 1 (stream-index (lambda (n) (= 1000 (digits n))) fibonacci-sequence))) (define (main argv) (display (solve)) (newline))

Perl の新 class 構文を使ってみる

Perl 5 のオブジェクト指向機能は基本的には Python の影響を受けたものだが、データを名前空間 (package) に bless する機構だけで Perl 4 以来の名前空間とサブルーチンをそのままクラスとメソッドに転換し第一級のオブジェクト指向システムとした言語設計は驚嘆に価する。 実際この言語のオブジェクトシステムは動的型付言語のオブジェクト指向プログラミングに要求されるおよそあらゆる機能を暗にサポートしており、CPAN には Moose を筆頭とした屋下屋オブジェクトシステムが複数存在しているがその多くは Pure Perl ライブラリである。つまり「やろうと思えば全部手書きで実現できる」わけである。 そういうわけで Perl のオブジェクト指向プログラミングサポートは機能面では (静的型検査の不在という現代的には極めて重大な欠如を除けば) 申し分ないのだが、しかし Moose その他の存在が示しているように一つ明らかな欠点がある。記述の冗長さだ。 コンストラクタを含むあらゆるメソッドは第一引数としてレシーバを受ける単なるサブルーチンとして明示的に書く必要があるし、オブジェクトのインスタンス変数 (a.k.a. プロパティ / データメンバ) は bless されたデータに直接的ないし間接的に プログラマ定義の方法 で格納されるためアクセス手段は実装依存である。これはカプセル化の観点からは望ましい性質だが、他者の書いたクラスを継承するときに問題となる。ある日データ表現を変更した親クラスがリリースされると突然自分の書いた子クラスが実行時エラーを起こすようになるわけだ。 そうならないためにはインスタンス変数へのアクセスに (protected な) アクセサを使う必要があるのだが、そのためには親クラスが明示的にそれらを提供している必要があるし、そもそも Perl にはメソッドのアクセス修飾子というものがないので完全な制御を与えるならばオブジェクトの内部状態がすべて public になってしまう。 そのような事情もあり、特にパフォーマンスが問題にならないようなアプリケーションコードでは Moose のようなリッチな語彙を提供するオブジェクトシステムを使うことが 公式のチュートリアルでも推奨 されてきた。Perl コアのオブジェクトシステムの改良は...

多分週刊チラシの裏 (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 上の対話で当事者双方が納得し合っ...

Project Euler - Problem 31

問題 原文 How many different ways can £2 be made using any number of coins? 日本語訳 いくらかの硬貨を使って2ポンドを作る方法はいくつあるでしょうか? 解答 ポンドとペンスを別々に扱うのは面倒と無駄以外の何者でもないので、単位をペンスに統一します。よって問題は合計が200ペンスとなるコインの組み合わせは何通りあるかです。 コインを昇順にC i (i = 0, 1, 2, ..., 7)と番号づけることにします。 合計nペンスとなるC k 以下のコインを使った組み合わせをcc(n, k)と表すと、次のようになります: cc(0, k) = 1 cc(n, 1) = 1 cc(n, k) = Σ(cc(n - iC k , k - 1))、ただしi ∈ { 0 , 1, 2, ..., floor(n / C k ) } 副問題は同じものが何度も出てくるのでメモ化しています。 #!/usr/bin/env perl use strict; use warnings; use feature qw/say state/; use List::Util qw/sum/; sub coin_comb($;$); { my @coins = (1, 2, 5, 10, 20, 50, 100, 200); sub coin_comb($;$) { state %memos; my ($currency, $coin_idx) = @_; $coin_idx //= $#coins; return $memos{$currency, $coin_idx} if exists $memos{$currency, $coin_idx}; return 1 if $currency == 0; return 1 if $coin_idx == 0; use integer; $memos{$currency, $coin_idx} = sum map { coin_comb($currency - $coins[$coin_idx] * $_, $coin_idx...