如何为 ziplist 创建应用实例?

How do I create an applicative instance for ziplist?

我想为我的自定义列表实现一个 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)

首先是 id 法失效:

λ> 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 的问题。

对于您的 ZipList 类方法,我们希望保持以下左身份:

pure id <*> someList = someList

为此,pure 不能 return 单元素列表,因为这会立即停止:

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

这不是左身份的预期结果。如果 pure 不能 return 只有一个元素列表,它应该 return 多少?答案是:无限:

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 ($)

但是checkers 无法检查此实例,因为您的 EqProb 实例,因为 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)

毕竟,我们只是想找到一个列表,其中 属性 成立。

扩展我对 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 ("Types of values that can be tested for equality, perhaps through random sampling") 中有一个 EqProp class 的原因——这样我们就可以实现搜索类型反例的技术和不允许简单相等比较的测试。