« 2009年2月 | トップページ | 2009年4月 »

2009年3月

2009年3月29日 (日)

困ったものです --- バグの混入

本当に困ったものです。

本日投稿した記事の中の手続きの一部にバグがあることに気付いちゃいま した。なんで、投稿する前に気付かないんだろう?

とういことで、とり急ぎ記事の訂正をしておきました。具体的には、 「sequence が 3 個の引数を取る場合」にちょっとしたバグが潜んでいまし た。

この手続きを使われる方は新しいバージョン(現在投稿し直された分)を使用 してください。

自作の手続きたち

Project Euler の問題を解くために自作の手続きを作っていたら、結構な数になったので、ここでまとめてグロブに載せておきます。(最新版を改めてこちらにまとめました : 2009/10/31)

ちなみに、処理系は Chez Scheme です。Gauche とは違った独自の拡張がされているので、多くの Gauche 使いの人は「ちょっと試しに使ってみる」というわけにもいかないかもしれませんが、少しでも Scheme を使っている人たちの役にたってくれればいいなあ……。

まず、今回紹介した手続きの中に含まれる、Chez 独自の拡張について簡単に紹介しておきます。詳しくは Chez Scheme のホームページにある『Chez Scheme Version 7 User's Guide (CSUG)』を見てください。

  • (isqrt n) : n の平方根の整数部分のみを返します。R5RSの手続きで定義するなら"(define isqrt (lambda (x) (inexact->exact (truncate (sqrt x)))))"でよいと思います。
  • (remv i lst) : lst から数値 i を取り除いたリストを返します。SRFI-1 の "delete" で代用できると思います。

続いて自作の手続きたちです。「参考になった」とか、「もっといい方法がある」といったご意見お待ちしてます。


注意1:最初に投稿したバージョンでは、「sequence が3個の引数を取る場合」に、ちょっとしたバグが紛れこんでいました。この記事は既に訂正されています。

注意2:人様のホームページからコピペさせてもらった手続きが紛れ込んでいました。出典は書いてありましたが、作者の方に無断で記事に書くのも気が引けるので、削除させていただきました。


