module Permutations where

fact n = foldl (*) 1 [2..n]

del k xs = [x | x <- xs, x /= k]

count p xs = length [x | x <- xs, p x]

--The number of the permutation in lexicographical order. Usage example: lexNumOfPerm [2, 4, 3, 1]
lexNumOfPerm [] = 1
lexNumOfPerm (x:xs) = lexNumOfPerm xs + count (< x) xs * fact (length xs)

lexPerm' k acc [] = acc
lexPerm' k acc xs = lexPerm' (k `mod` nf) (mark:acc)(del mark xs) where
			mark = xs !! (k `div` nf)
			nf = fact (length xs - 1)

--The k-th permutation in lexicographical order. Usage example: lexPerm 12 [1, 2, 3, 4]
lexPerm k = reverse . lexPerm' (k - 1) []

--The k-th permutation in lexicographical order. Usage example: revLexPerm 12 [1, 2, 3, 4]
revLexPerm k xs = lexPerm' (k - 1) [] (reverse xs)

fikePlaceVals n = foldl (\(x:xs) p -> p*x : x : xs) [1] [n, n - 1.. 3]

dSeq k n = reverse $ tail $ foldl (\(x:xs) p -> (mod x p) : (div x p) : xs) [k - 1] (fikePlaceVals n)

fikeSeq k n = zipWith (-) [1..n] (dSeq k $ n)

swap i j list | i == j = list
	      | i < j = hs ++ (y:xs) ++ (x:ys)
	      | otherwise = swap j i list where
		(hs, zs) = splitAt i list
		(x:xs, y:ys) = splitAt (j - i) zs

--The k-th permutation in Fike's order. Usage example: fikePerm 12 [1, 2, 3, 4]
fikePerm k marks = snd (foldl (\(i, p) j -> (i + 1, swap i j p)) (1, marks) $ fikeSeq k (length marks))

--Powerset of a set. Usage example: powerSet [1, 2, 3, 4]
powerSet [] = [[]];
powerSet (x:xs) = pXs ++ [x:ys | ys <- pXs] where pXs = powerSet xs

setFromBits _ 0 = []; setFromBits (x:xs) bits = if (bits `mod` 2 == 0) then setFromBits xs (bits `div` 2) else x : setFromBits xs (bits `div` 2)

--Powerset of a set using setFromBits
powerSet' set = map (setFromBits set) [0.. 2^n -1] where n = length set

--nCr
comb n r = foldl (*) 1 [n, n - 1 .. n - r + 1] `div` foldl (*) 1 [2..r]