为自定义 ZipList 实现 Applicative

Question

这来自First Principles 书中 Haskell中的一个练习。 练习是为ZipList'实现Applicative ，这类似于 Prelude 的ZipList 。 这本书有这个提示

检查 Prelude 以获得可以为您提供所需的功能。 一个以字母z开头，另一个以字母r 。 您正在从这些函数中寻找灵感，而不是在使用自定义List类型而不是Prelude提供的列表类型时直接重用它们。

我猜想以z开头的 function 是zipWith ，但我不知道以 r 开头的r 。

data List a =
    Nil
  | Cons a (List a)
  deriving (Eq, Show)

zipWith' :: (a -> b -> c) -> List a -> List b -> List c
zipWith' _ Nil _ = Nil
zipWith' _ _ Nil = Nil
zipWith' f (Cons x xs) (Cons y ys) = Cons (f x y) (zipWith' f xs ys)

newtype ZipList' a = ZipList' (List a)
  deriving (Eq, Show)

instance Functor ZipList' where
  fmap f (ZipList' xs) = ZipList' $ fmap f xs

instance Applicative ZipList' where
  pure x = ZipList' $ Cons x Nil
  (ZipList' fs) <*> (ZipList' xs) = ZipList' $ zipWith' ($) fs xs

这通过了书中的一个测试用例，但我想知道是否有更好的方法来实现它，因为我没有使用以 r 开头的r 。 我觉得这应该repeat ，因为它也应该适用于无限列表。

Answer 1

阅读原帖下的帖子，我得出一个结论，该帖子的作者试图证明实现符合规律（ fmap f xs = (pure f) <*> xs ）：

让我们尝试证明它是一个经典的身份，摆脱包装。 因此，让我们用右手工作：

(pure f) <*> xs = (repeat' f) <*> xs = zipWith' ($) (repeat' f) xs ;

就身份而言，证明zipWith' ($) (repeat' f) xs等于fmap f xs就足够了。

它们相同的原因很明显：

length (zipWith op xs ys) == min (length xs) (length ys) ; （如果xs和ys都是无限的，则无法评估此表达式）。

由于repeat' f是无限的， length $ zipWith' ($) (repeat' f) xs实际上就是length xs （这里，是否存在这样的值实际上并不重要：索引的存在就足够了）。 xs的每个元素都被应用于相同的 function f ，这是重复的。 如您所见，大小被保留，每个元素都被一个常量 function 变形，这是fmap的定义。

Answer 2

在Robin Zigmond 发表评论后，我想了一会儿：

关键是考虑fmap fx == (pure f) <*> x的合法Applicative实例的要求，并认识到列表x的长度没有上限。

这个实现应该满足应用法则。

data List a =
    Nil
  | Cons a (List a)
  deriving (Eq, Show)

zipWith' :: (a -> b -> c) -> List a -> List b -> List c
zipWith' _ Nil _ = Nil
zipWith' _ _ Nil = Nil
zipWith' f (Cons x xs) (Cons y ys) = Cons (f x y) (zipWith' f xs ys)

repeat' :: a -> List a
repeat' x = Cons x $ repeat' x

newtype ZipList' a = ZipList' (List a)
  deriving (Eq, Show)

instance Functor ZipList' where
  fmap f (ZipList' xs) = ZipList' $ fmap f xs

instance Applicative ZipList' where
  pure x = ZipList' $ repeat' x
  (ZipList' fs) <*> (ZipList' xs) = ZipList' $ zipWith' ($) fs xs