0

我正在测试一个简单的程序来生成包含测试的子集。例如，给定

*Main Data.List> factorsets 7
[([2],2),([2,3],1),([3],1),([5],1),([7],1)]

打电话chooseP 3 (factorsets 7)，我想得到（从右到左读，a la cons）

[[([5],1),([3],1),([2],2)]
,[([7],1),([3],1),([2],2)]
,[([7],1),([5],1),([2],2)]
,[([7],1),([5],1),([2,3],1)]
,[([7],1),([5],1),([3],1)]]

但是我的程序正在返回一个额外的[([7],1),([5],1),([3],1)]（并且缺少一个
[([7],1),([5],1),([2],2)]）：

[[([5],1),([3],1),([2],2)]
,[([7],1),([3],1),([2],2)]
,[([7],1),([5],1),([3],1)]
,[([7],1),([5],1),([2,3],1)]
,[([7],1),([5],1),([3],1)]]

包含测试是：成员的元组的第一部分必须有一个空交集。

一旦测试为工作，计划是对每个子集的内部乘积求和snd，而不是累加它们。

由于我之前问过类似的问题，我想会生成一个额外的分支，因为当递归在 [2,3] 处分裂时，第二个分支一旦通过跳过的部分就会运行相同的可能性。任何有关如何解决该问题的指示将不胜感激；如果您想分享有关如何更有效地枚举和汇总此类产品组合的想法，那也很棒。

哈斯克尔代码：

chooseP k xs = chooseP' xs [] 0 where
  chooseP' [] product count = if count == k then [product] else []
  chooseP' yys product count
    | count == k = [product]
    | null yys   = []
    | otherwise  = f ++ g
   where (y:ys) = yys
         (factorsY,numY) = y
         f = let zzs = dropWhile (\(fs,ns) -> not . and . map (null . intersect fs . fst) $ product) yys
             in if null zzs
                   then chooseP' [] product count
                   else let (z:zs) = zzs in chooseP' zs (z:product) (count + 1)
         g = if and . map (null . intersect factorsY . fst) $ product
                then chooseP' ys product count
                else chooseP' ys [] 0
4

1 回答 1

2

您的代码足够复杂，我可能会建议您重新开始。以下是我将如何进行。

  1. 写一个规范。让它尽可能地低效——例如，我在下面选择的规范将构建列表中元素的所有组合k，然后过滤掉坏的组合。即使是过滤器也会非常缓慢。

    sorted   xs = sort xs == xs
unique   xs = nub xs == xs
disjoint xs = and $ liftM2 go xs xs where
    go x1 x2 = x1 == x2 || null (intersect x1 x2)

-- check that x is valid according to all the validation functions in fs
-- (there are other fun ways to spell this, but this is particularly
-- readable and clearly correct -- just what we want from a spec)
allFuns fs x = all ($x) fs

choosePSpec k = filter good . replicateM k where
    good pairs = allFuns [unique, disjoint, sorted] (map fst pairs)

    为了确保它是正确的，我们可以在提示符下测试它：

    *Main> mapM_ print $ choosePSpec 3 [([2],2),([2,3],1),([3],1),([5],1),([7],1)]
[([2],2),([3],1),([5],1)]
[([2],2),([3],1),([7],1)]
[([2],2),([5],1),([7],1)]
[([2,3],1),([5],1),([7],1)]
[([3],1),([5],1),([7],1)]

    看起来不错。

  2. 现在我们有了规范，我们可以尝试提高一次重构的速度，始终检查它是否符合规范。我想做的第一件事是注意我们可以通过对输入进行排序并“以递增的方式”挑选事物来确保唯一性和排序性。为此，我们可以定义一个函数来选择给定长度的子序列。它搭载了该tails函数，您可以将其视为不确定地选择一个位置来拆分其输入列表。

    subseq 0 xs = [[]]
subseq n xs = do
    x':xt <- tails xs
    xs'   <- subseq (n-1) xt
    return (x':xs')

    下面是这个函数的一个例子：

    *Main> subseq 3 [1..4]
[[1,2,3],[1,2,4],[1,3,4],[2,3,4]]

    现在我们可以chooseP通过替换replicateM为subseq. 回想一下，我们假设输入已经排序并且是唯一的。

    choosePSlow k = filter good . subseq k where
    good pairs = disjoint $ map fst pairs

    我们可以通过在上面的特定输入上运行它来检查它是否正常工作：

    *Main> let i = [([2],2),([2,3],1),([3],1),([5],1),([7],1)]
*Main> choosePSlow 3 i == choosePSpec 3 i
True

    或者，更好的是，我们可以使用 QuickCheck 对其进行压力测试。我们需要更多的代码。这种情况k < 5只是因为规范太慢了，以至于更大的值k永远需要。

    propSlowMatchesSpec :: NonNegative Int -> OrderedList ([Int], Int) -> Property
propSlowMatchesSpec (NonNegative k) (Ordered xs)
    =   k < 5 && unique (map fst xs)
    ==> choosePSlow k xs == choosePSpec k xs

*Main> quickCheck propSlowMatchesSpec
+++ OK, passed 100 tests.

  3. 还有更多的机会可以让事情变得更快。例如，可以使用代替disjoint加速测试；或者我们可以在元素选择期间确保不相交并更早地修剪搜索；等等。你想如何从这里改进它我留给你——但基本技术（从愚蠢和缓慢开始，然后让它变得更聪明，随你测试）应该对你有所帮助。choose 2liftM2

于 2013-09-27T17:33:46.363 回答