7. 繰り返し

1. 初めに

今回は繰り返しについて説明します。繰り返しができれば、一通りプログラムを書くことができます。繰り返しのための構文 do もありますが、一般に、Scheme は繰り返しのために再帰を使います。

2. 再帰

再帰関数とは関数定義の中で自分自身を呼び出す関数です。慣れないと奇妙な感じがしますが、慣れてしまえば、気にならなくなります。

階乗の計算はよく使われる例です。

[code 1] 階上を求める関数 fact

(define (fact n)
  (if (= n 1)
      1
      (* n (fact (- n 1)))))

(fact 5) は次のように計算されます。

(fact 5)
⇒ 5 * (fact 4)
⇒ 5 * 4 * (fact 3)
⇒ 5 * 4 * 3 * (fact 2)
⇒ 5 * 4 * 3 * 2 * (fact 1)
⇒ 5 * 4 * 3 * 2 * 1
⇒ 5 * 4 * 3 * 2
⇒ 5 * 4 * 6
⇒ 5 * 24
⇒ 120

(fact 5) は (fact 4) を、(fact 4) は (fact 3) を呼び出し、最後に (fact 1) が呼び出されます。 (fact 5), (fact 4) ,.. (fact 1) はメモリーの別の領域に割り当てられ、(fact i) は (fact (- i 1)) が値を返すまでそこにとどまっていなければならないのでメモリー領域が無駄になり、また、関数呼び出しのオーバーヘッドのため、実行時間も長くかかります。

しかし、再帰には、簡単に繰り返しを表現できるという利点があります。リストは再帰的に定義されているので再帰関数と相性が良いです。例えば、リストの要素を全て２倍する関数は次のようにかけます。リストが空リストのとき空リストを返すようにしないと計算が終わりません。

(define (list*2 ls)
  (if (null? ls)
      '()
      (cons (* 2 (car ls))
	    (list*2 (cdr ls)))))

練習問題 1

次の関数を再帰を使って書いてください。

リストの要素の数を数える関数 my-length。（ちなみに length という関数があらかじめ定義されています。）
数のリストの要素の合計を求める関数。
リスト (ls) から要素 (x) を取り除いたリストを返す関数。
リスト (ls) の要素 (x) の位置を返す関数。位置は 0 から数え始め、 x がない場合は #f を返す。

3. 末尾再帰

普通の再帰は、計算途中で呼び出した関数が、値を返すまで、呼び出しもとの関数もメモリー上にとどまる必要があり、あまり効率の良いものではありませんでした。そこで、計算結果を引数に含めてしまう末尾再帰という手法があります。特に Scheme では、末尾再帰は関数呼び出しのオーバーヘッドもかからず、通常のループとして使えます。 [code 1] の階乗を求める関数を末尾再帰に書き直すと [code 2] のようになります。

[code 2] 末尾再帰版階乗計算関数 fact-tail

(define (fact-tail n)
  (fact-rec n n))

(define (fact-rec n p)
  (if (= n 1)
      p
      (let ((m (- n 1)))
	(fact-rec m (* p m)))))

fact-tail は次のようにして階乗を計算します。

(fact-tail 5)
⇒ (fact-rec 5 5)
⇒ (fact-rec 4 20)
⇒ (fact-rec 3 60)
⇒ (fact-rec 2 120)
⇒ (fact-rec 1 120)
⇒ 120

fact-rec は次に呼び出す関数の値をもとに計算する必要が無いので、役目を終わったらメモリーから消えます。 fact-rec は引数だけが変化して計算が進行しているので実質的にはループと同じです。 Scheme では仕様で、末尾再帰をループに変えることを要求しているので、ループ用の特別な構文なしに、繰り返しを行うことができます。

練習問題 2

次の関数を末尾再帰を使って書いてください。

