フィボナッチ数個の要素からなる木を表す非正則な代数的データ型

非正則データ型 (non-regular data type) というのは、再帰的な代数的データ型のうち、定義において自身を呼び出すときの引数が左辺と異なるものです。下の例では、左辺では F a b ですが右辺では引数が変わり F b (a,b) となっています。

非正則データ型は単純ですが奥が深いです。昔から知られているものだと完全二分木やドブラウン (de Bruijn) インデックスのラムダ項、最近だとフリーアプリカティヴ や FunList や Bazaar などが有名です。ちなみに完全二分木は『関数プログラミングの楽しみ』第10章でバタフライ回路の記述のために、アローと組み合わせて活用されています。

いろいろ別のことを考えていたらそういえば完全二分木だけでなくてフィボナッチ数個の要素からなる木も作れるな、と思って書いてみました。実用例は思いつきませんが、複数引数の非正則データ型の例として参考になるかもしれません。

-- fibonacci-number-element tree
newtype Fib a = Fib {unFib :: F a a}
data F a b = DoneF b | MoreF (F b (a, b))

-- binary tree
data Bin a = Leaf a | Node (Bin a) (Bin a)
instance Functor Bin where
	fmap f (Leaf a) = Leaf (f a)
	fmap f (Node l r) = Node (fmap f l) (fmap f r)
join :: Bin (Bin a) -> Bin a
join (Leaf b) = b
join (Node l r) = Node (join l) (join r)

-- fmap for fibonacci-number-element tree
instance Functor Fib where
	fmap f (Fib x) = Fib (bimap f f x)
bimap :: (a -> a') -> (b -> b') -> F a b -> F a' b'
bimap g h (DoneF b) = DoneF (h b)
bimap g h (MoreF x) = MoreF (bimap h (\(a,b) -> (g a, h b)) x)

-- fibonacci-number-element tree to binary tree
treeifyFib :: Fib a -> Bin a
treeifyFib = fmap (\e -> case e of Left a -> a; Right a -> a) . treeifyF . unFib
treeifyF :: F a b -> Bin (Either a b)
treeifyF (DoneF b) = Leaf (Right b)
treeifyF (MoreF f) = join $ fmap (\e -> case e of
	Left b -> Leaf (Right b); Right (a,b) -> Node (Leaf (Left a))
	(Leaf (Right b))) (treeifyF f)

ghci で型を確かめてみると、要素の数が確かにフィボナッチ数個になっています。

> :t Fib . MoreF . MoreF . MoreF . MoreF . MoreF . DoneF
Fib . MoreF . MoreF . MoreF . MoreF . MoreF . DoneF
  :: (((a, a), (a, (a, a))), ((a, (a, a)), ((a, a), (a, (a, a)))))
     -> Fib a