;;; ;;; (sequence start end) ;;; (sequence start end step) ;;; ;;; * start 以上 end 以下の範囲の等差数列のリストを返す。 ;;; * step が省略された場合、step = 1 とみなされる。 ;;; * step が少数の場合、計算誤差がでる場合があるので注意。 ;;; * Chez Scheme の iota は開始する数やステップを指定できない ;;; (その代わりとても高速)ので、この手続きを作った。 ;;; (define sequence (case-lambda ([start end] (let ([size (- end start -1)]) (cond ([nonpositive? size] '()) ([= start 0] (iota size)) ([= start 1] (cdr (iota (+ size 1)))) (else (map (lambda (x) (+ x start)) (iota size)))))) ([start end step] (let* ([range (- end start)] [size (+ 1 (real->integer (/ (- end start) step)))]) (cond ([negative? (* range step)] '()) ([= start 0] (map (lambda (x) (* x step)) (iota size))) (else (map (lambda (x) (+ (* x step) start)) (iota size)))))))) ;;; ;;; (pred-list pred? n) ;;; (pred-list pred? n start) ;;; ;;; * pred? が真になる整数の n 番目までのリストを返す。 ;;; * start が指定されなれば "1" から探し始める。 ;;; (define pred-list (case-lambda ([pred? n] (pred-list pred? n 1)) ([pred? n start] (let loop ([count n] [i start]) (cond ([zero? count] '()) ([pred? i] (cons i (loop (- count 1) (+ i 1)))) (else (loop count (+ i 1)))))))) ;;; ;;; (prime? n) ;;; ;;; * n が「素数」なら #t ;;; (define prime?* (lambda (n) (cond ([not (integer? n)] #f) ([< n 2] #f) ([= n 2] #t) ([even? n] #f) (else (let ([i-max (isqrt n)]) (let loop ([i 3]) (cond ([> i i-max] #t) ([zero? (remainder n i)] #f) (else (loop (+ i 2)))))))))) ;;; ;;; (prime-list n) ;;; ;;; * 自然数 n 以下の素数のリストを返す。 ;;; * Ruby の"sample/sieve.rb" のアルゴリズムを改良して使用。 ;;; (define prime-list (lambda (n) (cond ([< n 2] '()) ([= n 2] '(2)) (else ;; エラトステネスの篩 (let* ([p-vct (list->vector (cons 0 (sequence 3 n 2)))] ;; p-vct = #(3 5 7 ...) [size (vector-length p-vct)] [max (isqrt n)]) (let loop1 ([i 1]) (let ([j (vector-ref p-vct i)]) (cond ([zero? j] (loop1 (+ i 1))) ([> j max] (cons 2 (remv 0 (vector->list p-vct)))) (else (let loop2 ([k (* 2 i (+ i 1))]) (if [>= k size] (loop1 (+ i 1)) (begin (vector-set! p-vct k 0) (loop2 (+ j k)))))))))))))) ;;; ;;; (prime-list* n) ;;; ;;; * n 以下の素数のリストを返す。 ;;; * prime-list よりかなり遅い。 ;;; (define prime-list* (lambda (n) (cond ([< n 2] '()) ([= n 2] '(2)) (else (let ([n-max (isqrt n)]) (let loop ([lst (sequence 3 n 2)] [result '()]) (let ([a (car lst)]) (if [> a n-max] (cons 2 (append (reverse result) lst)) (loop (filter (lambda (x) (> (remainder x a) 0)) (cdr lst)) (cons a result)))))))))) ;;; ;;; (factorize n) ;;; ;;; * 自然数 n を素因数分解した要素のリストを返す。 ;;; ex : (factorize 12) => ((2 . 2) (3 . 1)) ;;; ex : (map (lambda (lst) ;;; (make-list (cdr lst) (car lst))) ;;; (factorize 12)) ;;; => ((2 2) (3)) ;;; (define factorize (lambda (n) (define result '()) (define check (lambda (n i) (let loop ([n n] [c 0]) (if [zero? (remainder n i)] (loop (/ n i) (+ c 1)) (begin (if [> c 0] (set! result (cons (cons i c) result))) n))))) (let loop ([n (check n 2)] [i 3]) (cond ([= n 1] (reverse result)) ([> (* i i) n] (reverse (cons (cons n 1) result))) (else (loop (check n i) (+ i 2))))))) ;;; ;;; (divisor n) ;;; ;;; * 自然数 n の約数のリストを返す。 ;;; (define divisor (lambda (n) (let* ([a (filter (lambda (x) (zero? (remainder n x))) (sequence 1 (isqrt n)))] [b (map (lambda (x) (/ n x)) a)]) (if (integer? (sqrt n)) (append a (cdr (reverse b))) (append a (reverse b)))))) ;;; ;;; (divisor2 n) ;;; ;;; * 自然数 n の約数をリストを返す。 ;;; * 素因数分解をもとに約数を探す。 ;;; (define divisor2 (lambda (n) ;; ex : (2 . 3) => (1 2 4 8) (define spread (lambda (lst) (let ([b (car lst)] [i-lst (iota (+ 1 (cdr lst)))]) (map (lambda (x) (expt b x)) i-lst)))) ;; ex : (1 2 4) (1 3) => (3 6 12 1 2 4) (define distribute (lambda (lst1 lst2) (do ([ls lst2 (cdr ls)] [result '() (cons (map (lambda (x) (* x (car ls))) lst1) result)]) ([null? ls] (apply append result))))) (if [= n 1] '(1) (let ([lst (map spread (factorize n))]) (sort < (fold-left distribute (car lst) (cdr lst))))))) ;;; ;;; (factorial n) ;;; (factorial n m) ;;; ;;; * 引数が 1 個の場合 : n! ;;; * 引数が 2 個の場合 : 下降階乗冪 ;;; (define factorial (case-lambda ([n] (factorial n n)) ([m n] (apply * (sequence (- n m -1) n))))) ;;; ;;; (permutation n r) ;;; ;;; * 順列 nPr ;;; (define permutation (lambda (n r) (factorial n r))) ;;; ;;; (combination n r) ;;; ;;; * 組合せ nCr ;;; (define combination (lambda (n r) (/ (factorial n r) (factorial r)))) ;;; ;;; (real->integer n) ;;; ;;; * 実数の少数部分を切り捨てて、整数に変換する。 ;;; (define real->integer (lambda (n) (exact (truncate n)))) ;;; ;;; (sum-of-divisors n) ;;; ;;; * 真の約数の和を求める。(約数に n 自身は含まれない) ;;; (define sum-of-divisors (lambda (n) (- (apply + (divisor n)) n))) ;;; ;;; (integer->list n) ;;; (integer->list n radix) ;;; ;;; * 整数の各桁を要素とするリストを返す。 ;;; * radix を指定すると、radix を基数にしたリストを返す。 ;;; ex : (integer->list 123) => (1 2 3) ;;; ex : (integer->list 123 2) => (1 1 1 1 0 1 1) ;;; (define integer->list (case-lambda ([n] (integer->list n 10)) ([n radix] (do ([n n (quotient n radix)] [result '() (cons (remainder n radix) result)]) ([< n radix] (cons n result)))))) ;;; ;;; (list->integer lst) ;;; (list->integer lst radix) ;;; ;;; * リストの要素を各桁とする整数を返す。 ;;; * radix を指定すると、radix を基数とした整数を返す。 ;;; ex : (list->integer '(1 2 3)) => 123 ;;; ex : (list->integer '(1 1 1 1 0 1 1) 2) => 123 ;;; (define list->integer (case-lambda ([lst] (list->integer lst 10)) ([lst radix] (fold-left (lambda (a b) (+ b (* radix a))) 0 lst)))) ;;; ;;; (sum-of-digits n) ;;; ;;; * 整数の各桁の合計を求める。 ;;; ex : (sum-of-digits 123) => 6 ;;; (define sum-of-digits (lambda (n) (apply + (integer->list n)))) ;;; ;;; (unique lst) ;;; ;;; * lst の重複する要素を取り除く。 ;;; ex : (unique '(a b a b c)) => (a b c) ;;; (define unique (lambda (lst) (if [null? lst] '() (let ([a (car lst)]) (cons a (unique (remove a (cdr lst)))))))) ;;; ;;; (pandigital? obj) ;;; ;;; * obj が 「Pandigital」ならば #t ;;; * obj は正の整数またはリスト。 ;;; * m 桁の数が Pandigital であるとは, 1 から m までの数を各桁に ;;; 1 つずつもつことである。 ;;; (define pandigital? (lambda (obj) (cond ([positive-integer? obj] (pandigital? (integer->list obj))) ([list? obj] (let* ([lst-a (list-head '(1 2 3 4 5 6 7 8 9) (length obj))] [lst-b (sort < obj)]) (equal? lst-a lst-b))) (else #f)))) ;;; ;;; (all-different? lst) ;;; ;;; * lst の要素がすべて異なれば #t ;;; (define all-different? (lambda (lst) (cond ([null? lst] #t) ([member (car lst) (cdr lst)] #f) (else (all-different? (cdr lst)))))) ;;; ;;; (palindromic? obj) ;;; ;;; * obj が「回文」なら #t ;;; * obj は正の整数またはリスト。 ;;; (define palindromic? (lambda (obj) (cond ([positive-integer? obj] (palindromic? (integer->list obj))) ([list? obj] (equal? obj (reverse obj))) (else #f)))) ;;; ;;; (make-palindromic-number n) ;;; (make-palindromic-number n #t) ;;; ;;; * 第 1 引数 n を上位の桁とする回文数を作る。 ;;; * 第 2 引数がない場合は奇数桁の回文数を作る。 ;;; * 第 2 引数が #t の場合、偶数桁の回文数を作る。 ;;; ex : (make-palindromic-number 123) => 12321 ;;; ex : (make-palindromic-number 123 #t) => 123321 ;;; (define make-palindromic-number (case-lambda ([n] (make-palindromic-number n #f)) ([n flag] (let* ([a (integer->list n)] [b (reverse a)]) (list->integer (append a (if flag b (cdr b))))))))

