Возврат со списком Monad в Haskell

Question

Я пытаюсь решить проблему разложения с возвратом и перечислить монаду в Haskell. Вот постановка задачи: для положительного целого числа 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 × 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 .

Мы можем использовать некоторую функцию, например Вавилонский метод [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

Мы можем проверить, действительно ли найденное root является точным квадратом root, возведя в квадрат root и посмотрим, получим ли мы обратно исходный ввод.

Итак, теперь, когда у нас есть это, мы можем перебирать нижнюю границу последовательности и искать верхнюю границу. Если он существует, мы возвращаем последовательность, в противном случае мы пробуем следующую:

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

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

Мы просто express ограничения на i и j для заданного n, используя формулу суммирования. Остальное просто решает 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.

Хотя это может не дать подробного понимания того, как решить проблему, он наверняка использует существующие технологии. Опять же, хотя в этом ответе не используется перечисленная монада, как просили, но, надеюсь, он представляет некоторый интерес при рассмотрении приложений решателей SMT в обычном программировании.