module Math.Combinat.Combinations where
import Math.Combinat.Helper
combinations'
:: [Int]
-> Int
-> [[Int]]
combinations' [] 0 = [[]]
combinations' [] _ = []
combinations' shape@(s:ss) n =
[ x:xs | x <- [0..min s n] , xs <- combinations' ss (nx) ]
countCombinations' :: [Int] -> Int -> Integer
countCombinations' [] 0 = 1
countCombinations' [] _ = 0
countCombinations' shape@(s:ss) n = sum
[ countCombinations' ss (nx) | x <- [0..min s n] ]
allCombinations' :: [Int] -> [[[Int]]]
allCombinations' shape = map (combinations' shape) [0..d] where d = sum shape
combinations
:: Int
-> Int
-> [[Int]]
combinations len d = combinations' (replicate len d) d
countCombinations :: Int -> Int -> Integer
countCombinations len d = binomial (len+d1) (len1)
combinations1
:: Int
-> Int
-> [[Int]]
combinations1 len d
| len > d = []
| otherwise = map plus1 $ combinations len (dlen)
where
plus1 = map (+1)
countCombinations1 :: Int -> Int -> Integer
countCombinations1 len d = countCombinations len (dlen)