2009年3月23日 (月)

Project Euler --- Problem 4

問題は「3桁の数の積で表される回文数のうち最大のものはいくらになるか」というものでした。

まず初めに考えつくのが、3 桁 × 3 桁の数のうち回文数になるものを探し出していくというものでしょう。(解答例には「内包表記」が使用されています)

(define palindromic-number? (lambda (n) (palindromic-list? (integer->list n)))) (define problem-004 (lambda () (let ([lst (set-of c (a in (sequence 100 999)) (b in (sequence a 999)) (c is (* a b)) (palindromic-number? c))]) (printf "~d~%" (apply max lst))))) (problem-004)

でもこれは最大のものを 1 つ見つけるために約 400000 回計算することになるので、答えが出るまでにちょっと時間がかかります。


そこで、ちょっと考え方を変えてみます。

ある数の約数を小さい順に並べると、その数の平方根を挟んで近い順から 2 つの数をかけると、すべて元の数になりますよね。

例えば 12 の場合、約数は 1, 2, 3, 4, 6, 12 ですから、

3 x 4 = 12
2 x 6 = 12
1 x 12 = 12

となります。

3 桁 × 3 桁の数は 5 桁か 6 桁になります。

そこで、6 桁または 5 桁の回文数を大きい順に調べていって、その数の平方根を挟んで、3 桁の約数が並んでいるものを探せば、それが答えとなるはずです。

