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

投稿

Project Euler - Problem 28

問題 再開言っておきながら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;

Project Euler - Problem 27

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

Project Euler - Problem 26

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

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

Project Euler - Problem 24

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

Project Euler - Problem 23

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

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...