« 2009年10月 | トップページ | 2009年12月 »

2009年11月

2009年11月30日 (月)

Haskell で fibonacci

 先日、『プログラミング Haskell』を購入しました。
 以前から「Haskell」に興味があったので、現在、『プログラミング Haskell』を読みながら手探りながら Haskell を勉強しています。

 とりあえず手始めに、フィボナッチ数列に関して関数を書いてみました。
 まず初めに書いたのは、以前 Scheme で作ったものを基にしたものでした。

fibonacci :: Int -> Integer fibonacci n = fib' n 1 1 where fib' 1 a _ = a fib' n a b = fib' (n - 1) b (a + b)

 さらに Haskell では無限リストも扱えるので、こんなものも作ってみました。

fibonacciList :: [Integer] fibonacciList = fib 1 1 where fib a b = a : fib b (a + b) fibonacci :: Int -> Integer fibonacci n = fibonacciList !! (n - 1)

 では、他の人たちは fibonacci のリストをどう書いているかを調べてみると……以下の 2 つがほとんどでした。

fib1 = 1 : 1 : [a + b | (a, b) <- zip fib1 (tail fib1)] fib2 = 1 : 1 : zipWith (+) fib2 (tail fib2)

 確かに再帰的な関数を一行で表す方法は簡潔ですばらしいのですが、別に"zip" とか "zipWith" なんか使って技巧に走らなくても……と思ってしまうのは「Haskell 初心者」だからでしょうか?

2009年11月23日 (月)

Project Euler - Problem 3 : 素因数分解

問題はこちらをご覧ください。


この問題は要するに素因数分解の問題です。自作の手続き "factorize" を使うのなら、

(define problem-003-1 (lambda (n) (caar (last-pair (factorize n))))) > (time (problem-003-1 600851475143)) (time (problem-003-1 600851475143)) no collections 1 ms elapsed cpu time 1 ms elapsed real time 24272 bytes allocated

これだけで終わってしまいます。

でも、わざわざ素因数分解の手続きを作らなくても、2 で繰り返し割った後、奇数の小さい方から順に割り続けるだけでも答えは出ます。

(define problem-003-2 (lambda (n) (define divide (lambda (n i) (cond ([= n 1] i) ([zero? (remainder n i)] (divide (/ n i) i)) (else n)))) (let loop ([n (divide n 2)] [i 3]) (if [> (* i i) n] n (loop (divide n i) (+ i 2)))))) > (time (problem-003-2 600851475143)) (time (problem-003-2 600851475143)) no collections 1 ms elapsed cpu time 1 ms elapsed real time 144 bytes allocated

2009年11月 9日 (月)

Project Euler - Problem 2 : 再帰的アルゴリズムと反復的アルゴリズム

問題はこちらをご覧ください。


この問題は、Scheme のコードを載せたことがあるのですが、改めて……

フィボナッチ数を求める場合、一番単純なのは定義に基づいて再帰的に求める方法です。(以下のコードはすべて Chez Scheme です)

;;; n 番目の Fibonacci 数を再帰的に求める。 (define fibonacci (lambda (n) (cond ([= n 1] 1) ([= n 2] 2) (else (+ (fibonacci (- n 2)) (fibonacci(- n 1)))))))

この手続きを使って、二つの方法を考えてみました。

