与哈斯克尔的Monad列表进行回溯

Question

我正试图通过回溯和在Haskell中列出Monad来解决分解问题。以下是问题陈述：给定一个正整数n，查找其和等于n的所有连续整数列表(在i..j范围内(。

我想出了下面的解决方案，看起来效果不错。有人能建议使用列表Monad和回溯来实现一个更好/更高效的实现吗？

欢迎提出任何建议。提前谢谢。

import Control.Monad
decompose :: Int -> [[Int]]
decompose n = concatMap (run n) [1 .. n - 1]
where
run target n = do
x <- [n]
guard $ x <= target
if x == target
then return [x]
else do
next <- run (target - n) (n + 1)
return $ x : next
test1 = decompose 10 == [[1,2,3,4]]
test2 = decompose 9 == [[2,3,4],[4,5]]

Answer 1

一系列数字的总和k。。l与k≤l等于(l×(l+1(-k×(k-1((/2。例如：1。。4等于(4×5-1×0(/2=(20-0(/2=10；和4。。5是(5&倍；6-4&倍；3(/2=(30-12(/2=9。

如果我们有一个和S和一个偏移量k，我们就可以发现是否有一个l的和保持为：

2×S=l×(l+1(-k×(k-1(

0=l²+l-2&次；S-k×(k-1(

因此，我们可以用来求解这个方程

l=(-1+√(1+8&次；S+4&次；k&次；(k-1((/2

如果这是一个整数，则序列存在。例如，对于S=9和k=4，我们得到：

l=(-1+√(1+72+48((/2=(-1+11(/2=10/2=5。

我们可以使用一些函数，如巴比伦方法[wiki]来快速计算整数平方根：

squareRoot :: Integral t => t -> t
squareRoot n 
| n > 0    = babylon n
| n == 0   = 0
| n < 0    = error "Negative input"
where
babylon a   | a > b = babylon b
| otherwise = a
where b  = quot (a + quot n a) 2

我们可以通过对根进行平方来检查找到的根是否确实是的平方根，并查看我们是否获得了原始输入。

现在我们有了它，我们可以迭代序列的下边界，并寻找上边界。如果存在，我们返回序列，否则，我们尝试下一个：

decompose :: Int -> [[Int]]
decompose s = [ [k .. div (sq-1) 2 ]
| k <- [1 .. s]
, let r = 1+8*s+4*k*(k-1)
, let sq = squareRoot r
, r == sq*sq
]

例如，我们可以通过以下方式获得物品：

Prelude> decompose 1
[[1]]
Prelude> decompose 2
[[2]]
Prelude> decompose 3
[[1,2],[3]]
Prelude> decompose 3
[[1,2],[3]]
Prelude> decompose 1
[[1]]
Prelude> decompose 2
[[2]]
Prelude> decompose 3
[[1,2],[3]]
Prelude> decompose 4
[[4]]
Prelude> decompose 5
[[2,3],[5]]
Prelude> decompose 6
[[1,2,3],[6]]
Prelude> decompose 7
[[3,4],[7]]
Prelude> decompose 8
[[8]]
Prelude> decompose 9
[[2,3,4],[4,5],[9]]
Prelude> decompose 10
[[1,2,3,4],[10]]
Prelude> decompose 11
[[5,6],[11]]

我们可以进一步约束范围，例如指定k<l，带有：

decompose :: Int -> [[Int]]
decompose s = [ [k .. l ]
| k <- [1 ..div s 2]
, let r = 1+8*s+4*k*(k-1)
, let sq = squareRoot r
, r == sq*sq
, let l = div (sq-1) 2
,k < l
]

这就给了我们：

Prelude> decompose 1
[]
Prelude> decompose 2
[]
Prelude> decompose 3
[[1,2]]
Prelude> decompose 4
[]
Prelude> decompose 5
[[2,3]]
Prelude> decompose 6
[[1,2,3]]
Prelude> decompose 7
[[3,4]]
Prelude> decompose 8
[]
Prelude> decompose 9
[[2,3,4],[4,5]]
Prelude> decompose 10
[[1,2,3,4]]
Prelude> decompose 11
[[5,6]]

Answer 2

NB这个答案有点切题，因为这个问题特别需要Haskell中的直接回溯解决方案。张贴它，以防有人对这个问题的其他方法感兴趣，特别是使用现成的SMT解决方案。

现成的约束求解器可以很容易地处理这类问题，Haskell中有几个库可以访问它们。在不涉及太多细节的情况下，以下是如何使用SBV库进行编码(https://hackage.haskell.org/package/sbv)：

import Data.SBV
decompose :: Integer -> IO AllSatResult
decompose n = allSat $ do
i <- sInteger "i"
j <- sInteger "j"
constrain $ 1 .<= i
constrain $ i .<= j
constrain $ j .<  literal n
constrain $ literal n .== ((j * (j+1)) - ((i-1) * i)) `sDiv` 2

使用求和公式，我们简单地表达了给定n对i和j的约束。其余部分由SMT求解器简单处理，为我们提供所有可能的解决方案。以下是一些测试：

*Main> decompose 9
Solution #1:
i = 4 :: Integer
j = 5 :: Integer
Solution #2:
i = 2 :: Integer
j = 4 :: Integer
Found 2 different solutions.

和

*Main> decompose 10
Solution #1:
i = 1 :: Integer
j = 4 :: Integer
This is the only solution.

虽然这可能无法深入了解如何解决问题，但它确实利用了现有技术。同样，虽然这个答案没有按照要求使用列表monad，但希望在考虑SMT求解器在常规编程中的应用时，它会引起一些兴趣。