モノイドと継続渡しの道具箱

関数型言語Haskellにおいて、普通は計算の結果は関数の戻り値として扱うが、「結果を受け取る関数」 に渡すという継続渡しというスタイルもある。これは単なる冗長なやり方ではなく、様々な興味深い性質を持つ。

基本形は、aという値を渡すところを

∀r. (a -> r) -> r

のような表現にする。たとえば、与えられた数の42倍を渡したいとき、そのまま\x -> x * 42ではなく、\x f -> f (x * 42)と書く。もちろんこれだけではありがたみが分からない。

さて、与えられた文字列の中のうち、大文字のアルファベットを取り出し、それがアルファベットの何番目か計算するプログラムを作りたい。普通はリストを使ってこのように書くかもしれない。

import Data.Char

uppers :: [Char] -> [Int]
uppers [] = []
uppers (x:xs)
   | isUpper x = fromEnum x - fromEnum 'A' : uppers xs
   | otherwise = uppers xs

継続渡しにすると([Int] -> r) -> rという形にもできるが、あえて(Int -> r) -> rのようにIntを渡したい場合はどうなるだろうか？すると、rのために新たな演算が必要になる。

uppers :: (Int -> r) -> [Char] -> r
uppers f [] = (空っぽ)
uppers f (x:xs)
   | isUpper x = (がっちゃんこ) (f (fromEnum x - fromEnum 'A')) (uppers f xs)
   | otherwise = uppers f xs

ここで(空っぽ)と(がっちゃんこ)の型に着目しよう。

(空っぽ) :: r (がっちゃんこ) :: r -> r -> r

つまり、rは空の値と、結合する演算を持つような型であることがわかる。これはモノイドと呼ばれる代数的構造である。HaskellではMonoid型クラスとして提供されている。

class Monoid a where
    mempty :: a
    (<>) :: a -> a -> a -- 実際は(<>) = mappendとして定義されている

Monoid rの制約をつけ、空っぽとがっちゃんこはそれぞれmemptyと(<>)で置き換えてやれば望みのプログラムは作れる。

uppers :: Monoid r => (Int -> r) -> [Char] -> r
uppers f [] = mempty
uppers f (x:xs)
   | isUpper x = f (fromEnum x - fromEnum 'A') <> uppers f xs
   | otherwise = uppers f xs

大文字をカウントするには、要素を数えるような振る舞いを持つモノイドを作ればよい。

data Count = Count { getCount :: Int }

instance Monoid Count where
    mempty = Count 0
    Count m <> Count n = Count (m + n)

single :: a -> Count
single _ = Count 1

実際にはSumというモノイドが定義されており、Countと同様、足し算がなすモノイドとして働く。

uppersにsingle関数を渡すとCountが返ってくる。その中身は数え立てほやほやの大文字の個数だ。

getCount . uppers single :: [Char] -> Int

uppersは、リスト以外の構造に対しても考えられる一方、要素の数え上げを実現するCountは、uppersの扱う対象の構造には関与しない。その関心の分離に、このスタイルのパワーが表れている。

uppers :: Monoid r => (Char -> r) -> Map String Char -> r
uppers :: Monoid r => (Char -> r) -> Maybe Char -> r
uppers :: Monoid r => (Char -> r) -> Seq Char -> r

標準ライブラリでは、uppersのような操作を抽象化するFoldableというクラスが定義されている。 foldMapは、コンテナf aの要素をすべて与えられた関数に渡すことが期待されている(期待されているというのは、一部だけ渡しても、あるいはまったく渡さなくても正当なインスタンスたりうる)。

class Foldable f where
    foldMap :: Monoid r => (a -> r) -> f a -> r

なお、大文字のみをフィルターする機能は独立して定義することが可能だ。

filtering :: Monoid r => (a -> Bool) -> (a -> r) -> a -> r
filtering p f a
    | p a = f a
    | otherwise = mempty

また、要素のマッピングも独立した関数として定義できる。こちらは単なる関数合成だ。

maps :: (a -> b) -> (b -> r) -> a -> r
maps f g = g . f

foldMap、filtering、mapsを組み合わせれば、uppersは以下のように書ける。上から下に処理の流れが表現されているのがわかるだろうか。

uppers :: (Foldable f, Monoid r) => (Int -> r) -> f Char -> r
uppers = foldMap
  . filtering isUpper
  . maps (subtract (fromEnum 'A') . fromEnum)

このような継続とモノイドを用いた畳み込みの仕組みは、高い柔軟性と美しい合成を提供する。 しかし、これでは不足する場合がある。というのも、foldMapは元の構造を忘れてしまうので、構造を保ったまま要素を書き換えたりする目的には使えない。たとえば、シーザー暗号を実装したい場合、今までのuppersでは元のリストを失ってしまうため実現できない。

元のuppersの定義に戻ってみよう。(空っぽ)と(がっちゃんこ)に元の構造を取り戻すヒントを教えてやれば、どうにかうまくやれそうだ。

