如何为 ziplist 创建应用实例？

Question

我想为我的自定义列表实现一个 Applicative 实例。

import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes


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

instance Eq a => EqProp (List a) where (=-=) = eq

instance Functor List where
  fmap _ Nil = Nil
  fmap f (Cons a Nil) = (Cons (f a) Nil)
  fmap f (Cons a as) = (Cons (f a) (fmap f as))

main = do
  let trigger = undefined :: List (Int, String, Int)
  quickBatch $ applicative trigger


instance Arbitrary a => Arbitrary (List a)  where
  arbitrary = sized go
    where go 0 = pure Nil
          go n = do
            xs <- go (n - 1)
            x  <- arbitrary
            return (Cons x xs)

instance Applicative List where
  pure x = (Cons x Nil)
  Nil <*> _ = Nil
  _ <*> Nil = Nil
 (Cons f fs) <*> (Cons a as) = (Cons (f a) (fs <*> as))

这会产生以下错误：

λ> main
applicative:
  identity:     *** Failed! Falsifiable (after 3 tests): 
Cons 0 (Cons (-1) Nil)
  composition:  *** Failed! Falsifiable (after 3 tests): 
Cons <function> (Cons <function> Nil)
Cons <function> (Cons <function> Nil)
Cons 1 (Cons (-2) Nil)
  homomorphism: +++ OK, passed 500 tests.
  interchange:  +++ OK, passed 500 tests.
  functor:      *** Failed! Falsifiable (after 3 tests): 
<function>
Cons (-2) (Cons (-1) Nil)

首先是身份证法失效：

λ> Cons id Nil <*> Cons 0 (Cons (-1) Nil)
Cons 0 Nil

我该如何解决这个问题？ pure 接受 a 而不是 List a 所以我看不到如何在 List 上匹配并保留嵌套列表结构。

构图法也失败了，这并不奇怪：

λ> (Cons "b" Nil) <*> (Cons "c" Nil)

<interactive>:295:7:
    Couldn't match expected type ‘[Char] -> b’
                with actual type ‘[Char]’
    Relevant bindings include
      it :: List b (bound at <interactive>:295:1)
    In the first argument of ‘Cons’, namely ‘"b"’
    In the first argument of ‘(<*>)’, namely ‘(Cons "b" Nil)’
    In the expression: (Cons "b" Nil) <*> (Cons "c" Nil)

编辑：由于我在实施适用于 ziplists 时得到了很好的答案，因此我将问题更改为关于 ziplists 的问题。

Answer 1

对于您的ZipList-like 方法，我们希望保持以下左身份：

pure id <*> someList = someList

为此，pure 无法返回单元素列表，因为这将立即停止：

(Cons id Nil) <*> Cons 1 (Cons 2 Nil)
  = Cons (id 1) (Nil <*> Cons 2 Nil)
  = Cons 1 Nil

这不是左身份的预期结果。如果pure 不能只返回一个元素列表，它应该返回多少？答案是：无限：

repeatList :: a -> List a
repeatList x = let c = Cons x c in c

为什么我将其称为ZipList 方法？因为它与Control.Applicative.ZipList 中的行为相同，可以通过zipWith 进行激励：

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

现在你的实例是

instance Applicative List where
  pure  = repeatList
  (<*>) = zipWithList ($)

然而，由于EqProb 实例，checkers 也无法检查此实例，因为pure f <*> pure x == pure (f x)（同态）会导致检查无限列表。不过，您可以提供一个替代方案。例如，您可以获取任意数量的元素并进行比较：

prop_sameList :: Eq a => (Int, Int) -> List a -> List a -> Property
prop_sameList bounds xs ys = forAll (choose bounds) $ \n -> 
  takeList n xs `eq` takeList n ys

takeList :: Int -> List a -> List a
takeList _ Nil = Nil
takeList n (Cons x xs)
 | n <= 0    = Nil
 | otherwise = Cons x (takeList (n - 1) xs)

然后，如果您想比较至少1000 和最多10000 元素，您可以使用：

instance Eq a => EqProb (List a) where
  (=-=) = prop_sameList (1000, 10000)

毕竟，我们只是想找到一个我们的属性不持有的列表。

Answer 2

扩展我对 Zeta 更值得回答的评论的评论，您需要进行第二次更改才能运行此测试：

-- | Test lists for equality (fallibly) by comparing finite prefixes
--  of them.  I've arbitrarily chosen a depth of 1,000. There may be 
-- better ideas than that.
instance Eq a => EqProp (List a) where
    xs =-= ys = takeList 1000 xs `eq` takeList 1000 ys

-- | Take a prefix of up to @n@ elements from a 'List'.
takeList :: Int -> List a -> List a
takeList _ Nil = Nil
takeList n (Cons a as)
    | n > 0 = Cons a (takeList (n-1) as)
    | otherwise = Nil

随着 Zeta 的变化和这一变化，您的测试套件通过了：

applicative:
  identity:     +++ OK, passed 500 tests.
  composition:  +++ OK, passed 500 tests.
  homomorphism: +++ OK, passed 500 tests.
  interchange:  +++ OK, passed 500 tests.
  functor:      +++ OK, passed 500 tests.

这里的关键见解是，从根本上说，QuickCheck 是一种用于查找属性的反例的工具。 QuickCheck 通常不能证明一个属性适用于所有可能的输入，因为域可能是无限的。这就是为什么在checkers 中有一个EqProp class 的原因（“可以通过随机抽样来测试相等的值的类型”）——这样我们就可以实施技术来搜索反例的类型和测试不允许简单的相等比较。