# public epsilonhalbe / MyCombinatorics.hs Created 2012-01-09

combinatorical functions for lambdaheads - 2012-01-09

MyCombinatorics.hs
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 module MyCombinatorics where import Data.List ( (\\), sort)import Control.Applicative ( liftA2, Applicative, pure) (^*) :: (a -> b) -> (b -> c) -> a -> cf ^* g = g . f -- | ungeordnete Variation ohne zurücklegen $\left(\begin{array}n\\k\end{array}$-- take k elements from a set of n elements i.e. (1,2,3) -> ((1,2),(1,3),(2,3))binom :: Integral a => a -> a -> abinom n k = product [n,n-1..n-k+1] div product [1..k] unorderedVariation :: [a] -> Int -> [a]unorderedVariation x n | n < 0 = error "no nonpositive number chosen" | otherwise = map fst $applyN uV n [([], reverse x)] uV :: [([a],[a])] -> [([a],[a])]uV = concatMap uV' uV' :: ([a],[a]) -> [([a],[a])]uV' = _uV' [] where _uV' :: [([a],[a])] -> ([a],[a]) -> [([a],[a])] _uV' acc (_,[]) = acc _uV' acc (yy,x:xx)= _uV' ((x:yy,xx):acc) (yy,xx) nFaculty :: (Integral a) => a -> anFaculty n = product [1..n] permute ::(Eq a) => [a] -> [[a]]permute xx = treeToList$ maketree ([],reverse xx) data Tree a = Leaf [a] | Node [Tree a] treeToList :: Tree a -> [[a]]treeToList (Leaf x) = [x]treeToList (Node xx) = concatMap treeToList xx maketree :: (Eq a) => ([a],[a]) -> Tree amaketree (xx,[]) = Leaf xxmaketree (xx,yy) = Node [maketree (x : xx, yy \\ [x])|x <- yy] maketree2 :: (Eq a) => ([a],[a]) -> Int -> Tree amaketree2 (xx,[]) _ = Leaf xxmaketree2 (xx,yy) 0 = Leaf xxmaketree2 (xx,yy) n = Node [maketree2 (x : xx, yy \\ [x]) (n-1)|x <- yy] set :: (Ord a, Eq a) => [a] -> [a]set xx = sort (_set [] xx) _set :: (Eq a) => [a] -> [a] -> [a]_set acc [] = acc_set acc (x:xx) |x ∈ acc = _set acc xx |otherwise = _set (x:acc) xx ordVarWithPutBack :: [a] -> Int -> [[a]]ordVarWithPutBack xx n = sequenceA (take n $repeat xx) ordVarNoPutBack :: (Eq a) => [a] -> Int -> [[a]]ordVarNoPutBack xx n = treeToList (maketree2 ([],xx) n) (∈) :: (Eq a) => a -> [a] -> Boolx ∈ xx = x elem xx applyN :: (a -> a) -> Int -> a -> aapplyN f n x = foldr ($) x (replicate n f) sequenceA :: (Applicative f) => [f a] -> f [a]sequenceA = foldr (liftA2 (:)) (pure [])
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 import Test.HUnitimport MyCombinatorics main = testAll testAll = runTestTT $TestList tests --------------------------------------------------------------------------------tests = ["unordered Variation" ~: "1" ~: True ~?= True, "unordered Variation" ~: "1 1" ~: unorderedVariation [1] 1 ~?= [[1]], "unordered Variation" ~: "2 1" ~: unorderedVariation [1,2] 2 ~?= [[1,2]], "unordered Variation" ~: "2 2" ~: unorderedVariation [1,2] 1 ~?= [[1],[2]], "unordered Variation" ~: "3 1" ~: unorderedVariation [1,2,3] 1 ~?= [[1],[2],[3]], "unordered Variation" ~: "3 2" ~: unorderedVariation [1,2,3] 2 ~?= [[1,2],[1,3],[2,3]], "unordered Variation" ~: "3 3" ~: unorderedVariation [1,2,3] 3 ~?= [[1,2,3]], "Permutation" ~: "[1]" ~: permute [1] ~?= [[1]], "Permutation" ~: "[1,2]" ~: permute [1,2] ~?= [[1,2],[2,1]], "Permutation" ~: "[1,2,3]" ~: permute [1,2,3] ~?= [[1,2,3],[2,1,3],[1,3,2],[3,1,2],[2,3,1],[3,2,1]], "Set" ~: "take 33$ cycle [1,2,3]" ~: set ( take 33 (cycle [1,2,3])) ~?= [1,2,3] ]