为自定义 ZipList 实施 Applicative

Implement Applicative for custom ZipList

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

Check Prelude for functions that can give you what you need. One starts with the letter z, the other with the letter r. You’re looking for inspiration from these functions, not to be able to directly reuse them as you’re using a custom List type, not the Prelude provided list type.

我猜z开头的函数是zipWith,但我不知道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开头的函数。我觉得这应该是 repeat 因为它也应该适用于无限列表。

阅读原post下的帖子,我得出结论post的作者试图证明实现满足法则(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); (如果 xsys 都是无穷大,则无法计算此表达式)。

因为 repeat' f 是无限的,所以 length $ zipWith' ($) (repeat' f) xs 实际上是 length xs (在这里,这个值是否存在实际上并不重要:索引的存在就足够了). xs 的每个元素都应用于相同的函数 f,它会重复。如您所见,大小被保留,每个元素都由一个常量函数变形,这是 fmap.

的定义

之后想了一下:

The key is to think about the requirement for a lawful Applicative instance that fmap f x == (pure f) <*> x, and recognise that there is no upper limit on the length of the list 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