Rollback with state

Question

List monad provides an excellent abstraction for backtracking in search problems. However, the problem that I am currently facing is that it includes a condition in addition to retreat. (It also includes restrictions related to previous choices made in the search path, but I will attack this problem later.)

The following simplified example illustrates the issue. the function sumTois given a non-negative integer and a list with pairs of integers. The first element in each pair is a positive integer, the second element is the number of such integers. The search problem is to express the first argument using integers in a list with counter restrictions. For example, here the integer 8 is represented differently as the sum of five 1s, three 2and two 4, taking into account the fact that all the numbers making up the sum should even (therefore, 1cannot be used).

λ> sumTo 8 [(1,5), (4,2), (2,3)]
[[4,4],[4,2,2],[2,2,4],[2,4,2]]

Below is my current recursive solution to the problem.

sumTo :: Int -> [(Int, Int)] -> [[Int]]
sumTo = go []
  where
    go :: [(Int, Int)] -> Int -> [(Int, Int)] -> [[Int]]
    go _ 0 _ = [[]] -- base case: success
    go _ _ [] = [] -- base case: out of options, failure 
    -- recursion step: use the first option if it has counts left and
    -- is suitable; append to this cases where current option is not
    -- used at this point
    go prevOpts n (opt@(val,cnt):opts) =
      (if cnt > 0 && val <= n && even val
       then map (val:) $ go [] (n - val) $ (val,cnt-1):(prevOpts ++ opts)
       else [])
      ++ go (opt:prevOpts) n opts

While the function works fine, it is much more complicated than the one without state, using the list monad.

sumToN :: Int -> [Int] -> [[Int]]
sumToN 0 _ = [[]]
sumToN n opts = do
  val <- opts
  guard $ val <= n
  guard $ even val
  map (val:) $ sumToN (n - val) opts

Without limitations, this gives one additional solution.

λ> sumToN 8 [1, 4, 2]
[[4,4],[4,2,2],[2,4,2],[2,2,4],[2,2,2,2]]

, - , StateT - , .

Answer 1

, , - StateT.

import Control.Applicative
import Control.Monad.State

- .

( (element, nb_copies)), pick , . (Int, [(Int, Int)]). pick .

"" . , ( - ). x (, i > 0). x (pickx), (pickxs), x .

pick :: [(Int, Int)] -> [(Int, [(Int, Int)])]
pick [] = []
pick ((x, i) : xs) = pickx ++ pickxs
  where
    pickx = if i == 1 then [ (x, xs) ] else [ (x, (x, i-1) : xs) ]
    pickxs = do
      (x', xs') <- pick xs
      return (x', (x, i) : xs')

sumTo : n = 0, ([]), . i, n-i .

sumTo :: Int -> [(Int, Int)] -> [[Int]]
sumTo = go
  where
    go 0 _ = return []
    go n xs = do
      (i, xs') <- pick xs
      guard $ i <= n
      guard $ even i
      s' <- go (n-i) xs'
      return (i : s')

. StateT "". [] - . StateT s [] - s. .

, pick . , pickState , . pickState , .

pickState :: StateT [(Int, Int)] [] Int
pickState = StateT pick

, 0.

sumToState :: Int -> StateT [(Int, Int)] [] [Int]
sumToState = go
  where
    go 0 = return []
    go n = do
      i <- pickState
      guard $ i <= n
      guard $ even i
      s' <- go (n-i)
      return (i : s')

---

main = do
  let n = 8
      xs = [(1, 5), (4, 2), (2, 3)]
  print $ sumTo n xs
  print $ evalStateT (sumToState n) xs

( )

Answer 2

StateT . , StateT, evalStateT.

opts, [(Int, Int)]. MultiSet , .

, :

import Control.Monad.State (StateT, evalStateT, get, modify, lift, guard)
import Data.MultiSet (MultiSet, fromOccurList, distinctElems, delete)

sumToN :: Int -> [(Int, Int)] -> [[Int]]
sumToN nStart optsStart =
    evalStateT (go nStart) (fromOccurList optsStart)
  where
    go :: Int -> StateT (MultiSet Int) [] [Int]
    go 0 = return []
    go n = do
        val <- lift . distinctElems =<< get
        guard (val <= n && even val)
        modify (delete val)
        (val:) <$> go (n - val)

λ> sumToN 8 [(1,5), (4,2), (2,3)]
[[2,2,4],[2,4,2],[4,2,2],[4,4]]

---

StateT . , MultiSet Int , .

import Control.Monad (guard)
import Data.MultiSet (fromOccurList, distinctElems, delete)

sumToN :: Int -> [(Int, Int)] -> [[Int]]
sumToN nStart optsStart =
    go nStart (fromOccurList optsStart)
  where
    go 0 _    = return []
    go n opts = do
        val <- distinctElems opts
        guard (val <= n && even val)
        (val:) <$> go (n - val) (delete val opts)