Data.Traversable

みなさんいかがお過ごしでしょうか。きれいな象さん本が出た昨今、皆様におかれましても急速にHaskell熱が高まっておられるものと思います。え？高まってない？KY*1

さて、象さん本を読んだことで僕もFunctor, Applicative, Monoid, Monadといった型クラスがなんとなく分かりました。正直Applicativeは未だにちゃんと分かってません。そんな僕ですが今回はとても便利な型クラスを紹介したいと思います。それはData.Traversableです。

ドキュメンテーションとしての型

そもそも僕がTraversableを知ったのは、「こんな型の関数が欲しいな〜」と思って、自分で実装する前に試しにhoogleで型を検索してみたらそのものずばりの型があった、という経緯です。その時のクエリはたしかt a -> (a -> m b) -> m (t b)でした。「型はドキュメントたりうる」という名ゼリフを実感しました。この型こそ、Traversableの基本操作である関数traverseだったのです。

class (Functor t, Foldable t) => Traversable t where
  traverse :: Applicative f => (a -> f b) -> t a -> f (t b)

ウゲー、Applicativeが出てきました。よくわからないのでMonadに読み替えましょう。それでも良くわからないので、IOモナドを具体例に取りましょう。tは自分がトラバースしたいデータ構造です。かりに木だとしましょう。

   traverse :: -- トラバースは 
   (a -> IO b) -- 「aを取ってbを返すプログラム」を元に、
-> Tree a      -- 『「aを要素にもつ木」を取って
-> IO (Tree b) -- 　bを要素にもつ木を返すプログラム』を作ってくれる。

ということのようです。要素を扱うモナドが既にあって、その要素からなる複雑なデータ構造があるとき、データ構造をくまなく舐めてくれるモナドが一発で作れる。そうそうこれがやりたかったんです！

Traversableココが凄い！

以下のようにPlayTree.hsを作って、インタプリタから読み込んでみます。

