在 Haskell 中使用列表 Monad 回溯

Question

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

我提出了以下似乎工作正常的解决方案。有人可以建议使用列表 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。

我们可以利用一些函数，比如Babylonian method [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，用：

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.

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