Star: ProfunctorとしてのReaderT

TL; DR

ReaderTパターンなどa -> f bが必要な場面でReaderTと同型なStarを採用すると、Profunctor関連の強力な表現力を利用できます。

はじめに

https://adventar.org/calendars/10452

この記事は仙骨マウスパッド^[1]アドベントカレンダー^[2]2024 ^[3]の記事です。

対象読者

Haskellの基本文法と、メジャーな型クラス(Functor, Applicative, Monad)に親しんでいることを前提知識としています。すなわち、モナドチュートリアルをすっとばします。

Haskellが一切関係ないアドベントカレンダーに書く記事としてはいささか不適切ですね。さまざまな場合、綺麗な模様だと思って眺めてください。

ReaderT と Star の類似性

Star は profunctors ^[4] パッケージで定義された型で、

newtype Star f d c = Star { runStar :: d -> f c }

というかたちをしています。

これは mtl の ReaderT ^[5]

newtype ReaderT r m a = ReaderT { runReaderT :: r -> m a }

と見比べると中身が同じa -> f bであることがわかります。 ^[6]

類似点の活用

中身が一緒なのもあってReaderTのもつインスタンスはだいたい実装できます。
(profunctor-5.6.2時点でStarのインスタンスでないものはOrphan Instanceになるので{-# OPTIONS_GHC -Wno-orphans #-}かnewtypeで回避する必要があります)

Reader

instance (Monad m) => MonadReader r (Star m r) where
  ask = Star pure
  local = lmap
  reader = eta

シンプルな定義ながらグローバルreadonly変数の代わりになるMonadReaderは、モナド変換子三種の神器^[7] の中でもあたまひとつ抜けて大人気です。

その表現力に目をつけて環境rに可変変数の参照を食わすことで並行化可能でスペースリークのないグローバル可変変数をも可能にする ReaderTパターン で有名です。

StarにおいてはProfunctorの力を借りることでよりパワフルで簡潔な宣言を行うことができます。

pure :: (Applicative m) => a -> m a、
後述のlmap :: (Profunctor p) => (a -> b) -> p b c -> p a c、
Data.Profunctor.Compositionのeta :: (Profunctor p, Category p) => (a -> b) -> p a bから
ask :: Star m a a、
local :: (a -> b) -> Star m b c -> Star m a c、
reader :: (a -> b) -> Star m a bがそれぞれ導出されます。

このインスタンスを生やすことで、lensライブラリの(終端がMonadReader m => m aになる)view系getterを使えるようになるのも嬉しいポイントです。

import Data.IntMap as IM
-- その他import省略

f :: (Monad m) => Int -> Star m (Bool,IM.IntMap (Char,Char)) (Either Int Char)
f i = do
  b <- view _1
  if b
    then pure (Left i)
    else maybe (Left i) Right <$> preview (_2 . ix i . _2)

ひどい例ですね。^[8]

RIO系

ReaderTパターンを取り入れた代替Prelude最大手 RIO ^[9] に習いましょう。

環境rに可変変数への参照を入れ、mにIOやST sなどのモナドを入れることでいろいろな手続きを構築することができます。^[10]

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

import Control.Arrow
import Control.Monad.Primitive
import Control.Lens
import Data.Primitive
import Data.Profunctor
import Data.Profunctor.Composition

import Linear.V2 (R2(_y))

class HasMut env s a | e -> a where
  _mut :: Lens' env (MutVar s a)

instance (PrimMonad m) => PrimMonad (Star m env) where
  type PrimState (Star m env) = PrimState m
  primitive = Star $ const primitive

instance (MonadPrim s m, HasMut env s a) => MonadState a (Star m env) where
  get = view _mut >>> Star readMutVar
  put s = view _mut >>> eta writeMutVar >>> Star ($ s)

addYOne :: (MonadState (t a) m, R2 t, Num a) => m ()
addYOne = _y += 1

lensパッケージ全部読もうとしたときがあって、(+=)とかいうあまりにHaskellっぽくない演算子を見つけて大笑いしたことがありましたが、使えます。

_y += 1、本当に面白い。

addYOneをStar上で動かすにはLinearのR2クラスを満たす型^[11]をなんか^[12]に包んで可変参照にしたもの、をenvにあたる何かの型Envが持っているように定義してStar IO Env ()とかって具体化する必要があります。こういちいち書くとダルいですがぶっちゃけRIOでやってることと変わんないです。^[13]

他にMonadWriterとかのインスタンスも生えるそうですが生やしたことがないので割愛します。

lift系

instance Functor f => Functor (Star f a)

こういう instance Foo f => Foo (Bar f a)みたいなかたちのインスタンスを型変数の中身が外側の能力に漏れてくるという点でMonadTransのliftみたいだなーと思って個人的にlift系と呼んでいます。

Starを選んだ時点で

• Functor
• Monad
• MonadPlus
• Applicative
• Alterenative
• Contravariant

これらは全部使えます。ただしStar f a bのfがその型クラスを満たしている場合。

大体fにIOとかIdentityとかApplicativeParserとか入れたいわけです。fの強さに応じて色々生えて嬉しいですね。

あとその他のモナド変換子^[14]は必要にかられたら書くと良いと思います。^[15]

ReaderT と Star の相違点

さてここまではReaderTでも得られるインスタンスの話でした。^[16]

ReaderT a f bとStar f a bの一番の違いはシグニチャfとaの位置で、Star f a bについてはStar fという* -> * -> *カインドの高階型が取り出せます。

これが面白いインスタンスを結構もちます。圏論のことは本当に何もわからない。^[17]

自動的に手に入るもの

Profunctor

圏論のことは本当によくわかりませんが、少なくともHaskell上で実用する限り、Profunctorというのは一言でいうと 外延可能な計算/手続き を表す型クラスです。

dimap :: Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d

という関数に特徴が集約されます。

bっぽいものからcっぽいものへの計算を表す型の、b部分を結果がbになる関数で伸ばし、c部分をcを引数にとる関数で伸ばせる構造です。

他に

lmap :: Profunctor p => (a -> b) -> p b c -> p a c
lmap f = dimap f id

rmap :: Profunctor p => (c -> d) -> p b c -> p b d
rmap f = dimap id f

というおまけがありますが、どちらかをidというなんもしない関数で埋めてもう片方だけにフィーチャーした特殊形というだけで特にそういうアレはないです。

計算といえばまず関数ですが、当然関数の型(->)もProfunctorのインスタンスを持ちます。

図示するとわかりやすいですね。ただ単純に関数合成すればいいだけです。

事実、

instance Profunctor (->) where
  dimap f g h = g . h . f
  -- 引数を補った形は
  -- dimap f g h a = g (h (f a))

と実装できます。

Star fもまた、出力がfに包まれているだけで(->)に毛が生えたようなものなので、

やれます。ただc -> dをf c -> f dに変換するためにfがFunctorである必要があるくらいです。

instance Functor f => Profunctor (Star f) where
  dimap f g (Star h) = Star (fmap g . h . f)

という感じで既に定義されてあります。

さっきMonadReaderの実装にあたって

local = lmap

というすごい一文がありましたね。ReaderTの世界で生きるかぎりlocalを定義するのにわざわざfをMonadにしなければいけませんが、シグニチャを入れ替えるだけでモナドを要求せずにlocal相当のものを得られます。迫力。

ReaderTパターンにおいてdimapは環境と出力の書き換えに相当します。
こんなものが弱いはずがないですね。

Category

profunctorsパッケージから少し離れます。
実際に使っている中で異常に便利なのがこのCategory型クラスです。
カテゴリーセオリーのカテゴリー、つまり圏ですね。圏論のことは何一つわかりませんが……

class Category p where
  id :: p a a
  (.) :: p b c -> p a b -> p a c

という感じの定義です。baseパッケージのidと(.)が(->)に特殊化されてて^[18]名前の衝突が本当に鬱陶しいので、NoImplicitPrelulde拡張やimport Prelude hiding ((.), id)で黙らせるなりimport qualified Control.Category as Cat ^[19] して避けましょう。

左(?)から右(?)に流れる計算/手続きに限定して考えると、左端のものをまっすぐ右端に流すidと、
手続きを2つとってそれを合成する(.)が利用可能な種類の計算というイメージになります。大丈夫そうですか？

Control.Categoryに定義され、Control.Arrowに再エクスポートされている^[20](>>>)のほうがわかりやすいのでは？

(>>>) :: Category p -> p a b -> p b c -> p a c
f >>> g = g . f

(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)の気配がしますね^[21]。

しりとりをするように手続き同士を合成できるということです。

ReaderTパターンの文脈でCategory (Star f)を使うと、

• 環境E0を読んで別の環境E1を返す手続きa :: Star f E0 E1
• 環境E1を読んで別の環境E2を返す手続きb :: Star f E1 E2
• 環境E2を読んで別の環境E3を返す手続きc :: Star f E2 E3
• 環境E3を読んでなんかの計算をして結果Rを返す手続きd :: Star f E3 R

を

composed :: Star f E0 R
composed = a >>> b >>> c >>> d

と合成することで環境E0から結果Rを返す手続きにすることができます。

しかもStarの場合E1 E2 E3 Rについては生値を取り出す必要がなく、fに包んだままでいいわけです。例えばIOに包んだままでいいので標準入力や乱数の値をしりとりにぶちこめます。

ただし、今度はモナドの要求から逃げられません。joinっぽい動きしてるし仕方がなさそう。

https://atcoder.jp/contests/abc148/submissions/57825198

この提出のmainだけ、雰囲気だけ見てください。

main :: IO ()
main =
  runSolverWith pG $
    runOnResult newEnv >>> readEnv >>> runOnResult do
      ifM
        do remembers odd
        do pure 0
        do
          update 10
          fix calc
          uses _acc getSum

景色があります。

あと私用ライブラリの めぐる式二分探索^[22] の部分を抜き出すと

meguru :: (MonadState t m, MonadReader s m, HasBottom s a, HasNg t a, HasOk t a, HasGetMid s a, HasCond s a) => m a
meguru = evalContT $ callCC \exit -> forever do
  s <- use _okng
  whenM (views _bottom $ (s &) . getPredicate) $ use _ok >>= exit
  views _getMid ($ s) >>= dimap (&) (views _cond getPredicate >>=) do
    lmap (lmap (bool _ng _ok) . flip (.=) <*>)

meguruC :: (Cat.Category p, MonadPrim q (p e), MonadState t (p (Mgr q a)), MonadReader s (p (Mgr q a)), HasOk t b, HasNg t b, HasBottom s b, HasGetMid s b, HasCond s b) => Predicate a -> Predicate (a, a) -> ((a, a) -> a) -> a -> a -> p e b
meguruC cond bottom getMid ok ng = Mgr cond bottom getMid <$> newMutVar (MgrM ok ng)
  >>> meguru

というふうになっていまして、いろいろな難点^[23]は置いといて>>> meguruのとこだけ見てほしいんですけど、アルゴリズムの実行に必要な環境を耳を揃えて渡して、計算して、始末しています。
呼び出し元にミュータブルなngとかokとかは現れません。STでやれやというごもっともな意見はありますが、環境から別の環境への手続きをしりとり式に合成できることの威力の例としてはいい線行っているのではないでしょうか。

自動導出されるその他

Star fのインスタンスとして

• (Functor f) => Strong (Star f)
• (Distributive f) => Closed (Star f)
• (Traversable f) => Cochoice (Star f)
• (Applicative f) => Choice (Star f)
• (Applicative f) => Traversing (Star f)
• (Applicative f, Distributive f) => Mapping (Star f)
• (Functor f) => (Data.Profunctor.Repの^[24]) Representative (Star f)
• (Functor f) => Sieve (Star f)

などがついてきます。

GHC2021ではDeriveFunctorがデフォルトでオンになっていて、令和のHaskellでFunctorはほぼタダです。数学がわからなくても気分が良くなってきますね。

tabulate :: Representable p => (a -> (Rep p) b) -> p a b
sieve :: Sieve p f => p a b -> a -> f b

あたりStarにおいては拍子抜けするほど簡単に書かれています^[25]が、意外と使い道があって、異なる種類のProfunctor同士の合成の型

data Procompose p q d c = Procompose (forall. x => p x c -> q d x)

とかいう扱いに腕力の要りそうなやつがIsomorphic Opticのtabulatedの力で結構スッと書けて気持ちよくなれるなどします。

その他

https://github.com/ekmett/profunctors/pull/111
これがマージされたのでやがて^[26]自動で得られるようになりますが、ここにあるものはMonadReaderと同様にOrphan Instanceになるので適宜回避が要ります。

Arrow

Control.Arrowでの定義はこういう感じです。

class Category a => Arrow a where
    {-# MINIMAL arr, (first | (***)) #-}

    arr :: (b -> c) -> a b c

    first :: a b c -> a (b,d) (c,d)
    first = (*** id)

    second :: a b c -> a (d,b) (d,c)
    second = (id ***)

    (***) :: a b c -> a b' c' -> a (b,b') (c,c')
    f *** g = first f >>> arr swap >>> first g >>> arr swap
      where swap ~(x,y) = (y,x)

    (&&&) :: a b c -> a b c' -> a b (c,c')
    f &&& g = arr (\b -> (b,b)) >>> f *** g

どうしてもprofunctorsのほうが後発なので昔に定義された型クラスであるArrowより小回りのきく粒度になっているのは仕方がないですが、GHC拡張に特殊構文があるくらいには流行ったことがあり、決して無下にはできません。

Profunctor系型クラス的にはfirstやsecondはStrongのfirst'やsecond'がそのまま使えるので、fがFunctorのStar fならそこだけは少しゆるいです。

そしてarrの定義にもfがモナドであることは要らなくてfがApplicativeなら実は書けてしまいます。しかし、ArrowがCategoryを継承している以上結局必要ですね……この辺PurescriptがMonadをApplyとBindに分けてるみたいなアプローチみたいなんが合意されていれば……とは思います。歴史ある言語の辛いとこですね。^[27]

firstStar :: (Functor f) => Star f b c -> Star f (b, d) (c, d)
firstStar = first'

secondStar :: (Functor f) => Star f b c -> Star f (d, b) (d, c)
secondStar = second'

-- 実はMonadReader.readerと同じ
arrStar :: (Applicative f) => (b -> c) -> Star f b c
arrStar = (<$> Star pure)

instance (Monad f) => Arrow (Star f) where
  arr = arrStar
  first = firstStar
  second = secondStar

さてわざわざこれを定義する目当てが何かというと(***)と(&&&)ですね。

二つの手続きを並列^[28]に合成することができて、タプルをタプルのままに色々いじれます。(->)(関数インスタンス)においてすらかなり有用なので、それがStarともなれば声が出ます。

StarにArrowを生やすときには、Strongがついてきます。Strong側に用意されたuncurry'、Closedに用意されたcurry'とかいうとても香り高い名前のものたちを併用して自由自在に計算のパスを操作する時代になりました。

ひとつの手続きを酷使といえるほど変形して合成して使い回すことで、カラッカラにDRYなコードを手に入れましょう。

• Arrow系

Control.ArrowにはArrowを継承したいろいろなインスタンスがありますが、ArrowがほぼStrongであったりArrowChoiceがほぼChoiceだったりして、あまりこちらを使う機会はないかもしれません。

ところで、Kleisliという型があって、これに結構それらのArrow系インスタンスが生えています。そしてReaderT, Starと並んでこいつも中身がa -> f bなので、なんか用事があるときはキャストして生やすと楽です。

_starKleisli :: Iso (Star f a b) (Star g c d) (Kleisli f a b) (Kleisli g c d)
_starKleisli = coerced

instance (MonadFix f) => ArrowLoop (Star f) where
  loop = _starKleisli %~ loop

なんならMonadReaderとかも

_starReader :: Iso (Star f a b) (Star g c d) (ReaderT a f b) (ReaderT c g d)
_starReader = coerced

instance Monad f => MonadReader (Star f) where
  ask = _starReader # ask
  local f = _starReader %~ local f
  reader f = _starReader # reader f

でいいんですよね。Control.Lens.Isoに感謝。

蛇足

Haskellは、過言かもしれませんが^[29]、非同期や非決定などさまざまな種類の手続きのみならずその場その場で作り出した新しい手続きの種類に対してもなお統一したインターフェースで扱える真の第一級手続き言語^[30]、あるいは、ユーザ定義のパラダイムをコードの中に植え付けることのできる最凶のマルチパラダイム言語であると信じています。^[31]

バチバチに型を付けながら、森羅万象を合成しませんか？

夢がありますね。夢は欲望の構文糖で甘い。

脚注

1. 何？

2. 仙骨マウスパッド(何？)のアドベントカレンダーって何？

3. 去年もやってたの激何？

4. 
   https://hackage.haskell.org/package/profunctors-5.6.2/
   

5. 
   https://hackage.haskell.org/package/mtl-2.3.1/docs/Control-Monad-Reader.html#t:ReaderT
   

6. fが* -> *カインドのとき

7. 
   https://scrapbox.io/haskell-shoen/三種の神器
   

8. そしてこの場合f :: (MonadReader s m, Simple Field1 s a, Simple Field2 s t, Ixed t, Simple Field2 (IxValue t) b) => Index t -> m (Either (Index t) b)と抽象度を上げておいたほうが変更に強くて気持ちいいです

9. 
   https://hackage.haskell.org/package/rio-0.1.22.0
   

10. Haskellって実質マルチパラダイム言語で……

11. ざっくり_xと_yというレンズが必要です

12. MutVarやIORefやSTRef

13. あとエンドポイントでrunStarで分解しつつ具体的な型のものをぶちこむと型推論でたいていいい感じになるのでそんなに心配するところではない

14. MonadCont, MonadFix, MonadThrowなど

15. MonadTrans書いてそれ経由がだるくないかも

16. つまりRIOに(依存絞ったやつではない)フルのlensパッケージを入れると+=は使えます

17. ekmett先生ありがとうございます

18. というよりCategoryのこいつらが実のところ恒等関数idと関数合成(.)の一般化なんですが

19. ニャー

20. おかげで名前が衝突しない

21. 実際Starの(>>>)は実質これ

22. 半開区間に一般化された二分探索。参考
    https://qiita.com/drken/items/97e37dd6143e33a64c8c
    

23. 謎のクラスとか長過ぎる型クラス制約とか明らかにやりすぎたポイントフリースタイルとか

24. 圏論系のパッケージにいろんなRepresentableがあって名前がぶつかりまくっています

25. それぞれ型定義にでてくるコンストラクタStar,デストラクタrunStarと等価です

26. パッケージのバージョンが上がったら

27. しかしSemigroupとかApplicative周りで大改革やれた実績がある以上夢は見てよさそう

28. とはいっても並列プログラミングとかそういうわけではない

29. 過言

30. 詭弁

31. 誇張