Implement Applicative for custom ZipList

Viewed 407

This comes from an exercise in book Haskell from First Principles. The exercise is to implement Applicative for ZipList', which is analogous to the Prelude's ZipList. The book has this hint

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.

I guessed the function that starts with z is zipWith, but I do not know about a function that starts with 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

This passes a test case in the book, but I am wondering if there's a better way to implement it since I did not use a function that starts with r. I have a feeling this was supposed to be repeat because it's also supposed to work over infinite lists.

2 Answers

Reading the thread under the original post, I came to a conclusion the author of the post is trying to prove that the implementation satisfies the law (fmap f xs = (pure f) <*> xs):

Let's try proving it as a classical identity, getting rid of the wrapper. Thus, let's work with the right hand:

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

As far as identity goes, proving that zipWith' ($) (repeat' f) xs equals fmap f xs would suffice.

The reason they are the same is pretty obvious:

length (zipWith op xs ys) == min (length xs) (length ys); (this expression could not be evaluated in case of both xs and ys being infinite).

Since repeat' f is infinite, length $ zipWith' ($) (repeat' f) xs is, in fact, length xs (here, it does not actually matter, whether such a value exists: the existence of indices would suffice). Each element of xs gets applied to the same function f, which is repeated. As you can see, the size is preserved and every element is morphed by a constant function, which is the definition of fmap.

I thought about it for a bit after Robin Zigmond's comment:

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.

This implementation should satisfy the Applicative laws.

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
Related