fuyuki

なんの役に立つのかわからんが書いてみるシリーズ。

alist-table

SLIBに同名のものがあるけど方向性がちがう。こっちは単なるhash-tableもどき。

(use srfi-1)
(use gauche.collection)

(define-class <alist-table> (<collection>)
  ((key= :getter key=-of :init-keyword :key= :init-value eq?)
   (alist :accessor alist-of :init-value '())))

(define (make-alist-table . maybe-key=)
  (make <alist-table> :key= (get-optional maybe-key= eq?)))

(define-method alist-table-get ((self <alist-table>) key . maybe-default)
  (cond ((assoc key (alist-of self) (key=-of self)) => cdr)
        ((null? maybe-default)
         (error "alist table doesn't have an entry for key" key))
        (else (car maybe-default))))

(define-method alist-table-put! ((self <alist-table>) key val)
  (cond ((assoc key (alist-of self) (key=-of self))
         => (lambda (kv) (set-cdr! kv val)))
        (else (push! (alist-of self) (cons key val)))))

(define-method alist-table-exists? ((self <alist-table>) key)
  (if (assoc key (alist-of self) (key=-of self)) #t #f))

(define-method alist-table-delete! ((self <alist-table>) key)
  (receive (kv alist) (assoc+delete1! key (alist-of self) (key=-of self))
    (if kv
        (begin (set! (alist-of self) alist)
               #t)
        #f)))

(define-method call-with-iterator ((self <alist-table>) proc . args)
  (let1 p (alist-of self)
    (proc (lambda () (null? p))
          (lambda () (pop! p)))))

(define (find-tail+prev pred lis)
  (let loop ((lis lis)
             (prev '()))
    (if (null? lis)
        (values #f #f)
        (if (pred (car lis))
            (values lis prev)
            (loop (cdr lis) lis)))))

(define (assoc+delete1! key alist . args)
  (let1 = (get-optional args eq?)
    (receive (tail prev) (find-tail+prev (lambda (elt) (= (car elt) key))
                                         alist)
      (if tail
          (if (null? prev)
              (values (car tail) (cdr alist))
              (begin
                (set-cdr! prev (cdr tail))
                (values (car tail) alist)))
          (values #f alist)))))

(use gauche.test)
(test "" '((a . 1) ((b . 2) (c . 3)))
      (lambda () (receive r (assoc+delete1! 'a '((a . 1) (b . 2) (c . 3))) r)))
(test "" '((b . 2) ((a . 1) (c . 3)))
      (lambda () (receive r (assoc+delete1! 'b '((a . 1) (b . 2) (c . 3))) r)))
(test "" '((c . 3) ((a . 1) (b . 2)))
      (lambda () (receive r (assoc+delete1! 'c '((a . 1) (b . 2) (c . 3))) r)))
(test "" '(#f ((a . 1) (b . 2) (c . 3)))
      (lambda () (receive r (assoc+delete1! 'd '((a . 1) (b . 2) (c . 3))) r)))

(define a (make-alist-table))
(alist-table-put! a 'a 1)
(alist-table-put! a 'b 2)
(alist-table-put! a 'c 3)
(alist-table-put! a 'a 4)
(test "" #t (lambda () (alist-table-delete! a 'b)))
(test "" #f (lambda () (alist-table-delete! a 'b)))
(test "" 4 (lambda () (alist-table-get a 'a)))
(test "" #f (lambda () (alist-table-get a 'b #f)))
(test "" #t (lambda () (alist-table-exists? a 'a)))

fuyuki 2003/01/11 19:58:28 PST alist-table-delete!をまじめに書き直した。 prevが必要になるのはかなり一般的な問題じゃないのかなあ。なんで最初からこうなってないんだ？>srfi-1 findの見つからなかった場合をどう表現するか問題もこれで処理しとけばいいような(それともまたなんか勘違いしてる？？)。あと、Gaucheの場合、Cで実装されている関数を選んで使ったほうが速くなる気がする。alist-table-delete!もassocとalist-delete!で書いちゃったほうがたぶん速い。

Shiro 2003/01/11 21:07:02 PST: prevが必要なのって、callerがset-cdr!したいからですよね。srfi-1はわりと関数型のアプローチに見えるので、そういう副作用を前提とするアプローチは避けたんじゃないでしょうか。srfi-1には確かに!付き手続きも多数定義されていますが、あくまで「実装は渡されたリストのセルを再利用してもよい」というadvisoryな仕様であって、純粋に副作用無しで実装することも許していますね。

write barrier使った世代別GCで、新しいセルはstack allocationするような処理系だと、もしかするとset-cdr!よりセルをコピーした方が速いなんてことはあるんでしょうか。ありそうな気もするけど、そのへんちゃんと測ったこと無いのでわかりません。

あとfind等で2つ値を返すようにするのはCommonLispなんかで良くありますが、 CLでは使わない返り値が無視できるのに対し、Schemeでは受け手もきっちり同じ数で受けなきゃならないので、嫌ったのかも。

memoizeといろいろ

そもそもmemoizeとはなにか

memoize。いわゆるひとつのmemoize。テキストや論文にはよく出てくるくせに実際に使われているのをめったに見ない謎の関数。くわしくはこっち。

http://www.geocities.co.jp/SiliconValley-PaloAlto/7043/#memoize

(ていうかぜんぜん説明してないやろ、自分)

なお、PerlやRubyにもmemoizeモジュールがある。でもってやっぱりあんまり使われていないみたい。

Schemeで書いてあるなかでいちばん凝ってそうなのがこれ。

http://www.mit.edu/afs/sipb/project/mechanics/scmutils/src/general/memoize.scm

memoise って、SICP にもありますが、パズル的で結構おもしろいですね。-- nobsun
- cons をmemoise すると equal? なリストは、eq?なリストになるので、比較が楽。とか (HLISP ?)
- memo table をガーベッジ・コレクションの対象にすると、まさにキャッシュだよね。とか
- weak hashの登場を待ちましょう>上　--fuyuki
この項、おもしろいので独立させません? Scheme:memoizeといろいろ?とか。Shiro
- それも考えたんですが、内容がいいかげんな個人連載なのでやめときました。ちなみに未完の三部作なので今回で終わりです。次の企画はGauche:イディオムかな。--fuyuki

まずは自分で書いてみる

R5RSだとこんな感じ。

;; In R5RS
(define (memoize fn)
  (let ((cache '()))
    (lambda args
      (apply values (or (cond ((assoc args cache) => cdr)
                              (else #f))
                        (call-with-values (lambda () (apply fn args))
                          (lambda result
                            (set! cache (cons (cons args result) cache))
                            result)))))))

どこにでもあるmemoize。多値を扱えるのが特徴といえば特徴。

でもハッシュがあるならやっぱりそっちを使いたいよね。

Gaucheだとこんなん。

;; In Gauche
(define (memoize fn)
  (let1 cache (make-hash-table 'equal?)
    (lambda args
      (apply values (or (hash-table-get cache args #f)
                        (receive result (apply fn args)
                          (hash-table-put! cache args result)

                          result))))))

使う

よくある例。

(define (fib n)
  (cond ((= n 0) 0)
        ((= n 1) 1)
        (else (+ (fib (- n 1)) (fib (- n 2))))))

(set! fib (memoize fib))

(fib 100) => 354224848179261915075

よくない例。

(use srfi-27)

(set! random-real (memoize random-real)) ;memoized random

(random-real) => 0.9575068354342976
(random-real) => 0.9575068354342976
(random-real) => 0.9575068354342976

疑問をいだく

引数にキーワードが入ってると「equal?じゃないけど意味的にはいっしょ」な場合がありえるんですけどどうしたらいいですかせんせー。

ほっとけ。引数をどう扱うかなんてそんなもん関数の勝手だ。気にせんでよろしい。

いじる

上のmemoizeはバックエンドがハッシュに固定されているのでおもしろくない。変えられるようにしてみる。

まずは単純に可変要素を引数にした例。

(define (memoize fn . args)
  (let-optionals* args ((init (make-hash-table 'equal?))
                        (put! hash-table-put!)
                        (get (lambda (cache args)
                               (hash-table-get cache args #f))))
    (let1 cache init
      (lambda args
        (apply values (or (get cache args)
                          (receive result (apply fn args)
                            (put! cache args result)
                            result)))))))

意味もなくキューをキャッシュにしてみる。

(use util.queue)
(set! fib
      (memoize fib
               (make-queue)
               (lambda (cache args result)
                 (queue-push! cache (cons args result)))
               (lambda (cache args)
                 (cond ((find-in-queue
                         (lambda (e) (equal? (car e) args)) cache)
                        => cdr)
                       (else #f)))))

もっといじる

上の例はこんなふうに書いたほうがよりScheme的かもしれない。

(define (memoize fn put! get)
  (lambda args
    (apply values (or (get args)
                      (receive result (apply fn args)
                        (put! args result)
                        result)))))

(use util.queue)
(define (memoize-queue fn)
  (let1 cache (make-queue)
    (define (put! args result)
      (queue-push! cache (cons args result)))
    (define (get args)
      (cond ((find-in-queue
              (lambda (e) (equal? (car e) args)) cache)
             => cdr)
            (else #f)))
    (memoize fn put! get)))

(set! fib (memoize-queue fib))

なお、memoizeを上のようにしておけば、キューなんてもちださなくてもassocで素直に書ける。

(define (memoize-assoc fn)
  (let1 cache '()
    (define (put! args result)
      (set! cache (acons args result cache)))
    (define (get args)
      (cond ((assoc args cache) => cdr)
            (else #f)))
    (memoize fn put! get)))

(set! fib (memoize-assoc fib))

ハッシュ版はこう。

(define (memoize-hash fn)
  (let1 cache (make-hash-table 'equal?)
    (define (put! args result)
      (hash-table-put! cache args result))
    (define (get args)
      (hash-table-get cache args #f))
    (memoize fn put! get)))

(set! fib (memoize-hash fib))

結論(なんの)

むかしのLispの教科書だとこのへんで「おおLispの拡張性はすばらしい」となるのかもしらんが、いまどきこれで感心してくれる人はいないと思う。

次回は(つづくんかい)OO的なアプローチについて。

memoizeとうろうろ

混迷の現代をうろうろ切る(迷惑)。

前回のあらすじ

いやーmemoizeってけっこうえらかったのね。てきとうに検索にひっかかったやつを読んでたら、 memoizeの源流は1968年のNatureに載った記事にさかのぼるらしい。 Natureって、あのNatureだよねえ？

nobsun 2003/01/10 07:04:59 PST あのNatureです。そのペーパーのコピーを持ってたんですがいまは見あたらなぁ。

残酷なOが支配する(こともある)

Schemeだとget, put!はクロージャとして渡すところだけど、今のプログラマーなら「get, put!というふたつのメッセージを受け取るオブジェクトを渡す」と考える人のほうが圧倒的に多いと思う。少なくともOO系言語ならそうする。現にRubyのmemoizeはそうなってる。

Gaucheだと、次のようにすれば <hash-table>がget, put!メッセージを受け取る感じになる。

(define-method get ((self <hash-table>) key)
  (hash-table-get self key #f))

(define-method put! ((self <hash-table>) key val)
  (hash-table-put! self key val))

(define h (make-hash-table))
(put! h 'a 1)
(get h 'a) => 1

で、memoizeをキャッシュとなるオブジェクトを取るように書き直す。

(define (memoize fn cache)
  (lambda args
    (apply values (or (get cache args)
                      (receive result (apply fn args)
                        (put! cache args result)
                        result)))))

(set! fib (memoize fib (make-hash-table 'equal?)))

Gaucheのメソッドディスパッチはあまり速くないらしいが、この場合クロージャ渡し版と比べてたいした差は見られない。

クロージャ版。

;(time (fib 10000))
; real  23.829
; user  23.711
; sys    0.047

OO版。

;(time (fib 10000))
; real  24.581
; user  24.500
; sys    0.047

ということでいとも簡単に終わってしまったので、別のネタをひねり出すことにする。

Soft Objects

「Lispだとオブジェクトシステムがほうらこんなに簡単」みたいなのはいろいろ見たけど、そのなかでは Soft Objects がいちばんのお気に入り。なにしろ単純でいい。ちなみにCGの世界でいうsoft objectsとは全然関係なし。どんなもんかというと、

素直に「クロージャ===オブジェクト」
クラスがない。あるのはすべてのはじまりとなるur-objectだけ。
インスタンス生成はオブジェクトを別のクロージャでラッピングする感じ。

つまりここでは「階級制を打破して大いなる一者に回帰すべし」というまことに日本人ごのみというかドイツ人ごのみというかな思想が表明されているわけだ(ちがう)。クラスがないあたりちょっと Self に似てなくもない。

まあうだうだ説明するより現物を見てもらったほうが早いと思う。ミニマムな実装を論文から抜いてきた。

;; Taken from:
;; Ken Hasse, "Soft Object: A Paradigm for Object Orient Programming"
;; (ftp://publications.ai.mit.edu/ai-publications/pdf/AIM-1014.pdf)

(define (make-new-object old-object handlers)
  (define (new-object message . arguments)
    (if (eq? message 'handle) (make-new-object new-object arguments)
        (let ((local-handler (mget message handlers)))
          (if local-handler (apply local-handler arguments)
              (apply old-object message arguments)))))
  new-object)

(define (mget message handlers)
  (if (null? handlers) #F
      (if (eq? (car handlers) message) (cadr handlers)
          (mget message (cddr handlers)))))

(define (ignoramus message . arguments)
  (error "Can't handle message" message arguments))

(define ur-object (make-new-object ignoramus ()))

こんだけ。なにそれ。

変容のオブジェクト

いちおう上のコードを説明する。 "ur" はドイツ語から来た語でprimaryみたいな意味。 "ignoramus" はラテン語から来た語で「ものしらず」。ってコードの説明じゃないけど、つまずきそうなのはこれくらいのもんでしょ。なお、 EDICT でignoramusを引くと、「盲」「不束者」と出る。そう読みかえるのも一興。

例を見ないとようわからんという向きのために(おれだ)実際に使ってみる。キャッシュオブジェクトを定義する。

(define cache
  (let1 h (make-hash-table 'equal?)
    (ur-object 'handle
               'get (lambda (key) (hash-table-get h key #f))
               'put! (lambda (key val) (hash-table-put! h key val)))))

ここではur-objectを変形してcacheというオブジェクトを生成している。オブジェクトが括弧の先頭に来るのがいいやね。

let1の下をいんちきOO言語で書くと、

ur-object.handle('get => (lambda (key) (hash-table-get h key #f)),
                 'put! => (lambda (key val) (hash-table-put! h key val)))

といったところか。つまり、ur-objectに対して「これこれこういうメッセージを処理するオブジェクトを作ってね。 getが来たらこう、put!が来たらこう」という指令を出しているわけだ。いいかえれば、原初の一を棒でつつくとたちどころに懐胎し、光のアムダを産み落とすという筋書き。

アムダ(もういいって)をさらにつついてみる。

(cache 'put! 'a 1)
(cache 'get 'a) => 1

戯お邪魔します。HasheWiki:クロージャとオブジェクト/例えばオブジェクトを「シンボルを引数に取る関数」ととらえて見るとを思い出しました。
- fuyuki や、おんなじようなことを考えている人がいますね (議論自体は難しくてついていけない ;)。個人的にはgeneric functionは強力なしかけだとは思うんですが、微妙にもてあまし気味な感じがしています。
- あちらで議論を続けられない(^^;のと、ちょうど今の話題に絡むので、ここに書きますが、 HasheWiki:クロージャとオブジェクト/Schemerがオブジェクトを使う時の「いちいちオブジェクト定義をするのがめんどくさい」への反論(?)として、「Objectは本来"生成"するもんであって"定義"するもんじゃない。いちいち定義なんかしないとならん面倒な言語が駄目なんだ」という気がしています(^^;。
  - ゆえに俺は最近、(LightWeight言語では)Class方式はちょっと敬遠中。Prototypeな言語で(もし必要を感じたら)Classを自作するのは容易なのだから不安は無し。
  - ドリトルって(日本語でPrototypeOOPな)言語が面白いかも。あと今自分で作って遊んでる言語もPrototype方式。

逆襲のmemoize

上で定義したcacheを取るようにmemoizeを書き換える。

(define (memoize fn cache)
  (lambda args
    (apply values (or (cache 'get args)
                      (receive result (apply fn args)
                        (cache 'put! args result)
                        result)))))

(set! fib (memoize fib cache))

あんまり変わんないね。スピードはさすがに遅くなるだろうと思ったら、こっちもたいして変わらない。

;(time (fib 10000))
; real  23.403
; user  23.336
; sys    0.031

Last modified : 2014/06/15 18:04:27 UTC