僕のIT革命

要約 マルチバイト文字を扱うワンライナはとりあえず-CSDとでもしておくと安心。 長文 どう書く？org で バイナリクロック のお題に 解答したら 、あの 小飼弾氏 が さらに短くして下さいました 。うはー! perl -CIO -Mutf8 -le 'print for map { $_ = sprintf "%06b", $_; tr/01/□■/; $_ } (localtime)[2,1];' Perl5.8対応(そうか、-lで $\ 出力だった)はともかく-Cスイッチって何ぞや、と思ったのでperldoc perlrun ： −C [number/list] The "−C" flag controls some of the Perl Unicode features. 「Perl5.8.1より前はWin32のワイド版APIを使うためのスイッチだったけど、誰も使わなかったから使い回すことにしたよ」とか中々楽しいことが書いてあり、現在はPerlIOレイヤを操作するスイッチになっているそうです。 以下簡単な説明。 -C(I|O|E|S) -C(I|O|E)はそれぞれ標準(入力|出力|エラー出力)のPerlIOレイヤをUTF-8に設定するオプションです。つまり次のコードと等価になります： binmode STDIN, ':utf8'; # -CI binmode STDOUT, ':utf8'; # -CO binmode STDERR, ':utf8'; # -CE また-CSオプションで、これらをまとめて指定できます。 -C(i|o|D) -C(i|o)はそれぞれ読み出し(<)、書き込み(>)用に開くファイルハンドルに適用されるデフォルトのPerlIOレイヤをUTF-8に指定します。-CDは両者の一括指定。それぞれ open プラグマを使った以下のコードと等価です： use open IN => ':utf8'; # -Ci use open OUT => ':utf8'; # -Co use open

問題 原文 Let d 1 be the 1 st digit, d 2 be the 2 nd digit, and so on. In this way, we note the following: d 2 d 3 d 4 =406 is divisible by 2 d 3 d 4 d 5 =063 is divisible by 3 d 4 d 5 d 6 =635 is divisible by 5 d 5 d 6 d 7 =357 is divisible by 7 d 6 d 7 d 8 =572 is divisible by 11 d 7 d 8 d 9 =728 is divisible by 13 d 8 d 9 d 10 =289 is divisible by 17 Find the sum of all 0 to 9 pandigital numbers with this property. 日本語訳 d 1 を1桁目, d 2 を2桁目の数とし, 以下順にd n を定義する. この記法を用いると次のことが分かる. d 2 d 3 d 4 =406は2で割り切れる d 3 d 4 d 5 =063は3で割り切れる d 4 d 5 d 6 =635は5で割り切れる d 5 d 6 d 7 =357は7で割り切れる d 6 d 7 d 8 =572は11で割り切れる d 7 d 8 d 9 =728は13で割り切れる d 8 d 9 d 10 =289は17で割り切れる このような性質をもつ0から9のPandigital数の総和を求めよ. 解答 Problem 41 と同様に Pandigital数 を作るだけです。途中で枝切りして無駄な計算を省いています。 除数を保持する配列は一応定数にしてみました。定数の宣言には標準プラグマに constant がありますが、コードが分かり易い Attribute::Constant というCPANモジュールを使っています。 #!/usr/bin/env perl use strict; use wa

問題 原文 By converting each letter in a word to a number corresponding to its alphabetical position and adding these values we form a word value. For example, the word value for SKY is 19 + 11 + 25 = 55 = t 10 . If the word value is a triangle number then we shall call the word a triangle word. Using words.txt (right click and 'Save Link/Target As...'), a 16K text file containing nearly two-thousand common English words, how many are triangle words? 日本語訳 単語中のアルファベットを数値に変換した後に和をとる. この和を「単語の値」と呼ぶことにする. 例えば SKY は 19 + 11 + 25 = 55 = t 10 である. 単語の値が三角数であるとき, その単語を三角語と呼ぶ. 16Kのテキストファイル word.txt 中に約2000語の英単語が記されている. 三角語はいくつあるか? 解答 42問目! ちょっと拍子抜けするほど簡単です。三角数を片っ端から計算して連想配列に入れておき、文字列の値を計算して照合するだけです。 #!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use List::Util qw/sum/; sub word_value($) { my $offset = ord('A') - 1; sum map { ord($_) - $offset } split //, uc shift; } sub tri_num($) { my $n = shift; $n * ($n + 1) / 2

問題 原文 What is the largest n-digit pandigital prime that exists? 日本語訳 n桁のPandigitalな素数の中で最大の数を答えよ. 解答 ある数が3の倍数のとき、その各桁を足し合わせた数もまた3の倍数であり、その逆もいえます： n = a m-1 a m-2 ...a 0 = a m-1 ×10 m-1 + a m-2 ×10 m-2 + ... + a 0 ×10 0 = a m-1 ×(1 + 999...9) + a m-2 ×(1 + 99...9) + ... + a 1 ×(1 + 9) + a 0 ×1 = (a m-1 + a m-2 + ... + a 0 ) + a m-1 ×(999...9) + a m-2 ×(99...9) + ... + a 1 ×9 ∴ nが3の倍数のとき、a m-1 + a m-2 + ... + a 0 は3の倍数 つまり1 + 2 + ... + mが3の倍数であったとすると、m桁のPandigital数の中に解は存在し得ないことが分かります。m = 8, 9のときがこの場合に該当するので、探索範囲を大きく減らせます。 Pandigital数 を作る際に数値を重複なく選ぶため、 Set::Object というCPANモジュールを使って簡単な集合演算を行っています。 #!/usr/bin/env perl; use strict; use warnings; use feature qw/say state/; use List::Util qw/sum/; use List::MoreUtils qw/none/; use Set::Object qw/set/; 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 ..