;;; n 未満の偶数の Fibonacci 数の合計を出す。 (define problem-002-1 (lambda (n) (let loop ([i 1] [sum 0]) (let ([f (fibonacci i)]) (cond ([>= f n] sum) ([even? f] (loop (+ i 1) (+ sum f))) (else (loop (+ i 1) sum))))))) ;; > (time (problem-002-1 4000000)) ;; (time (problem-002-1 4000000)) ;; no collections ;; 3344 ms elapsed cpu time ;; 3411 ms elapsed real time ;; 2432 bytes allocated ;;; n 未満の Fibonacci 数列を作り、偶数だけを合計する。 (define problem-002-2 (lambda (n) (let loop ([i 1] [result '()]) (let ([f (fibonacci i)]) (if [>= f n] (apply + (filter even? result)) (loop (+ i 1) (cons f result))))))) ;; > (time (problem-002-2 4000000)) ;; (time (problem-002-2 4000000)) ;; no collections ;; 3324 ms elapsed cpu time ;; 3389 ms elapsed real time ;; 2848 bytes allocated

フィボナッチ数を求める場合、再帰的なアルゴリズムでは同じ計算を繰り返し行うので、非常に遅くなります。

実際、どちらも答えが出るまで約 3 秒かかっています。


もう一つの方法として、反復的なアルゴリズムでフィボナッチ数列を作ってから、そのリストを処理するというものがあります。

;;; n 未満の Fibonacci 数列を反復的に生成する。 (define fibonacci-list (lambda (n) (let loop ([a 1] [b 1] [result '()]) (if [>= a n] result (loop b (+ a b) (cons a result)))))) ;;; n 未満の Fibonacci 数列を求め、偶数だけを合計する。 (define problem-002-3 (lambda (n) (apply + (filter even? (fibonacci-list n))))) ;; > (time (problem-002-3 4000000)) ;; (time (problem-002-3 4000000)) ;; no collections ;; 0 ms elapsed cpu time ;; 0 ms elapsed real time ;; 496 bytes allocated

この場合、同じ計算を繰り替えさないので、非常に速く答えが出ます。

なお、"fibonacci-list" は内部処理を末尾再帰にしたかったのと、答えを出すのにリスト内の順序は関係なかったので、返ってくるリストはあえて「降順」のままになっています。


以前も書きましたが、繰り返しの処理には、"do" や "内部定義"、"letrec" などいろいろな方法があります。

でも、今回は自分の好みで、"named let" ばかりになってしまいました。たぶん、今後もそうなるんだろうなぁ……。

2009年11月 1日 (日)

Project Euler - Problem 1 : 今度は Scheme で……

問題はこちらをご覧ください。


この問題はいろいろな解き方があります。

例えば繰り返しを使って和を求めるもの。

Scheme では繰り返しは再帰を使って表現するのですが、それにもいくつか方法があります。

(なお、以下の手続きはすべて、「n 未満の和」を求めるものです。(problem-001-1 1000) といった具合に、引数に "1000" を与えるとこの問題の答えが出ます。また、自作の手続きについてはこちらをご覧ください)

内部定義を使うもの。

;; 内部定義を使って繰り返し(末尾再帰) (define problem-001-1 (lambda (n) (define iter (lambda (m sum) (cond ([>= m n] sum) ([or (zero? (remainder m 3)) (zero? (remainder m 5))] (iter (+ m 1) (+ sum m))) (else (iter (+ m 1) sum))))) (iter 1 0)))

"retlec" や "named let" を使っても同じことができます。

;; letrec を使って繰り返し (define problem-001-2 (lambda (n) (letrec ([iter (lambda (m sum) (cond ([>= m n] sum) ([or (zero? (remainder m 3)) (zero? (remainder m 5))] (iter (+ m 1) (+ sum m))) (else (iter (+ m 1) sum))))]) (iter 1 0))))

;; named let を使って繰り返し (define problem-001-3 (lambda (n) (let iter ([m 1] [sum 0]) (cond ([>= m n] sum) ([or (zero? (remainder m 3)) (zero? (remainder m 5))] (iter (+ m 1) (+ sum m))) (else (iter (+ m 1) sum))))))

条件に合うリストを作っておいて、それを加工していく方法もあります。

;;; list を加工して計算する 1 (define problem-001-5 (lambda (n) (apply + (filter (lambda (x) (or (zero? (remainder x 3)) (zero? (remainder x 5)))) (seq 1 (- n 1))))))

これは 1 から n までの数を並べたリストから条件に合う数だけを抜き出して、足していく手続きです。("seq" は等差数列を作る自作の手続きです)


;;; list を加工して計算する 2 (define problem-001-6 (lambda (n) (let ([lst1 (seq 0 (- n 1) 3)] ; 3 の倍数のリスト [lst2 (seq 0 (- n 1) 5)]) ; 5 の倍数のリスト (apply + (unique (append lst1 lst2))))))

これは予め「3 の倍数のリスト」と「5 の倍数のリスト」を連結して、重複したものを取り除いたうえで和を求めています。("unique" はリストの要素から重複したものを取り除く自作の手続きです)


ちなみに、こんな解き方もあります。

(define problem-001-7 (lambda (n) (let* ([m (- n 1)] [sum1 (apply + (seq 0 m 3))] ; 3 の倍数の和 [sum2 (apply + (seq 0 m 5))] ; 5 の倍数の和 [sum3 (apply + (seq 0 m 15))]) ; 15 の倍数の和 (- (+ sum1 sum2) sum3))))

一つの問題でもアプローチの仕方やコードの書き方にはいろいろな方法があります。解き方のバリエーションを考えるのもなかなか面白いものです。

« 2009年10月 | トップページ | 2009年12月 »

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            
フォト

最近のトラックバック

無料ブログはココログ