こんにちは、びしょ〜じょです。では、今週1のハイライトです。

本を買ってもらったりノートpcを貸してもらったりして、研究室はどんどん利用していきたいですね。


1. はじめに

『Purely Functional Data Structures』2(以降、"PFDS"と省略する)という本の邦訳版が出ました。 名著とのことで、また読める位置にも原著があったが結局読んでこなかったが、この度ジャパニーズで読めてしまう以上は読んでおきたいと思い、購入に至りました。

さて、PFDSに記述されている例はすべてStandard MLで書かれている。 邦訳したkinabaさんによるSMLの解説もある。

(中略)

せっかくなのでTyped Racketで実装していってみたい。 本にも「schemeによる実装も容易」と書かれているように、Racketでも伝統的なcarcdr…といった関数がある。 しかし残念ながらMLのmodule systemやHaskellの型クラスに相当するものはない。 core RacketにもMLとは別のmodule systemがあるため、マクロ展開時にmodule importをcontractで制御できればいい感じになるんちゃうかと思うんですが、皆さんへの課題とします。 parametric contractをrequire/contractに噛ませるといいんですかね。適当言ってます。

2. 永続性 ー リスト、スタック、二分探索木

2-1. リスト

#lang typed/racket
; list.rkt

(require racket/match)

(provide (all-defined-out))

(define-type {MyList A} (U
                          Empty
                          (Cons A (MyList A))))