問題 原文 An irrational decimal fraction is created by concatenating the positive integers: 0.123456789101112131415161718192021... It can be seen that the 12 th digit of the fractional part is 1. If d n represents the n th digit of the fractional part, find the value of the following expression. d 1 × d 10 × d 100 × d 1000 × d 10000 × d 100000 × d 1000000 日本語訳 正の整数を順に連結して得られる以下の10進の無理数を考える: 0.123456789101112131415161718192021... 小数点第12位は1である. d n で小数点第n位の数を表す. d 1 × d 10 × d 100 × d 1000 × d 10000 × d 100000 × d 1000000 を求めよ. 解答 数列作って、繋げて、取り出して、掛け合わせる。おしまい。 #!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use List::Util qw/reduce/; my $n = 0; my $str = ''; $str .= $n++ while length $str <= 1_000_000; our ($a, $b); say reduce { $a * $b } map { substr $str, 10 ** $_, 1 } 0 .. 6;

問題 原文 If p is the perimeter of a right angle triangle with integral length sides, {a,b,c}, there are exactly three solutions for p = 120. {20,48,52}, {24,45,51}, {30,40,50} For which value of p ≤ 1000, is the number of solutions maximised? 日本語訳 辺の長さが{a,b,c}と整数の3つ組である直角三角形を考え, その周囲の長さをpとする. p = 120のときには3つの解が存在する: {20,48,52}, {24,45,51}, {30,40,50} p < 1000 で解の数が最大になる p を求めよ. 解答 問題の前提からp = a + b + cです。 三平方の定理よりa 2 + b 2 = c 2 で、p = a + b + c ⇒ c = p - (a + b)なので、cを消去して： a 2 + b 2 = (p - (a + b)) 2 = p 2 - 2p(a + b) + a 2 + 2ab + b 2 よってp 2 - 2p(a + b) + 2ab = 0であり、a、bが解のときpは偶数であることが分かります。 またこれをbについて解くとb = (2ap - p 2 ) / 2(a - p)なので、aの値を定めればbの値は一意に決まることが分かります。 結局各pについてa > bとなるまでaを一通り試すだけで良いことになります。 実のところ答えの3つ組を計算する必要はなかったりしますが、答えを出力した上でその数を数える形にしています。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use List::Util qw/reduce/; sub solutions($) { my $p = shift; return () unless $p % 2 == 0; my @solut

問題 原文 What is the largest 1 to 9 pandigital 9-digit number that can be formed as the concatenated product of an integer with (1,2, ... , n) where n > 1? 日本語訳 整数と(1,2,...,n) (n > 1) との連結積として得られる9桁のPandigital数の中で最大のものを答えよ. 解答 乗数が1, 2, ..., n (n > 1)で桁数は9なので、被乗数mは1から9999の範囲です。 範囲が分かれば後は簡単で、m×1から順に積を連結していって、丁度9桁となったときにPandigital数であればいいわけです。 Pandigital数 を定義通り考えれば「1から9のすべての数字が1回以上現れる数」ですが、この問題では桁数の制約からいずれの数字も1回ずつしか現れないため、「同じ数字が重複して出現せず、0が現れない数」に読み替えることができます。Perlだとこちらの方が正規表現マッチングが高速でした。 #!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use List::Util qw/max/; say max map { my $cat = ''; for (my $mul = 1; length $cat < 9; $cat .= $_ * $mul++) {} (length $cat == 9 and $cat !~ /0/ and $cat !~ /(\d).*\1/) ? $cat : () } 1 .. 9999;

問題 原文 Find the sum of the only eleven primes that are both truncatable from left to right and right to left. 日本語訳 右から切り詰めても左から切り詰めても素数になるような素数は11個しかない. 総和を求めよ. 解答 考え方は Problem 35 と同じで、切り詰めていくと途中で合成数になることが分かっている数を最初に除外しています。 0、4、6、8のいずれかの数字を含む場合は明らかに途中で偶数になりますが、2と5は少し特別で、数の一番上の桁にのみ現れた場合は除外できません。何故なら： 左から切り詰めたときは最初に取り除かれるので関係がない。 右から切り詰めていって最後の1桁になったとき、2と5は素数である。 からです。具体的には23と53がこのケースに該当するので、間違って除外すると処理が終わりません。 #!/usr/bin/env perl use strict; use warnings; use feature qw/say state/; use List::Util qw/sum/; 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 is_truncatable_prime($) { my $n = shift; return 0 if length $n == 1; return 0 if $n =~ /[0468]/; return 0 if $n =~ /.[25]/; return 0 unless is_prime $n; all { is_prime substr($n, $_) and

問題 原文 Find the sum of all numbers, less than one million, which are palindromic in base 10 and base 2. 日本語訳 100万未満で10進でも2進でも回文数になるような数の総和を求めよ. 解答 nで割り切れる数はn進法で表すと下の桁が0になります(e.g. 100 10 、32=20 16 、8=1000 2 )。 このような数は反転させると(先頭の0は無視するので)桁数が変わってしまうため、回文数になりません。よってこのような数は最初に除外できます。 この問題の場合、2か10で割り切れる数は解にならないことが分かります。10で割り切れるときは当然2でも割り切れるので、実際には2で割り切れるか調べれば十分です。 #!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use List::Util qw/sum/; sub is_palindromic($) { my $n = shift; $n eq reverse $n; } say sum grep { is_palindromic $_ and is_palindromic sprintf '%b', $_; } grep { $_ % 2 != 0 } 1 .. 1_000_000; 追記 値の範囲ですが、1,000,000まで探索する必要はありませんでした。 1から999まで探索して、それを反転させた数値と連結すれば偶数桁の回文数、その間に1つ数字を入れれば奇数桁の回文数が得られるので、探索範囲を絞った上に10進数の回文数判定も省けます。 少し長いですが、70倍ほど高速化できました。 use Scalar::Util qw/looks_like_number/; say sum grep { $_ <= 1_000_000 and is_palindromic sprintf '%b', $_; } map { my $half = $_; map { $half . $_ . reverse

問題 原文 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

問題 原文 Find the sum of all numbers which are equal to the sum of the factorial of their digits. 日本語訳 各桁の数の階乗の和が自分自身と一致するような数の総和を求めよ. 解答 Problem 30 とほぼ同じ問題なので、その時の解答を基にして考えます。 前回の問題と違うのは、0! = 1なので0を含む数字を含まない数字と同一視できない点です。 そこで正規化の際に0を省くのをやめて、例えば251と2501はそれぞれ125と0125として別に扱うことにします。 また0! = 1!なので、例えば110と100のように各桁の階乗の和が同じになる数が存在し、これを重複して数えないようにしなければなりません。 既に数えた値を連想配列で覚えておいてもいいのですが、 List::MoreUtils の uniq 関数で重複要素を前もって削除する方が高速でした。 #!/usr/bin/env perl; use strict; use warnings; use feature qw/say/; use List::Util qw/sum reduce/; use List::MoreUtils qw/uniq/; sub factorial($) { our ($a, $b); my $n = shift; return 1 if $n == 0; return reduce { $a * $b } 1 .. $n; } my @facts = map { factorial $_ } 0 .. 9; my $max_digits; for ($max_digits = 1; 10 ** $max_digits <= $max_digits * $facts[9]; $max_digits++) {} my @sum_dicts = ({}, { map { ($_ => $facts[$_]) } 0 .. 9 }); until ($#sum_dicts == $max_digits) { push @sum_dicts, { map { my $prev_key

問題 原文 The fraction 49/98 is a curious fraction, as an inexperienced mathematician in attempting to simplify it may incorrectly believe that 49/98 = 4/8, which is correct, is obtained by cancelling the 9s. We shall consider fractions like, 30/50 = 3/5, to be trivial examples. There are exactly four non-trivial examples of this type of fraction, less than one in value, and containing two digits in the numerator and denominator. If the product of these four fractions is given in its lowest common terms, find the value of the denominator. 日本語訳 49/98は面白い分数である. 「分子・分母の9をキャンセルしたので 49/98 = 4/8 が得られた」と経験を積んでいない数学者が誤って思い込んでしまうかもしれないからである. 我々は 30/50 = 3/5 のようなタイプは自明な例だとする. 1より小さく分子・分母がともに2桁の数になるような自明でない分数は 4個ある. その4個の分数の積が約分された形で与えられたとき, 分母の値を答えよ. 解答 どうも「自明でない分数」の基準がよく分かりませんが、「分子・分母に共通する数字を取り除いたとき、元の分数と同じ値になるような分数(ただし分子・分母が10の倍数である場合を除く)」みたいです。 分数を (numerator, denominator) というリストの形で扱うことにして、「共通する数字を取り除いた1桁/1桁の分数で、通分した結果が元の分数のそれと等しい」という長ったら

問題 原文 Find the sum of all products whose multiplicand/multiplier/product identity can be written as a 1 through 9 pandigital. 日本語訳 掛けられる数/掛ける数/積に1から9の数が1回ずつ出現するような積の総和を求めよ. 解答 n桁×m桁の数の積はn+m-1桁かn+m桁になる(e.g. 10×10=100, 99×99=9,801)ので、桁数の合計が9になるとき、積の桁数は4桁であることが分かります。つまり、調べる積の範囲は1,000から9,999までとなります。 あとは数字が重複していないかどうかの判定ですが、積・乗数・被乗数を並べて数字列を作り、小さい順に並べ替えて123456789になれば重複していないことになります。 例えば4396=28×157の場合、並べて書くと439628157という数字列ができます。これを並べ替えると123456789になりますから、4396は答えの1つであることが分かります。 乗数の取り得る範囲は1から積の平方根の間ですが、1の時は積と被乗数が同じになるので明らかに答えではありません。従って2から開始すると少しだけ早くなります。 #!/usr/bin/env perl use strict; use warnings; use feature qw/say/; use List::Util qw/sum/; use List::MoreUtils qw/any/; say sum grep { my $n = $_; any { join('', sort split //, $n . $_ . $n / $_) eq '123456789'; } grep { $n % $_ == 0 } 2 .. sqrt $n; } 1000 .. 9999;

問題 原文 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

問題 原文 Find the sum of all the numbers that can be written as the sum of fifth powers of their digits. 日本語訳 各桁を5乗した和が元の数と一致するような数の総和を求めよ. 解答 まず探索範囲の上限を定める必要があります。n桁の最大の整数a n = 9 n-1 9 n-2 ...9 0 を考えると、その各桁の5乗の和はb n = 9 5 nと表せます。 a n+1 = 10a n + 9 b n+1 = b n + 9 5 ですから、桁数nが大きくなるにつれてaがbよりも急激に大きくなるのが分かります。ある桁数n max を超えると、常にa n max > b n max が成立するので、両者が等しくなることはなくなります。 実際に調べるとn max は6なので、探索範囲は高々0から999,999までとなります。 各桁の乗数の和は、桁の並びに関わらず各桁の数のみによって決まります。例えば2501、5012、(0)215のいずれも同じb n を持つので、これを別々に計算するのは時間の無駄です。 そこで、このような数をすべて同値と見なす正規化を考えます。手っ取り早く桁の並べ替えで良いでしょう。各桁を昇順に並べ替え、その上で先頭に1個以上0があったら取り除くという処理です。先ほどの例に挙げた数字をこの方法で正規化すると、いずれも125となります。 この正規化された数のみを走査すれば良いわけですから、（0を含まない）n桁の数1つにつき同じ値をn!通り計算していたところが、1通りで済むことになります。 処理の手順をまとめると次のようになります： 全ての正規化された数に対してb n を計算し、連想配列に格納しておく。 連想配列に格納された値を1つ取り出し、a n とする。 a n を正規化して連想配列から対応するb n を引く。 a n = b n であれば解に加える。 連想配列の値を全て走査するまで2.に戻って繰り返す。 下記のコードでは初期化の都合上、桁数ごとに連想配列を分けていますがアルゴリズム自体に違いはありません。 #!/usr/bin/env perl

こんばんは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 a b 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というのも芸がないし、少し頭を使って解いてみることにしました。 a b = (a n ) b/n であることに着目しましょう。これは中学だか高校だかで習った通りです。ただし問題の範囲は整数なので、指数は2 ≤ b/n ≤ 100なる整数でなければなりません。つまりnはbの約数（ただしb自身を除く）です。 この等号で結ばれたべき乗は同じ（つまり重複した）値を持ちます。 例えば2 12 = 4(=2 2 ) 6 = 8(=2 3 ) 4 = 16(=2 4 ) 3 = 64(=2 6 ) 2 = 4,096であり、他に4,096となるようなべき乗は整数の範囲ではなさそう

問題 再開言っておきながら10日も開いてしまいました。今度こそ再開します。きっと。 原文 What is the sum of both diagonals in a 1001 by 1001 spiral formed in the same way? 日本語訳 1001・1001の螺旋を同じ方法で生成したとき, 対角線上の数字の合計はいくつだろうか? 解答 1周する毎に数字の間隔が2広がるわけですから、単純に書いて十分早く答えが出ます。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; my $sum = 1; for (my ($i, $step) = (1, 2); $i < 1001 * 1001; $step += 2) { $sum += $i += $step for 1 .. 4; } say $sum;

問題 しばらく止まってましたが今日から再開。 原文 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)

