List 的应用实例在 QuickCheck/Checkers 的组合法测试中永远运行

Question

我想使用我自定义的列表实现列表的常规应用实例：

import Control.Monad

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

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


instance Functor List where
  fmap f (Cons x xs) = Cons (f x) (fmap f xs)
  fmap f Nil = Nil


instance Applicative List where
  pure x = Cons x Nil
  (<*>) Nil _ = Nil
  (<*>) _ Nil = Nil
  (<*>) (Cons f fs) xs = (+++) (fmap f xs) (fs <*> xs)

(+++) :: List a -> List a -> List a
(+++) (Cons x Nil) ys = Cons x ys
(+++) (Cons x xs) ys = Cons x xs'
  where xs' = (+++) xs ys

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 (Eq a) => EqProp (List a) where
  (=-=) = eq

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

我的代码通过了 Checkers 中的所有应用测试，除了组合法则。测试合成法则没有报错，只是一直没结束。

我的代码是否以某种我无法看到的方式永远重复出现，或者它只是测试组合法则的速度非常慢？

这是我在跳棋执行期间按 control-c 时收到的错误消息：

applicative:
  identity:     +++ OK, passed 500 tests.
  composition:  *** Failed! Exception: 'user interrupt' (after 66 tests): 
Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> Nil))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> (Cons <function> Nil))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
Cons (-61) (Cons (-24) (Cons 56 (Cons (-10) (Cons 28 (Cons 5 (Cons (-5) (Cons 33 (Cons 18 (Cons 47 (Cons 43 (Cons 43 (Cons (-58) (Cons 35 (Cons (-52) (Cons (-52) (Cons (-41) (Cons 3 (Cons (-7) (Cons (-53) (Cons (-22) (Cons (-20) (Cons (-12) (Cons 46 (Cons (-53) (Cons 35 (Cons (-31) (Cons (-10) (Cons 43 (Cons (-16) (Cons 47 (Cons 53 (Cons 22 (Cons 8 (Cons 1 (Cons (-64) (Cons (-39) (Cons (-57) (Cons 34 (Cons (-31) (Cons 20 (Cons (-39) (Cons (-47) (Cons (-59) (Cons 15 (Cons (-42) (Cons (-31) (Cons 4 (Cons (-62) (Cons (-14) (Cons (-24) (Cons 47 (Cons 42 (Cons 61 (Cons 29 (Cons (-25) (Cons 30 (Cons (-20) (Cons 16 (Cons (-30) (Cons (-38) (Cons (-7) (Cons 16 (Cons 19 (Cons 20 Nil))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
  homomorphism: +++ OK, passed 500 tests.
  interchange:  +++ OK, passed 500 tests.
  functor:      +++ OK, passed 500 tests.

如果其中一个函数很慢，我猜是 (+++)，但我不知道 GHC 如何很好地执行代码以理解原因。

更新：

组成规律为：

pure (.) <*> u <*> v <*> w = u <*> (v <*> w)

我可以用我的代码来展示它的简单示例：

Cons (+1) Nil <*> (Cons (*2) Nil <*> Cons 1 (Cons 2 (Cons 3 Nil)))

和

pure (.) <*> Cons (+1) Nil <*> Cons (*2) Nil <*> Cons 1 (Cons 2 (Cons 3 Nil))

两者都给出了相同的结果，所以为什么合成定律永远不会结束让我很困惑。这可能是 checkers 库的问题？

Answer 1

我的第一个想法是 go 得到一个否定的参数并循环。但是，当修改它以使用 trace 并在 n < 0 时抛出错误时，我发现它要简单得多：你的代码真的很慢。

这是我修改的部分（go'用于跟踪，但我将其短路用于基准测试）：

import Debug.Trace

(+++) :: List a -> List a -> List a
{-# INLINE (+++) #-}
(+++) (Cons x Nil) ys = Cons x ys
(+++) (Cons x xs) ys = Cons x xs'
  where xs' = (+++) xs ys

maxListSize = 10

instance Arbitrary a => Arbitrary (List a)  where
  arbitrary = sized go''
    where
      go'' n = go' $ mod n maxListSize
      go' n = if n < 0 then error ("bad n:" ++ show n) else trace (show n ++ " , ") $ go n
      go 0 = pure Nil
      go n = do
        xs <- go' (n - 1)
        x  <- arbitrary
        return (Cons x xs)

检查某种无限循环的痕迹，我发现事情从未停止过，n 一直在减少，然后弹出回来进行下一次测试。当它变慢时，单个测试只需要秒。请记住，您正在尝试运行每个测试 500。

我的基准测试并不严格，但这是我得到的（x 是模数，在运行ge [1..18] 中）：

发现快速回归 5.72238 - 2.8458 x + 0.365263 x^2。当我运行跟踪的时候，n一直在增加。虽然我不确定测试如何进行运行，但如果每次测试增加 n，那么 n 将达到 500。

这个公式不太公平，但我们假设它是一个不错的界限。（我觉得应该是因为算法是O(n^2)。）

然后运行在我的机器上完成所有测试大约需要 25 个小时。

P.S。由于所有测试都在 n 的合理范围内通过，而且我找不到错误，我认为您的代码是正确的。

List 的应用实例在 QuickCheck/Checkers 的组合法测试中永远运行

Applicative instance of List runs forever in composition law test with QuickCheck/Checkers

haskell

list

applicative