リストの要素の順番を反転させる関数 my-reverse。（ちなみに reverse という関数があらかじめ定義されています。）
数のリストの要素の合計を求める関数。
正の整数を表す文字列を整数に変関する関数。例： "1232" → 1232 入力エラーチェックはしなくて良い。ヒント：
1. 文字 #\0 ... #\9 のASCII コード番号から 48 を引くとその数そのものになります。アスキーコードを求める関数は char->integer です。
2. 文字列を文字のリストに変換する関数 string->list を使うと便利です。

4. 名前つき let

ループを表すのに名前つき let という構文が使えます。 [code 2] のfact-rec の代わりに loop という名前の付いた let 式を使います。まず、; 1 で変数を初期化します。ここでは、変数 n1, p を n で初期化します。処理が１順すると ; 2 で変数を更新します。ここでは、n1 を 1 減らし、p に (n1-1) をかけています。

名前つき let は Scheme で繰り返しを表す標準的な方法です。

[code 3]

(define (fact-let n)
  (let loop((n1 n) (p n))           ; 1
    (if (= n1 1)                    
        p
        (let ((m (- n1 1)))
          (loop m (* p m))))))      ; 2

練習問題 3

以下の関数を名前付き let を使って書いてください。

練習問題 1 の 3, 4 および
練習問題 2 で書いた関数を名前つき let を使って書いてください。
0 から n 未満の整数のリストを返す関数 range
任意個の引数をとりそれらの平均を返す関数。
レストパラメータを使う。全ての引数は数、エラー処理は不要。
例：
```
> (ave 1.1 2.3 4.6)
2.6666666666666665

> (ave 3.3 4.7 10.2 20.6 100.1)
27.779999999999994
```

5. letrec

let と似ていますが、定義内で自分の名前を参照できます。複雑な再帰関数を書くときに使います。 fact を letrec を使って書き直すと以下のようになります。

[code 4]

(define (fact-letrec n)
  (letrec ((iter (lambda (n1 p)
		   (if (= n1 1)
		       p
		       (let ((m (- n1 1)))
			 (iter m (* p m)))))))     ; *
    (iter n n)))

; * に示すように、局所関数 iter を iter の定義内で参照することができます。 letrec は局所関数を定義する一般的な方法です。

練習問題 4

練習問題 2 で書いた関数を letrec を使って書いてください。

6. do 式

あまり使われませんが、繰り返しを表す構文 do 式が定義されています。書式は以下の通りです。

(do binds (predicate value)
    body)

まず、binds 部で変数をバインドし、それから、 predicate でループを抜け出すかどうか判断し、抜け出すとき value を返します。

binds 部の書式は以下の通りです。

[binds] → ((p1 i1 u1) (p2 i2 u2) ... )

変数 p1, p2 ... を i1, i2 ... で初期化し、ループが一順するごとに u1, u2 ... で更新します。

fact を do 式を使って書くと次のようになります。

[code 5]

(define (fact-do n)
  (do ((n1 n (- n1 1)) (p n (* p (- n1 1)))) ((= n1 1) p)))

まず、変数 n1 を n で初期化し、ループが回るごとに 1 を引きます。変数 p は n で初期化し、ループが回るごとに (n1 - 1) をかけます。 n1 が 1 になったら p を返します。

人によって感じ方は違うと思いますが、かえってわかりにくい感じです。

練習問題 5

練習問題 2 で書いた関数を do を使って書いてください。

7. 終わりに

今回までの説明で、とりあえずプログラムが書けるようになったと思います。簡単なループは名前つき let を使うのが一般的です。また、複雑な再帰は letrec を使うことが多いようです。

次回は関数を引数にとる関数（高階関数）について説明します。高階関数を使いこなすとプログラムが Scheme らしくなります。

練習問題の解答

練習問題 1

; 1
(define (my-length ls)
  (if (null? ls)
      0
      (+ 1 (my-length (cdr ls)))))

; 2
(define (my-sum ls)
  (if (null? ls)
      0
      (+ (car ls) (my-sum (cdr ls)))))

; 3
(define (remove x ls)
  (if (null? ls)
      '()
      (let ((h (car ls)))
        ((if (eqv? x h)
            (lambda (y) y)
            (lambda (y) (cons h y)))
         (remove x (cdr ls))))))

