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

与“左侧部分”大致相同。完整代码位于MAVEN_HOME, MVN_HOME or M2_HOME。

现在我们可以制作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 constaint。

测试

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

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])

这是一项有趣的运动！

Answer 2

以下似乎可以解决这个问题，利用“仅”undefined。可行的法律可以保证这是可以的，但我并没有试图证明这一点。

{-# LANGUAGE GADTs, KindSignatures, TupleSections #-}

import Data.Biapplicative

import Data.Traversable

data Bimock :: (* -> * -> *) -> * -> * where
   Bimock :: p a b -> Bimock p (a,b)
   Bimfmap :: ((a,b) -> c) -> p a b -> Bimock p c
   Bimpure :: a -> Bimock p a
   Bimapp :: Bimock p ((a,b) -> c) -> p a b -> Bimock p c

instance Functor (Bimock p) where
  fmap f (Bimock p) = Bimfmap f p
  fmap f (Bimfmap g p) = Bimfmap (f . g) p
  fmap f (Bimpure x) = Bimpure (f x)
  fmap f (Bimapp gs xs) = Bimapp (fmap (f .) gs) xs
instance Biapplicative p => Applicative (Bimock p) where
  pure = Bimpure
  Bimpure f<*>xs = fmap f xs
  fs<*>Bimpure x = fmap ($x) fs
  fs<*>Bimock p = Bimapp fs p
  Bimfmap g h<*>Bimfmap i xs = Bimfmap (\(~(a₁,a₂),~(b₁,b₂)) -> g (a₁,b₁) $ i (a₂, b₂))
                              $ bimap (,) (,) h<<*>>xs
  Bimapp g h<*>xs = fmap uncurry g <*> ((,)<$>Bimock h<*>xs)

runBimock :: Biapplicative p => Bimock p (a,b) -> p a b
runBimock (Bimock p) = p
runBimock (Bimfmap f p) = bimap (fst . f . (,undefined)) (snd . f . (undefined,)) p
runBimock (Bimpure (a,b)) = bipure a b
runBimock (Bimapp (Bimpure f) xs) = runBimock . fmap f $ Bimock xs
runBimock (Bimapp (Bimfmap h g) xs)
     = runBimock . fmap (\(~(a₂,a₁),~(b₂,b₁)) -> h (a₂,b₂) (a₁,b₁))
           . Bimock $ bimap (,) (,) g<<*>>xs
runBimock (Bimapp (Bimapp h g) xs)
     = runBimock . (fmap (\θ (~(a₂,a₁),~(b₂,b₁)) -> θ (a₂,b₂) (a₁,b₁)) h<*>)
           . Bimock $ bimap (,) (,) g<<*>>xs

traverse2 :: (Biapplicative p, Traversable t) => (a -> p b c) -> t a -> p (t b) (t c)
traverse2 f s = runBimock . fmap (\bcs->(fmap fst bcs, fmap snd bcs)) $ traverse (Bimock . f) s


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

即使这是安全的，如果它给出了可怕的表现，那么无可辩驳的模式和二次（甚至是指数？）元组树的构建也不会让我感到惊讶。

Answer 3

一些观察结果缺乏完整的原始答案。

如果你有一个Biapplicative bifunctor，你可以用它做什么就把它应用到某个东西上并将它分成一对与它的两个组件同构的分数。

data Helper w a b = Helper {
  left :: w a (),
  right :: w () b
}

runHelper :: forall p a b. Biapplicative p => Helper p a b -> p a b
runHelper x = biliftA2 const (flip const) (left x) (right x)

makeHelper :: (Biapplicative p)
           => p a b -> Helper p a b
makeHelper w = Helper (bimap id (const ()) w)
                      (bimap (const ()) id w)

type Separated w a b = (w a (), w () b)

通过将fmap (makeHelper . f)应用于结构s，可以将@nnnmmm和@leftroundabout的方法结合起来，从而无需undefined，但是您需要制作Helper或替换某个类型类的instance，其中包含可帮助您解决问题的有用操作。

如果你有Traversable结构，你可以做的是sequenceA Applicative个仿函数（在这种情况下，你的解决方案看起来像traverse2 f = fromHelper . sequenceA . fmap (makeHelper . f)，你的{{1} }}实例使用Applicative构建一对t结构）或traverse（在这种情况下，您的解决方案看起来像Functor ...）。无论哪种方式，您都需要定义traverse2 f = fromHelper . traverse (g . makeHelper . f) where实例，因为Functor继承自Applicative。您可以尝试从Functor和Functor或<<*>>构建bipure id id，或者您可以在同一个传递中处理两个分开的变量。

不幸的是，要使类型适用于bimap实例，您必须将Functor转换为我们非正式地调用:: p b c的类型，其中一个参数是笛卡尔积的:: w (b,c)的两个参数。没有非标准扩展，Haskell的类型系统似乎不允许这样做，但是@leftroundabout可以使用p类来实现这一点。使用Bimock强制两个分离的仿函数具有相同的类型。

对于性能，你想要做的只是进行一次遍历，这会产生一个与undefined同构的对象然后你可以转换（类似于自然性定律）。因此，您希望实现p (t b) (t c)而不是traverse2并将sequence2定义为sequence2，以避免遍历两次。如果你将变量分开并产生与traverse2 id同构的东西，你可以将它们重新组合为@mmmnnn。

在实际使用中，我怀疑你会想要在问题上强加一些额外的结构。您的问题使(p (t b) (), p () (t c))的{{1}}和b组件完全免费，但实际上它们通常是协变或逆变函子，可以使用c排序或遍历一起Bifunctor而不是biliftA2 Bitraversable，或者甚至可能有Traversable，t或Semigroup个实例。

如果Applicative与Monad p同构，Monoid操作会产生与<>同构的数据结构，那么优化就会非常有效。（这适用于列表和二叉树; t是具有此属性的代数类型。）在这种情况下，操作的关联性允许您将结构转换为严格的左折叠或惰性右折叠。

这是一个很好的问题，虽然我没有比@leftroundabout更好的代码用于一般情况，但我从中学到了很多东西。

Answer 4

使用来自Magma的{{1}}之类的一种唯一有点恶意的方式。这似乎比leftaroundabout的解决方案简单得多，虽然它也不漂亮。

lens

穿越Biapplicative

4 个答案:

实施

测试