問題 原文 Find the value of d < 1000 for which 1/d contains the longest recurring cycle in its decimal fraction part. 日本語訳 d < 1000 なる 1/d の中で循環節が最も長くなるような d を求めよ。 解答 筆算の過程から類推できるように、この問題は同じ余りが出るまでの間隔を調べる問題に置き替えることができます。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use List::Util qw/reduce/; sub rec_cycle_period($$) { my ($deno, $upper_lim) = @_; my %appeared_rems; my $remainder = 10; my $i = 0; do { return 0 if $remainder == 0; return -1 if $i >= $upper_lim; $appeared_rems{$remainder} = $i++; $remainder %= $deno; $remainder *= 10; } until exists $appeared_rems{$remainder}; return $i - $appeared_rems{$remainder}; } say map { $_->[0] } reduce { $a->[1] > $b->[1] ? $a : $b } map { [$_, rec_cycle_period($_, 1000)] } 1 .. 1000;

問題 原文 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))

問題 原文 What is the millionth lexicographic permutation of the digits 0, 1, 2, 3, 4, 5, 6, 7, 8 and 9? 日本語訳 0,1,2,3,4,5,6,7,8,9からなる順列を辞書式に並べたときの100万番目を答えよ 解答 n (> 0)桁目の数字が決まると残りの数字の順列は(n - 1)!通りですから、一般にn桁の順列の（0から数えて）m番目というとき、m = p n (n - 1)! + p n-1 (n - 2)! + ... + p 1 (0)! (0 <= p i < i)と表すと、p n , p n-1 , ..., p 1 の値は一意に定まります。 よってn桁目の数字を決めるとき、その時点で使える数字を昇順に並べた中からp n 番目の数字を選ぶという操作をn = 1まで繰り返すことで解が得られます。 (use srfi-1) (define (factorial n) (apply * (iota n 1))) (define (solve) (define (solve-1 n digits acc) (if (null? digits) (list->string (map integer->digit (reverse acc))) (let* ((fact (factorial (- (length digits) 1))) (mult (floor (/ n fact))) (digit (ref digits mult)) (rest (remove (cut = digit <>) digits))) (solve-1 (- n (* fact mult)) rest (cons digit acc))))) (solve-1 (- 1000000 1) (iota 10) '())) (define (main argv) (display (solve)) (newline))

問題 原文 Find the sum of all the positive integers which cannot be written as the sum of two abundant numbers. 日本語訳 2つの過剰数の和で書き表せない正の整数の総和を求めよ. 解答 Problem 21 を解くときに使った divisors を流用してブルートフォース。 small-sigma は 約数関数 です。 (use srfi-1) (define (divisors n) (define (divisor? m) (zero? (reremainder n m))) (let loop ((i 1) (early '()) (later '())) (if (> (* i i) n) (append-reverse early later) (cond ((= (* i i) n) (loop (+ i 1) (cons i early) later)) ((divisor? i) (loop (+ i 1) (cons i early) (cons (/ n i) later))) (else (loop (+ i 1) early later)))))) ;;; divisor function (define (small-sigma x n) (apply + (map (cut expt <> x) (divisors n)))) (define small-sigma1 (cut small-sigma 1 <>)) (define (abundant-number? n) (< (* 2 n) (small-sigma1 n))) (define (get-sieve upper-limit) (define lookup-table (make-vector (+ upper-limit 1) #f)) (define (sum-of-abundants? n) (ref lookup-table n)) (define abunda

問題 原文 What is the total of all the name scores in the file? 日本語訳 ファイル中の全名前のスコアの合計を求めよ. 解答 まさにPerlにうってつけの問題です。どこらへんに数学が必要なのかよく分かりません。 ファイルの中身はダブルクォートで囲まれた名前のカンマ区切りリストです。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use List::Util qw/sum/; open my $input, 'names.txt' or die $!; my @names = sort map { /([A-Z]+)/; $1 } split /,/, do { local $/; <$input> }; my $line_no = 1; my $total_score = 0; my $ord_A = ord 'A'; for my $name (@names) { $total_score += $line_no++ * sum map { ord($_) - $ord_A + 1 } split //, $name; } say $total_score;

問題 原文 Evaluate the sum of all the amicable numbers under 10000. 日本語訳 10000未満の友愛数の合計を求めよ。 解答 ほとんど書き下しただけです。注意点は 完全数 を計算に含めないことくらいでしょうか。 (use srfi-1) (define (divisors n) (define (divisor? m) (zero? (remainder n m))) (let loop ((i 2) (early '()) (later '())) (if (> (* i i) n) (cons 1 (append-reverse early later)) (cond ((= (* i i) n) (loop (+ i 1) (cons i early) later)) ((divisor? i) (loop (+ i 1) (cons i early) (cons (/ n i) later))) (else (loop (+ i 1) early later)))))) (define (d n) (apply + (divisors n))) (define (amicable-number? n) (define m (d n)) (and (not (= n m)) (= n (d m)))) (define (solve) (apply + (filter amicable-number? (iota (- 10000 1) 1)))) (define (main argv) (display (solve)) (newline))

問題 原文 Find the sum of the digits in the number 100! 日本語訳 100! の各桁の数字の合計を求めよ。 解答 毎度のことですがMath::BigIntのお世話になりました。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use List::Util qw/sum reduce/; use Math::BigInt; sub factorial(_) { no warnings qw/once/; my $n = shift; return 1 if $n == 0; reduce { Math::BigInt->new($a) * Math::BigInt->new($b) } 1 .. $n; } say sum split //, factorial(Math::BigInt->new(100));

問題 原文 How many Sundays fell on the first of the month during the twentieth century (1 Jan 1901 to 31 Dec 2000)? 日本語訳 20世紀（1901年1月1日から2000年12月31日）で月の初めの日曜日の数を数えよ。 解答 単純な2重ループで足し合わせていくだけです。 (use srfi-1) (define (leap-year? year) (cond ((and (zero? (remainder year 100)) (not (zero? (remainder year 400)))) #f) ((zero? (remainder year 4)) #t) (else #f))) (define (days-of year month) (case month ((1 3 5 7 8 10 12) 31) ((4 6 9 11) 30) ((2) (if (leap-year? year) 29 28)))) (define (day-of-week-after wday days) (define offset (case wday ((Sun) 0) ((Mon) 1) ((Tue) 2) ((Wed) 3) ((Thu) 4) ((Fri) 5) ((Sat) 6))) (list-ref '(Sun Mon Tue Wed Thu Fri Sat) (remainder (+ offset days) 7))) (define (solve) (define wday-of-1-Jan-1901 (day-of-week-after 'Mon (apply + (map (cut days-of 1900 <>) (iota 12 1))))) (let ye

問題 原文 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

問題 原文 If all the numbers from 1 to 1000 (one thousand) inclusive were written out in words, how many letters would be used? 日本語訳 1 から 1000 (one thousand) までの数字をすべて英単語で書けば、全部で何文字になるか。 解答 どう考えても数値計算じゃなくて文字列処理の問題です。つまりPerlの出番です。 数値を英語表現に変換する必要がありますが、 Lingua::EN::Numbers というCPANモジュールがまさにその機能を持っています。 以前のバージョンではイギリス/アメリカ英語の切り替え機能を持っていたようですが、現在は削除されています。生成される英語表現はイギリス英語が元になっているようなので、当座の用は満たせます。 コードの本質的な箇所ではありませんが、Perl 5.10から関数プロトタイプに _ を指定できるようになりました。 これを使うと、引数が省略されたとき $_ の値を使うという組み込み関数と同様の挙動を簡単に実現できます。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use Lingua::EN::Numbers qw/num2en/; use List::Util qw/sum/; sub num_of_chars_in_english(_) { my $english_expr = num2en shift; $english_expr =~ tr/a-z//; } say sum map { num_of_chars_in_english } 1 .. 1000;

問題 原文 What is the sum of the digits of the number 2^(1000)? 日本語訳 2 1000 の各数字の合計を求めよ。 解答 Gaucheの整数精度は無制限（実はR5RSでは要求されていない。驚き）なので特に悩む必要はありません。 (define (solve) (apply + (map digit->integer (string->list (number->string (expt 2 1000)))))) (define (main argv) (display (solve)) (newline)) ついでにPerl 5.10の一行野郎。 perl -Mbigint -MList::Util=sum -E"say sum split //, 2 ** 1000"

問題 原文 How many routes are there through a 20・20 grid? 日本語訳 20 ・ 20 のマス目ではいくつのルートがあるか。 解答 グリッド上の座標を(x, y)で表すこととし、左上の始点を(0, 0)、右下の終点を(20, 20)と定めます。 座標(x, y)から(20, 20)へのルート数をroutesFrom(x, y)と書くことにすると、この問題はroutesFrom(0, 0)を求める問題に相当します。 routesFrom(x, y)は次のようにして求められます： routesFrom(x, y) = 1 (x = 20, y = 20) routesFrom(x, y) = 0 (x > 20 or y > 20) routesFrom(x, y) = routesFrom(x + 1, y) + routesFrom(x, y + 1) (otherwise) routesFrom(0, 0)の計算量はグリッドの大きさnの増加に対応して急激に大きくなります（多分計算量の上限はO(2^n)くらい）。 routesFrom(0, 0) = routesFrom(1, 0) + routesFrom(0, 1) = routesFrom(2, 0) + routesFrom(1, 1) + routesFrom(1, 1) + routesFrom(0, 2) = ...といったように、基底ケース（上の1.と2.）に行き当たるまで倍々に項が増えていきます。今回はn=20なので、このままでは現実的な時間内に終わりません。 別々のルートが同じ座標を通ることはよくあります。先ほどの展開でroutesFrom(1, 1)という項が2回出てきているのは、(0, 0)から(1, 1)に至るルートが2つ存在するからです。 その座標に至るまでのルートに関わらずそれ以降に取り得るルートの数は同じなので、routesFrom(x, y)の値をメモ化することで膨大な計算を省くことができます。 (use srfi-1) (define (count-routes num-cells) (define lookup-table (make-vector (

問題 ある関数を繰り返し適用して得られる数列が最も長くなる初期値n（1,000,000未満）を求める問題です。 原文 日本語訳 解答 nから始まる数列の長さをlen(n)で表すと、次のように定義できます： len(n) = 1 (n = 1) len(n) = len(3n + 1) + 1 (nは奇数) len(n) = len(n / 2) + 1 (nは偶数) つまり、len(n)の計算は1.の場合を基底ケースとする再帰アルゴリズムとして実装できます。 これをそのまま実装しても答えが得られますが、非常に遅いです。高速化の為に少し検討を加えましょう。 まず56から始まる数列を考えます。56は偶数なので3.の場合に該当し、len(56) = len(56 / 2) + 1 = len(28) + 1です。また、9から始まる数列の場合は2.に該当し、len(9) = len(3 * 9 + 1) + 1 = len(28) + 1となります。 つまりlen(56) = len(9) = len(28) + 1というわけで、len(56)とlen(9)の値は実は同じです。2.と3.の再帰式を見て予想できるように、このような重複は度々起こるので、それぞれの計算でlen(28)の計算をやり直すようなことをしていると大きな無駄となります。 これを解決するには過去に計算したlen(n)の値を覚えておき、次に同じnが与えられた時には覚えていた値を返すようにします。そうすることで2度目以降の関数呼び出しでは計算を省くことができ、時間の節約になります。これは同じ引数に対して常に同じ値を返す（つまり参照透過性がある）関数一般に使えるテクニックで、これを メモ化 と呼びます。 そう言うわけで長々と説明しましたが、要は Problem 10 で使ったルックアップ・テーブルと同じものです。今回はクロージャ生成時に確保されたベクタの長さより大きい n が与えられる場合（十分大きい奇数が与えられた時）が有り得るので、上限（ upper-limit ）より大きい n に対してはその都度計算し直しています。 (use srfi-1) (define (get-sequence-length next-value upper-limit)

問題 原文 Work out the first ten digits of the sum of the following one-hundred 50-digit numbers. 日本語訳 以下の50桁の数字100個の総和の上位10桁を求めよ。 解答 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use Math::BigInt; my $result = Math::BigInt->new(0); $result += $_ for <DATA>; say substr($result, 0, 10); __DATA__ 37107287533902102798797998220837590246510135740250 46376937677490009712648124896970078050417018260538 74324986199524741059474233309513058123726617309629 91942213363574161572522430563301811072406154908250 23067588207539346171171980310421047513778063246676 89261670696623633820136378418383684178734361726757 28112879812849979408065481931592621691275889832738 44274228917432520321923589422876796487670272189318 47451445736001306439091167216856844588711603153276 70386486105843025439939619828917593665686757934951 62176457141856560629502157223196586755079324193331 64906352462741904929101432445813822663347944758178 9257586771833721766196375159057923972824559883

問題 原文 What is the value of the first triangle number to have over five hundred divisors? 日本語訳 501 個以上の約数をもつ最初の三角数はいくらか。 解答 約数の個数は素因数分解の結果から求めることができます。 例えばn = p a * q b （pとqは素数）という合成数がある場合、約数は以下の表のようになります： 1 p p 2 ... p a q p * q p 2 * q p a * q q 2 p * q 2 p 2 * q 2 p a * q 2 ... q b p * q b p 2 * q b p a * q b p 0 = q 0 = 1であることを考えれば、0..aの(a + 1)通りのpのべき乗と、0..bの(b + 1)通りのqのべき乗を掛け合わせた数がnの約数であることが分かります。 これは素因数が3つ以上の場合も同様で、一般にp a * q b * r c * ...の約数は(a + 1)(b + 1)(c + 1)...個存在します。 Problem 3 で使った素因数分解を行う関数 factorize を改良し、各素因数について、べき乗回数をcdrに入れたペアのリストを返すようにしました。 (define (triangle-number n) (* (+ 1 n) (/ n 2))) (define (factorize n) (define max-divisor (floor->exact (sqrt n))) (define (factorize-1 n div result) (if (> div max-divisor) (if (= n 1) result (cons (cons n 1) result)) (let count ((n n) (i 0)) (define (divisor? m) (zero? (modulo n m))) (if (divisor? div) (count (/ n div) (+ i 1))

問題 原文 What is the greatest product of four adjacent numbers in any direction (up, down, left, right, or diagonally) in the 20・20 grid? 日本語訳 上下左右斜めのいずれかの方向で連続する4つの数字の積のうち最大のものを求めよ。 解答 単なる総当り問題です。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use List::Util qw/max reduce/; my @grid = map { chomp; [ split /\s+/ ] } <DATA>; my @products; OUTER: for (my $i = 0; $i < @grid; $i++) { my $curr_row = $grid[$i]; for (my $j = 0; $j < @$curr_row; $j++) { last OUTER if $i >= @grid - 3 and $j >= @$curr_row - 3; if ($j < @$curr_row - 3) { push @products, reduce { $a * $b } map { $grid[$i][$j + $_] } 0 .. 3; } if ($i < @grid - 3) { push @products, reduce { $a * $b } map { $grid[$i + $_][$j] } 0 .. 3; } if ($i < @grid - 3 and $j < @$curr_row - 3) { push @products, reduce { $a * $b } map { $grid[$i + $_][$j + $_] } 0 .. 3; } if ($i < @grid - 3 and $j >= 3) { p

問題 原文 Find the sum of all the primes below two million. 日本語訳 200万以下の全ての素数の和を計算しなさい. 解答 素数を探す点はProblem 7と同様ですが、2,000,000以下の素数は148,933個も存在するので計算量は文字通り桁違いです。 アルゴリズムを替えるほどではありませんが、以前のコードは大きなリストを何度もコピーし、 filter にかけているので低速です。 ベクタを使ったルックアップ・テーブルを事前に用意し、 filter の適用も1回に抑えることで3倍程度高速化しました。2以外の偶数が素数でないのは明らかなので、奇数のみを篩にかけ、後から2と cons しています。 SRFI-17の setter を使ってベクタの書き換えを抽象化しています。 (use srfi-1) (define (get-sieve upper-limit) (define lookup-table (make-vector (+ upper-limit 1) #t)) (define (prime? n) (ref lookup-table n)) (set! (setter prime?) (lambda (n retval) (set! (ref lookup-table n) retval))) (set! (prime? 0) #f) (set! (prime? 1) #f) (let sieve-evens ((i 4)) (unless (> i upper-limit) (set! (prime? i) #f) (sieve-evens (+ i 2)))) (let sieve-odds ((i 3)) (unless (> (* i i) upper-limit) (when (prime? i) (let inner-loop ((j (* i i))) (unless (> j upper-limit)

問題 原文 There exists exactly one Pythagorean triplet for which a + b + c = 1000. Find the product abc. 日本語訳 a + b + c = 1000となるピタゴラスの三つ組が一つだけ存在する. このa,b,cの積を計算しなさい. 解答 何の変哲もない2重ループです。 (define (square n) (* n n)) (define (solve) (let outer-loop ((i 1)) (let inner-loop ((j 1)) (define k (sqrt (+ (square i) (square j)))) (cond ((= (+ i j k) 1000) (* i j (inexact->exact k))) ((> (+ i j k) 1000) (outer-loop (+ i 1))) (else (inner-loop (+ j 1))))))) (define (main argv) (display (solve)) (newline))

問題 原文 Find the greatest product of five consecutive digits in the 1000-digit number. 日本語訳 1000桁の数字から5つの連続する数字を取り出してその積を計算する。そのような積の中で最大のものの値はいくらか。 解答 計算よりデータの読み込みが面倒です。Perl 5を使って解くことにしました。 do { local $/; <FILE_HANDLE> } はファイル一気読みのイディオムですが、改行文字を落とすために grep をかけています。 #!/usr/bin/perl use strict; use warnings; use feature qw/say/; use List::Util qw/reduce/; my @digits = do { local $/; grep /\d/, split //, <DATA> }; my $max = 0; until (5 > @digits) { no warnings qw/once/; my $product = reduce { $a * $b } @digits[0 .. 4]; $max = $product if $max < $product; shift @digits; } say $max; __DATA__ 73167176531330624919225119674426574742355349194934 96983520312774506326239578318016984801869478851843 85861560789112949495459501737958331952853208805511 12540698747158523863050715693290963295227443043557 66896648950445244523161731856403098711121722383113 62229893423380308135336276614282806444486645238749 303589072962904915604407723907138105158593079608

Haskellの有名な特徴として、関数が勝手に カリー化 されるという点があります。 要するにHaskellの関数は常に部分適用可能になっていて、 f foo bar baz という関数適用は (((f foo) bar) baz) と解釈されています。これは非常に強力な機能で、汎用的な関数を目的に合わせて簡単に特殊化することができます。 Schemeやその他のLispでは、引数は必ず同時に与えないといけないので、カリー化したものを作ろうとするとクロージャを使って (define f (lambda (x) (lambda (y) (lambda (z) ...)))) とでもしなければなりません。しかも呼び出すときには (((f foo) bar) baz) と、1つずつ順番に適用する必要があります。 私が欲しいのは、"（Haskellが透過的にやっているように）与えられた引数を先頭から順に束縛し、足りない分を引数とするクロージャを返す"ような関数です。 ((f foo) bar baz) だろうが (f foo bar baz) だろうが (((f foo) bar) baz) だろうが同じ結果を返す関数を作りたいわけです。そこで、カリー化関数を作成するマクロを書きました。 (define-syntax curry (syntax-rules () ((_ (arg0) body ...) (lambda (arg0) body ...)) ((_ (arg0 arg1 ...) body ...) (lambda (arg0 . rest) (define applied (curry (arg1 ...) body ...)) (if (null? rest) applied (apply applied rest)))))) このマクロを使って作成した関数は、引数を先頭から束縛していき、すべての引数が揃ったときに値を返します。 (define greet (curry (when who) (display (string-append "

問題 原文 What is the 10001st prime number? 日本語訳 10001 番目の素数を求めよ。 解答 素数判定といえば エラトステネスの篩 という有名なアルゴリズムがあります。 それを実装したのが下記の eratos で、与えられたリスト（昇順に並んでいると仮定）を篩にかけ、残った数値をリストにして返します。リストを先頭の要素と残りに分割するというのはHaskellやPerlなどでよく見かけるパターンですが、SchemeでもSRFI-1の car+cdr を使って簡潔に書けます。 take-primes は与えられた個数以上の素数が得られるまで、リストを拡張しながら eratos を繰り返し適用し、得られたリストから与えられた個数の素数を返します。 (use srfi-1) (define (eratos xs) (define (eratos-1 xs result) (if (null? xs) (reverse result) (let ((last-num (last xs))) (receive (n ns) (car+cdr xs) (if (< last-num (* n n)) (append (reverse result) xs) (let ((not-multiple-of-n? (lambda (m) (not (zero? (modulo m n)))))) (eratos-1 (filter not-multiple-of-n? ns) (cons n result)))))))) (eratos-1 xs '())) (define (take-primes num-primes) (define (take-primes-1 primes) (if (< num-primes (length primes)) (take

問題 原文 Find the difference between the sum of the squares of the first one hundred natural numbers and the square of the sum. 日本語訳 最初の100個の自然数について和の二乗と二乗の和の差を求めよ。 解答 これまた簡単な問題。ほとんど問題を書き下すだけの作業です。 (use srfi-1) (define (solve) (define nums (iota 100 1)) (define sum-of-squares (apply + (map (lambda (n) (expt n 2)) nums))) (define square-of-sum (expt (apply + nums) 2)) (- square-of-sum sum-of-squares)) (define (main argv) (display (solve)) (newline))

問題 原文 What is the smallest number that is evenly divisible by all of the numbers from 1 to 20? 日本語訳 1 から 20 までの整数全てで割り切れる数字の中で最小の値はいくらになるか。 解答 いきなり難易度が下がりました。人はそれを最小公倍数と呼びます。 Schemeには組み込み関数 lcm があるので、何も面白くありません。 (use srfi-1) (define (solve) (apply lcm (iota 20 1))) (define (main argv) (display (solve)) (newline)) これでおしまい。せっかくなのでPerl 6版の gcd / lcm 関数でも貼っておきます。 subset NonZeroInt of Int where { $_ != 0 } sub gcd(NonZeroInt $m is copy, NonZeroInt $n is copy, NonZeroInt *@rest) { $m = -$m if $m < 0; $n = -$n if $n < 0; $m, $n = $n, $m if $m < $n; my Int $mod = $m % $n; my Int $gcd = $mod == 0 ?? $n !! gcd($n, $mod); +@rest == 0 ?? $gcd !! gcd($gcd, |@rest); } sub lcm(NonZeroInt $m is copy, NonZeroInt $n is copy, NonZeroInt *@rest) { $m = -$m if $m < 0; $n = -$n if $n < 0; my Int $lcm = $m * $n / gcd($m, $n); +@rest == 0 ?? $lcm !! lcm($lcm, |@rest); }

問題 原文 Find the largest palindrome made from the product of two 3-digit numbers. 日本語訳 3桁の数の積で表される回文数のうち最大のものはいくらになるか。 解答 3桁の数値なので、考えられる項は100 .. 999です。つまりナイーブな実装では、900 * 900 = 810,000回の乗算を行う必要があります。これは不可能な大きさではありません。というより私がまともな解法を思いつかないので、今回はこれで。 まず回文数かどうか判定する述語を作ります。 palindromic-number? という関数がそれです。やっていることは単純で、数値を文字列に変換した上で反転したものと比較しているだけです。文字列の反転はSRFI-13の string-reverse で可能です。 実際には文字列の前半と、反転させた後半のみを比較すれば良いのですが、文字列を切り出すコストの方が高いのでそのまま比較しています。 実際の探索を行っている solve は単純で、すべての積を計算した上で、その中から回文数をSRFI-1の filter で抽出してリスト palins とし、そこから max で最大値を選び出します。 簡単な最適化として、例えば100 * 101と101 * 100は同じなので、無駄な計算を省くために100 <= i <= j <= 999が常に成り立つように内側の map に渡すリストを工夫しています。これによって乗算の回数をおよそ半分にできます。 これまでの問題がミリ秒単位で計算できたのに比べると今回のプログラムは時間がかかりますが、数秒で計算できると思います。 (use srfi-1) (use srfi-13) (define (palindromic-number? n) (define n-str (number->string n)) (string=? n-str (string-reverse n-str))) (define (solve) (define palins (filter palindromic-number? (apply append

問題 原文 What is the largest prime factor of the number 600851475143 ? 日本語訳 600851475143 の素因数のうち最大のものを求めよ。 解答 いきなり難易度が上がりました。素因数分解の問題です。 結局のところ片っ端から割ってみるしかないのですが、探索範囲を狭めることはできます。 正の整数の範囲で考えると、l = m * nかつm >= nであれば、floor(sqrt(l)) >= nであることが直感的に分かります。ここでfloorは実数を0の方向に丸めて整数にする関数、sqrtは平方根を返す実数関数です。 nが分かれば、mは除算で求められます。つまりlが与えられた時、それを2つの因数に分解するのに探索する範囲は高々2 .. floor(sqrt(l))で十分ということです。 2つに分けられたならこっちのもの、得られたmとnを再帰的に分解して、その結果を合わせれば素因数分解の結果が得られます。 アルゴリズムを書き下すと次のようになります： n <- floor(sqrt(l))とする。 n = 1なら、これ以上は分解できない（lは素数である）のでlをそのまま返す。 nがlの因数なら、m <- l / nとし、mとnに対してこのアルゴリズムを再帰的に適用し、その結果を連結して返す。 因数でないなら、n <- n - 1とし、2.から繰り返す。 これで計算は可能です。しかしもう少し最適化を検討してみましょう。 偶数は一般に2mの形で表せます。同様に奇数は2m + 1と書けます。 偶数同士の積は2m * 2n = 4mnとなり、l = 2mnとおけば2lなのでこれも偶数です。 奇数同士の積は(2m + 1)(2n + 1) = 4mn + 2(m + n) + 1であり、l = 2mn + m + nとすると2l + 1なのでこれも奇数です。 偶数と奇数の積は2m(2n + 1) = 4mn + 2mなので、l = 2mn + mとおいて2lなので偶数です。 つまり、奇数の因数は必ず奇数のみから成るということが分かります。先ほどのアルゴリズムでは、4.のステップでn <- n - 1としていました。

問題 4,000,000以下のフィボナッチ数列の偶数の総和を求める問題です。 原文 日本語訳 解答 これまた悩む部分はなし。フィボナッチ数列は指数関数的に大きくなるので、かなり早く答えが出ます。 SRFI-1の first と second はそれぞれリストの最初と次の要素を返すユーティリティ関数です。 (use srfi-1) (define (solve) (define fibos (let gen-fibos-loop ((fibos '(1 1))) (define next-val (+ (first fibos) (second fibos))) (if (> next-val 4000000) fibos (gen-fibos-loop (cons next-val fibos))))) (apply + (filter even? fibos))) (define (main argv) (display (solve)) (newline))

まず1問目から。日本語訳を公開してくれている Wiki があるのでそちらのページもリンクすることにします。 問題 原文 Find the sum of all the multiples of 3 or 5 below 1000. 日本語訳 1,000 未満の 3 か 5 の倍数になっている数字の合計を求めよ。 解答 最初の問題だけあって、別段難しくもありません。ほとんどFizzBuzz問題です。 0から999まで、公差1の等差数列から3あるいは5の倍数を抽出して合計すればいいわけです。 Scheme(Gauche)で書いてみました。 multiple-of? は n が m の倍数かどうかを示す述語で、 iota はSRFI-1に収録されているリスト構築子です。 (use srfi-1) (define (multiple-of? n m) (zero? (modulo n m))) (define (solve) (apply + (filter (lambda (n) (or (multiple-of? n 3) (multiple-of? n 5))) (iota 1000)))) (define (main argv) (display (solve)) (newline))

ようこそ。ここは情報工学を学ぶ一学生のブログです。 4月から大学編入生になるので、これからの学習記録や作ったものを公開していきたいと思います。 3月中は準備運転。当面は以前から挑戦していた Project Euler でも進めていきます。 本ブログの目標： 3日に1回以上更新、コンスタントに！ 文体はこだわらない。 ジャンルもこだわらない。ただし中心はプログラム。 私的なことや妄想はmixi。 ぼちぼちやっていきます。フィード購読してね！