public
Created

combinatorical functions for lambdaheads - 2012-01-09

  • Download Gist
MyCombinatorics.hs
Haskell
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 [])
tMyCombinatorics.hs
Haskell
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]
]

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.