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

投稿

3月, 2009の投稿を表示しています

Project Euler - Problem 22

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

Project Euler - Problem 21

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

Project Euler - Problem 20

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

Project Euler - Problem 19

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

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 = ma

Project Euler - Problem 17

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

Project Euler - Problem 16

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

Project Euler - Problem 15

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

Project Euler - Problem 14

問題 ある関数を繰り返し適用して得られる数列が最も長くなる初期値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)

Project Euler - Problem 13

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

Project Euler - Problem 12

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

Project Euler - Problem 11

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

Project Euler - Problem 10

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

Project Euler - Problem 9

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

Project Euler - Problem 8

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

Schemeでカリー化

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 "

Project Euler - Problem 7

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

Project Euler - Problem 6

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

Project Euler - Problem 5

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

Project Euler - Problem 4

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

Project Euler - Problem 3

問題 原文 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としていました。

Project Euler - Problem 2

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

Project Euler - Problem 1

まず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))

0th post

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