;;; 第 1 引数をもとにして、第 2 引数が #t なら偶数桁、 ;;; それ以外なら奇数桁の回文数を作る。 (define make-palindromic-number (lambda (n . flag) (let* ([flag (if [null? flag] #f (car flag))] [a (integer->list n)] [b (reverse a)]) (list->integer (append a (if flag b (cdr b))))))) (define problem-004 (lambda () ;; その数の平方根を挟んで一番近い 2 つの約数の組を探す。 (define find-divisor (lambda (n) (let loop ([m (isqrt n)]) (if [zero? (remainder n m)] (cons m (/ n m)) (loop (- m 1)))))) (define 3digits-pair? (lambda (pair) (let ([a (car pair)] [b (cdr pair)]) (and (and (> a 99) (< a 1000)) (and (> b 99) (< b 1000)))))) ;; まず、6 桁の回文数を調べる。 ;; もしなければ、5 桁の回文数を調べる。 (let loop ([n 997] [flag #t]) (if [< n 100] (if flag (loop 999 #f) #f) (let* ([p-num (make-palindromic-number n flag)] [pair (find-divisor p-num)]) (if [3digits-pair? pair] (printf "~d~%" p-num) (loop (- n 1) flag))))))) (problem-004)

この方法だと、最初の一つを見つければ計算が終わるので、私のパソコンでも短時間で答えが出ます。

$ time petite --script problem004.ss 906609 (= 913 * 993) real 0m0.355s user 0m0.216s sys 0m0.016s

REPL で実行した場合は次のようになりました。

> (time (problem-004)) 906609 (= 913 * 993) (time (problem-004)) no collections 20 ms elapsed cpu time 20 ms elapsed real time 42936 bytes allocated

ちなみに私のパソコンは Pentium 1500MHz, Ubuntu 8.10 で動いています。


追記:Project Euler - Problem 4 再びも参照してみてください。

2009年3月19日 (木)

Project Euler --- Problem 27 再び

最近、以前解いた問題を「リスト内包表記」で書き換えられないか試してます。 例えば、"Problem 27" を書き直したのが、次のコードです。

(define problem-027 (lambda () ;; (+ (* n n) (* a n) b) で n がいくつまで素数になるかを調べる。 ;; n < 40 の場合は 0 を返す。 (define check (lambda (a b) (let loop ([n 1]) (if [prime? (+ (* n n) (* a n) b)] (loop (+ n 1)) (if [> n 39] n 0))))) (let* ([lst (set-of (cons c (cons a b)) (b in (cdr (prime-list (- 1000 1)))) (a in (sequence (- (quotient (- b) 40) 40) 999)) (odd? a) (c is (check a b)) (> c 0))] [a-lst (car (sort (lambda (lst1 lst2) (> (car lst1) (car lst2))) lst))] [a (cadr a-lst)] [b (cddr a-lst)] [c (car a-lst)]) (printf "a:~d, b:~d, n:~d, a*b:~d~%" a b c (* a b)))))

