[up]

[prev]

[next]

[download]

Scheme 入門

10. 代入

1. 初めに

ここまで代入について説明しなかったのは、 代入抜きのプログラミングに慣れていだだきたかったのと、 代入にはそれなりの弊害があるからです。 代入の弊害については、 SICP: 3.1 Assignment and Local State や なぜ関数プログラミングは重要か を見てください。

Scheme は基本的に関数型プログラミング言語なので、基本的には代入を用いないでプログラムを書くことができます。 しかし、代入を用いたほうがかえって簡潔に書ける場合もあり、 内部状態や継続を利用する時は代入を使う必要があります。

R⁵RS に定義されている代入ステートメントには set!, set-car!, set-cdr!, string-set!, vector-set! などがあります。また、そのほかに処理系依存の代入ステートメントがあります。 scheme では、代入などの破壊的なステートメントの名前にはプログラマーの注意を促すために ! が付きます。

2. set!

次のように使います。

(define var 1)
(set! var (* var 10))
var ⇒ 10

(let ((i 1))
    (set! i (+ i 3))
    i)
⇒ 4

3. 内部状態

3.1. 静的スコープ(レキシカルクロージャ）

変数の有効範囲を限定する式には let 式、lambda 式および後で説明する letrec 式 などがあります。lambda 式の引数は、そのlambda 式内でのみ有効です。

実は、let 式は下に示すように lambda 式で置き換えることができます。

(let ((p1 v1) (p2 v2) ...) body)
⇔
((lambda (p1 p2 ...) body) v1 v2 ...)

3.2. レキシカルクロージャ と代入による内部状態の実装

(define bank-account
  (let ((amount 1000))
    (lambda (n)
      (set! amount (+ amount n))
      amount)))

(bank-account 2000)     ;2000 円預け入れ
;Value: 3000

(bank-account -2500)     ;2500 円引き出し
;Value: 500

Scheme は手続きを返す手続きを書くことができるので、 銀行口座を作る関数を書くこともできます。
この例を見ると、関数型言語を使ってオブジェクト指向にするのは簡単であることがわかると思います。 実際、あとほんの少し手を加えればオブジェクト指向になります。

(define (make-bank-account amount)
  (lambda (n)
    (set! amount (+ amount n))
    amount))

(define yamada-bank-account (make-bank-account 1000))   ; 山田さんが 1000 円預金して銀行口座を作る。
;Value: yamada-bank-account

(yamada-bank-account 5000)                              ; 5000 円預け入れる
;Value: 6000

(yamada-bank-account -5500)                             ; 5500 円引き出す
;Value: 500


(define saito-bank-account (make-bank-account 10000))  ; 斉藤さんが 10000 円預金して銀行口座を作る。
;Value: saito-bank-account

(saito-bank-account -7000)                             ; 7000 円引き出す
;Value: 3000

(saito-bank-account 30000)                             ; 30000 円預け入れる
;Value: 33000

3.3. 副作用

練習問題 1

4. set-car!, set-cdr!

(define tree '((1 2) (3 4 5) (6 7 8 9)))

(set-car! (car tree) 100)  ; tree の 1 を 100 に変える

tree
 ((100 2) (3 4 5) (6 7 8 9))

(set-cdr! (third tree) '(a b c)) ; tree の '(7 8 9) を '(a b c) に変える

tree
⇒ ((100 2) (3 4 5) (6 a b c))

4.1. 待ち行列 (Queue) の実装

set-car!, set-cdr! を利用すると待ち行列を実装することができます。 通常のリストは先入れ後出しですが、Queue は先入れ先出しのデータです。 Queue は図１のようなデータ構造をとっており、cons-cell-top の car 部はリストに、 cons-cell-top の cdr 部はそのリストの最後のコンスセルへのポインターを持ちます。

図１：

Queue の最後に要素 (item 4) を追加するには、Queue の最後のコンスセル ((cdr cons-cell-top) で直接アクセスできます） の cdr 部のポインターを、 car 部が item 4, cdr 部が '() のコンスセルにします。 その後、cons-cell-top の cdr 部を、そのコンスセルへのポインターにします。(図 2）

図２：

一方、先頭の要素を取り出して、Queue からそれを取り除くには、先頭の要素をまず、局所変数に 保存し、その後、 cons-cell-top の car 部を リストの２番目のコンスセルに移します(図 3）。

図３：

[code 1] に Queue を実装したコードを示します。 [code 1] の enqueue! は queue の最後の obj を追加した Queue を返す関数、 dequeue! は queue から最初の要素を取り除き、取り除いた最初の要素を返す関数です。

[code 1]

(define (make-queue)
  (cons '() '()))

(define (enqueue! queue obj)
  (let ((lobj (cons obj '())))
    (if (null? (car queue))
	(begin
	  (set-car! queue lobj)
	  (set-cdr! queue lobj))
	(begin
	  (set-cdr! (cdr queue) lobj)
	  (set-cdr! queue lobj)))
    (car queue)))

(define (dequeue! queue)
  (let ((obj (car (car queue))))
    (set-car! queue (cdr (car queue)))
    obj))

(define q (make-queue))
;Value: q

(enqueue! q 'a)
;Value 12: (a)

(enqueue! q 'b)
;Value 12: (a b)

(enqueue! q 'c)
;Value 12: (a b c)

(dequeue! q)
;Value: a

q
;Value 13: ((b c) c)

(make-eq-hash-table size), (make-eqv-hash-table size), (make-equal-hash-table size), (make-string-hash-table size)

ハッシュ表を作成します。それぞれ、key を比較する関数として eq?, eqv?, equal?, string=? を使用します。 ハッシュ表の初期サイズ size を指定することもできます（省略化）。eq-hash-table はアドレスを比較するだけので もっとも高速です。equal-hash-table や string-hash-table はシークエンスを比較するので速度は遅くなります。

(hash-table/put! hash-table key datum)

hash-table の key に対応する値を datum にします。

(hash-table/get hash-table key default)

hash-table の key に対応する値を返します。 hash-table 中に key が無ければ default を返します。

(hash-table->alist hash-table)

hash-table を連想リストに変換します。

01:     ;;; make an alist of probable spelling from a given english text
02:     
03:     
04:     (define (skip-char? c)
05:       (or (not (char-graphic? c)) (memv c '(#\: #\; #\' #\"))))
06:     
07:     
08:                    
09:     (define (ss-make-alist c alist)
10:       (let ((found #f))
11:         (let ((ls1 (map (lambda (p)
12:     		      (if (and (not found) (char=? (car p) c))
13:     			  (begin
14:     			    (set! found #t)
15:     			    (set-cdr! p (inc (cdr p)))))
16:     		      p)
17:     		    alist)))
18:           (if found
19:     	  ls1
20:     	  (cons (cons c 1) ls1)))))
21:                          
22:     
23:     
24:     (define (ss-make-dat filename)
25:       (let ((char-hash (make-eqv-hash-table)))
26:         (with-input-from-file filename
27:           (lambda ()
28:     	(let loop ((c #\Space))
29:     	  (let ((c1 (read-char)))
30:                      (if (not (eof-object? c1))
31:                          (if (skip-char? c1)
32:                              (loop c)
33:                              (let ((c1 (char-downcase c1)))
34:     			   (hash-table/put! char-hash c
35:     					    (ss-make-alist c1 (hash-table/get char-hash c '())))
36:     			   (loop c1))))))))
37:         (with-output-to-file "stat-spell.dat"
38:           (lambda ()
39:     	(display "(define *stat-spell* \'(")
40:     	(newline)
41:     	(let loop ((alst (sort (hash-table->alist char-hash) 
42:     			       (lambda (x y) (char<? (car x) (car y))))))
43:     	  (if (pair? alst)
44:     	      (begin
45:     		(write (car alst))
46:     		(newline)
47:     		(loop (cdr alst)))))
48:     	(display "))")))))

(skip-char? c)

c が、グラフィック文字でないか、#\:, #\;, #\', #\", であるとき #t を返します。 これらの文字は読み込む際にスキップされます。

(ss-make-alist c alist)

文字の出現回数の連想リスト alist と、文字 c を引数にとり、 c が alist にあれば、そのペアの cdr に 1 を加えます。 無ければ、 (cons c 1) を alist に加えます。 この関数で、代入ステートメント set!, set-cdr! を使っています。

(ss-make-dat filename)

filename から１文字ずつ読み込んで、その文字の次に来る文字とその回数の連想リストを 文字別に作り、それを stat-spell.dat に保存します。 34, 35 行目で、ある文字に引き続く文字と頻度をハッシュ表から取り出し、それを更新してまたハッシュ表に登録します。 保存されるデータは連想リストの連想リストになっています。 例えば、

(#\v (#\y . 1) (#\a . 3) (#\o . 7) (#\e . 51) (#\i . 15))

は、文字 #\v の次には #\y, #\a, #\o, #\e, #\i がそれぞれ 1, 3, 7, 51, 15 回来たことを示します。

5.1.2. make-pw.scm

1. #\Space から初めて、9--13 文字のリストを stat-spell.dat のデータをもとにしてランダムに生成する。
2. 最初の文字(すなわち #\Space) をリストの最後にもって行き、その後に 0--99 の数字をランダムに選んで 付け足す。
3. #\Space をランダムに、#\- #\_ #\/ #\Space #\. #\, で置き換える。
4. アルファベットの 30% をランダムに大文字にする。

[code 3]

01:     ;;; make password from the alist of probable spelling
02:     
03:     (load "stat-spell.dat")
04:     
05:     
06:     (define (pw-random-select ls)
07:       (list-ref ls (random (length ls))))
08:     
09:     
10:     (define (occasional-upcase c)
11:       (if (< (random 10) 3)
12:           (char-upcase c)
13:         c))
14:     
15:     
16:     (define (pw-strong ls)
17:       (reverse!
18:        (map (lambda (c)
19:     	  (cond
20:     	   ((char=? c #\Space)
21:     	    (pw-random-select  '(#\- #\_ #\/  #\Space  #\. #\,)))
22:     	   ((char-alphabetic? c)
23:     	    (occasional-upcase c))
24:     	   (else c)))
25:     	ls)))
26:                    
27:                                     
28:     
29:     (define (random-following alist)
30:       (let ((n (random (apply + (map cdr alist)))))
31:         (let loop ((j 0) (alist alist))
32:           (if (pair? alist)
33:     	  (let* ((pair (car alist))
34:     		 (k (+ j (cdr pair))))
35:     	    (if (> k n)
36:     		(car pair)
37:     		(loop k (cdr alist))))))))
38:     
39:     
40:     
41:     (define (make-pw n)
42:       (let loop ((i 0) (c #\Space) (acc ()))
43:         (if (= i n)
44:     	(let ((rn (random 100))
45:     	      (pw (pw-strong (cons c acc))))
46:     	  (string-append
47:     	   (list->string (append (cdr pw) (list (car pw))))
48:     	   (if (< rn 10) "0" "")
49:     	   (number->string rn)))
50:     	(loop (inc i) (random-following (cdr (assv c *stat-spell*))) (cons c acc)))))
51:         
52:     
53:     
54:     (define (pw-candidates)
55:       (let loop ((i 0))
56:         (if (< i 10)
57:     	(begin
58:     	  (display i)
59:     	  (display ": ")
60:     	  (write (make-pw (+ 9 (random 4))))
61:     	  (newline)
62:     	  (loop (inc i))))))

(pw-random-select ls)

ls の要素をランダムに選びます。

(occasional-upcase c)

30% の確率で c をランダムに大文字にします。

(pw-strong ls)

文字のリスト ls を加工してパスワードが破れれにくくします。

(random-following alist)

連想リスト alist の中から、頻度に基づいて文字をランダムに選びます。

(make-pw n)

n+3 文字のパスワードを作ります。パスワードの最後はランダムな２桁の数字です。

(pw-candidates)

長さが 12--15 のパスワードを 10 個生成します。

(compile-file "stat-spell.scm")
(compile-file "make-pw.scm")
(load "stat-spell")
(load "make-pw")

;;; sicp_foreword.txt に基づいて綴りのデータを作ります。
(ss-make-dat "sicp_foreword.txt")

;;; 綴りのデータに基づいてパスワードを 10 個作ります。
(pw-candidates)

0: "TH-haVEMis/t/19"
1: "MoghaTrad_-Z.82"
2: "seatSk-nev 64"
3: "wIE t incar,92"
4: "<bIcoMpure,e/48"
5: "d_t,ustampRE.48"
6: "wiN,O/LEx.90"
7: "OfU-D wogr/29"
8: "d the.ole_95"
9: "tippRiooU,77"
;Unspecified return value

6. 終わりに

むやみに代入を使うと手続き型言語のコードの様になってしまいますが、 必要なときは注意して使いましょう。

練習問題 1

(define (make-bank-account amount)
  (lambda (n)
    (let ((m (+ amount n)))
      (if (negative? m)
	  'error
	  (begin
	    (set! amount m)
	    amount)))))

[top]

[up]

[prev]

[next]

[download]