在 Haskell 中使用列表 Monad 回溯

Question

我正在尝试使用 Haskell 中的回溯和列表 Monad 来解决分解问题。 下面是问题陈述：给定一个正数 integer 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×Sk×(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 。

我们可以利用一些 function，如巴比伦方法[wiki]快速计算 integer 平方根：

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

注意这个答案有点切题，因为这个问题特别要求 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的约束。 rest 由 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.

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