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

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 = max $rows[-1][$i], $rows[-1][$i + 1];
    $curr_row->[$i] += $bigger_branch;
  }
  $#rows--;
}

say $rows[0][0];

__END__
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23

コメント

  1. 平田敦2009年6月3日 9:02:00 JST

    エントリを拝読しました。
    大変参考になりました。
    感謝です。

    返信削除
  2. Koichi SATO2009年6月13日 19:46:00 JST

    見落としていました。コメント承認が遅くなりましてすいません。
    ありがとうございます。稚拙なエントリですが、何かの役に立ちましたなら幸いです。

    返信削除
  3. 平田敦2009年6月13日 21:04:00 JST

    とんでもない、とても役に立ちました。
    年をとって頭が固くなっていますから、
    Webでこうしていろんな方のコードを見せてもらうことがとてもいい刺激になっているんです。

    感謝です。

    返信削除

コメントを投稿

このブログの人気の投稿

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

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

去る6月に Perl 5.32.0 がリリースされたので差分を把握するために perldelta を読んだ件

要旨 Perl 5 メジャーバージョンアップの季節がやって来たのでまともな Perl プログラマの嗜みとして perldelta を読んだ。 今回は有り体に言えばルーティン的なリリースで、言語コアの拡張は他言語にも見られる構文が実験的に入ったくらいで大きな変化はない。新機能は RegExp の拡充が主である。 比較的重要と思われる変更点を抜粋する。 新機能 isa 演算子 実験的機能。Python とか Java における isinstance とか instanceof 。 これまでも UNIVERSAL::isa があったが、これはメソッドなのでレシーバにオブジェクトでもクラスでもない値 (i.e., 未定義値 / bless されていないリファレンス) を置くと実行時エラーが起きるのが問題だった: package Foo { use Moo; } package Bar { use Moo; extends ' Foo ' ; } package Baz { use Moo; } use feature qw/ say / ; sub do_something_with_foo_or_return_undef { my ( $foo ) = @_ ; # Returns safely if the argument isn't an expected instance, in mind. return unless $foo -> isa ( ' Foo ' ); ...; } # OK. do_something_with_foo(Bar->new); # |undef| is expected in mind, but actually error will be thrown. do_something_with_foo( undef ); これを避けるために今までは Scalar::Util::blessed を併用したりしていたわけだが、 isa 演算子は左辺が何であっても意味のある値を返すのでよりシンプルになる: # True +( bless +{} ...
コメントを投稿
続きを読む

Project Euler - Problem 35

問題 原文 How many circular primes are there below one million? 日本語訳 100万未満の巡回素数は何個か? 解答 回転させた数値がすべて素数ということは、すべての桁が奇数でなければいけません(ただし2を除く)。 追記 匿名氏にコメントでご指摘頂いたのでコードを一部修正しました。 いずれかの桁に5がある場合も、回転させると必ず5の倍数が現れるので除外できます。 もっと追記 前の修正に間違いが入っているのをご指摘頂いたので修正しました。 5自体は素数なので、巻き添えで除外してはいけません。 #!/usr/bin/env perl use strict; use warnings; use feature qw/say state/; use List::MoreUtils qw/all none/; sub is_prime($) { state %memos; my $n = shift; return 0 if $n < 2; return 1 if $n == 2; return 1 if $n == 3; return $memos{$n} if exists $memos{$n}; $memos{$n} = none { $n % $_ == 0 } 2 .. sqrt $n; } sub rotate($) { my $n = shift; substr($n, 1) . substr($n, 0, 1); } sub rotations($) { my $n = shift; my %seen = ($n => 1); $seen{$n} = 1 until exists $seen{$n = rotate $n}; keys %seen; } sub is_circular_prime($) { state %memos; my $n = shift; return 0 if $n =~ /[024568]/ and $n != 2 and $n != 5; return $memos{$n} if exists $memos{$n}; my ...
4 件のコメント
続きを読む

LIBLINEAR 2.41 で One-class SVM が使えるようになったので Perl から触ってみよう

改訂 (Sep 15, 2020): 必要のない手順を含んでいたのでサンプルコードと記述を修正しました。 CPAN に Algorithm::LibLinear 0.22 がリリースされました (しました。) 高速な線形 SVM およびロジスティック回帰による複数の機械学習アルゴリズムを実装したライブラリである LIBLINEAR への Perl バインディングです。 利用している LIBLINEAR のバージョンが LIBLINEAR 2.30 から LIBLINEAR 2.41 に上がったことで新しいソルバが追加され、One-class SVM (OC-SVM) による一値分類が利用可能になっています (しました。) OC-SVM って何 一値分類を SVM でやること。 一値分類って何 ある値が学習したクラスに含まれるか否かを決定する問題。 HBO の「シリコンバレー」に出てきた「ホットドッグ」と「ホットドッグ以外」を識別するアプリが典型。「ホットドッグ以外」の方は犬でも神でも一つの指輪でも何でも含まれるのがミソ。 二値分類の場合正反両者のデータを集める必要があるのに対して、一値分類の学習器は正例データのみしか要求しない (ものが多い。) 主な用途は外れ値検出で、もちろんホットドッグやホットドッグ様のものを検出したりもできる。 使い方 手順自体は他の二値ないし多値分類問題と同じです。つまり、 訓練パラメータを決めて 訓練データセットで訓練して テストデータセットで確度を検証して 十分良くなったらモデルを保存する といういつもの流れ。 訓練パラメータ use 5.032 ; use Algorithm::LibLinear ; my $learner = Algorithm::LibLinear ->new( epsilon => 0.01 , nu => 0.75 , solver => ' ONECLASS_SVM ' , ); solver => 'ONECLASS_SVM' が一値分類用のソルバです。LIBLINEAR の train コマンドで言うところの -s 21 。 OC-SVM の良いところは (ハイパー)...
コメントを投稿
続きを読む

Perl 7 より先に Perl 5.34 が出るぞという話

Perl 5 の次期バージョンとして一部後方互換でない変更 (主に間接オブジェクト記法の削除とベストプラクティスのデフォルトでの有効化) を含んだメジャーバージョンアップである Perl 7 がアナウンスされたのは昨年の 6 月 のことだったが、その前に Perl 5 の次期周期リリースである Perl 5.34 が 5 月にリリース予定 である。 現在開発版は Perl 5.33.8 がリリースされておりユーザから見える変更は凍結、4 月下旬の 5.33.9 で全コードが凍結され 5 月下旬に 5.34.0 としてリリース予定とのこと。 そういうわけで事前に新機能の予習をしておく。 8進数数値リテラルの新構文 見た瞬間「マジかよ」と口に出た。これまで Perl はプレフィクス 0 がついた数値リテラルを8進数と見做してきたが、プレフィクスに 0o (zero, small o) も使えるようになる。 もちろんこれは2進数リテラルの 0b や 16進数リテラルの 0x との一貫性のためである。リテラルと同じ解釈で文字列を数値に変換する組み込み関数 oct も` 新構文を解するようになる。 昨今無数の言語に取り入れられているリテラル記法ではあるが、この記法の問題は o (small o) と 0 (zero) の区別が難しいことで、より悪いことに大文字も合法である： 0O755 Try / Catch 構文 Perl 5 のリリース以来 30 年ほど待たれた実験的「新機能」である。 Perl 5 における例外処理が特別な構文でなかったのは予約語を増やさない配慮だったはずだが、TryCatch とか Try::Tiny のようなモジュールが氾濫して当初の意図が無意味になったというのもあるかも知れない。 use feature qw/ try / ; no warnings qw/ experimental::try / ; try { failable_operation(); } catch ( $e ) { recover_from_error( $e ); } Raku (former Perl 6) だと CATCH (大文字なことに注意) ブロックが自分の宣言されたスコープ内で投げられた例外を捕らえる...
1 件のコメント
続きを読む