2013/12/20

gosh> (time (find-heron 100))
;(time (find-heron 100))
; real   1.011
; user   0.967
; sys    0.032
((100 100 56) (100 99 89) ...

norm> (time (find-heron 100))
((100 100 56) (100 99 89) ...
total 0.897 second
GC    0.0 second
#<undef>
norm>

ああ、そうか。

sqrt は正確な正の平方数が与えられたら、正確な結果を返す (cf. Exact sqrt) のだけど、その計算を

exact-integer-sqrt で正確な正の引数nに対し n = q*q + m (0 <= m < q) なる正確数q, mを計算
mが0ならqが答え
そうでなければnは正確数の平方数ではないので浮動小数点数にしてCのsqrtに投げる

としていた。これだと引数が有理数の平方数でない場合、 exact-integer-sqrt で一回平方根に近い正確値を計算し、さらに3.でもう一度sqrtを計算するという二度手間をやってたことになる。

二度手間を避けるようにしたらこれこのとおり。

変更前

shiro@scherzo:~/src/Gauche/src$ ./gosh -ftest ../heron.scm
;(time (find-heron 100))
; real   0.722
; user   0.720
; sys    0.000

変更後

shiro@scherzo:~/src/Gauche/src$ ./gosh -ftest ../heron.scm
;(time (find-heron 100))
; real   0.617
; user   0.620
; sys    0.000

Tags: Programming, Gauche

Comments (0)

2013/12/08

#permalink

コンポジションに便利なpropagatedスロット

Metaobject Protocol(MOP) Advent Calendar 2013参加エントリ (12/9分)

GUI作っている時などによく出会うケースだけど、複数の関連するオブジェクトをまとめてひとつのオブジェクトとして扱いたいことがある。例えばラベル、テキストボックス、アイコンイメージを並べたものをひとつのウィジェットとして扱いたい、とか。

これはまあ普通にコンテナとなるクラスのサブクラスを作って部品を配置し、必要な処理について委譲するメソッドを書いてやればいいんだけど、 GUIなんかだと「子ウィジェットのこのプロパティ(スロット)を合成した部品のプロパティとして見せたい」ってのが多い。上の例のウィジェットでテキストボックスのtextスロットを合成ウィジェットのtextスロットとして参照させたい、等。

テキストボックス自体をスロットとして見せることで、(~ widget 'text-box 'text) というふうに多段で参照させる手もあるけど、必要以上に中身を見せている感じがしていまいち。(アクセスコントロールがデフォルトで備わっていないCLOSで中身が見えるのを気にするのも妙な話ではあるけれど、上のような多段アクセス法を公式なAPIにしてしまうと、後で実装を変えたくなった時に面倒だったり、途中のオブジェクトへの参照を予想外のところで保持されて困ったりする。)

そんな時にpropagatedスロット。これは自分が内包しているオブジェクトのスロットをあたかも自分のスロットであるかのように見せるスロットオプションだ。 Gaucheでは gauche.mop.propagate モジュールで提供されている。もともとSTkにあった機能を真似したものだ。最低限の部分だけ示すとこんな感じ：

(use gauche.mop.propagate)

(define-class <text-box> ()
  ((text :init-keyword :text)))

(define-class <composited-widget> ()
  ((text-box :init-form (make <text-box>))
   (text     :allocation :propagated
             :propagate-to 'text-box
             :init-keyword :text))
  :metaclass <propagate-meta>)

<composited-widget> の text スロットへの読み書きは、 text-box に保持された text スロットへの読み書きになる。通常の方法で初期化もできるので、当初<text-box>を使っていたコードを変えずにその部品だけ<composited-widget>にすげ替えることができたりして便利。

gosh> (define cw (make <composited-widget> :text "abc"))
cw
gosh> (~ cw 'text)
"abc"
gosh> (~ cw 'text-box 'text) ; 確かに子ウィジェットに伝わってるか確認
"abc"
gosh> (set! (~ cw 'text) "def")
#<undef>
gosh> (~ cw 'text-box 'text) ; 確かに子ウィジェットに伝わってるか確認
"def"

さて、この機能もMOPで実現されている。これまでの例と同じく、compute-get-n-set をオーバライドする。 allocation スロットオプションが :propagated なら自前で作ったアクセサ手続きを返し、そうでなければnext-methodを呼んでデフォルトの振る舞いに任せる。 (matchの二番目の節は、子スロットの名前と違う名前を親スロットで定義したい場合の処理)。

(define-method compute-get-n-set ((class <propagate-meta>) slot)
  (let ([name  (slot-definition-name slot)]
        [alloc (slot-definition-allocation slot)])
    (if (eq? alloc :propagated)
      (match (or (slot-definition-option slot :propagate #f)
                 (slot-definition-option slot :propagate-to #f))
        [(? symbol? prop)
         `(,(^o (slot-ref (slot-ref-using-class class o prop) name))
           ,(^(o v) (slot-set! (slot-ref-using-class class o prop) name v))
           ,(^o (slot-bound? (slot-ref-using-class class o prop) name))
           #t)]
        [((? symbol? object-slot) (? symbol? real-slot))
         `(,(^o (slot-ref (slot-ref-using-class class o object-slot)
                          real-slot))
           ,(^(o v) (slot-set! (slot-ref-using-class class o object-slot)
                               real-slot v))
           ,(^o (slot-bound? (slot-ref-using-class class o object-slot)
                             real-slot))
           #t)]
        [other
         (errorf "bad :propagated slot option value ~s for slot ~s of class ~s"
                 other name class)])
      (next-method))))

compute-get-n-set が返しているのは4要素のリストで、各要素の意味は