2013-11-11 1 views
3

У меня есть код в Haskell, который генерирует трехчастную композицию номера:Haskell, алгоритм всего возможного состав числа

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

Я хотел бы сделать что-то вроде kompozycje пк, который будет генерировать меня к-часть композиций и тогда, если, например, k будет равным 4, будет четыре переменные и четыре числа, возвращаемые, и в условии будет что-то вроде u + x + y + z == n. Есть ли для этого какое-то простое решение?

ответ

9

Да, да, есть. Он использует список монады и 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] 

В списке монады replicateM будет генерировать все возможные списки длины k, состоящей из чисел 1 .. n.

Это создает дубликаты, такие как [1, 2, 1] и [1, 1, 2]. Но и ваши оригинальные методы.

+1

Второй replicateM на основе answe r за один день: O – jozefg

+3

И Симонс сказал: выходите и «реплицируйте». –

+1

Это можно улучшить, если сделать 1 replicateM less и вычислить последнее число как (n-sum ls). – Ingo

3

Как бы то ни было, существует прекрасный, эффективный и неясный алгоритм (?) Для перечисления разделов k с размером n, начиная с 1779 года. Дональд Кнут - кто еще? - подробно описывается в проекте Art of Computer Programming, под номером Algorithm H. Здесь для услаждения является алгоритм в 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') 
1

Это действительно комментарий на ответ @Aaron Рот, который является хорошим (и способ более эффективен, чем принято отвечать).

Я думаю, вы можете улучшить это, fmap кажется ненужным. Также представление Кнута H5/H6 (ваш шаг) затмевает, что это всего лишь сумма &. Вот версия, которая торчит рядом с именованием Кнута, при попытке сделать алгоритм понятнее:

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 [email protected](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 

Или признать, что H3 Кнута просто разворачивая цикл один раз, мы можем написать nextPartition компактно как:

nextPartition [] = Nothing 
nextPartition [email protected](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)