> cat PlayTree.hs
{-# OPTIONS -Wall #-}
import Control.Applicative
import Data.Foldable
import Data.Functor
import Data.Monoid
import Data.Traversable
import Prelude hiding (mapM,sequence,fmap,foldr, foldl,foldl1,foldr1)

data Tree a = Empty | Node a (Tree a) (Tree a) 

instance (Show a) => Show (Tree a) where
  show Empty = ""
  show (Node x left right) = "(" ++ show x ++ show left ++ show right ++ ")"

instance Functor Tree where
  fmap = fmapDefault
instance Foldable Tree where
  foldMap = foldMapDefault

instance Traversable Tree where
  traverse _ Empty               = pure Empty
  traverse up (Node x left right) = 
    Node <$> up x <*> traverse up left <*> traverse up right

> ghci PlayTree.hs
 ...
Ok, modules loaded: Main.
 *Main> 

これでTraversableなTreeが出来ました！

すごい１：定義すべきはtraverseだけ

自作のデータ構造をTraversableにするために必要なのはただ一つ。traverseという関数を定義する事です。では、上のtraverseをどうやって作ったのかを説明しましょう。

  traverse :: Applicative f => (a -> f b) -> t a -> f (t b)

全然わからないけどApplicative？っていうの？を使った何か？をどうにかして組み立てないといけません。材料はおそらくこの辺です。

 *Main> :t Empty
Empty :: Tree a
 *Main> :t Node
Node :: a -> Tree a -> Tree a -> Tree a
 *Main> :t pure
pure :: Applicative f => a -> f a
 *Main> :t (<$>)
(<$>) :: Functor f => (a -> b) -> f a -> f b
 *Main> :t (<*>)
(<*>) :: Applicative f => f (a -> b) -> f a -> f b

と、とにかくtraverseの第一引数は関数 up :: a -> f b で、第二引数はTreeのはずです。

instance Traversable Tree where
  traverse up Empty               = undefined
  traverse up (Node x left right) = undefined

Emptyはもうこれ以上崩しようがないので、とりあえずpureっておけばいいでしょう。型はf (Tree b)なので合ってます。

  traverse up Empty               = pure Empty

問題はNodeです。象さん本によるとApplicativeってのは、ピュアな関数をfの上の"関数"に変化させるもので、そのとき元々の呼び出し方「関数　引数　引数　引数」だったものは「関数<$>引数<*>引数<*>引数」という形になるはずです。そこで次の型を調べてみます。

 *Main> :t (\x y z -> Node <$> x <*> y <*> z)
(\x y z -> Node <$> x <*> y <*> z)
  :: Applicative f => f a -> f (Tree a) -> f (Tree a) -> f (Tree a)

というわけでノードをトラバースする式の右辺には "Node <$> x <*> y <*> z"という式を書けば良く、x,y,zの型はそれぞれ f b , f (Tree b) , f (Tree b) であると分かります。

  traverse up (Node x left right) = undefined

左辺には x :: a , left :: Tree a , right :: Tree b が来ています。こいつらは up :: a -> f b と、traverse up :: Tree a -> f (Tree b) を使って必要な型に変えられます！こうしてtraverseを作ることができました。

instance Traversable Tree where
  traverse _ Empty               = pure Empty
  traverse up (Node x left right) = 
    Node <$> up x <*> traverse up left <*> traverse up right

そしてこれは正しく動作します！

・・・うむ、茶番に付き合ってもらってすまない。最初に書いたときはData.TraverseのhaddockにあるTreeのサンプルをいじっただけで、ここまで深く考えたわけじゃないです。

すごい２：どんなモナドでも扱える

Traversableのインスタンスにしただけで、このツリーには数々の強力な機能が備わりました。試してみましょう。架空の一族、sazae家の家系図を作ってみます。

 *Main> let t = Node "sazae" (Node "katsuo" Empty Empty) (Node "wakame" Empty Empty)
 *Main> t
("sazae"("katsuo")("wakame"))

まずはこの木をIOモナドに舐めさせてみましょう。

 *Main> :t mapM (putStrLn) t
mapM (putStrLn) t :: IO (Tree ())
 *Main> mapM (putStrLn) t
sazae
katsuo
wakame
(()(())(()))

木の要素がputStrLnされて、Tree ()が返ってきています。Tree ()を返されたところであまり有用ではありませんが、IOなので「ディレクトリ構造を再帰的に舐めた上で見つかったファイルの中身をディレクトリ木構造に入れて返すIOモナド」なんてのが美しく書けそうですね。

つづいて他のモナドに舐めさせてみます。IO以外のモナドといえば非決定計算です。sazae家の各キャラが男性"M" なのか女性"F" なのかコンスタントに疑い続ける、という姿勢を貫いてみましょう。

 *Main>  mapM (const ["M", "F"]) t
[("M"("M")("M")),("M"("M")("F")),("M"("F")("M")),("M"("F")("F")),("F"("M")("M")),("F"("M")("F")),("F"("F")("M")),("F"("F")("F"))]

予想通り、sazae家のあり得る性別の組み合わせが全列挙されました。リストモナドにはいつも驚かされます。

すごい３：いまなら無料でFunctorとFoldableがついてくる！

Traversableのクラス定義をあらためて見ると、(Functor t, Foldable t) => というコンテキストがついてます。

class (Functor t, Foldable t) => Traversable t where

ウゲー、Traversabe t をインスタンスするにはまず Functor t, Foldable t を書かないといけないの？そんなことはないんです！

Data.Traversableには fmapDefault と foldMapDefaultというのが用意されており、これを使うとFunctorとFoldableのインスタンスは機械的に作れます。

instance Functor Tree where
  fmap = fmapDefault
instance Foldable Tree where
  foldMap = foldMapDefault

Traversable tにするにはまず(Functor t, Foldable t)であること必要だが、(Functor t, Foldable t)であることはTraversable tであることを利用して定義されている。こんなことがどうして可能になるのでしょう。恐らく円環の理の導きによるものだと思われます。Haskellすごいですね。

とにかくこれでTreeはFunctorでもありFoldableでもあるということになりました。Functorなので、木構造を保ったままfmapできます。

 *Main> let age s = if s=="sazae" then 24 else if s=="katsuo" then 11 else 9
 *Main> fmap age t
(24(11)(9))

さらにFoldableですので様々なフォールドが使えます。フォールドは、traverseで指定された順序でツリーの要素を１つづつ綴じ込んでいく、という操作になります。Foldには左派と右派がおり、綴じる方向が違います。

 *Main> foldl (\sum str -> sum + age str) 0 t
44
 *Main> foldr (\str sum -> sum + age str) 0 t
44
 *Main> putStrLn $ foldl1 (\x y -> " <"++x++" "++y++"> ") t
 < <sazae katsuo>  wakame> 
 *Main> putStrLn $ foldr1 (\x y -> " <"++x++" "++y++"> ") t
 <sazae  <katsuo wakame> > 

さらにfoldMapという関数もあり、これは木の各要素からMonoidを作り出したあげくMonoidの結合演算ですべてを結合する、というものです。

 *Main> :t foldMap
foldMap :: (Monoid m, Foldable t) => (a -> m) -> t a -> m

そんな説明ではさっぱりわかりませんね。例えばリストはMonoidで結合演算は++です。例えばツリーの要素をすべて単一要素のリストに変えたうえで結合すると

 *Main>  foldMap (\a->[a]) t
["sazae","katsuo","wakame"]
 *Main>  foldMap (:[]) t
["sazae","katsuo","wakame"]

このようにツリー全体がリストに変化します。一瞬何が起きたか分からないので、各キャラが猫を連れている、という状況を表現してみます。

 *Main>  foldMap (\x -> [x, x++"'s cat"]) t
["sazae","sazae's cat","katsuo","katsuo's cat","wakame","wakame's cat"]

さらに文字列もリストなので、ぶっちゃけそのまま連結することもできます。

 *Main>  foldMap id t
"sazaekatsuowakame"

リストばかりがMonoidではありません。たとえばProductというMonoidは結合すると掛け算を行います。

 *Main>  foldMap (Product . age) t
Product {getProduct = 2376}

sazae家全員の年齢の積が分かりました。

いまスーパークラスのデフォルトインスタンスを定義する機能というのが議論されているそうで(via http://favstar.fm/users/shelarcy/status/45649867862839296)、これが組み込まれれば、あの４行すら不必要になって更に便利になると思われます。

まとめ

自作のデータ構造を Data.Traversable にすれば

• 「要素を扱うモナド」「その要素からなるデータ構造」があるとき、「モナドにデータ構造をくまなく舐めさせる」ことができます。
  • モナドが凄いので、これで自作のデータ構造に凄まじいモナドの力が備わり凄いことになります。
• さらにそのデータ構造に対するfmapとfoldが無料でついてきます。
• 今は分からなくてもいい。俺だって分からん。型を信じろ。俺が信じるお前が信じる型を信じろ。

本日のサンプルはここに置いてあります。 https://github.com/nushio3/Data.Traversable-example
「本物のプログラマは〜」にも掲載予定だそうで、楽しみにしてます！http://big.freett.com/shelarcy/articles_status.pdf

追記

それGHC拡張でderiveできます。id:mr_konnさんありがとう！しかしこのフラグ達、GHC拡張の一覧にないですね。どこに定義されてるんだろう。Cabalはそういう言語拡張があるのを知っているみたいだけど。

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
{-# OPTIONS -Wall #-}
import Data.Foldable
import Data.Functor
import Data.Traversable
import Prelude hiding (mapM,sequence,fmap,foldr, foldl,foldl1,foldr1)

data Tree a = Empty | Node a (Tree a) (Tree a) 
            deriving (Functor, Foldable, Traversable)
              
instance (Show a) => Show (Tree a) where
  show Empty = ""
  show (Node x left right) = "(" ++ show x ++ show left ++ show right ++ ")"

*1:learn you a hasKell for great good Yome!の略