ちょっとだけ、すっきりしたように思えます。スピードも若干速くなっています。自分で一生懸命考えたループより、 マクロの方が速いのがちょっとくやしいですが、「リスト内包表記」の威力を感じた問題でした。

2009年3月14日 (土)

アルゴリズムの重要性 Project Euler --- Problem 36

Project Euler の問題を解いていると、やっぱり他の人の解き方も見てみたくなりますよね。

そこでネット上にある解答例を探したりするのですが、最近、ちょっと気になることがあります。「取り合えず答えが出ればいい」といった雰囲気のコードが多いのです。

Project Euler に対するスタンスにはいろいろあると思います。

「なるだけ速く、多くの問題を解きたい」というのであれば、アルゴリズムを吟味する意味はあまりないのかもしれません。でも、プログラミングの勉強のために Project Euler の問題を解いているのなら、もう少しアルゴリズムに気を配るべきではないでしょうか?

ひとつの問題を解くためのアルゴリズムはいくつもあります。

中には膨大な計算量が必要となり、メモリや CPU の無駄使いをするものもあるかもしれません。しかし、ちょっと工夫をしたり、アルゴリズムを見直すと、驚くほど計算量を減らせることがあります。

例えば、Problem 36 を考えてみます。

「100 万未満で 10 進でも 2 進でも回文数になるような数の総和を求めよ。」という問題でした。

まず考えつくのが、1 から 999999 までの総ての数に対して条件にあるものを探して行くという方法だと思います。(今回のコードには「リスト内包表記」が含まれています。詳しくは、以前の記事を読んでください)

(define integer->list (lambda (n . radix) (let ([r (if [null? radix] 10 (car radix))]) (do ([n n (quotient n r)] [result '() (cons (remainder n r) result)]) ([< n r] (cons n result)))))) (define palindromic-list? (lambda (lst) (equal? lst (reverse lst)))) (define problem-036 (lambda () (let ([lst (set-of a (a in (cdr (iota 999999))) (odd? a) (palindromic-list? (integer->list a)) (palindromic-list? (integer->list a 2)))]) (printf "~d~%" (apply + lst))))) (time (problem-036))

探す範囲が広いのでかなり時間がかかります。私のパソコンでは "1558 ms elapsed cpu time" と表示されました。

ここでちょっと考え方を変えてみます。まず 10 進法で回文数を作っておいて、その数が 2 進法で回分数になるかを調べてみます。

(define make-palindromic-number (lambda (n . flag) (let* ([a (integer->list n)] [b (reverse a)]) (list->integer (append a (if [null? flag] (cdr b) b)))))) (define problem-036 (lambda () (let* ([base-lst (cdr (iota 999))] [lst-odd (set-of a (b in base-lst) (a is (make-palindromic-number b)) (odd? a) (palindromic-list? (integer->list a 2)))] [lst-even (set-of a (b in base-lst) (a is (make-palindromic-number b #t)) (odd? a) (palindromic-list? (integer->list a 2)))]) (apply + (append lst-odd lst-even))))) (time (problem-036))

この方法では "29 ms elapsed cpu time" となりました。速さにして、約 50 倍です。速さが総てとはいいませんが、アルゴリズムを見直すだけで、こんなに変わってくるものなのです。

使い捨てのスクリプトを作るのなら、あれこれアルゴリズムを吟味する前に、思いつくままにコードを書くほうが結果的に速いかもしれません。しかし、長い間使われ続けるプログラムを作る場合はアルゴリズムを十分吟味するべきだと思います。

最近のソフトは CPU の性能やメモリの量をかなり要求しているものがありますが、しっかりとしたアルゴリズムの検討がなされているのか疑問に思うことがあります。

私はアルゴリズムを考えるのが好きなので、一度解いた問題も、「もっといい方法があるのでは?」と見直し、考え直すことが多いので、なかなか先に進めません。

« 2009年2月 | トップページ | 2009年4月 »

2016年7月
          1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31            
フォト

最近のトラックバック

無料ブログはココログ