; 4
(define (position x ls)
  (position-aux x ls 0))

(define (position-aux x ls i)
  (cond
   ((null? ls) #f)
   ((eqv? x (car ls)) i)
   (else (position-aux x (cdr ls) (inc i)))))

練習問題 2

; 1
(define (my-reverse ls)
  (my-reverse-rec ls ()))

(define (my-reverse-rec ls0 ls1)
  (if (null? ls0)
      ls1
      (my-reverse-rec (cdr ls0) (cons (car ls0) ls1))))

;-------------------
; 2
(define (my-sum-tail ls)
  (my-sum-rec ls 0))

(define (my-sum-rec ls n)
  (if (null? ls)
      n
      (my-sum-rec (cdr ls) (+ n (car ls)))))

;--------------------
; 3
(define (my-string->integer str)
  (char2int (string->list str) 0))

(define (char2int ls n)
  (if (null? ls)
      n
      (char2int (cdr ls) 
		(+ (- (char->integer (car ls)) 48)
		   (* n 10)))))

練習問題 3

; 1a
(define (remove x ls)
  (let loop((ls0 ls) (ls1 ()))
    (if (null? ls0) 
	(reverse ls1)
	(loop
	 (cdr ls0)
          (if (eqv? x (car ls0))
              ls1
            (cons (car ls0) ls1))))))

; 1b
(define (position x ls)
  (let loop((ls0 ls) (i 0))
    (cond
     ((null? ls0) #f)
     ((eqv? x (car ls0)) i)
     (else (loop (cdr ls0) (inc i))))))

; 2a
(define (my-reverse-let ls)
  (let loop((ls0 ls) (ls1 ()))
    (if (null? ls0)
	ls1
	(loop (cdr ls0) (cons (car ls0) ls1)))))

; 2b
(define (my-sum-let ls)
  (let loop((ls0 ls) (n 0))
    (if (null? ls0)
	n
	(loop (cdr ls0) (+ (car ls0) n)))))

; 2c
(define (my-string->integer-let str)
  (let loop((ls0 (string->list str)) (n 0))
    (if (null? ls0)
	n
	(loop (cdr ls0)
	      (+ (- (char->integer (car ls0)) 48)
		 (* n 10))))))

; 3
(define (range n)
  (let loop((i 0) (ls1 ()))
    (if (= i n)
        (reverse ls1)
      (loop (inc i) (cons i ls1)))))

; 4
(define (ave . ls)
  (let loop((sum 0) (ls1 ls))
    (if (null? ls1)
	(/ sum (length ls))
	(loop (+ sum (car ls1)) (cdr ls1)))))

練習問題 4

; 1
(define (my-reverse-letrec ls)
  (letrec ((iter (lambda (ls0 ls1)
		   (if (null? ls0)
		       ls1
		       (iter (cdr ls0) (cons (car ls0) ls1))))))
    (iter ls ())))

; 2
(define (my-sum-letrec ls)
  (letrec ((iter (lambda (ls0 n)
		   (if (null? ls0)
		       n
		       (iter (cdr ls0) (+ (car ls0) n))))))
    (iter ls 0)))

; 3
(define (my-string->integer-letrec str)
  (letrec ((iter (lambda (ls0 n)
		   (if (null? ls0)
		       n
		       (iter (cdr ls0)
			     (+ (- (char->integer (car ls0)) 48)
				(* n 10)))))))
    (iter (string->list str) 0)))

練習問題 5

; 1
(define (my-reverse-do ls)
  (do ((ls0 ls (cdr ls0)) (ls1 () (cons (car ls0) ls1)))
      ((null? ls0) ls1)))

; 2
(define (my-sum-do ls)
  (do ((ls0 ls (cdr ls0)) (n 0 (+ n (car ls0))))
      ((null? ls0) n)))

; 3
(define (my-string->integer-do str)
  (do ((ls0 (string->list str) (cdr ls0))
       (n 0 (+ (- (char->integer (car ls0)) 48) 
	       (* n 10))))
      ((null? ls0) n)))