ネコになるとしたらオッドアイのネコになりたい。左右の眼の色が違う珍しいネコ。
と考えていたら、そう思った。
質問「どうして2つ必要なの?」
答え「オッドアイのネコになりたいから」
質問「複数の場合は? どうして複数必要なの?」
答え「私が複数のオッドアイのネコになりたいから」
答えにならないかもしれないことを頭の中の色々なネコに閉じ込めたい。シュレーディンガーの猫もそういう借りてきたネコの一種だ。自分でもよくわからなくなってきた。だた、「オッドアイのネコになりたい」というところはシックリきている。これは自分の井戸でこだましている声。答えがないことは、答えがないのだから答えられないかもしれないが、心にハマってそれを止める言葉は常に存在するかもしれない。そういう言葉をたくさん知っている人間になりたい。
昨日はHaskellで二分探索木の勉強をした。
Common Lispでもそれと同じようなことをしている人を見つけた。
ありがたい。浅くしかコードを読んでいないが、コピー・アンド・ペーストして実行することで、溜飲を下げる。
(ql:quickload :optima) (use-package :optima) (defstruct (leaf (:constructor leaf))) (defstruct (node (:constructor node (color left label right))) color left label right) (defun rb-member (x tree) (match tree ((leaf) nil) ((node left label right) (cond ((< x label) (rb-member x left)) ((> x label) (rb-member x right)) (t t))))) (defun red (left label right) (node :red left label right)) (defun black (left label right) (node :black left label right)) (defpattern red (left label right) `(node (color :red) (left,left) (label ,label) (right ,right))) (defpattern black (left label right) `(node (color :black) (left,left) (label ,label) (right ,right))) (defun balance (tree) (match tree ((or (black (red (red a x b) y c) z d) (black (red a x (red b y c)) z d) (black a x (red (red b y c) z d)) (black a x (red b y (red c z d)))) (red (black a x b) y (black c z d))) (otherwise tree))) (defun rb-insert (x tree) (labels ((ins (tree) (match tree ((leaf) (red (leaf) x (leaf))) ((node color left label right) (cond ((< x label) (balance (node color (ins left) label right))) ((> x label) (balance (node color left label (ins right)))) (t tree)))))) (match (ins tree) ((node left label right) (black left label right)))))
上が書かれたファイルをロードしてからREPLで下のようにやってみる。
CL-USER> (setq tree (leaf)) #S(LEAF) CL-USER> (mapcar (lambda (xx) (setq tree (rb-insert xx tree))) '(8 6 4 1 7 3 5)) (#S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 8 :RIGHT #S(LEAF)) #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(LEAF) :LABEL 6 :RIGHT #S(LEAF)) :LABEL 8 :RIGHT #S(LEAF)) #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 4 :RIGHT #S(LEAF)) :LABEL 6 :RIGHT #S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 8 :RIGHT #S(LEAF))) #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(LEAF) :LABEL 1 :RIGHT #S(LEAF)) :LABEL 4 :RIGHT #S(LEAF)) :LABEL 6 :RIGHT #S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 8 :RIGHT #S(LEAF))) #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(LEAF) :LABEL 1 :RIGHT #S(LEAF)) :LABEL 4 :RIGHT #S(LEAF)) :LABEL 6 :RIGHT #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(LEAF) :LABEL 7 :RIGHT #S(LEAF)) :LABEL 8 :RIGHT #S(LEAF))) #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 1 :RIGHT #S(LEAF)) :LABEL 3 :RIGHT #S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 4 :RIGHT #S(LEAF))) :LABEL 6 :RIGHT #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(LEAF) :LABEL 7 :RIGHT #S(LEAF)) :LABEL 8 :RIGHT #S(LEAF))) #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 1 :RIGHT #S(LEAF)) :LABEL 3 :RIGHT #S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 4 :RIGHT #S(NODE :COLOR :RED :LEFT #S(LEAF) :LABEL 5 :RIGHT #S(LEAF)))) :LABEL 6 :RIGHT #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(LEAF) :LABEL 7 :RIGHT #S(LEAF)) :LABEL 8 :RIGHT #S(LEAF)))) CL-USER> tree #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 1 :RIGHT #S(LEAF)) :LABEL 3 :RIGHT #S(NODE :COLOR :BLACK :LEFT #S(LEAF) :LABEL 4 :RIGHT #S(NODE :COLOR :RED :LEFT #S(LEAF) :LABEL 5 :RIGHT #S(LEAF)))) :LABEL 6 :RIGHT #S(NODE :COLOR :BLACK :LEFT #S(NODE :COLOR :RED :LEFT #S(LEAF) :LABEL 7 :RIGHT #S(LEAF)) :LABEL 8 :RIGHT #S(LEAF))) CL-USER> (rb-member 8 tree) T CL-USER> (rb-member 100 tree) NIL CL-USER> (rb-member 1 tree) T CL-USER> (rb-member 10 tree) NIL CL-USER> (mapcar (lambda (xx) (rb-member xx tree)) '(1 2 3 4 5 6 7 8 9 10)) (T NIL T T T T T T NIL NIL)
Common Lispの方の木はごちゃごちゃしていて、Haskellの方をやっていなかったら、すごく理解しにくかったと思う。わかっていても (mapcar (lambda (xx) (setq tree (rb-insert xx tree))) '(8 6 4 1 7 3 5)) の後のは目が滑って迷子になる。
低脳だから学ばなければならないはずだけど、低脳だと気づきたくないから目を背けてしまう。最近プログラミングの勉強を疎かにしている。「よくないな久しぶりにやろうか」ということで、今日はこれ「Learn You a Haskell for Great Good!」を少し読み進めた。
binary search tree、もしくは赤黒木?(上の画像は白黒木のwikipediaから拝借した) の実装のところで、再帰を使って木の型を定義するのは、シンプルだが不思議な感覚がして感銘を受けた。そういえば、私は木というものが昔から好きだった。忘れると思ったから私が今日読んだ当該部分をコピペする。
--Treeという型をつくる。 data Tree a = EmptyTree | Node a (Tree a) (Tree a) deriving (Show, Read, Eq) --ノードの末端は空(NIL)ということ。 singleton :: a -> Tree a singleton x = Node x EmptyTree EmptyTree --Treeの中に要素を挿入する。要素は順序が比較できる型を持っていなければならない。 treeInsert :: (Ord a) => a -> Tree a -> Tree a treeInsert x EmptyTree = singleton x treeInsert x (Node a left right) | x == a = Node x left right | x < a = Node a (treeInsert x left) right | x > a = Node a left (treeInsert x right) --Treeにある特定の要素が入っているか確認する。 treeElem :: (Ord a) => a -> Tree a -> Bool treeElem x EmptyTree = False treeElem x (Node a left right) | x == a = True | x < a = treeElem x left | x > a = treeElem x right
そして、端末からghciの中に入って、上の関数が書かれたファイルをロードする。
ghci> :l ファイル名
それから、たとえば次のように入力してみる。
ghci> let nums = [8,6,4,1,7,3,5] ghci> let numsTree = foldr treeInsert EmptyTree nums ghci> numTree Node 5 (Node 3 (Node 1 EmptyTree EmptyTree) (Node 4 EmptyTree EmptyTree)) (Node 7 (Node 6 EmptyTree EmptyTree) (Node 8 EmptyTree EmptyTree)) ghci> 8 `treeElem` numsTree True ghci> 100 `treeElem` numsTree False ghci> 1 `treeElem` numsTree True ghci> 10 `treeElem` numsTree False
上のfoldrで折り畳んでnumsに入っていた数字をTreeの中に入れるのはいいなと思った。Skitchを使って指で適当につくった雑なものだけど、numsTreeの図を書いてみた。
foldrでright(右)から畳み込むやり方をやったので、ついでだから、foldlでleft(左)からも同じことをやってみる。
ghci> let numsTree00 = foldl (flip treeInsert) EmptyTree nums ghci> numsTree00 Node 8 (Node 6 (Node 4 (Node 1 EmptyTree (Node 3 EmptyTree EmptyTree)) (Node 5 EmptyTree EmptyTree)) (Node 7 EmptyTree EmptyTree)) EmptyTree ghci> map ((flip treeElem) numsTree00) [1..10] [True,False,True,True,True,True,True,True,False,False]
numsTree00の図を書いてみたが、右から入れた場合と木の形が違う。要素を入れる順序によってつくられる木の形が変わるんだね。
