Question

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

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

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

holesList的类型与真实holesOf的类型一样，无法捕获生成的对数等于容器元素数的事实。因此，更美丽的类型将是

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

我们可以使用holes来制作一个列表，然后在holesList中遍历以重新插入元素，从而实现State。但这有两个原因，其中一个原因令人不满意实际后果：

slurping代码将有一个无法访问的错误调用来处理在遍历完成之前列表为空的情况。这很恶心，但对使用该功能的人来说可能并不重要。
无限延伸到左侧或左下方的容器根本不起作用。向远处向左延伸的容器处理效率非常低。

我想知道是否有任何办法解决这些问题。很可能使用镜头中的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的博客文章的评论。

Answer 1

Your existing solution为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"

Answer 2

我还没有找到一个非常漂亮的方法来做到这一点。那可能是因为我不够聪明，但我怀疑它是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。

Answer 3

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

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是一个“懒惰的延续应用函子”。如果我们用标准Cont monad替换它，我们也会得到一个工作解决方案，但不是很懒惰：

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)

Answer 4

这并没有真正回答原始问题，但它显示了另一个角度。看起来这个问题实际上与我问过的previous question相关。假设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))

查看相关问题答案中的非法方式。

有了这个，我们可以设计一种非常类似于罗马的类型，但是有一种扭曲来自猖獗：

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)

是否有可能懒散地获得Traversable的所有上下文？

4 个答案: