20

lens提供holesOf，这是这个假设函数的一个更通用和更强大的版本：

holesList :: Traversable t
          => t a -> [(a, a -> t a)]

给定一个容器，holesList生成一个容器元素列表以及替换这些元素的函数。

的类型holesList，与 real 的类型一样holesOf，未能捕捉到生成的对数将等于容器元素数的事实。因此，一个更漂亮的类型将是

holes :: Traversable t
      => t a -> t (a, a -> t a)

我们可以holes通过使用holesList来创建一个列表，然后遍历State以将元素重新插入。但这并不令人满意，原因有两个，其中一个会产生实际后果：

  1. slurping 代码将有一个无法访问的错误调用来处理列表在遍历完成之前运行为空的情况。这很恶心，但对于使用该功能的人来说可能并不重要。

  2. 向左无限延伸的容器，或在左侧触底的容器根本不起作用。向左延伸很远的容器处理起来效率很低。

我想知道是否有任何方法可以解决这些问题。Magma使用类似镜头的东西很可能捕获遍历的形状：

data FT a r where
  Pure :: r -> FT a r
  Single :: a -> FT a a
  Map :: (r -> s) -> FT a r -> FT a s
  Ap :: FT a (r -> s) -> FT a r -> FT a s

instance Functor (FT a) where
  fmap = Map
instance Applicative (FT a) where
  pure = Pure
  (<*>) = Ap

runFT :: FT a t -> t
runFT (Pure t) = t
runFT (Single a) = a
runFT (Map f x) = f (runFT x)
runFT (Ap fs xs) = runFT fs (runFT xs)

现在我们有

runFT . traverse Single = id

traverse Single使一棵树充满元素以及将它们构建到容器中所需的功能应用程序。如果我们替换树中的一个元素，我们可以runFT得到一个替换了该元素的容器。不幸的是，我被困住了：我不知道下一步会是什么样子。

模糊的想法：添加另一个类型参数可能有助于更改元素类型。该Magma类型做了类似的事情，并且至少可以追溯到 Zemyla 对 Van Laarhoven 的博客文章的评论关于FunList.

4

4 回答 4

13

您现有的解决方案为构造函数runMag定义的树中的每个分支调用一次。Ap

我没有分析任何东西，但由于runMag它本身是递归的，这可能会减慢一棵大树的速度。

另一种方法是打结，这样你就（实际上）只runMag为整棵树调用一次：

data Mag a b c where
  One :: a -> Mag a b b
  Pure :: c -> Mag a b c
  Ap :: Mag a b (c -> d) -> Mag a b c -> Mag a b d

instance Functor (Mag a b) where
  fmap = Ap . Pure

instance Applicative (Mag a b) where
  pure = Pure
  (<*>) = Ap

holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes = \t -> 
    let m :: Mag a b (t b)
        m = traverse One t 
    in fst $ go id m m
  where
    go :: (x -> y)
       -> Mag a (a, a -> y) z
       -> Mag a a x
       -> (z, x)
    go f (One a)    (One _)    = ((a, f), a)
    go _ (Pure z)   (Pure x)   = (z, x)
    go f (Ap mg mi) (Ap mh mj) = 
      let ~(g, h) = go (f . ($j)) mg mh
          ~(i, j) = go (f .   h ) mi mj
      in (g i, h j)
    go _ _ _ = error "only called with same value twice, constructors must match"
于 2018-02-27T05:43:57.733 回答
8

我还没有找到一个非常漂亮的方法来做到这一点。那可能是因为我不够聪明，但我怀疑这是traverse. 但是我找到了一个有点丑的方法！关键确实似乎是使用的额外类型参数Magma，它使我们可以自由地构建一个期望特定元素类型的框架，然后稍后填充元素。

data Mag a b t where
  Pure :: t -> Mag a b t
  Map :: (x -> t) -> Mag a b x -> Mag a b t
  Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
  One :: a -> Mag a b b

instance Functor (Mag a b) where
  fmap = Map

instance Applicative (Mag a b) where
  pure = Pure
  (<*>) = Ap

-- We only ever call this with id, so the extra generality
-- may be silly.
runMag :: forall a b t. (a -> b) -> Mag a b t -> t
runMag f = go
  where
    go :: forall u. Mag a b u -> u
    go (Pure t) = t
    go (One a) = f a
    go (Map f x) = f (go x)
    go (Ap fs xs) = go fs (go xs)

我们递归地递减一个类型的值Mag x (a, a -> t a) (t (a, a -> t a))与一个类型Mag a a (t a)使用后者来产生a和a -> t a值，而前者作为t (a, a -> t)从这些值构建的框架。x实际上会是a；它是多态的，以使“俄罗斯方块类型”不那么令人困惑。

-- Precondition: the arguments should actually be the same;
-- only their types will differ. This justifies the impossibility
-- of non-matching constructors.
smash :: forall a x t u.
         Mag x (a, a -> t) u
      -> Mag a a t
      -> u
smash = go id
  where
    go :: forall r b.
          (r -> t)
       -> Mag x (a, a -> t) b
       -> Mag a a r
       -> b
    go f (Pure x) _ = x
    go f (One x) (One y) = (y, f)
    go f (Map g x) (Map h y) = g (go (f . h) x y)
    go f (Ap fs xs) (Ap gs ys) =
      (go (f . ($ runMag id ys)) fs gs)
      (go (f . runMag id gs) xs ys)
    go _ _ _ = error "Impossible!"

我们实际上Mag使用一次调用来生成两个值（不同类型的！）traverse。这两个值实际上将由内存中的单个结构表示。

holes :: forall t a. Traversable t => t a -> t (a, a -> t a)
holes t = smash mag mag
  where
    mag :: Mag a b (t b)
    mag = traverse One t

现在我们可以玩一些有趣的值，比如

holes (Reverse [1..])

从哪里来。Reverse_Data.Functor.Reverse

于 2018-02-26T19:49:44.143 回答
7

这是一个简短、完整的实现（如果你忽略循环性），不使用任何中间数据结构，并且是惰性的（适用于任何类型的无限可遍历）：

import Control.Applicative
import Data.Traversable

holes :: Traversable t => t a -> t (a, a -> t a)
holes t = flip runKA id $ for t $ \a ->
  KA $ \k ->
    let f a' = fst <$> k (a', f)
    in (a, f)

newtype KA r a = KA { runKA :: (a -> r) -> a }

instance Functor (KA r) where fmap f a = pure f <*> a
instance Applicative (KA r) where
  pure a = KA (\_ -> a)
  liftA2 f (KA ka) (KA kb) = KA $ \cr ->
    let
      a = ka ar
      b = kb br
      ar a' = cr $ f a' b
      br b' = cr $ f a b'
    in f a b

KA是一个“惰性延续应用函子”。如果我们用标准的 monad 替换它Cont，我们也会得到一个可行的解决方案，但它并不懒惰：

import Control.Monad.Cont
import Data.Traversable

holes :: Traversable t => t a -> t (a, a -> t a)
holes t = flip runCont id $ for t $ \a ->
  cont $ \k ->
    let f a' = fst <$> k (a', f)
    in k (a, f)
于 2018-02-27T13:11:24.057 回答
1

这并没有真正回答原始问题，但它显示了另一个角度。看起来这个问题实际上与我之前提出的问题有相当深的联系。假设Traversable有一个额外的方法：

traverse2 :: Biapplicative f
           => (a -> f b c) -> t a -> f (t b) (t c)

注意：这个方法实际上可以为任何具体的Traversable数据类型合法地实现。对于像这样的怪事

newtype T a = T (forall f b. Applicative f => (a -> f b) -> f (T b))

在链接问题的答案中查看非法方式。

有了这些，我们可以设计一个与 Roman 非常相似的类型，但与 rampion 的不同：

newtype Holes t m x = Holes { runHoles :: (x -> t) -> (m, x) }

instance Bifunctor (Holes t) where
  bimap f g xs = Holes $ \xt ->
    let
      (qf, qv) = runHoles xs (xt . g)
    in (f qf, g qv)

instance Biapplicative (Holes t) where
  bipure x y = Holes $ \_ -> (x, y)
  fs <<*>> xs = Holes $ \xt ->
    let
      (pf, pv) = runHoles fs (\cd -> xt (cd qv))
      (qf, qv) = runHoles xs (\c -> xt (pv c))
    in (pf qf, pv qv)

现在一切都很简单：

holedOne :: a -> Holes (t a) (a, a -> t a) a
holedOne x = Holes $ \xt -> ((x, xt), x)

holed :: Traversable t => t a -> t (a, a -> t a)
holed xs = fst (runHoles (traverse2 holedOne xs) id)
于 2018-03-01T07:46:55.357 回答