# epsilonhalbe / MyCombinatorics.hs Created January 09, 2012

### SSH clone URL

You can clone with HTTPS or SSH.

combinatorical functions for lambdaheads - 2012-01-09

View 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 -> c f ^* 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 -> a binom 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 -> a nFaculty 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 a maketree (xx,[]) = Leaf xx maketree (xx,yy) = Node [maketree (x : xx, yy \\ [x])|x <- yy]   maketree2 :: (Eq a) => ([a],[a]) -> Int -> Tree a maketree2 (xx,[]) _ = Leaf xx maketree2 (xx,yy) 0 = Leaf xx maketree2 (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] -> Bool x ∈ xx = x elem xx applyN :: (a -> a) -> Int -> a -> a applyN f n x = foldr ($) x (replicate n f)   sequenceA :: (Applicative f) => [f a] -> f [a] sequenceA = foldr (liftA2 (:)) (pure [])
View MyCombinatorics.hs
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 import Test.HUnit import 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] ]