Skip to content

Instantly share code, notes, and snippets.

@epsilonhalbe
Created January 9, 2012 12:45
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save epsilonhalbe/1582790 to your computer and use it in GitHub Desktop.
combinatorical functions for lambdaheads - 2012-01-09
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 [])
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]
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment