為自定義 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