QuickCheck放弃调查递归数据结构(玫瑰树).

给定一个任意树,我可以使用舒伯特编号在该树上构建一个子类型关系:

constructH :: Tree a -> Tree (Type a)

其中Type嵌套原来的标签,并且还提供了执行父/子(或子类型)的检查所需要的数据.使用Schubert编号,两个Int参数就足够了.

data Type a where !Int -> !Int -> a -> Type a

这导致二元谓词

subtypeOf :: Type a -> Type a -> Bool

我现在想用QuickCheck测试这确实做了我想做的事情.但是,以下属性不起作用,因为QuickCheck只是放弃了:

subtypeSanity ? Tree (Type ()) ? Gen Prop
subtypeSanity Node { rootLabel = t, subForest = f } =
  let subtypes = concatMap flatten f
  in (not $ null subtypes) ==> conjoin
     (forAll (elements subtypes) (\x ? x `subtypeOf` t):(map subtypeSanity f))

如果我遗漏了递归调用subtypeSanity,即我传递给列表的尾部conjoin,属性运行正常,但只测试树的根节点!如果没有QuickCheck放弃生成新的测试用例,我如何递归地下载到我的数据结构中？

如果需要,我公司可提供的代码来构建舒伯特层次和Arbitrary实例Tree (Type a),提供完整的可运行的例子,但是这将是相当多的代码.我确信我只是没有"获得"QuickCheck,并且在这里以错误的方式使用它.

编辑:不幸的是,这个sized功能似乎没有消除这里的问题.它最终得到了相同的结果(见J. Abrahamson答案的评论.)

编辑II:我最终通过避免递归步骤来避免"修复"我的问题conjoin.我们只列出树中的所有节点,然后测试单节点属性(从一开始就工作正常).

allNodes ? Tree a ? [Tree a]
allNodes n@(Node { subForest = f }) = n:(concatMap allNodes f)

subtypeSanity ? Tree (Type ()) ? Gen Prop
subtypeSanity tree = forAll (elements $ allNodes tree)
  (\(Node { rootLabel = t, subForest = f }) ?
    let subtypes = concatMap flatten f
    in (not $ null subtypes) ==> forAll (elements subtypes) (\x ? x `subtypeOf` t))

调整Arbitrary树的实例不起作用.这是我仍在使用的任意实例:

instance (Arbitrary a, Eq a) ? Arbitrary (Tree (Type a)) where
  arbitrary = liftM (constructH) $ sized arbTree

arbTree ? Arbitrary a ? Int ? Gen (Tree a)
arbTree n = do
  m ? choose (0,n)
  if m == 0
    then Node <$> arbitrary <*> (return [])
    else do part ? randomPartition n m
            Node <$> arbitrary <*> mapM arbTree part

-- this is a crude way to find a sufficiently random x1,..,xm,
-- such that x1 + .. + xm = n, for any n, m, with 0 < m.
randomPartition ? Int ? Int ? Gen [Int]
randomPartition n m' = do
  let m = m' - 1
  seed ? liftM ((++[n]) . sort) $ replicateM m (choose (0,n))
  return $ zipWith (-) seed (0:seed)

我认为这个问题"现在已经解决了",但是如果有人能够向我解释为什么递归步骤和/或conjoin使QuickCheck放弃(在通过"仅"0测试之后),我将不胜感激.