僕のIT革命

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