こんにちは､びしょ〜じょです｡では､今週¹のハイライトです｡

ノートpcを修理に出したら10日くらい音沙汰なかった挙句修理費見積もりが本体価格より3万くらい高くて完全にバカにしてきてるなlenovo､はよ死んでくれ…｡
— びしょ〜じょ (@Nymphium) May 16, 2017

研究室からマッキブックproを拝借する運びとなった。
— びしょ〜じょ (@Nymphium) May 18, 2017

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

1. はじめに

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

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

(中略)

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

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

2-1. リスト

src/pfds/2/list.rkt

list.rkt

#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. 二分探索木

src/pfds/2/binsearchtree.rkt

binsearchtree.rkt

#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先生ですからね､最高や｡

19日からだらだら書いているので､本記事の中で時空の歪みが生じている｡よって宇宙人は存在する｡ ↩
原著と邦訳版 ↩

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

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

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