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 | |
binom :: Integral a => a -> a -> a | |
binom n k = product [n,n-1..n-k+1] `div` product [1..k] | |
combination :: [a] -> Int -> [[a]] | |
combination 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, | |
"combination" ~: "1 1" ~: combination [1] 1 ~?= [[1]], | |
"combination" ~: "2 2" ~: combination [1,2] 2 ~?= [[1,2]], | |
"combination" ~: "2 1" ~: combination [1,2] 1 ~?= [[1],[2]], | |
"combination" ~: "3 1" ~: combination [1,2,3] 1 ~?= [[1],[2],[3]], | |
"combination" ~: "3 2" ~: combination [1,2,3] 2 ~?= [[1,2],[1,3],[2,3]], | |
"combination" ~: "3 3" ~: combination [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