如何编写函数属性的快速检查？

Question

我正在尝试做 Haskell Book（第 15 章，“Monoid，Semigroup”）中的 Monoid 练习之一，但我被卡住了。给出如下：

newtype Combine a b =
  Combine { unCombine :: (a -> b) }

我应该为 Combine 编写 Monoid 实例。

我是这样写的：

instance (Semigroup b) => Semigroup (Combine a b) where
  Combine { unCombine = f } <> Combine { unCombine = g } =
    Combine { unCombine = \x -> f x <> g x }

instance (Monoid b) => Monoid (Combine a b) where
  mempty = Combine { unCombine = \_ -> mempty }
  mappend = (<>)

但我不知道如何为实例编写quickCheck。

这是我的尝试（不编译）：

monoidLeftIdentity1 :: (Eq m, Monoid m) => m -> Bool
monoidLeftIdentity1 x = mappend mempty x == x

monoidRightIdentity1 :: (Eq m, Monoid m) => m -> Bool
monoidRightIdentity1 x = mappend x mempty == x


main :: IO ()
main = do 
  quickCheck (monoidLeftIdentity1 :: Combine Int (Sum Int) -> Bool)
  quickCheck (monoidRightIdentity1 :: Combine Int (Sum Int) -> Bool)

看来我必须在这种类型上实例化Arbitrary 和Eq，但是如何为函数编写它们？

有一个similar question，在那个问题中，我们被要求为Combine 编写Semigroup 实例。

Answer 1

首先是一个完整的代码示例：

module Main where

import Test.QuickCheck
import Data.Monoid

newtype Combine a b = Combine { unCombine :: a -> b }

instance (Semigroup b) => Semigroup (Combine a b) where
    a <> _ = a
--  (Combine f) <> (Combine g) = Combine $ \a -> (f a) <> (g a)

instance (Monoid b) => Monoid (Combine a b) where
  mempty = Combine $ \_ -> mempty

monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool
monoidLeftIdentity m = mappend mempty m == m

monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool
monoidRightIdentity m = mappend m mempty == m

monoidLeftIdentityF :: (Eq b, Monoid m) => (Fun a b -> m) -> (m -> a -> b) -> a -> Fun a b -> Bool
monoidLeftIdentityF wrap eval point candidate = eval (mappend mempty m) point == eval m point 
 where m = wrap candidate

monoidRightIdentityF :: (Eq b, Monoid m) => (Fun a b -> m) -> (m -> a -> b) -> a -> Fun a b -> Bool
monoidRightIdentityF wrap eval point candidate = eval (mappend m mempty) point == eval m point 
 where m = wrap candidate

main :: IO ()
main = do
  quickCheck $ (monoidLeftIdentityF (Combine . applyFun) unCombine :: Int -> Fun Int (Sum Int) -> Bool)
  quickCheck $ (monoidRightIdentityF (Combine . applyFun) unCombine :: Int -> Fun Int (Sum Int) -> Bool)

我们在这里做什么？

首先我们需要一种生成随机函数的方法。也就是说，这个Fun 是关于什么的。如果a 和b 有某些实例可用，则Fun a b 有一个Arbitrary 实例。但大多数时候我们都有这些。

可以显示Fun a b 类型的值，因此Fun a b 有一个显示实例，前提是a 和b 有一个。我们可以用applyFun提取函数。

为了让 QuickCheck 能够利用这一点，我们需要提供一个 Testable，其中所有参数位置都可以随机生成和显示。

所以我们必须根据a、b 和Fun a b 来制定我们的属性。

为了将所有这些与Combine 连接起来，我们提供了一个从Fun a b 到Combine a b 的函数。

现在我们遇到了另一个问题。我们无法比较函数，因此我们无法比较 Combine a b 类型的值是否相等。由于我们已经在随机生成测试用例，为什么不随机生成用于测试函数是否相等的点。平等不会是一个确定的事情，但我们正在寻找可证伪的例子！所以这对我们来说已经足够好了。为此，我们提供了一个函数，将Combine a b 类型的值“应用”到a 类型的值上，以获得b 类型的值，希望可以比较其是否相等。

Answer 2

您可以使用Test.QuickCheck.Function 生成随机函数值，因此您应该能够编写类似以下内容来处理Arbitrary 约束：

quickCheck (monoidLeftIdentity1 . Combine . apply :: Fun Int (Sum Int) -> Bool)

但是，对于Eq 约束，您将无法比较函数值。我认为只检查一些输入样本的逐点相等性就足够了，例如

funoidLeftIdentity1 :: (Monoid b, Eq b) => Fun a b -> a -> Bool
funoidLeftIdentity1 (Fn f) x = uncombine (Combine f <> mempty) x == uncombine mempty x