今回はオブジェクト指向の簡単な例題として、ベクタを自動的に拡張する「可変長ベクタ (variable length vector) 」を作ってみましょう。Scheme のベクタは生成するときに大きさを指定しますが、その後で大きさを変更することはできません。可変長ベクタはデータを追加するとき、満杯の場合は自動的にベクタを拡張します。可変長ベクタ (配列) は Perl, Python, Ruby などでは標準でサポートされている機能です。
クラス名は <vlvector> とします。今回は簡単な例題ということで、ベクタの末尾にデータを追加するとき、ベクタが満杯ならば容量を 2 倍に増やすことにしましょう。ただし、ベクタの大きさを自動的に減らすことはしません。そのかわり、ベクタの大きさを変更するメソッドを用意することにします。
可変長ベクタクラス <vlvector> のメソッドを表 1 に示します。
| メソッド | 機能 |
|---|---|
| vlvector-ref v n | n 番目の要素を参照する |
| vlvector-set! v n x | n 番目の要素を x に書き換える |
| vlvector-push! v x | ベクタの末尾にデータ x を追加する |
| vlvector-pop! v | ベクタの末尾からデータを取り出す |
| vlvector-clear! v | ベクタを空にする |
| vlvector-empty? v | ベクタが空ならば #t を返す |
| vlvector-length v | ベクタの要素数を返す |
| vlvector-size v | ベクタの大きさ (容量) を返す |
| vlvector-resize v size | ベクタの大きさを size に変更する |
| fill-pointer v | フィルポインタの値を返す |
| fill-pointer-set! v n | フィルポインタの値を n に書き換える |
引数 v はクラス <vlvector> のインスタンスで、引数 n と size は整数値です。プログラムのポイントはフィルポインタ (fill-pointer) の使い方です。ベクタの中で 0 番目から fill-pointer - 1 番目までの要素を有効なデータとして扱います。つまり、fill-pointer でデータの要素数を管理するわけです。
vlvector-push! で末尾にデータを追加する場合、fill-pointer の位置にデータを書き込み、fill-pointer の値を +1 します。vlvector-pop! で末尾からデータを取り出す場合、fill-pointer の値を -1 してから、fill-pointer の位置にある要素を返します。これはスタックの動作と同じになります。
データを追加するとき、fill-pointer の値とベクタの大きさを比較します。同じ値の場合、ベクタは満杯なので容量を 2 倍に増やします。Scheme の場合、ベクタの大きさを変更することはできないので、新しいベクタを生成して元のベクタからデータをコピーします。
容量の変更はメソッド vlvector-resize で行います。ベクタを縮小することもできますが、fill-pointer よりも小さくすることはできません。
fill-pointer の値はメソッド fill-pointer-set! で変更することができます。範囲は 0 からベクタの大きさまでです。値が範囲外の場合はエラーを送出します。
あとは、クラス <sequence> を Mix-in します。<sequence> のメソッドはベクタの 0 番目から fill-pointer - 1 番目までの要素に対して働きますが、メソッド vlvector-ref と vlvector-set! はベクタ全体にアクセスできるものとします。なお、これらの仕様は Common Lisp の「配列 (array) 」を参考にしました。
それではプログラムを作りましょう。最初にクラスを定義します。
リスト 1 : 可変長ベクタクラスの定義 ; メタクラス (define-class <vlvector-meta> (<class>) ()) ; クラス (define-class <vlvector> (<sequence>) ((buff :accessor get-buff :init-keyword :buff) (size :accessor get-size :init-value *min-size* :init-keyword :size) (nums :accessor get-nums :init-value 0)) :metaclass <vlvector-meta>)
まず、<sequence> で必要になるメタクラス <vlvector-meta> を定義します。それから、クラス <vlvector> で <sequence> を Mix-in します。スロット buff にベクタを、size にベクタの大きさを、nums に要素数を格納します。この nums が fill-pointer になります。最後に :metaclass に <vlvector-meta> を指定します。
スロット buff の初期化は総称関数 initialize で行います。次のリストを見てください。
リスト 2 : インスタンスの初期化
; 初期化
(define-method initialize ((obj <vlvector>) initargs)
(next-method)
(if (< (get-size obj) *min-size*)
(set! (get-size obj) *min-size*))
(set! (get-buff obj) (make-vector (get-size obj))))
まず next-method でスーパークラスの initialize を呼び出します。それから、スロット size の値をチェックします。もしも、size がグローバル変数 *min-size* (4) よりも小さい場合は、その値を *min-size* に書き換えます。あとは大きさ size のベクタを make-vector で生成して buff にセットするだけです。
次はフィルポインタを操作するメソッドを作ります。
リスト 3 : フィルポインタの操作
; フィルポインタを求める
(define-method fill-pointer ((v <vlvector>))
(get-nums v))
; フィルポインタの変更
(define-method fill-pointer-set! ((v <vlvector>) (n <integer>))
(if (or (negative? n) (< (get-size v) n))
(error "fill-pointer-set! : out of range"))
(set! (get-nums v) n))
; 汎変数
(set! (setter fill-pointer) fill-pointer-set!)
メソッド fill-pointer は簡単です。メソッド get-nums でスロット nums の値を求めるだけです。メソッド fill-pointer-set! はスロット num の値を引数 n に書き換えるだけです。このとき、n の値が範囲内 (0 から size まで) であることを確認します。範囲外であればエラーを送出します。
フィルポインタは set! で変更できると便利です。Gauche では汎変数を簡単に定義することができます。これには setter を使います。
setter proc
関数 setter は引数 proc の setter 手続きを返します。Gauche の場合、setter 手続きは値を更新する関数のことです。たとえば、setter 手続きを update とすると、update は (proc args ...) が参照した値を次の形式で更新します。
update args ... value
簡単な例を示しましょう。
gosh> (setter car) #<subr set-car!> gosh> (setter vector-ref) #<subr vector-set!> gosh> (setter list-ref) #f gosh> (define a '(1 2 3 4 5)) a gosh> (set! (car a) 10) #<undef> gosh> a (10 2 3 4 5)
car の setter 手続きは set-car! なので、(set! (car a) 10) は (set-car! a 10) に変換されて、リストの先頭要素が 10 に変更されます。また、vector-ref の setter 手続きは vector-set! ですが、list-ref の setter 手続きは定義されていません。
setter 手続きの設定にも汎変数が使えるので簡単です。(set! (setter proc) update) とすれば、proc の setter 手続きを update に設定することができます。fill-pointer の場合も、(set! (setter fill-pointer) fill-pointer-set!) とすれば、fill-pointer の setter 手続きを fill-pointer-set! にすることができます。
次はベクタの大きさを変更するメソッド vlvector-resize を作ります。
リスト 4 : ベクタサイズの変更
(define-method vlvector-resize ((v <vlvector>) (new-size <integer>))
(if (< new-size (get-nums v))
(error "vlvector-resize : not enough new-size"))
(if (< new-size *min-size*)
(set! new-size *min-size*))
(let ((new-buff (make-vector new-size)))
(let loop ((i (- (get-nums v) 1)))
(cond ((<= 0 i)
(vector-set! new-buff i (vector-ref (get-buff v) i))
(loop (- i 1)))))
(set! (get-buff v) new-buff)
(set! (get-size v) new-size)))
引数 new-size が新しいベクタの大きさです。new-size が要素数 nums よりも小さい場合はエラーを送出します。new-size が *min-size* よりも小さい場合は、new-size を *min-size* に変更します。あとは、大きさ new-size の新しいベクタを生成して、そこに buff からデータをコピーするだけです。
次はメソッド vlvector-push! と vlvector-pop! を作ります。
リスト 5 : データの追加と取り出し
; 追加
(define-method vlvector-push! ((v <vlvector>) value)
(if (= (get-size v) (get-nums v))
(vlvector-resize v (* (get-size v) 2)))
(vector-set! (get-buff v) (get-nums v) value)
(inc! (get-nums v)))
; 取り出し
(define-method vlvector-pop! ((v <vlvector>))
(if (vlvector-empty? v)
(error "vlvector-pop! : <vlvector> is empty"))
(dec! (get-nums v))
(vector-ref (get-buff v) (get-nums v)))
vlvector-push! は簡単です。まず、ベクタが満杯かチェックし、そうであれば vlvector-resize を呼び出してベクタの大きさを 2 倍に拡張します。そして、nums の位置にデータ value をセットしてから nums の値を +1 します。
vlvector-pop! は vevector-empty? を呼び出してベクタが空かチェックし、空の場合はエラーを送出します。そして、nums の値を -1 してから、その位置にある要素を取り出して返します。
次は <sequence> で使うイテレータとビルダーを作ります。
リスト 6 : <sequence> 用メソッド
; イテレータ
(define-method call-with-iterator ((v <vlvector>) proc . opts)
(let ((n (get-keyword :start opts 0)))
(proc
(lambda () (eqv? n (get-nums v)))
(lambda ()
(if (eqv? n (get-nums v))
#f
(begin0 (vector-ref (get-buff v) n)
(inc! n)))))))
; ビルダー
(define-method call-with-builder ((class <vlvector-meta>) proc . opts)
(let ((v (make <vlvector>)))
(proc (lambda (val) (vlvector-push! v val))
(lambda () v))))
; 参照
(define-method referencer ((avec <vlvector>)) vlvector-ref)
; 更新
(define-method modifier ((avec <vlvector>)) vlvector-set!)
; オーバーライド
(define-method size-of ((v <vlvector>))
(vlvector-length v))
(define-method lazy-size-of ((v <vlvector>))
(vlvector-length v))
ベクタの有効範囲は 0 番目から nums - 1 番目までです。call-with-iterator は変数 n の位置にある要素を取り出して返すだけなので簡単です。call-with-builder も make で <vlvector> のインスタンスを生成して、vlvector-push! で要素を追加していくだけです。
<vlvector> の要素数は簡単に求めることができるので、メソッド size-of と lazy-size-of をオーバーライドして、vlvector-length の値を返すようにします。デフォルトの動作は、call-with-iterator を呼び出してコレクションの大きさを求めています。
後のメソッドは簡単なので説明は割愛いたします。詳細はプログラムリスト２をお読みください。
それでは簡単な実行例を示します。
gosh> (use vlvector) #<undef> gosh> (use gauche.sequence) #<undef> gosh> (define a (make <vlvector>)) a gosh> (vlvector-length a) 0 gosh> (vlvector-size a) 4 gosh> (vlvector-empty? a) #t gosh> (dotimes (x 10) (vlvector-push! a x)) #t gosh> (vlvector-length a) 10 gosh> (vlvector-size a) 16 gosh> (vlvector-empty? a) #f gosh> (for-each (lambda (x) (format #t "~D " x)) a) 0 1 2 3 4 5 6 7 8 9 #t gosh> (map (lambda (x) (* x x)) a) (0 1 4 9 16 25 36 49 64 81) gosh> (define b (map-to <vlvector> (lambda (x) (* x x)) a)) b gosh> (for-each (lambda (x) (format #t "~D " x)) b) 0 1 4 9 16 25 36 49 64 81 #t gosh> (size-of b) 10 gosh> (dotimes (x 10) (format #t "~D " (vlvector-pop! b))) 81 64 49 36 25 16 9 4 1 0 #t gosh> (size-of b) 0 gosh> (vlvector-empty? b) #t gosh> (set! (fill-pointer b) 10) #<undef> gosh> (size-of b) 10 gosh> (vlvector-empty? b) #f gosh> (dotimes (x 10) (format #t "~D " (vlvector-pop! b))) 81 64 49 36 25 16 9 4 1 0 #t
正常に動作しているようです。興味のある方はいろいろ試してみてください。
;
; vlvector.scm : 可変長ベクタクラス (variable-length vector)
;
; Copyright (C) 2010 Makoto Hiroi
;
(define-module vlvector
(use gauche.sequence)
(export <vlvector>
vlvector-ref vlvector-set!
vlvector-push! vlvector-pop!
vlvector-empty? vlvector-clear!
vlvector-length vlvector-size
fill-pointer fill-pointer-set!
vlvector-resize
call-with-iterator
call-with-builder
referencer
modifier))
(select-module vlvector)
;;; 定数
(define *min-size* 4)
;;; クラス定義
; メタクラス
(define-class <vlvector-meta> (<class>) ())
; クラス
(define-class <vlvector> (<sequence>)
((buff :accessor get-buff :init-keyword :buff)
(size :accessor get-size :init-value *min-size* :init-keyword :size)
(nums :accessor get-nums :init-value 0))
:metaclass <vlvector-meta>)
; 初期化
(define-method initialize ((obj <vlvector>) initargs)
(next-method)
(if (< (get-size obj) *min-size*)
(set! (get-size obj) *min-size*))
(set! (get-buff obj) (make-vector (get-size obj))))
;;; メソッドの定義
; 空にする
(define-method vlvector-clear! ((v <vlvector>))
(set! (get-nums v) 0))
; 空か？
(define-method vlvector-empty? ((v <vlvector>))
(zero? (get-nums v)))
; フィルポインタを求める
(define-method fill-pointer ((v <vlvector>))
(get-nums v))
; フィルポインタの変更
(define-method fill-pointer-set! ((v <vlvector>) (n <integer>))
(if (or (negative? n) (< (get-size v) n))
(error "fill-pointer-set! : out of range"))
(set! (get-nums v) n))
; 汎変数
(set! (setter fill-pointer) fill-pointer-set!)
; 要素数を求める
(define-method vlvector-length ((v <vlvector>))
(get-nums v))
; 大きさを求める
(define-method vlvector-size ((v <vlvector>))
(get-size v))
; 参照 (ベクタ全体にアクセスできる)
(define-method vlvector-ref ((v <vlvector>) (n <integer>))
(vector-ref (get-buff v) n))
; 更新 (ベクタ全体にアクセスできる)
(define-method vlvector-set! ((v <vlvector>) (n <integer>) value)
(vector-set! (get-buff v) n value))
; 大きさの変更
(define-method vlvector-resize ((v <vlvector>) (new-size <integer>))
(if (< new-size (get-nums v))
(error "vlvector-resize : not enough new-size"))
(if (< new-size *min-size*)
(set! new-size *min-size*))
(let ((new-buff (make-vector new-size)))
(let loop ((i (- (get-nums v) 1)))
(cond ((<= 0 i)
(vector-set! new-buff i (vector-ref (get-buff v) i))
(loop (- i 1)))))
(set! (get-buff v) new-buff)
(set! (get-size v) new-size)))
; 追加
(define-method vlvector-push! ((v <vlvector>) value)
(if (= (get-size v) (get-nums v))
(vlvector-resize v (* (get-size v) 2)))
(vector-set! (get-buff v) (get-nums v) value)
(inc! (get-nums v)))
; 取り出し
(define-method vlvector-pop! ((v <vlvector>))
(if (vlvector-empty? v)
(error "vlvector-pop! : <vlvector> is empty"))
(dec! (get-nums v))
(vector-ref (get-buff v) (get-nums v)))
;;; イテレータ (fill-pointer までが有効)
(define-method call-with-iterator ((v <vlvector>) proc . opts)
(let ((n (get-keyword :start opts 0)))
(proc
(lambda () (eqv? n (get-nums v)))
(lambda ()
(if (eqv? n (get-nums v))
#f
(begin0 (vector-ref (get-buff v) n)
(inc! n)))))))
; ビルダー
(define-method call-with-builder ((class <vlvector-meta>) proc . opts)
(let ((avec (make <vlvector>)))
(proc (lambda (val) (vlvector-push! avec val))
(lambda () avec))))
; 参照
(define-method referencer ((avec <vlvector>)) vlvector-ref)
; 更新
(define-method modifier ((avec <vlvector>)) vlvector-set!)
; オーバーライド
(define-method size-of ((v <vlvector>))
(vlvector-length v))
(define-method lazy-size-of ((v <vlvector>))
(vlvector-length v))
(provide "vlvector")