在QuickCheck中缩小记录的惯用法

时间:2012-12-22 19:44:53

标签: haskell quickcheck

假设我有一个记录类型:

data Foo = Foo {x, y, z :: Integer}

编写Arbitrary实例的一种巧妙方法是使用Control.Applicative,如下所示:

instance Arbitrary Foo where
   arbitrary = Foo <$> arbitrary <*> arbitrary <*> arbitrary
   shrink f = Foo <$> shrink (x f) <*> shrink (y f) <*> shrink (z f)

因此,Foo的收缩列表是其成员所有收缩的笛卡尔积。

但如果其中一个收缩返回[]那么整个Foo就不会收缩。所以这不起作用。

我可以尝试通过在收缩列表中包含原始值来保存它:

   shrink f = Foo <$> ((x f) : shrink (x f)) <*> ... {and so on}.

但现在缩小(Foo 0 0 0)将返回[Foo 0 0 0],这意味着收缩永远不会终止。所以这也不起作用。

看起来应该有&lt; *&gt;以外的东西在这里使用,但我看不出来。

2 个答案:

答案 0 :(得分:8)

如果你想要一个只会缩小一个位置的应用程序仿函数,你可能会喜欢我刚刚创建的那个正好刮开它的那个:

shrink (tss,m) = unShrinkOne $
    ((,) <$> shrinkOne tss <*> traverse shrinkOne m)

我在看起来像这样的代码中使用它,在元组的左元素或元组的右元素的一个字段中缩小:

def set_value_from_cursor(self, xpos):
    width = self.frameGeometry().width()
    percent = float(xpos) / width
    val = self.maximum() * percent
    if val % 5:
        val += 5 - (val % 5)
    self.setValue(val)

到目前为止工作得很好!

事实上,它的工作非常好,我将其上传为a hackage package

答案 1 :(得分:6)

我不知道什么是惯用的,但是如果你想确保每次收缩都会减少至少一个字段而不增加其他字段,

shrink f = tail $ Foo <$> shrink' (x f) <*> shrink' (y f) <*> shrink' (z f)
  where
    shrink' a = a : shrink a

会这样做。列表的Applicative实例是原始值是结果列表中的第一个,所以只需删除它就会得到一个真正缩小的值列表,从而缩小终止值。

如果你希望所有字段尽可能缩小,并且只保留不可收缩的字段,那就更复杂一点,你需要告知你是否已经成功收缩,如果你没有' t得到任何结尾,返回一个空列表。最让我失望的是

data Fallback a
    = Fallback a
    | Many [a]

unFall :: Fallback a -> [a]
unFall (Fallback _) = []
unFall (Many xs)    = xs

fall :: a -> [a] -> Fallback a
fall u [] = Fallback u
fall _ xs = Many xs

instance Functor Fallback where
    fmap f (Fallback u) = Fallback (f u)
    fmap f (Many xs)    = Many (map f xs)

instance Applicative Fallback where
    pure u = Many [u]
    (Fallback f) <*> (Fallback u) = Fallback (f u)
    (Fallback f) <*> (Many xs)    = Many (map f xs)
    (Many fs)    <*> (Fallback u) = Many (map ($ u) fs)
    (Many fs)    <*> (Many xs)    = Many (fs <*> xs)

instance Arbitrary Foo where
    arbitrary = Foo <$> arbitrary <*> arbitrary <*> arbitrary
    shrink f = unFall $ Foo <$> shrink' (x f) <*> shrink' (y f) <*> shrink' (z f)
      where
        shrink' a = fall a $ shrink a

也许有人想出一个更好的方法来做到这一点。