a -> (a -> b) -> (a, b) への遠い道のり

そしてポイントフリーな a -> (a -> IO b) -> IO (a, b) への遠い道のり

Haskellでプログラミングしていて、こういうコードを書くことがあります。

{-# LANGUAGE TupleSections #-}
  lst <- ...
x <- mapM (\i -> (i, ) <$> f i) lst -- 引数と関数適用の結果の組が欲しい

そんなに大きなプログラムではなくても、何度も出てくることがあります。 このmapMの第1引数をポイントフリーで書けないのだろうか? すごく気になったのでちょっと考えてみました。

ゴール

欲しいものは a -> (a -> b) -> (a, b)、 またはその前駆体(?)としての a -> (a, a) なのだけど標準ライブラリにはないようです。 Control.Allow あたりにありそうだけど、ないなら作らないといけないか。

ここからaがArrowを表すことにすると、求める関数は

f :: a b c -> a b c' -> a b (c, c')

です。さてどうやって作ろう。

Scratch 1

-- | まず、基本となる持ち上げ関数(Control.Arrow)
arr :: Arrow a => (b -> c) -> a b c
-- | 基となる関数の型
f :: b -> c
-- | 持ち上げると
arr f :: a b c
-- | 一方、恒等関数idを持ち上げると
arr id :: a b b
-- ただし`id`は型クラス`Category`で定義されており、`Arrow`は`Category`なので
-- `arr id` は `id` と同じ。
-- | 次に合成するライブラリ関数(演算子)
(&&&) :: a b c -> a b c' -> a b (c, c')
-- | 組み合わせると
arr id &&& arr f :: a b c -> a b (b, c)
-- | idの話を使うと
id &&& arr f :: a b c -> a b (b, c)

で、どうやってこの式に引数を与えればいい? Arrowはモナドだから<-を使えばいい?

ここが分かってなかった。☛ Arrowはそのまま関数である。

Prelude Control.Arrow> :i Arrow  
class Control.Category.Category a => Arrow (a :: * -> * -> *) where
arr :: (b -> c) -> a b c
first :: a b c -> a (b, d) (c, d)
second :: a b c -> a (d, b) (d, c)
(***) :: a b c -> a b' c' -> a (b, b') (c, c')
(&&&) :: a b c -> a b c' -> a b (c, c')
-- Defined in ‘Control.Arrow’
instance Monad m => Arrow (Kleisli m) -- Defined in ‘Control.Arrow’
instance Arrow (->) -- Defined in ‘Control.Arrow’

ということでArrowなものは* -> * -> *なkindを持つことになっていた。このあたりはCategoryの定義を見れば分かります。基本となるメソッド<<<, >>>が通常の関数合成として定義されているなら、Arrowレベルでの式は関数合成の式であり、結果としてそれらはArrowであると同時に関数である、と。

これで

lst' <- mapM (id &&& arr f) lst

と書けるようになって問題解決し、、、してない! 実は欲しい関数というのは fが副作用を持っている場合の話だったので、IO (b, c)を返さなければいけなかった!

ということで、本当に欲しいのは

a -> (a -> b) -> (a, b)

ではなく、

a -> (a -> IO b) -> IO (a, b)

でした。これはArrowレベルでは解決できない。もっと下位の話のようだ。

Scratch 2

-- | まずArrowレベルで複製
id &&& id :: a (IO b) (IO b, IO b)
-- | こういうのが欲しい訳じゃないけど、tuple化するのがよさそう。
-- a ➡️ (a, a) ➡️ (return a, f b) ➡️ join???
-- あるいは型から考えると
-- a ➡️ (a, a) ➡️ (a, IO b) ➡️ uncurry ➡️ IO (a, b)
-- なんかこんな感じ
-- uncurryが重要そうだ
uncurry :: (a -> b -> c) -> (a, b) -> c
-- | 色々試行錯誤してこういうのを見つけた
(<$>) . (,) :: Functor f => a1 -> f a -> f (a1, a)
-- これは普通に書けば
(\x -> (x,) <$>) :: f a -> f (a1, a)
-- モナドの中に元引数を取り込めそうだ
-- | タプルから引数を受け取れるようにuncurryと組み合わせると
uncurry (<$>) . (,)) :: Functor f => (a1, f a) -> f (a1, a)
-- | 関数合成する前段も書くと
uncurry ((<$>) . (,)) . (id &&& (undefined :: a -> IO a1)) :: a -> IO (a, a1)
-- | 従ってf :: b -> IO c を代入すると求めるポイントフリー関数:
uncurry ((<$>) . (,)) . (id &&& f)) :: b -> IO (b, c)

ということで

{-# LANGUAGE TupleSections #-}
import Control.Arrow (&&&)
  lst <- ...
x <- mapM (uncurry ((<$>) . (,)) . (id &&& f)) lst

となりました。問題なし。

追記

このコードを少し変換すると分かりやすくなるかも。

{-# LANGUAGE TupleSections #-}
import Control.Arrow (&&&)
  lst <- ...
x <- mapM (uncurry (<$>) . (((,) . id) &&& f)) lst -- idは無駄
x <- mapM (uncurry (<$>) . ((,) &&& f)) lst

タプルの第1要素は1引数関数なので、あとはタプルの第2引数を第1引数に適用するだけになります。

もう少し進めて &&& の両辺を同じ型に持ち上げるときれいになるかも。

{-# LANGUAGE TupleSections #-}
import Control.Arrow (&&&)
import Control.Monad (ap)
  lst <- ...
x <- mapM (uncurry ap . ((return . (,)) &&& f)) lst

これなら頭に入りそう。

追記2: (<*>) を使えば分配できるじゃん

別の問題を考えていて別解を発見。

:t (<*>)
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
(((<$>) . (,)) <*> (\i -> [i])) 4
=> [(4,4)]

ということで、こうなりました。。。

{-# LANGUAGE TupleSections #-}
  lst <- ...
x <- mapM (((<$>) . (,)) <*> f) lst
One clap, two clap, three clap, forty?

By clapping more or less, you can signal to us which stories really stand out.