Creatable a => a -> IO b

Haskellと数学とちょびっと音楽

プログラマであるあなたが圏論を学んで得られる事、得られない事

Haskellと数学とちょびっと音楽」なんていうシャレオツなサブタイをブログに付けてるのは誰ですか? 俺だよー!

大体、Haskell関連のコミュニティに顔を出していると、 数学科出ましたーとか、物理専攻ですー、とか、そーいう人がわりと多いのですが、 僕は「勉強なんて出来ないんジャー・レッド」だったので、サブタイトルに「数学」なんて入れつつも、 数学の話はほとんど出来なかったりとか出来たりとか・・・結局Haskellの記事しか書いてないですね、はい。

ただ、どちらかというと、Haskellでも処理系どうのとか、パフォーマンス云々とか、 そういう話より型システムでどうやって抽象化するかーみたいな、そういう話のほうがおもしれーとか思ったりしたので、 気づいたら圏論なんかはガジガジしてまして、多少の自己流の知識があったりとかなかったりとかしてるのです。

純粋関数型やらHaskellやらがメジャー化していくのに伴って、 「副作用」やら「関数型」と同時に「圏論」もバズワード化してきているような気がしているので、 今回は、圏論によって何が出来るか、何が出来ないか、雰囲気的な事をまとめようと思います。

圏論の基礎の基礎の基礎くらいの話

まず、圏論ってどんな事やんの?っていうほわほわっとした感覚を掴んで頂くために、 圏論のイロハのイの半分くらいまで説明しようかと思います。 こいつらどんな事考えてるのかなーっていうヒントにはなるんじゃないかなーと、そんな感じです。

あー、ちゃんと図式書くの面倒なのでAAで我慢してね。

下の図の、矢印の頂点A, B, Cを「対象(Object)」といいます。
下の図の、矢印f, gを「射(Arrow)」といいます。

         f         g
    A ------> B ------> C

射と射をくっつける「射の合成(composite)」という計算ができ、 fからgへの結合をg○fみたいに書きます。

             g○f
    +-------------------+
    |                   |
    |   f          g    v
    A ------> B ------> C

あと、全ての対象に自分から自分への射、恒等射Id_Xがあります。 これわりとミソです。

        Id_A
    +---------+
    |         |
    |         |
    A <------ + 

んで、射の合成には結合則ってのがあります。 下の図のAからDへの矢印はどの経路を通っても同じ結果にならなくてはいけません。

             g○f
    +-------------------+
    |                   |
    |   f          g    v    h
    A ------> B ------> C ------> D
              |                   ^
              |                   |
              +-------------------+
                       h○g

あと、恒等射には単位元則があります。 下の図の、f○Id_AとId_B○fはいずれもfと同じにならなくてはいけません。

                            Id_B
                        + ------- +
                        |         |
                   f    |         |
    + ------> A ------> B <------ +
    |         |
    |         |
    + ------- +
       Id_A

んで、これらの道具立てがひと通り揃ったものを「圏」と呼びます。 基本的には、このルールに則って色んなものの間に矢印を引き、 その矢印の関係性「だけ」を使って性質や特徴を導いていくのが圏論です。

で、圏論がプログラミングに何で重要なのかというと、 関数プログラミングの型システムがデカルト閉圏という圏と対応するからです。

単純に、

  • 型が対象
  • 関数が射
  • 関数合成が射の合成
  • id関数が恒等射

と対応します。これが実際に圏となる事は、上記の道具立てがちゃんと整っている事を一つ一つ確認してみればわかるでしょう。

Haskell圏論の密接な関係

とまぁ、圏論の入門以前的な話をしましたが、 本エントリの主題は圏論入門ではなく、この話をさらに突き詰めていくとどうなるのか、という事なので、 本格的な圏論入門は書きません。

Haskellのもっとも身近な圏論由来の概念はFunctor(関手)でしょう。 圏論において関手とは圏から圏への対応付けの事を言います。 HaskellのFunctorはその中でも、自己関手という特殊な関手を実装に落とし込んだものです。

我らがモナドも勿論、圏論由来の概念です。 「自己関手の圏におけるモノイド対象だぜ、フフフ」ってのもありますが、 クライスリ圏という圏を勉強すると、(>>=)演算子の正体が見えて来たりします。

さらに、LensやFree、Yonedaといった最近名前を聞く抽象的なライブラリも、 バックグラウンドに圏論があるようですが、残念ながらこのエントリを書いてる段階で、 ちゅーんさんの知識はそこまで進んで無いのです(´・ω・`)
わりと必要に迫られてる気がするので、しばらくすると解る人になってます。 その頃になったら聞いて下さい、ドヤ顔で説明します。はい。

で、

fmap関数がFunctorのメソッドである事からわかるかもしれませんが、 Listのmap関数も圏論の視点から説明する事は出来ますし、 fold関数を圏論で一般化すると、catamorphismという概念が出てきます。 また何気なく作った多相関数が「自然変換」と呼ばれる形になっている事は多々ありますし・・・ 後はあんまり意識する事は無いですが、代数的データ型自体もF始代数と呼ばれる圏論の概念として表現できまして、 その事は例えば、型レベルで計算が出来るという話にもつながってきます。

とか、とか、こんな感じ?

圏論を学んで得られる事、得られない事

と、偉そうにタイトルを掲げてみたんですけど、ここまで書いて、いざ本題に入ろうとしたら、あの、あれです、 どうしてもポエーっとなってしまって(´・ω・`)←今こんな顔してます
というわけで、ここに書かれている内容はかなーり独断と偏見にまみれてると思ってお読みください。☆(ゝω・)vてへっ

とりあえず、間違いなく言える事として、銀の弾丸にはなり得ないという事だけははっきりと述べておきましょう。

期待しても良い事

知識としては、FunctorやMonad等、 Haskellプログラミングによく現れる概念に対する、数学的な背景が得られます。 実の所「道具として使えてはいるけど、結局モナドって何だか良くわかってないよね?」みたいな、 そんな「わかってんだかわかってないんだかわかんないもやもや感」を解消出来るのが、 圏論を学んで一番うれしい事かもしれません。

後はかなり実感的な部分で確証がある話では無いのですが、圏論の概念が対応しているのは型システムなので、 Haskellプログラミングに重要な「型レベルで考える」感覚は養えるように思います。

あとは、ちゅーんさんの場合はもともと数学スキルが絶望的なので、 数学の基本的な感覚を身につけるのに圏論のお世話になりました。 ってか現在進行形でなってます。本当にありがとうございます。

あんまり期待できない事

だいたい、Haskellで使う圏論的な概念をプログラムで使う際に必要な公理やら定理の類は、「〜則」みたいな形でプログラムに落としこまれているので、 よほど新規性の高い事をやらないと、圏論で得た知識をそのままの形でプログラミングに応用出来る事はあまり無いように思います。

それから、抽象度の高い高度なライブラリを設計するのに役立つとは言いますが、 圏論を学んで、実際にそのレベルで圏論を応用出来る才能のある人は、限られているように思われますぅ・・・。 但し、型設計のための貴重な判断材料にはなり得るので、全否定する程では無いかもですね。

あと、基本的には応用範囲が型レベルですから、 値レベルにまで掘り下げないと解決できない問題には無力です。実に無力なのです。

まとめ的な何か

というわけで、「圏論」のバズワード化を懸念して、初学者の立場からあれこれと纏めてみました。

自己流で色々とかじってる感じ、決して表面をなぞっただけで人に説明できるほど簡単な学問ではありませんが、 微積分が出来ないどころか分数の四則演算でテンパるちゅーんさんでもこのくらいの内容の話は出来ますので、 あなたの知りたい事、やりたい事にあわせて、本格的に学びはじめて見ても良いのではないでしょうか?か?

ハトクラモナドをごにょごにょ - モナドで問題をどう解決するか

ボドゲ楽しいよね。 最近、家族で遊べないかなぁと思ってドミニオンの標準パックを買ってみたところ、 わりと好評だったのでほくほくしてます。

はい、てなわけで、ちゅーんさんですおばんです。