uppers' :: (Int -> (Intを保つ何か)) -> [Char] -> ([Char]を保つ何か)
uppers' f [] = (空っぽ) []
uppers' f (x:xs)
   | isUpper x = (がっちゃんこ) (:) x' (uppers' f xs)
   | otherwise = (がっちゃんこ) (:) ((空っぽ) x) (uppers' f xs)
   where
       x' = (ごにょ) (\n -> toEnum $ n + fromEnum 'A') (f (fromEnum x - fromEnum 'A'))

ここでの(空っぽ)、(ごにょ)、(がっちゃんこ)はそれぞれ以下のような型を持つはずだ。

(空っぽ) :: s -> (sを保つ何か)
(ごにょ) :: (a -> b) -> (aを保つ何か) -> (bを保つ何か)
(がっちゃんこ) :: (a -> s -> (sを保つ何か)) -> (aを保つ何か) -> (sを保つ何か) -> (sを保つ何か)

(xを保つ何か)というのは型パラメータxを持つ型で表せる。ここではfとしよう。

(空っぽ) :: s -> f s
(ごにょ) :: (a -> s) -> f a -> f s
(がっちゃんこ) :: (a -> s -> f s) -> f a -> f s -> f s

これらの操作ができるようなfにはApplicativeという名前がついている。

class Functor f where
    fmap :: (a -> b) -> f a -> f b

instance Functor f => Applicative f where
    pure :: a -> f a
    (<*>) :: f (a -> b) -> f a -> f b

liftA2 :: Applicative f => (a -> b -> f c) -> f a -> f b -> f c
liftA2 f a b = fmap f a <*> b

(ごにょ)がfmap、(空っぽ)、(がっちゃんこ)がそれぞれpureとliftA2である。すると、uppers'はこう書ける。

import Control.Applicative

uppers' :: Applicative f => (Int -> f Int) -> [Char] -> f [Char]
uppers' f [] = pure []
uppers' f (x:xs)
   | isUpper x = liftA2 (:) x' (uppers' f xs)
   | otherwise = fmap (x:) (uppers' f xs)
   where
       x' = fmap (\n -> toEnum $ n + fromEnum 'A') (f (fromEnum x - fromEnum 'A'))

Applicativeは「元の構造を保てる」モノイドになっている。もしシーザー暗号を実装する場合、結果として[Char]そのものが欲しい。 そんな時は、元の構造をそのまま包むIdentityが使える。

newtype Identity a = Identity { runIdentity :: a }

instance Functor Identity where
    fmap f (Identity a) = Identity (f a)

instance Applicative Identity where
    pure = Identity
    Identity f <*> Identity a = Identity (f a)

シーザー暗号は以下のように実装できる。Identityは操作をそのまま中身に伝えるので、純粋な結果が得られる。

caesar :: Int -> [Char] -> [Char]
caesar k = runIdentity . uppers' (Identity . (`mod`26) . (+k))

いちいちIdentityとrunIdentityを書くのは骨なので、以下のような関数で共通化すると便利だ。

purely :: ((a -> Identity a) -> s -> Identity s) -> (a -> a) -> s -> s
purely t f = runIdentity . t (Identity . f)

各要素に対してアクションを走らせたい場合は、それをそのまま渡すだけだ。一番簡単なパターンかもしれない。

printUppers :: [Char] -> IO [Char]
printUppers = uppers' (\x -> print x >> return x)

もし今までと同じように元の構造を捨て、モノイドにしたいときは、そのようなふるまいを持つApplicativeが使える。

newtype Const r a = Const { getConst :: r }

instance Functor (Const r) where
    fmap _ (Const r) = Const r

instance Monoid r => Applicative (Const r) where
    pure _ = Const mempty
    Const a <*> Const b = Const (a <> b)

uppers'ではfmapとpureに元の構造のための操作が渡されていたが、Constはそれらを捨てており、代わりにモノイドの演算をしていることがわかる。以下のsmashは、Constを用いて「格下げ」を行う関数で、uppers = smash uppers'の関係が成り立つ。

smash :: ((a -> Const r a) -> s -> Const r s) -> (a -> r) -> s -> r
smash t f = getConst . t (Const . f)

この強化されたuppers'だが、こちらも共通化のためのクラスが提供されており、こちらはTraversableと呼ばれている。traverseはfoldMapの上位版に位置する。

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

フィルターは今までとほぼ同じような形で、独立して定義できる。

filtered :: Applicative f => (a -> Bool) -> (a -> f a) -> a -> f a
filtered p f a
    | p a = f a
    | otherwise = pure a

要素へのマッピングをするには、元の構造に戻すための関数が追加で必要となる。

isomorphic :: Functor f => (s -> a) -> (a -> s) -> (a -> f a) -> s -> f s
isomorphic f g c = fmap g . c . f

traverse、filtered、isomorphicを使うとuppers'はこう書ける。IntをCharに戻す関数が必要になったのを除けば、Foldable版とほぼ変わらない。

uppers' :: (Applicative f, Traversable t) => (Int -> f Int) -> t Char -> f (t Char)
uppers' = traverse
    . filtered isUpper
    . isomorphic (subtract (fromEnum 'A') . fromEnum) (\n -> toEnum $ n + fromEnum 'A')

このように、foldMapやtraverseに代表されるようなこの手の関数は、コンテナの処理に対して素晴らしい表現力を持つ。 ならばこれを最大限に活用しようと作られたのがlensパッケージだ。

uppers'のような関数はtraversalと呼ばれ、lensパッケージでは型シノニムが定義されている。

type Traversal' s a = forall f. Applicative f => (a -> f a) -> s -> f s

たとえば、コンテナの特定の要素を指すtraversalなどを提供している。

ix :: Ixed m => Index m -> Traversal' m (IxValue m)
-- ix :: k -> Traversal' (Map k a) a
-- ix :: Int -> Traversal' (Vector a) a

また、ここで紹介したpurely、smash、isomorphicに相当するものだけでなく、traversalを構築および使用する手段が豊富に提供されている。

lensが扱っていない範囲でも、この考え方はプログラミングに役に立つ。計算結果をリストか何かで返そうと思ったとき、是非このスタイルも思い出してみてほしい。