haskell - 使用 Biapplicative 遍历

Question

我正在考虑解压缩操作，并意识到表达它们的一种方法是遍历 Biapplicative 仿函数。

import Data.Biapplicative

class Traversable2 t where
  traverse2 :: Biapplicative p
            => (a -> p b c) -> t a -> p (t b) (t c)

-- Note: sequence2 :: [(a,b)] -> ([a], [b])
sequence2 :: (Traversable2 t, Biapplicative p)
          => t (p b c) -> p (t b) (t c)
sequence2 = traverse2 id

instance Traversable2 [] where
  traverse2 _ [] = bipure [] []
  traverse2 f (x : xs) = bimap (:) (:) (f x) <<*>> traverse2 f xs

我闻起来好像 Traversable 的每个实例可以机械地转化为 Traversable2 的实例.但是我还没有找到真正实现 traverse2的方法使用 traverse , 没有在列表之间进行转换，或者可能使用 unsafeCoerce 玩非常肮脏的把戏.有没有很好的方法来做到这一点？

进一步的证据表明任何事情 Traversable是 Traversable2 :

class (Functor t, Foldable t) => Traversable2 t where
  traverse2 :: Biapplicative p
            => (a -> p b c) -> t a -> p (t b) (t c)
  default traverse2 ::
               (Biapplicative p, Generic1 t, GTraversable2 (Rep1 t))
            => (a -> p b c) -> t a -> p (t b) (t c)
  traverse2 f xs = bimap to1 to1 $ gtraverse2 f (from1 xs)

class GTraversable2 r where
  gtraverse2 :: Biapplicative p
             => (a -> p b c) -> r a -> p (r b) (r c)

instance GTraversable2 V1 where
  gtraverse2 _ x = bipure (case x of) (case x of)

instance GTraversable2 U1 where
  gtraverse2 _ _ = bipure U1 U1

instance GTraversable2 t => GTraversable2 (M1 i c t) where
  gtraverse2 f (M1 t) = bimap M1 M1 $ gtraverse2 f t

instance (GTraversable2 t, GTraversable2 u) => GTraversable2 (t :*: u) where
  gtraverse2 f (t :*: u) = bimap (:*:) (:*:) (gtraverse2 f t) <<*>> gtraverse2 f u

instance (GTraversable2 t, GTraversable2 u) => GTraversable2 (t :+: u) where
  gtraverse2 f (L1 t) = bimap L1 L1 (gtraverse2 f t)
  gtraverse2 f (R1 t) = bimap R1 R1 (gtraverse2 f t)

instance GTraversable2 (K1 i c) where
  gtraverse2 f (K1 x) = bipure (K1 x) (K1 x)

instance (Traversable2 f, GTraversable2 g) => GTraversable2 (f :.: g) where
  gtraverse2 f (Comp1 x) = bimap Comp1 Comp1 $ traverse2 (gtraverse2 f) x

instance Traversable2 t => GTraversable2 (Rec1 t) where
  gtraverse2 f (Rec1 xs) = bimap Rec1 Rec1 $ traverse2 f xs

instance GTraversable2 Par1 where
  gtraverse2 f (Par1 p) = bimap Par1 Par1 (f p)

Answer 1

我想我可能有适合你的东西。 (编辑:它没有，见评论。)你可以在 p () c 上定义新类型。和 p b ()并制作它们Functor实例。

执行

这又是你的类，带有默认定义。我走的是实现sequence2的路线根据 sequenceA因为它看起来更简单。

class Functor t => Traversable2 t where
  {-# MINIMAL traverse2 | sequence2 #-}
  traverse2 :: Biapplicative p => (a -> p b c) -> t a -> p (t b) (t c)
  traverse2 f = sequence2 . fmap f

  sequence2 :: Biapplicative p => t (p b c) -> p (t b) (t c)
  sequence2 = traverse2 id

现在， Biapplicative 的“右侧部分”是

newtype R p c = R { runR :: p () c }

instance Bifunctor p => Functor (R p) where
  fmap f (R x) = R $ bimap id f x

instance Biapplicative p => Applicative (R p) where
  pure x = R (bipure () x)
  R f <*> R x =
    let f' = biliftA2 const (flip const) (bipure id ()) f
    in  R $ f' <<*>> x

mkR :: Biapplicative p => p b c -> R p c
mkR = R . biliftA2 const (flip const) (bipure () ())

sequenceR :: (Traversable t, Biapplicative p) => t (p b c) -> p () (t c)
sequenceR = runR . sequenceA . fmap mkR

与“左侧部分”大致相同。完整代码在 this gist .

现在我们可以制作 p (t b) ()和 p () (t c)并将它们重新组装成 p (t b) (t c) .

instance (Functor t, Traversable t) => Traversable2 t where
  sequence2 x = biliftA2 const (flip const) (sequenceL x) (sequenceR x)

我需要为该实例声明打开 FlexibleInstances 和 UndecidableInstances。此外，不知何故 ghc 想要一个 Functor 约束。

测试

我用您的实例验证了 []它给出了相同的结果:

main :: IO ()
main = do
  let xs = [(x, ord x - 97) | x <- ['a'..'g']]
  print xs
  print (sequence2 xs)
  print (sequence2' xs)

traverse2' :: Biapplicative p => (a -> p b c) -> [a] -> p [b] [c]
traverse2' _ [] = bipure [] []
traverse2' f (x : xs) = bimap (:) (:) (f x) <<*>> traverse2 f xs

sequence2' :: Biapplicative p => [p b c] -> p [b] [c]
sequence2' = traverse2' id

输出

[('a',0),('b',1),('c',2),('d',3),('e',4),('f',5),('g',6)]
("abcdefg",[0,1,2,3,4,5,6])
("abcdefg",[0,1,2,3,4,5,6])

这是一个有趣的练习!