さて、今日ははる君(@haru2036)が書いた、ハトクラのモナドの記事

http://haru2036.hatenablog.com/entry/2014/12/17/014142

を楽しく読みました。 こういう何か題材を見つけてHaskellで解決しようみたいなアプローチ、 なかなか無いので貴重です。 とても面白い題材なのですが、いくつか気になった点があったのでがばっと改善してみました。

えっ、自分の進捗ですか? それは聞かない約束です( ー`дー´)キリッ

ActionPhaseの定義と役割について考えてみる

そもそもモナドのなんたるかについては、 ruiccさんの「モナド入門以前」という記事がおもろいのでこっち読むと良いと思います。

http://qiita.com/ruicc/items/6ba44359d86c3bf84492

ここでも何度も述べられているのですが、モナドは「プログラム」そのものを表すクラスであり、 チューリング完全DSLを構築するための道具なのであります。

さて、ここで元記事のActionPhaseの定義を見てみましょう。

type ActionPhase = StateT Field (Either (Coins, Field)) Coins

--もしくは

type ActionPhase = EitherT Coins (State Field) Coins

どちらも、最後の型引数がCoinsになってしまっています。 ActionPhaseが「ハトクラのアクションフェーズに行う一連の手続き」を担うDSLなのであれば、 他のモナドインスタンスのように、多相型であるべきでしょう。

何故ならば、あるモナドm aの型引数aというのは、 命令形プログラムにおけるファンクションの返却値の型に相当するからです。 もしあなたが使うDSLで、ファンクションで返せる値の型が限定されていたら嫌でしょう?

あと、それから、EitherTは実質僕が提案したものではあるのですが、MaybeTに変更します。 後ほどまた説明しますが、実際に書いてみたところCoinsFieldの中に入れたらスッキリするからです。 それを踏まえて、ActionPhaseは次のような定義になりました。

type ActionPhase a = MaybeT (State Field) a

さて、元のコードでは、カードそのものを表す型が次のように定義されています。

type Card = Coins -> ActionPhase

Cardの持つ効果は実質、アクションフェーズのDSLとして記述出来るので、良いセン行っているのですが、 こうしてしまうとCardという名前からActionPhaseというDSLのプログラムであるという情報を得られないのにも関わらず、 DSL内でファンクション呼び出しのように使う事が出来てしまうというややこしい問題が起こります。

特定のモナドアクションm aの型変数aを固定して、型の別名を付けてしまうのは、 Hackageなんかでもたびたび見かけるのですが、個人的にはかなーり悪手だと思います。 ってかIOでコレをやられた時はキレそうになりましたし、Qモナドもめちゃくちゃ混乱しました。

ひとまず、Card型は次のように定義しましょう。

newtype Card = Card { play :: ActionPhase () }

こうする事によって、playというフィールドは、次のような型を持ったActionPhaseモナドアクションとなります。

ghci> :t play
play :: Card -> ActionPhase ()

使い方は型を見れば明らかですね。 こうする事によって、次のようにわかりやすくカードをプレイして行く様を表現できます、

sample :: ActionPhase ()
sample = do
  play farm --農園
  play farm --農園
  play farm --農園
  play alchemist --錬金術士
  ...

Coinsを状態に持たせた事で、カードをプレイする事によって自動的に購入フェーズで使えるコイン数は集計されます。

Fieldに関するもろもろ

ハトクラでは「カードの連結」という表現をしているのですが、基本的に、

  • 右にのみ連結出来るカードは、ドミニオンの+1アクション
  • 右と下に連結出来るカードは、ドミニオンの+2アクション

と同等なので、残りアクション数を記録するactionフィールドを定義しますでしょ。 あと、くどいようですが、コインの枚数も状態で持たせますでしょ。 それから、山札、手札、捨て札も状態として持たせます。これは好みの問題ではあるのですが、元コードでCardsという型定義をしているのは、 Stringのような特別なアイデンティティがあるわけでは無いので、個人的には[Card]とそのまま書くほうが好きです。

そういえば元記事ではinheritanceRightsっていうフィールドを持っていましたが、何に使うのか良くわからなかったです。

data Field = Field
  { _coins :: Int
  , _action :: Int
  , _hand :: [Card]
  , _deck :: [Card]
  , _trash :: [Card]
  }

makeLenses ''Field

さて、ActionPhaseの型定義がややこしいので、なかなか気付きにくくはあるのですが、 実は、MaybeTStateの合成はMonadState型クラスのインスタンスになります。

MonadState型クラスのインスタンスであれば、特にliftしなくてもgetとかput出来るのです。 で、さらに状態に持っている型FieldLensになっている事に注目しましょう。 実はLensには次のような演算子が定義されていて、状態への操作がめちゃんこ楽に行えるんですね。

ghci> :t (.=) --代入
(.=) --代入 :: MonadState s m => Setter s s a a -> a -> m ()
ghci> :t (+=) --加算
(+=) --加算 :: (Num a, MonadState s m) => Setter s s a a -> a -> m ()

あー、ちなみにこの型定義はちゅーんさんの作ったちっこいLensの定義になってます。 中身は一緒ですが、公式のLensだとちょっと違う表記になってるかもかも。

で、この事を利用すると、例えば農園のカードは次のように定義する事ができるのです。

farm :: Card
farm = Card $ do 
  coins += 1 --+1コスト
  action += 1 --+1アクション

アクションの終了判定をどこでやるか

まず、アクションフェーズを終了するstopアクションは次のようになっていましたが・・・

stop :: Card
stop c = do
  fld <- (lift get)
  left c

ActionPhaseの定義に合わせて、次のように書き換えます。 ぶっちゃけ、このくらいの関数は標準で定義しておいて欲しい気はしますが。

stop :: ActionPhase ()
stop = MaybeT $ return Nothing

そして、終了判定を行い、終了条件を満たしていたらstopする、judgeアクションを定義しましょう。

judge :: ActionPhase ()
judge = do
  action -= 1
  act <- use action
  if act < 0 then
    stop
  else
    return ()

尚、use関数は、状態からフィールドの値を取り出すLensの関数です。

ghci> :t use
use :: MonadState s m => Getting a s a -> m a

さて、カードをプレイする度に毎回judgeアクションを呼び出すのはアホらしいので、 Card型とplayアクションを次のように書き換えてしまいましょう。

newtype Card = Card (ActionPhase ())

play :: Card -> ActionPhase ()
play (Card cardAction) = do
  cardAction
  judge

あー、ちなみに、手元で試してみたらmakeLenses関数の評価のタイミングの関係で、定義する場所気をつけないとエラーになるっぽい。 実際の記述順は最後にコード全体載せるのでそちらを参考にしてくらはい。

これもちゅーんさんの小さいLens特有の問題かしら、公式のLensではまだ試してないです。

とにかくこれで、カードをプレイする度に判定処理が行われて、アクションの残りが負数になったら、 その後の記述を無視して結果を返すようになりました。

ActionPhaseモナドと純粋な計算を繋ぐ

通常、モナドによって作られた言語内DSLと純粋な計算を繋ぐ・・・即ち、DSLを実行する関数には、 run〜という名前が付けられるのが定例です。 そのルールに則り、runActionPhase関数を定義しましょう。

runActionPhase :: Field -> ActionPhase a -> (Maybe a, Field)
runActionPhase fld = flip runState (resetField fld) . runMaybeT
  where
    resetField :: Field -> Field
    resetField f = f { _coins = 0, _action = 0 }

あー、なんかFieldの定義が納得いかない。resetFieldとかめっちゃダサい。 というワケで型定義をこんなんにして・・・

data ActionPhaseState = ActionPhaseState 
  { _coins :: Int
  , _action :: Int
  , _field :: Field
  }

data Field = Field
  { _hand :: [Card]
  , _deck :: [Card]
  , _trash :: [Card]
  }

makeLenses ''ActionPhaseState
makeLenses ''Field

で、こんなんにしてみました。

runActionPhase :: Field -> ActionPhase a -> (Maybe a, ActionPhaseState)
runActionPhase fld = flip runState (mkState fld) . runMaybeT
  where
    mkState :: Field -> ActionPhaseState
    mkState f = ActionPhaseState { _coins = 0, _action = 0, _field = f }

型定義が上手く出来ていたので、書き換える所はわりと少なくて済んだようです。まる。

残りの部分について

というわけで、元のプログラムから根本的な設計の部分を見なおしてみました。 手札や山札など、Fieldそのものに纏わる操作については触れませんでしたが、 何れもActionPhaseモナドの状態として管理しており、makeLensesしているので、 この辺を操作するためのアクションを提供するのも難しくは無いでしょう。

以上、この記事を通してHaskellモナドを使った設計手法が、 少しでも多くの人に伝わってたら嬉しいなーとか思います。

そいでは、今回書いたコードをひと通り整理しておわります。

{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Monad.Trans.Maybe
import Control.Monad.State
import Control.Lens

type ActionPhase a = MaybeT (State ActionPhaseState) a

type Coins = Int

newtype Card = Card (ActionPhase ())

data ActionPhaseState = ActionPhaseState 
  { _coins :: Int
  , _action :: Int
  , _field :: Field
  }

data Field = Field
  { _hand :: [Card]
  , _deck :: [Card]
  , _trash :: [Card]
  }

makeLenses ''ActionPhaseState
makeLenses ''Field

----

play :: Card -> ActionPhase ()
play (Card cardAction) = do
  cardAction
  judge

stop :: ActionPhase ()
stop = MaybeT $ return Nothing

judge :: ActionPhase ()
judge = do
  action -= 1
  act <- use action
  if act < 0 then
    stop
  else
    return ()

runActionPhase :: Field -> ActionPhase a -> (Maybe a, ActionPhaseState)
runActionPhase fld = flip runState (mkState fld) . runMaybeT
  where
    mkState :: Field -> ActionPhaseState
    mkState f = ActionPhaseState { _coins = 0, _action = 0, _field = f }

----

farm :: Card
farm = Card $ do 
  coins += 1
  action += 1

city :: Card
city = Card $ do 
  coins += 2
  action += 1

alchemist :: Card
alchemist = Card $ do
  --読者への課題とする(ドヤ顔ダブルピース
  return ()

------

sample :: ActionPhase ()
sample = do
  play farm
  play farm
  play city
  play alchemist
  --これ以降はアクション数が足りないため無視される。
  play city
  play farm

sampleField :: Field
sampleField = Field
  { _hand = []
  , _deck = []
  , _trash = []
  }
  
main :: IO ()
main = do
  (a, s) <- return $ runActionPhase sampleField sample
  print $ a
  print $ s^.coins 

でわでわのしのし。

型「の」計算にレッツチャレンジ

はいどーも、ちゅーんさんです。 最近「楽園追放」見てきたのですが、楽しかったです。(小学生並のry

いやあの、普通に良作でしたので、興味のある方なんかは、是非劇場で見に行くと良いと思います。 ハデだし。

いえい

はい、で、この記事はあれです。

Haskell Advent Calendar 2014 - Qiita

の、7日目の記事です。

皆さん!型は好きですかーっ!?
お れ は 好きだぜーっ!!!

とゆーわけで、今日は代数的データ型とゆー概念そのものに関する、ちょっといっぱい数学っぽい話をしようと思います。 この「っぽい」っての大事、超大事。

型の足し算

ここにUnit型がありますでしょ。

data () = () deriving Eq

突然ですが、Unit型は1です。

あ、それからここにBool型があります。

data Bool = True | False deriving Eq

これまた突然ですが、Bool型は2です。

ちょっと思い立ったので、ここにBoolUnit型を作ってみました。

data BoolUnit = Bub Bool | Buu () deriving (Show, Eq)

Boolは2で()は1なので、1+2は3ですね。そう、つまりBoolUnitは3なんです。
ちょっと何言ってるのか(ry

さて、母さんが夜なべをして手袋を編んでくれたので、手袋型を定義します。

data Tebukuro = T1 | T2 | T3 deriving (Show, Eq)

いきなりなんでビックリしないでくださいね? はっきり言わせてもらうとTebukuroは3です。

あれ?BoolUnitTebukuroも3でしたね、つまりこういう事でしょうか?

{ \displaystyle
BoolUnit = Tebukuro
}

いえいえ、でもやっぱりBoolUnitBoolUnitだし、TebukuroTebukuroなので、 イコールで繋ぐのは気が引けますね。

おっと、ここで天から \cong という記号を使って、両方共同じく3である事を表すと良いとのお言葉を頂きました。

{ \displaystyle
BoolUnit \cong Tebukuro
}

もっというと、BoolUnitBoolの2とUnitの1を足し算して3なので、次のように書いても良いですね。

{ \displaystyle
Bool + Unit \cong Tebukuro
}

いやでもちょっとマテ茶、そもそもこの1とか2とか3.14についてちゃんと説明が無いじゃないですか(#゚Д゚)ゴルァ!!

いや、なんとなくわかりますよ、データコンストラクタの合計数と同じっぽい事くらい。 でもやっぱり違う型って事は別物なわけですよ。 大体このグラディウスビッグコアのレーザーにミミズがくっついたみないな記号は何なんですかっ!? ちゃんと説明してくださいっ!

同型とは何ぞや

例えば、次のような Tebukuro -> Int みたいな関数を作ったとしますよね?

f :: Tebukuro -> Int
f T1 = 1
f T2 = 2
f T3 = 3

これはTebukuroからIntへの関数であって、BoolUnitからIntへの関数では無いです。

あ、いやでも兄さん、ちょっと落ち着いて考えてみて下さい、次のような関数作ったとするじゃないっすか。

bu2te :: BoolUnit -> Tebukuro
bu2te (BUB True) = T1
bu2te (BUB False) = T2
bu2te (BUU ()) = T3

そしたら関数合成で BoolUnit -> Int っていう関数作れますでしょ?

ghci> :t f . bu2te
f . bu2te :: BoolUnit -> Int

こういう時に理屈っぽ人は、関数合成で作れる関数は、その関数があるのと同じ事にしちゃうんだそうです。 つまりbu2tefがあれば、BoolUnit -> Intなる関数が初めからあるのと大差ねぇじゃんっていう話です。

逆いきましょう、逆。ここにBoolUnit -> Boolなる関数gがあるじゃろ?

g :: BoolUnit -> Char
g (BUB True) = 'a'
g (BUB False) = 'b'
g (BUU ()) = 'c'

これをこうして・・・

te2bu :: Tebukuro -> BoolUnit
te2bu T1 = BUB True
te2bu T2 = BUB False
te2bu T3 = BUU ()

こうじゃ!

ghci> :t g . te2bu
g . te2bu :: Tebukuro -> Char

えー、bu2te, te2buふたつの関数によって、BoolUnitTebukuro型は互いに互いの代用を務める事ができるようになりました。 あくまで性質の話ですけど。

で、本当にBoolUnitTebukuroが同じものとして扱えますよーっていう事を示す、一般的な方法があります。 te2bubu2teについて、次のような性質を満たす事が確認出来れば良いのです。

te2bu . bu2te = id

かつ

bu2te . te2bu = id

もうちょっと厳密に言えば、このような等式を満たすような互いに変換しあう関数が実装可能ならば、 互いに互いの代用を務める事ができるわけですから、乱暴に「同じ型」として見ても良い事になります。

このような時、その二つの型は同型であるといい、AとBが同型である事をA \cong Bのように書きます。

理屈っぽい人達にとって「実装することが出来る」と「実装されてる」の差は大した問題ではありません。 BoolUnitTebukuroは上記二つの関数を実装する事が可能です、 従ってこの二つのデータ型は同型である、という事がいえるわけです。

もうちょっとちゃんと確かめる

このくらい簡単な例なら、なんとなく目で見て、あー、確かに同型っぽい、うん、同型だよ同型。 みたいな感じに言える気がしますが、いやでももっと複雑な例になると確かめるのが大変になりそうな気がしますし、 ここはエンジニアらしく簡単に確かめられる仕組みを作っておきましょう。

といっても、データ型の定義からいきなり同型である事を厳密に示すのには、 CoqやAgdaのような証明系と呼ばれるなんかおっかないもんを使わなくてはいけないので、 あくまで変換する関数は人力で実装した上で、だいたいまぁ、同じっしょ? というような事が言える仕組みが欲しいぜ隊長!

というわけで、みんな大好きTest.QuickCheckの出番です。

instance Arbitrary BoolUnit where
  arbitrary = elements [BUB True, BUB False, BUU ()]
instance Arbitrary Tebukuro where
  arbitrary = elements [T1, T2, T3]

propIso :: (Arbitrary a, Arbitrary  b, 
  Eq a, Eq b) => (a -> b) -> (b -> a) -> (a, b) -> Bool
propIso f g (x, y) = (g . f) x == x && (f . g) y == y

main :: IO ()
main = do
  quickCheck $ propIso bu2te te2bu

これを普通に動作させて、テストが成功する事をチェック・・・

+++ OK, passed 100 tests.

んで、あえて失敗するケースを作って試してみましょう。bu2te関数を次のように書き換えます。

bu2te :: BoolUnit -> Tebukuro
bu2te (BUB True) = T1
bu2te (BUB False) = T1 --ここが違う
bu2te (BUU ()) = T3

んで、実行っと・・・

*** Failed! Falsifiable (after 2 tests):  
(BUB False,T3)

おk、大丈夫そうですね。 こうしておけば、Eqインスタンスになっているデータ構造の同型性なら簡単に確認する事ができます。

色々準備

いつまでもBoolUnitとかTebukuroとかわけのわからん型を使ってると大変なので、 とりあえずまず、1〜6くらいまでのデータ型を定義して、この足し算の性質について探って行くことにしましょう。 まずデータ定義しますでしょ?QuickCheckしたいのでArbitrary型クラスのインスタンスにしますでしょ?

data T1 = T1C1 deriving (Show, Eq)
data T2 = T2C1 | T2C2 deriving (Show, Eq)
data T3 = T3C1 | T3C2 | T3C3 deriving (Show, Eq)
data T4 = T4C1 | T4C2 | T4C3 | T4C4 deriving (Show, Eq)
data T5 = T5C1 | T5C2 | T5C3 | T5C4 | T5C5 deriving (Show, Eq)
data T6 = T6C1 | T6C2 | T6C3 | T6C4 | T6C5 | T6C6 deriving (Show, Eq)

--quickCheck用
instance Arbitrary T1 where
  arbitrary = elements [T1C1]
instance Arbitrary T2 where
  arbitrary = elements [T2C1, T2C2]
instance Arbitrary T3 where
  arbitrary = elements [T3C1 .. T3C3]
instance Arbitrary T4 where
  arbitrary = elements [T4C1 .. T4C4]
instance Arbitrary T5 where
  arbitrary = elements [T5C1 .. T5C5]
instance Arbitrary T6 where
  arbitrary = elements [T6C1 .. T6C6]

うわきもい

で、予行練習がてら、bool型とT2、T1とUnitが同型である事をチェックしてみましょう。

main :: IO ()
main = do
  quickCheck $ propIso t1_unit unit_t1
  quickCheck $ propIso t2_bool bool_t2

----
-- T1 =~ Unit

t1_unit :: T1 -> ()
t1_unit T1C1 = ()

unit_t1 :: () -> T1
unit_t1 () = T1C1

----
-- T2 =~ Bool

t2_bool :: T2 -> Bool
t2_bool T2C1 = True
t2_bool T2C2 = False

bool_t2 :: Bool -> T2
bool_t2 True = T2C1
bool_t2 False = T2C2

実行結果、OKです。

+++ OK, passed 100 tests.
+++ OK, passed 100 tests.

あ、ここからはテストコードのみ載せるので、実行結果は読者が直接手で確認してみてください。 基本的には通るはずです。

型の足し算++

さて、足し算の話をもうちょっとしましょう。 足し算・・・つまり直和型は、新しく型を定義しても良いですが、Either型を使うほうが簡単に作れます。

それを利用して

{ \displaystyle
T2 + T3 \cong T5
}

を確認してみましょう。

main :: IO ()
main = do
  quickCheck $ propIso t2p3_t5 t5_t2p3

----
-- T2 + T3 =~ T5

t2p3_t5 :: Either T2 T3 -> T5
t2p3_t5 (Left T2C1)  = T5C1
t2p3_t5 (Left T2C2)  = T5C2
t2p3_t5 (Right T3C1) = T5C3
t2p3_t5 (Right T3C2) = T5C4
t2p3_t5 (Right T3C3) = T5C5

t5_t2p3 :: T5 -> Either T2 T3
t5_t2p3 T5C1 = (Left T2C1)  
t5_t2p3 T5C2 = (Left T2C2)  
t5_t2p3 T5C3 = (Right T3C1) 
t5_t2p3 T5C4 = (Right T3C2) 
t5_t2p3 T5C5 = (Right T3C3) 

さて、直和型は整数の加算のように結合則および交換則を満たす事がわかっています。 つまり、どんな型についても

{ \displaystyle (a + b) + c \cong a + (b + c) }
{ \displaystyle a + b \cong b + a }

が成り立つという事ですね。

なんか直感的に正しそうです。 っていうかこのへんの定義の話、もうちょっと定理証明に詳しければわざわざテストコード書くまでも無いきがするのですが 色々と復習してる時間無かったり、ましてやわかりやすくブログで説明できる自信もないので、頑張ってテストする事にします。

具体的な型をベタ書きするのはかなりしんどいので、次のような多相な関数を作りましょう。

associative_from :: Either (Either a b) c -> Either a (Either b c)
associative_from (Left (Left x)) = Left x
associative_from (Left (Right x)) = Right (Left x)
associative_from (Right x) = Right (Right x)

associative_to :: Either a (Either b c) -> Either (Either a b) c
associative_to (Left x) = (Left (Left x))  
associative_to (Right (Left x)) = (Left (Right x)) 
associative_to (Right (Right x)) = (Right x)        

そのまま使おうとすると最終的に記述量がえらい長くなってしまうので、短く書くための型の別名と関数を定義します。

type Associative a b c = (Either (Either a b) c, Either a (Either b c)) -> Bool

propAssociative :: (Arbitrary a, Arbitrary b, Arbitrary c, 
  Eq a, Eq b, Eq c, Show a, Show b, Show c) => Associative a b c
propAssociative = propIso associative_from associative_to

あとはpropAssociativeに型シグネチャを付けて、quickCheck関数に渡せばおk・・・

なのですが、T1〜T6全て組み合わせを試すとやたら組み合わせ多くてつらぽよ度高いので、 適当に何パターンか繕って実行してみます。

main :: IO ()
main = do
  quickCheck $ (propAssociative :: Associative T1 T1 T1)
  quickCheck $ (propAssociative :: Associative T3 T3 T3)
  quickCheck $ (propAssociative :: Associative T6 T6 T6)
  quickCheck $ (propAssociative :: Associative T1 T2 T3)
  quickCheck $ (propAssociative :: Associative T2 T3 T4)
  quickCheck $ (propAssociative :: Associative T3 T4 T5)
  quickCheck $ (propAssociative :: Associative T4 T5 T6)

これを実行してみてください、何百回やっても、Associativeの型引数をどう変えても必ずテストが通るはずです。 本当は全パターン試せる上手いやり方無いかな〜とか思ったんですが、ちょっとすぐには思いつかなかったのでこれで勘弁してください。

続いて、交換則の話にうつりましょう、 こっちはもっと簡単なので一気にいきます。

main :: IO ()
main = do
  quickCheck $ (propCommutative :: Commutative T1 T1)
  quickCheck $ (propCommutative :: Commutative T2 T2)
  quickCheck $ (propCommutative :: Commutative T3 T3)
  quickCheck $ (propCommutative :: Commutative T3 T4)
  quickCheck $ (propCommutative :: Commutative T4 T5)
  quickCheck $ (propCommutative :: Commutative T5 T6)

----
-- a + b  =~ b + a

commutative :: Either a b -> Either b a
commutative (Left x) = Right x
commutative (Right x) = Left x

type Commutative a b = (Either a b, Either b a) -> Bool

propCommutative :: (Arbitrary a, Arbitrary b, Eq a, Eq b, Show a, Show b) => Commutative a b
propCommutative = propIso commutative commutative

足し算と来たら次は引き算・・・と行きたいところですが、 代数的データ型には引き算とか割り算に相当する概念は存在しないので、すっとばして掛け算いきましょう。

型の掛け算

型の足し算が直和型だったので、もうわかると思いますが、 型の掛け算は直積型です。

例えば、T2T3の直積T2 \times T3は次のように定義できます。

data T2T3 = T2T3 T2 T3 deriving (Show, Eq)

--quickCheck用
instance Arbitrary T2T3 where
  arbitrary = do
    t2 <- arbitrary
    t3 <- arbitrary
    elements [T2T3 t2 t3]

直和の時にEitherを使ったのと同じように、直積はタプルを使えば簡単に作る事ができます。 今作ったT2T3(T2,T3)が同型な事をちゃちゃっと確認してしまいましょう。

main :: IO ()
main = do
  quickCheck $ propIso t2T3_Tuple tuple_T2T3

----
-- T2T3 =~ (T2, T3)

t2T3_Tuple :: T2T3 -> (T2, T3)
t2T3_Tuple (T2T3 t2 t3) = (t2, t3)

tuple_T2T3 :: (T2, T3) -> T2T3
tuple_T2T3 (t2, t3) = T2T3 t2 t3

さて、直積型は次のような規則をもっている事がわかっています。

{ \displaystyle 1 \times a \cong a }
{ \displaystyle (a \times b) \times c \cong a \times (b \times c) }
{ \displaystyle a \times b \cong b \times a }

一つ目の規則は単位元則、そして残りは直和の場合と同じく、結合則と交換則といいます。 単位元は、右単位元と左単位元とありますが、交換則があれば片方を示す事でどちらも成り立たせる事ができるので、片方だけテストします。

さあさ、テストコード、だだーっといきますよ。

main :: IO ()
main = do
  quickCheck $ (propIdentityElem :: IdentityElem T1)
  quickCheck $ (propIdentityElem :: IdentityElem T2)
  quickCheck $ (propIdentityElem :: IdentityElem T3)
  quickCheck $ (propIdentityElem :: IdentityElem T4)
  quickCheck $ (propIdentityElem :: IdentityElem T5)
  quickCheck $ (propIdentityElem :: IdentityElem T6)

  quickCheck $ (propAssociative' :: Associative' T1 T1 T1)
  quickCheck $ (propAssociative' :: Associative' T3 T3 T3)
  quickCheck $ (propAssociative' :: Associative' T6 T6 T6)
  quickCheck $ (propAssociative' :: Associative' T1 T2 T3)
  quickCheck $ (propAssociative' :: Associative' T2 T3 T4)
  quickCheck $ (propAssociative' :: Associative' T3 T4 T5)
  quickCheck $ (propAssociative' :: Associative' T4 T5 T6)

  quickCheck $ (propCommutative' :: Commutative' T1 T1)
  quickCheck $ (propCommutative' :: Commutative' T2 T2)
  quickCheck $ (propCommutative' :: Commutative' T3 T3)
  quickCheck $ (propCommutative' :: Commutative' T3 T4)
  quickCheck $ (propCommutative' :: Commutative' T4 T5)
  quickCheck $ (propCommutative' :: Commutative' T5 T6)

-- 1 * a =~ a

idelem_from :: ((), a) -> a
idelem_from ((), x) = x

idelem_to :: a -> ((), a)
idelem_to x = ((), x)

type IdentityElem a = (((), a), a) -> Bool

propIdentityElem :: (Arbitrary a, Eq a, Show a) => IdentityElem a
propIdentityElem = propIso idelem_from idelem_to

----
-- (a * b) * c  =~ a * (b * c)

associative_from' :: ((a, b), c) -> (a, (b, c))
associative_from' ((x, y), z) = (x, (y, z))

associative_to' :: (a, (b, c)) -> ((a, b), c)
associative_to' (x, (y, z)) = ((x, y), z) 

type Associative' a b c = (((a, b), c), (a, (b, c))) -> Bool

propAssociative' :: (Arbitrary a, Arbitrary b, Arbitrary c, 
  Eq a, Eq b, Eq c, Show a, Show b, Show c) => Associative' a b c
propAssociative' = propIso associative_from' associative_to'

----
-- a * b =~ b * a

commutative' :: (a, b) -> (b, a)
commutative' (x, y) = (y, x)

type Commutative' a b = ((a, b), (b, a)) -> Bool

propCommutative' :: (Arbitrary a, Arbitrary b, Eq a, Eq b, Show a, Show b) => Commutative' a b
propCommutative' = propIso commutative' commutative'

んで、もういっこ、直積・直和にまつわる分配法則という重要な法則があります。

{ \displaystyle
a \times (b + c) \cong a \times b + a \times c
}

そうです、中学校の数学でやったあれです。 この法則が数の足し算掛け算だけでなく、型に関しても成り立つ事を確認しましょうできました。

main :: IO ()
main = do
  quickCheck $ (propDistributive :: Distributive T1 T1 T1)
  quickCheck $ (propDistributive :: Distributive T3 T3 T3)
  quickCheck $ (propDistributive :: Distributive T6 T6 T6)
  quickCheck $ (propDistributive :: Distributive T1 T2 T3)
  quickCheck $ (propDistributive :: Distributive T2 T3 T4)
  quickCheck $ (propDistributive :: Distributive T3 T4 T5)
  quickCheck $ (propDistributive :: Distributive T4 T5 T6)

----
-- a * (b + c) =~ a * b + a * c

distributive_from :: (a, Either b c) -> Either (a, b) (a, c)
distributive_from (x, Left y) = Left (x, y)
distributive_from (x, Right y) = Right (x, y)

distributive_to :: Either (a, b) (a, c) -> (a, Either b c)
distributive_to (Left (x, y)) = (x, Left y)
distributive_to (Right (x, y)) = (x, Right y)

type Distributive a b c = ((a, Either b c), Either (a, b) (a, c)) -> Bool

propDistributive :: (Arbitrary a, Arbitrary b, Arbitrary c, 
  Eq a, Eq b, Eq c, Show a, Show b, Show c) => Distributive a b c
propDistributive = propIso distributive_from distributive_to

関数はどーすんの

さて、Haskellの関数を表す(->)は型引数を二つとるコンストラクタでもありましたね。

*Main> :k (->)
(->) :: * -> * -> *

Haskellは強い型システムを持っていますから、こんなふーに関数自体も他の型とおんなじよーな感じで扱う事ができますし、 今日やってるような「型の計算」で、関数を扱えないという事はまさか無いでしょう。 実の所、「型の計算」においては、関数を扱えるようになってからが本番なのですっ!

おっとここでまた天の声が聞こえてきましたよ?型の計算において関数は「べき乗」のように扱うんだそうです。 例えば、A -> Bという関数はBAのように記述します。

当然、この「型のべき乗」にも、直和型や直積型と同じようにいくつかの法則があります。 すっげー身近な所だと、curryuncurryは、次のような同型関係を表してるんです。

{ \displaystyle c } (a × b) { \displaystyle \cong (c } b { \displaystyle ) } a

所で、このcurryuncurryの関係は、高校数学で習う指数法則のうちの一つとそっくりですね?

そんな感じで、他の指数法則も適用できます。

{ \displaystyle c } a {\displaystyle \times c } b { \displaystyle \cong c }(a + b)
{ \displaystyle (b \times c) } a {\displaystyle \cong b }a { \displaystyle  \times c}a

それぞれ、こんな感じに実装できますね。

----
-- C^A*C^B =~ C^(A+B)

exponent1_from :: (a -> c, b -> c) -> (Either a b -> c)
exponent1_from (f, g) (Left x) = f x
exponent1_from (f, g) (Right x) = g x

exponent1_to :: (Either a b -> c) -> (a -> c, b -> c) 
exponent1_to f = (f . Left, f . Right)

----
-- (B*C)^A =~ B^A*C^A

exponent2_from :: (a -> (b, c)) -> (a -> b, a -> c)
exponent2_from f = (fst . f, snd . f)

exponent2_to :: (a -> b, a -> c) -> (a -> (b, c))
exponent2_to (f, g) = \x -> (f x, g x)

あー、指数法則のQuickCheckでのテストはめちゃんこややこしいので無しで良いですか?

ところで、そもそもの話なんですけど、ちゅーんさんがこの辺のお勉強をしてた時、 ちゃんと数値計算のべき乗と同じように

{ \displaystyle a \times a \times a \times ... \times a \cong a}n

が成り立つかって情報を得ることができなかったので、あんまり自信なかったのです。 ので、2パターンほど試してみました。

main :: IO ()
main = do
  mapM_ quickCheck propExponential 
  mapM_ quickCheck propExponential'

----
-- T2 * T2 =~ T2^T2

exponential_from :: (T2, T2) -> T2 -> T2
exponential_from (T2C2, T2C1) = ft2
exponential_from (T2C1, T2C2) = id
exponential_from (T2C1, T2C1) = \_ -> T2C1
exponential_from (T2C2, T2C2) = \_ -> T2C2

ft2 :: T2 -> T2
ft2 T2C1 = T2C2
ft2 T2C2 = T2C1

exponential_to :: (T2 -> T2) -> (T2, T2)
exponential_to f = (f T2C1,f T2C2)

propExponential :: [((T2, T2), T2) -> Bool]
propExponential = 
  [ \(xy, _) -> (exponential_to . exponential_from $ xy) == xy
  , \(xy ,z) -> let f = exponential_from xy in 
    (exponential_from . exponential_to $ f) z == f z
  ]

----
-- T2 * T2 * T2 =~ T2^T3

exponential_from' :: (T2, T2, T2) -> T3 -> T2
exponential_from' (T2C2, T2C1, T2C1) = \x -> if x == T3C1 then T2C2 else T2C1
exponential_from' (T2C1, T2C2, T2C1) = \x -> if x == T3C2 then T2C2 else T2C1
exponential_from' (T2C1, T2C1, T2C2) = \x -> if x == T3C3 then T2C2 else T2C1
exponential_from' (T2C1, T2C2, T2C2) = \x -> if x == T3C1 then T2C1 else T2C2
exponential_from' (T2C2, T2C1, T2C2) = \x -> if x == T3C2 then T2C1 else T2C2
exponential_from' (T2C2, T2C2, T2C1) = \x -> if x == T3C3 then T2C1 else T2C2
exponential_from' (T2C1, T2C1, T2C1) = \_ -> T2C1
exponential_from' (T2C2, T2C2, T2C2) = \_ -> T2C2

exponential_to' :: (T3 -> T2) -> (T2, T2, T2)
exponential_to' f = (f T3C1, f T3C2, f T3C3)

propExponential' :: [((T2, T2, T2), T3) -> Bool]
propExponential' = 
  [ \(xyz, _) -> (exponential_to' . exponential_from' $ xyz) == xyz
  , \(xyz, w) -> let f = exponential_from' xyz in 
    (exponential_from' . exponential_to' $ f) w == f w
  ]

色々書いてた感じ、だーいたいの法則性は分かりました、証明したわけでは無いですが、ちゃんと成り立つっぽい。

まとめ

とゆーわけで、「型の計算」と題して、型を式にして色々変換してみる手法を紹介してみました。はい。 あ、一点だけ意識していただきたいのですが。今回はわりと自明な内容なのもあり、色々手を抜く目的でQuickCheckiを使ったテストを行いましたが、本来はちゃんと数学的に証明するか、網羅的なテストを行うべきです。

さて、こーゆー型の性質を実際のプログラミングに応用するのは、一定の経験値が必要そうな気はしますが、 OOPにしても関数型にしても、データ構造の持つ性質に着目する事は、重要そうに見えますね?

まー、この記事はそれ以前に「どや、面白いやろ?」という話ですので、 そこんとこ、楽しんで頂ければハッピーです。

あとあれ、識者の方は色々つっこむ所あればつっこんでください。 ちゅーんさんもにょきにょき成長したいです。

では、この辺でノシノシ

ちゅーんさんがreasonable-lensをHackageでリリースしたようです

はいはい、最近色々とアレがアレしてアレな感じのちゅーんさんですがちゃんと生きてます。安心してください。

もともとekmettによってlensというパッケージが公開されています。
これがすごく強力で便利な代物なのですが、いかんせん巨大で依存関係も複雑なので、使うのに気合が必要という問題があったりします。

根本的な仕組みは複雑であれ大きくは無いので、良く使う機能に限定した小型版lensを実装しました。
以下、HackageのURL:

https://hackage.haskell.org/package/reasonable-lens

これは何なの

lensは複雑な代数的データ型へのフィールドアクセスをぐっと使いやすくするためのライブラリです。 TemplateHaskellによるコンパイル時処理で、アクセサと呼ばれる関数を生成する事で、ややこしいフィールド操作をサポートします。

基本的な機能やら使い方については、去年のEkmett勉強会での発表資料を参照してください。

対応機能

  • Lens
    • 型 Lens
  • Setter
    • 型 Setter, Mutator
    • 関数 over, set
    • 演算子 .~, %~, +~, -~, *~, /~, &
    • 演算子 .=, %=, +=, -=, *=, //=
  • Getter
    • 型 Getting, Accessor
    • 関数 foldMapOf, foldOf, use
    • 演算子 ^.
  • Tuple
    • 型クラス Field1, ~ , Field4
    • 関数 _1, ~ , _4
  • TH
    • 関数 makeLenses

課題

絶対欲しい機能

対応するかもしれないやつ

  • Action
  • Iso
  • Prism

その他課題

  • パフォーマンス
    • ekmettの本気チューニングに勝てる気はしないけど可能な限り
  • 可読性向上
    • 内部的な問題だけど、THがカオス
    • 本家だとPrism使ってるんだよねー。どういう事なんだろ。

EffのState上でLensのアクセサを利用する

はいはい、どーも、キルラキル面白いですね。
ちゅーんさんです。

前回、前々回とHaskell上で状態を扱う手段として、LensのClassy、Effを紹介した際に、 この2つが併用可能かどうかについて「よくわからん」と書きました。

ので、やってみました。

結論から言うと、とても簡単です。

EffをMonadStateの型にする

*Main> :i (.=)
(.=) ::
  Control.Monad.State.Class.MonadState s m =>
  ASetter s s a b -> b -> m ()
    -- Defined in `Control.Lens.Setter'
infix 4 .=
*Main> :i (+=)
(+=) ::
  (Control.Monad.State.Class.MonadState s m, Num a) =>
  ASetter' s a -> a -> m ()
    -- Defined in `Control.Lens.Setter'
infix 4 +=
*Main> :i (*=)
(*=) ::
  (Control.Monad.State.Class.MonadState s m, Num a) =>
  ASetter' s a -> a -> m ()
    -- Defined in `Control.Lens.Setter'
infix 4 *=

これらの演算子は状態を扱うモナドにMonadStateを要求しています。 つまり、EffがmtlのMonadStateのインスタンスになっていれば良いということです。

実際に定義してみましょう。

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
module Main where
import Data.Typeable
import Control.Eff
import Control.Eff.State.Lazy as EST
import Control.Monad.State.Class (MonadState(..))

instance (Typeable x, Member (State x) r) => MonadState x (Eff r) where
  get = EST.get 
  put = EST.put 

EffをMonadStateのインスタンスにするには、いくつかのGHC拡張が必要です。 また、get関数、put関数はEffの定義そのままで良いのですが、インスタンスにするための型定義はやや複雑です。

Member型クラスになっているのは、Effが型クラスのシグネチャによって関数内で許される作用を特定しているため、必要になります。 Effの内部実装上、作用を階層化する際に型の情報を削ぎ落としているため、元の型を復元するためにTypeable型クラスが要求されます。(それでも型安全にするために、Member型クラスがあります)

といっても、実際に使う分には内部実装の知識は必要ありません。
基本的に上記のように記述すれば、Eff State内でLensによるアクセサ操作が行えると思えば良いでしょう。

実際に使う

では、Eff State上でLensの演算子が実際に使えるかどうか試してみましょう。 Lensモジュールをインポートし、DeriveDataTypeable, TemplateHaskell, FlexibleContextsの言語拡張を有効にし、 次のコードを追加します。

data Foo = Foo
  { _hoge :: Int
  , _piyo :: String
  , _fuga :: Bool
  } deriving (Show, Typeable)

makeLenses ''Foo

proc :: (Member (State Foo) r) => Eff r ()
proc = do
  piyo .= "Hello, Lens with Extensible Effects!"
  fuga .= True

main = do
   let foo = Foo
               { _hoge = 100
               , _piyo = "Hello"
               , _fuga = False
               }
   print . run $ execState foo proc

実行結果:

Foo {_hoge = 100, _piyo = "Hello, Lens with Extensible Effects!", _fuga = True}

State + Lens + Choose

で、せっかくEffとLensを組み合わせて使ってみたのだから、他の作用とも合成してみたくなりますね。 mtlのListモナドに相当する、Chooseという作用がEffモナドにはあります。

Eff.Chooseモナドをimportし、ScopedTypeVariables言語拡張を有効にすれば、 次のようにLensを使って状態を扱う処理と、リストモナドのような組み合わせを走査する計算を同時に記述する事が可能です。

proc :: (Member Choose r, Member (State Foo) r) => Eff r Foo
proc = do
  x <- choose [1, 2, 3]
  s <- choose ["+++", "---", "***"]
  b <- choose [True, False]

  hoge *= x
  p <- use $ piyo
  piyo .= s ++ p ++ s
  fuga .= b

  (res :: Foo) <- EST.get
  return res

実際に実行してみましょう。

main = do
   let foo = Foo
               { _hoge = 100
               , _piyo = "Hello"
               , _fuga = False
               }
   print . run $ runChoice (execState foo proc)

実行結果:

[ Foo {_hoge = 100, _piyo = "+++Hello+++", _fuga = True}
, Foo {_hoge = 100, _piyo = "+++Hello+++", _fuga = False}
, Foo {_hoge = 100, _piyo = "---Hello---", _fuga = True}
, Foo {_hoge = 100, _piyo = "---Hello---", _fuga = False}
, Foo {_hoge = 100, _piyo = "***Hello***", _fuga = True}
, Foo {_hoge = 100, _piyo = "***Hello***", _fuga = False}
, Foo {_hoge = 200, _piyo = "+++Hello+++", _fuga = True}
, Foo {_hoge = 200, _piyo = "+++Hello+++", _fuga = False}
, Foo {_hoge = 200, _piyo = "---Hello---", _fuga = True}
, Foo {_hoge = 200, _piyo = "---Hello---", _fuga = False}
, Foo {_hoge = 200, _piyo = "***Hello***", _fuga = True}
, Foo {_hoge = 200, _piyo = "***Hello***", _fuga = False}
, Foo {_hoge = 300, _piyo = "+++Hello+++", _fuga = True}
, Foo {_hoge = 300, _piyo = "+++Hello+++", _fuga = False}
, Foo {_hoge = 300, _piyo = "---Hello---", _fuga = True}
, Foo {_hoge = 300, _piyo = "---Hello---", _fuga = False}
, Foo {_hoge = 300, _piyo = "***Hello***", _fuga = True}
, Foo {_hoge = 300, _piyo = "***Hello***", _fuga = False}]

まとめ

単純に状態を伴う計算を行うだけであれば、State+Lensで状態の拡張にはmakeClassyを使えば良いでしょう。
そこに状態以外の作用(非決定性計算等)を加える場合、その複雑性によってはモナド変換子ではなく、Effの導入を検討してみるのもありですね。 そのような拡張に耐えうるコードにするため、状態を扱う処理はStateモナドではなく、MonadState型クラスで記述するようにしておくと良いかもしれません。

最後に、最終的なコード全体を以下に記述しておわります。

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
{-# LANGUAGE DeriveDataTypeable, TemplateHaskell, FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Data.Typeable
import Control.Eff
import Control.Eff.State.Lazy as EST
import Control.Eff.Choose
import Control.Monad.State.Class (MonadState(..))
import Control.Lens

instance (Typeable x, Member (State x) r) => MonadState x (Eff r) where
  get = EST.get 
  put = EST.put 

data Foo = Foo
  { _hoge :: Int
  , _piyo :: String
  , _fuga :: Bool
  } deriving (Show, Typeable)

makeLenses ''Foo

----

proc :: (Member Choose r, Member (State Foo) r) => Eff r Foo
proc = do
  x <- choose [1, 2, 3]
  s <- choose ["+++", "---", "***"]
  b <- choose [True, False]

  hoge *= x
  p <- use $ piyo
  piyo .= s ++ p ++ s
  fuga .= b

  (res :: Foo) <- EST.get
  return res

main = do
   let foo = Foo
               { _hoge = 100
               , _piyo = "Hello"
               , _fuga = False
               }
   print . run $ runChoice (execState foo proc)

状態の合成比較:モナド変換子 vs Eff vs Classy

前回の記事について、実際に他の方法と比較してみたいという声を頂いたので、それぞれ同じような事をするためのコードを書き下してみました。

オーバーヘッドとかそのへんのパフォーマンス周りについては調べてないです。 きっと誰かがやってくれるさ。

モナド変換子の場合

module Main where
import Control.Monad.State

data Foo = Foo
  { foostr :: String
  , fooint :: Int
  } deriving Show

data Bar = Bar
  { barstr :: String
  , barint :: Int
  } deriving Show

----

changeFoo :: State Foo () 
changeFoo = modify $ \foo -> foo { foostr = "NYAN" }

changeFooBar :: StateT Foo (State Bar) ()
changeFooBar = do
  modify $ \foo -> execState changeFoo foo
  lift . modify $ \bar -> bar { barint = 100 }
    
main = do
  let foo = Foo { foostr = "hoge", fooint = 1 }
  let bar = Bar { barstr = "piyo", barint = 2 }
  print (foo, bar)
  print $ execState changeFoo foo
  print $ runState (execStateT changeFooBar foo) bar

こうしてみると、State同士をモナド変換子で合成するのはとても良い設計とは言えない感じ。

changeFooBar関数の中でexecStateを実行しなくちゃいけないのもダサいですし、なにより、liftが付きまとうのは辛いですね・・・。状態の数が3つ以上になったら、一旦一つの型にまとめたほうが良さそうです。4つとか5つくらいのStateモナドを合成して扱うなんてなったら、脳みそが付いていける自信無い・・・。

Extensible Effects

{-# LANGUAGE FlexibleContexts, DeriveDataTypeable #-}
module Main where
import Data.Typeable
import Control.Eff
import Control.Eff.State.Lazy

data Foo = Foo
  { foostr :: String
  , fooint :: Int
  } deriving (Show, Typeable)

data Bar = Bar
  { barstr :: String
  , barint :: Int
  } deriving (Show, Typeable)

----

changeFoo :: (Member (State Foo) r) => Eff r ()
changeFoo = modify $ \foo -> foo { foostr = "NYAN" }

changeFooBar :: (Member (State Foo) r, Member (State Bar) r) => Eff r ()
changeFooBar = do
  changeFoo
  modify $ \bar -> bar { barint = 100 }

main = do
  let foo = Foo { foostr = "hoge", fooint = 1 }
  let bar = Bar { barstr = "piyo", barint = 2 }
  print (foo, bar)
  print . run $ execState foo changeFoo
  print . run $ runState foo (execState bar changeFooBar)

モナド変換子のlift地獄解決のために作られたみたいなライブラリです。 あるモナドアクションが合成されたどのモナドのものなのかは、そのアクションの型で決定されるので、liftが不要になります。 ただし、型シグネチャがお伊達にも分かりやすいとは言えないほか、mtlとの互換性が全くないのはどうなんだろう・・・。

ブラックボックスの範囲の話をすると、いちおう圏論的なアプローチで作られてはいるようですが、数学的な背景がHask圏に収まっていないっぽくて、メタな部分で超絶技巧な事をしてたりします。 あとlensと組み合わせて使えるか今のところわかんないので、いずれやってみてまだブログ書きます。

Classy

{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Lens
import Control.Monad.State

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

makeClassy ''Foo
makeClassy ''Bar

----

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''FooBar

instance HasFoo FooBar where
  foo = foobarFoo
instance HasBar FooBar where
  bar = foobarBar

----

changeFoo :: HasFoo a => State a ()
changeFoo = foostr .= "NYAN"

changeFooBar :: (HasFoo a, HasBar a) => State a ()
changeFooBar = do
  changeFoo
  barint .= 100

main = do
  let foo = Foo { _foostr = "hoge", _fooint = 1 }
  let foobar = FooBar 
                 { _foobarFoo = foo 
                 , _foobarBar = Bar { _barstr = "piyo", _barint = 2 }
                 }
  print foobar
  print $ execState changeFoo foo 
  print $ execState changeFooBar foobar

モナド変換子とEffが「モナドの合成」なのに対し、こっちは「型の合成」になります。一旦型を宣言してしまえば、純粋な関数でもlensを通して使えます。 「型を作る」というアプローチであるが故に、型宣言の量が多くなってしまうのは難点ですが、その分、実際の処理部分は一番わかりやすいです。

ようは、「単純に複数の状態を一気に扱いたいだけなら、モナドの合成なんてややこしい事しないで、型を一つにまとめちゃえば良いでしょ?」という形での代案なので、List/Maybeモナドを代表とする、非決定計算を扱うモナドの代用は出来ないです。 Effとlensの組み合わせが出来るようであれば、Effと一緒に使ってみても良いかもしれないですね。

lensのmakeClassyで型を合成する

はいはい、とんとご無沙汰しとります。ちゅーんさんです。

HaskellではStateモナド等を使って、状態を扱う事ができます。 また、モナドの合成にはモナド変換子がよく使われますが、 モナド変換子は階層構造になっているため、複数の状態系モナドを、 組み合わせて使うような、よくある場合に適さないという問題があります。

で、

この解決方法には、例えばOleg先生のextensible-effects 等、いろいろと考えだされています。

個人的にEffは超絶技巧のわりにはあまり分かりやすいイメージもなく、 既存のモナドをすべて置き換えなくてはいけないため、あまり好きではないのです。 そこで、単純に複数のレコードを一つに纏めあげたいだけの場合は、 lensライブラリmakeClassy というTHを使って型を作成するのをおすすめします。

導入

まず、以下のような2つの型を考えましょう。

data Foo = Foo
  { foostr :: String
  , fooint :: Int
  }

data Bar = Bar
  { barstr :: String
  , barint :: Int
  }

単純に、これらの型をまとめ上げた、FooBar型を考えます。

data FooBar
  { foobarFoo :: Foo
  , foobarBar :: Bar
  }

そしてこれを単純にStateモナドで扱う事を考えます。

proc :: State FooBar ()
proc = do
  base <- get
  let foo = foobarFoo base
  put $ base { foobarFoo = foo { fooint = 100 }  } 

main = do
  foobar <- return $ FooBar 
    { foobarFoo = Foo { foostr = "hoge", fooint = 1 }
    , foobarBar = Bar { barstr = "piyo", barint = 2 }
    }
  print $ runState proc foobar

proc関数を読んでみましょう。

なんというかこう

とてもつらい

lensとState

MonadStateのインスタンスになっているモナドで状態の一部を変更したりという事を頻繁に行うのであれば、 状態に用いる方をlensにしてしまうのが良いです。

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''Foo
makeLenses ''Bar
makeLenses ''FooBar

lensのアクセサによって値の操作がぐっと楽になります。

proc :: State FooBar ()
proc = do
  foobarFoo.foostr .= "HOGE"
  foobarBar.barint *= 100

さて、予めFooに対し、次のような関数が用意されていた場合を考えてみましょう。

changeFoo :: State Foo ()
changeFoo = do
  foostr .= "NYAN"
  fooint .= 1000

この関数をFooBar型のStateに使うためには、execStateしなくてはいけません。 あんまり格好良くないですね。

proc :: State FooBar ()
proc = do
  tmp <- use foobarFoo
  foobarFoo .= execState changeFoo tmp

型クラスの作成と型の合成

先ほど上げたような問題は、Foo型、Bar型それぞれの型クラスを作成する事によって解決できる気がします。 しかしlensの型はややこしいため、それらを自力で実装するのはあまり良い考えではなさそうです。

素晴らしい事に、任意の型をlensで扱えるようにすると同時に、 そのアクセサが定義された型クラスを自動的に生成するTHの実装が用意されています。 それが、makeClassyです。

試しに、Foo型をmakeClassyで扱ってみましょう。

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

makeClassy ''Foo

このFoo型は普通にlensで扱える(※多相な型の場合等、makeLensesと違って制限があるようです)他、 ある型がXを内包している事を表すHasXという型クラスが実装されます。

ghci> :i HasFoo
class HasFoo c_a1YO where
  foo :: Functor f => (Foo -> f Foo) -> c0 -> f c0
  fooint :: Functor f => (Int -> f Int) -> c0 -> f c0
  foostr :: Functor f => (String -> f String) -> c0 -> f c0
    -- Defined at Main.hs:54:1
instance HasFoo Foo -- Defined at Main.hs:54:1

このうち、実装が必要なのはfoo関数のみで、これはある型が内包するfoo関数へのアクセサを設定すればOKです。 実際に、FooとBarをmakeClassyを使って合成してみましょう。

まず、FooとBarに対しmakeClassy、FooBarに対しmakeLensesを実行します。

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

makeClassy ''Foo
makeClassy ''Bar

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''FooBar

さらに、FooBarをHasFoo、HasBarそれぞれの型クラスにします。

instance HasFoo FooBar where
  foo = foobarFoo
instance HasBar FooBar where
  bar = foobarBar

最後に、changeFoo関数の型定義を次のように変更すれば、FooBar型に対しても、changeFoo関数による操作が出来るようになります。

changeFoo :: HasFoo a => State a ()
changeFoo = do
  foostr .= "NYAN"
  fooint .= 1000

コード全体

{-# LANGUAGE TemplateHaskell #-}
module Main where
import Control.Lens
import Control.Monad.State

data Foo = Foo
  { _foostr :: String
  , _fooint :: Int
  } deriving Show

data Bar = Bar
  { _barstr :: String
  , _barint :: Int
  } deriving Show

makeClassy ''Foo
makeClassy ''Bar

data FooBar = FooBar
  { _foobarFoo :: Foo
  , _foobarBar :: Bar
  } deriving Show

makeLenses ''FooBar

instance HasFoo FooBar where
  foo = foobarFoo
instance HasBar FooBar where
  bar = foobarBar

----

changeFoo :: HasFoo a => State a ()
changeFoo = do
  foostr .= "NYAN"
  fooint .= 1000

proc :: State FooBar ()
--proc :: (HasFoo a, HasBar a) => State a () --型定義はこのほうが良いかも
proc = do
  --FooBarはFoo, Barそれぞれのインスタンスなので
  --次のような書き方も出来る
  foostr .= "FOO!"
  fooint .= 123
  barstr .= "BAR!"
  barint .= 321

main = do
  foobar <- return $ FooBar 
    { _foobarFoo = Foo { _foostr = "hoge", _fooint = 1 }
    , _foobarBar = Bar { _barstr = "piyo", _barint = 2 }
    }
  print foobar
  print $ runState changeFoo foobar
  print $ runState proc foobar