public

epsilonhalbe / MyCombinatorics.hs

Created 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]
  ]