(struct Empty () #:transparent)
(struct {A _} Cons ([x : A] [xs : (MyList A)]) #:transparent)

(define (raise-empty-stack)
  (raise 'Empty-MyList))

(: empty Empty)
(define empty (Empty))

(: isEmpty (-> (MyList Any) Boolean))
(define isEmpty
  (match-lambda
    [(Empty) #t]
    [_ #f]))

(: cons (All {A} (-> A (MyList A) (MyList A))))
(define (cons a s)
  (Cons a s))

(: head (All {A} (-> (MyList A) A)))
(define head
  (match-lambda
    [(Empty) (raise-empty-stack)]
    [(Cons a _) a]))

(: tail (All {A} (-> (MyList A) (MyList A))))
(define tail
  (match-lambda
    [(Empty) (raise-empty-stack)]
    [(Cons _ s-) s-]))

(: ++ (All {A} (-> (MyList A) (MyList A) (MyList A))))
(define/match (++ xs ys)
  [((Empty) _) ys]
  [((Cons x xsr) _) (cons x (++ xsr ys))])

(: update (All {A} (-> (MyList A) Integer A (MyList A))))
(define/match (update xs i y)
  [((Empty) _ _) (raise-empty-stack)]
  [((Cons _ xsr) 0 y) (Cons y xsr)]
  [((Cons x xsr) i y) (Cons x (update xsr (sub1 i) y))])

なるほど。いろいろなパターンマッチの方法がある以外あまり見どころはないですね。

演習2.1

(: suffixes (All {A} (-> (MyList A) (MyList (MyList A)))))
(define/match (suffixes xs)
  [((Empty)) empty]
  [((Cons _ xsr)) (cons xs (suffixes xsr))])

リストの先頭を消費して残りを再帰的に適用していくので、リストの長さ\(n\)に対して\(O(n)\)。

2-2. 二分探索木

#lang typed/racket
; binsearchtree.rkt

(require racket/match)

(provide (all-defined-out))

(struct Empty () #:transparent)
(struct {T E T} Node ([left : (Tree E)] [val : E] [right : (Tree E)]) #:transparent)

(define-type {Tree Elem} (U
                           Empty
                           (Node (Tree Elem) Elem (Tree Elem))
                           ))

(: member  (-> Real (Tree Real) Boolean))
(define (member a t)
  (match t
    [(Empty) #f]
    [(Node l v r)
     (if (> v a)
       (member a l)
       (if (< v a)
         (member a r)
         #t))]))

(: insert (-> Real (Tree Real) (Tree Real)))
(define (insert a t)
  (match t
    [(Empty) (Node (Empty) a (Empty))]
    [(Node l v r)
     (if (> v a)
       (Node (insert a l) v r)
       (if (> v a)
         (Node l v (insert a r))
         t))]))

(Tree Real)しか使えないのはやはり厳しいですね。モジュールや型クラスを用いずに>などを持つ型Aといった感じのものを定めるには…。

演習2.2 ノードの値の比較回数が(木の深さ+1)に収まるmember

(: member2 (-> Real (Tree Real) Boolean))
(define (member2 a t)
  (: member2-impl (-> Real (Tree Real) Real Boolean))
  (define (member2-impl a t c)
   (match t
    [(Empty) (eq? a c)]
    [(Node l v r)
     (if (< a v)
       (member2-impl a l c)
       (member2-impl a r v))]))

  (member2-impl a t 0))

比較したノードの値をキャッシュとして持っていって、木の底についたらキャッシュした値との比較の結果を返します。 キャッシュの初期値に0を与えているけどいいのかな、わからん。

演習2.3 すでに木の中に要素aがある場合はノードのコピーをしないinsert

(: insert2 (-> Real (Tree Real) (Tree Real)))
(define (insert2 a tx)
  (: insert2-impl (-> Real (Tree Real) (-> (Tree Real) (Tree Real)) (Tree Real)))
  (define (insert2-impl a t k)
    (match t
      [(Empty) (Node (Empty) a (Empty))]
      [(Node l v r)
       (if (> v a)
         (Node (insert2-impl a l k) v r)
         (if (< v a)
           (Node l v (insert2-impl a r k))
           (k tx)))]))

    (call/cc (lambda ([k : (-> (Tree Real) (Tree Real)) ]) (insert2-impl a tx k))))

Blood of schemeということでcall/ccを使ってみました。雑だ。 もともとは例外飛ばしていけとのことなので、例外キャッチして元の値を返すなどでOKでしょう。

演習2.4 演習2.2と2.3の融合 ノードの値の比較回数が(木の深さ+1)に収まる、すでに木の中に要素aがある場合はノードのコピーをしないinsert

(: insert3 (All {A} (-> Real (Tree Real) (Tree Real))))
(define (insert3 a tx)
  (: insert3-impl (All {All} (-> Real (Tree Real) Real (-> (Tree Real) (Tree Real)) (Tree Real))))
  (define (insert3-impl a t c k)
    (match t
      [(Empty)
       (if (eq? a c)
         (k tx)
         (Node (Empty) a (Empty)))]
      [(Node l v r)
       (if (< a v)
         (Node (insert3-impl a l v k) v r)
         (Node l v (insert3-impl a r v k)))]))

  (call/cc (lambda ([k : (-> (Tree Real) (Tree Real))]) (insert3-impl a tx 0 k))))

member2のように底までキャッシュを引き回して、底に来たときに比較してあるやんけ! となれば最初に受け取った引数の木を継続に渡して脱出します。やったか…!?

演習2.5

(1) すべてのノードにxが格納された、深さdの完全二分木ジェネレーター

(: complete (All {A} (-> A Integer (Tree A))))
(define (complete x n)
(if (= n 0)
  (Empty)
  (let ((subt (complete x (sub1 n))))
    (Node subt x subt))))

深さdに対して線形に動作するので、\(O(d)\)。

はい。

(2) 任意のサイズの平衡木ジェネレーター

よくわからん

演習2.6

ファンクターに相当する機能なし

3. おわりに

Typed RacketはuntypedだったRacketの資産も活用してうまくやっていこうというGradual typingなのであんまり強くないね、というのを再確認しました。 Typed LuaやFlowtype、Pythonの型アノテーション、といった型の面々…


今週の百合コーナー

『コレクターズ』が本当にやばかった。『となりのロボット』を書き上げる西UKO先生ですからね、最高や。


  1. 19日からだらだら書いているので、本記事の中で時空の歪みが生じている。よって宇宙人は存在する。 

  2. 原著邦訳版