haskell - Haskell，算法所有可能的数字组成

Question

我在haskell中有一个代码，它生成由三部分组成的数字：

kompozycje n = [ (x,y,z) | x<-[1..n], y<-[1..n], z<-[1..n], x+y+z==n]

我想做一些像 kompozycje nk 这样的东西，它会生成我的 k 部分组合，然后如果例如 k 等于 4，就会有四个变量和四个数字返回，并且在条件下会有类似 u+x+y+z 的东西==n。有一些简单的解决方案吗？

Answer 1

是的，是的。它使用列表 monad 和replicateM.

import Control.Monad

summy :: Integer -> Integer -> [[Integer]]
summy k n = do
  ls <- replicateM k [1..n]
  guard (sum ls == n)
  return ls

要不就

summy k n = filter ((==n) . sum) $ replicateM k [1..n]

在 list monad 中，将生成由 numbers 组成的replicateM所有可能的长度列表。k1 .. n

这确实会生成重复项，例如[1, 2, 1]和[1, 1, 2]。但是您的原始方法也是如此。

Answer 2

碰巧的是，有一个可爱、高效且晦涩的 (?) 算法用于枚举至少可以追溯到 1779 年的k-size 分区。 Donald Knuth——还有谁？- 在算法 Hn下的计算机编程艺术草稿中详细描述了它。Haskell 中的算法让您高兴：

import Data.List (unfoldr)

partitions :: Int -> Int -> [[Int]]
partitions k n | k < 1 || k > n = []
partitions k n = initPartition : unfoldr (fmap (\x -> (x, x)) . nextPartition) initPartition
  where
    initPartition = (n-k+1) : replicate (k-1) 1

nextPartition :: [Int] -> Maybe [Int]
nextPartition [] = error "nextPartition should never be passed an empty list"
nextPartition [x] = Nothing
nextPartition (x:y:rest)
    | x-y > 1 = Just $ (x-1) : (y+1) : rest
    | otherwise = do
        (s, c, xs) <- go (x+y-1) rest
        Just $ (s-c) : c : xs
  where
    go _ [] = Nothing
    go s (z:zs)
        | x-z > 1 = let z' = z+1 in Just (s, z', z' : zs)
        | otherwise = do
            (s', c, zs') <- go (s+z) zs
            Just (s'-c, c, c:zs')

Answer 3

这确实是对@Aaron Roth 答案的评论，这很好（并且比公认的答案更有效）。

我认为您可以改进这一点， fmap 似乎没有必要。Knuth 对 H5/H6（你的“开始”步骤）的介绍也掩盖了它只是一个求和和复制。这是一个接近 Knuth 命名的版本，同时试图使算法更清晰：

import Data.List (unfoldr)

partitions m n
  | n < m || n < 1 || m < 1 = []
  | otherwise = unfoldr nextPartition ((n - m + 1) : (replicate (m - 1) 1))

nextPartition [] = Nothing
nextPartition [a] = Just ([a], [])
nextPartition a@(a1 : a2 : rest)
  | a2 < a1 - 1 = Just (a, (a1 - 1):(a2 + 1):rest)
  | otherwise = Just (a, h5 (span (>= a1 - 1) rest))
  where
    h5 (_, []) = []
    h5 (xs, aj:ys) =
      let j = length xs + 3 in
      let tweaked = replicate (j - 1) (aj + 1) in
      let a1' = sum (take j a) - sum tweaked in
      a1' : tweaked ++ drop j a

或者认识到 Knuth 的 H3 只是展开循环一次，我们可以将 nextPartition 紧凑地写为：

nextPartition [] = Nothing
nextPartition a@(a1 : rest) =
  Just (a, -- H2
    case (span (>= a1 - 1) rest) of -- H4
      (_, []) -> [] -- H5, termination
      (xs, aj:ys) ->
        a1 + sum (xs) + aj - (length xs + 1) * (aj + 1) -- H6 "Finally..."
        : replicate (length xs + 1) (aj + 1) ++ ys) -- H5/H6 

编辑添加：一年后偶然回到这个，看了上面的内容，我不知道为什么我不只是建议这个更简单的递归解决方案：

part m n = part2 (n-m+1) m n
  where
    part2 t m n
      | m == 1 && t == n = [[t]]
      | n < m || n < 1 || m < 1 || t < 1 = []
      | otherwise = [t:r|r <- part2 t (m-1) (n-t)] ++ (part2 (t-1) m n)