
module H2128
(
  myInsertAt,
  myRange,
  myRandSelect,
  myRandomRange,
  myRandomPerm,
  mySubsets,
  myMultiChoose,
  myLSort,
  myLFSort
)
where

import System.Random
import Data.List
import qualified Data.Map as Map

import H110
import H1120

--Problem 21: Insert At
myInsertAt :: a -> [a] -> Int -> [a]
myInsertAt e [] _ = [e]
myInsertAt e (x:xs) k
		    | k <= 1 = e:x:xs
		    | otherwise = x : myInsertAt e xs (k-1)

--Problem 22: Range
myRange :: Int -> Int -> [Int]
myRange start end
		| start < end = start : myRange (start+1) end
		| start == end = [end]
		| otherwise = []

--Problem 23: Random Select
myRandSelectHelper :: [a] -> Int -> StdGen -> [a]
myRandSelectHelper _ 0 _ = []
myRandSelectHelper [] _ _ = []
myRandSelectHelper xs num gen = (xs !! idx) : (myRandSelectHelper (myRemoveAt xs (idx+1)) (num-1) gen')
			where (idx, gen') = randomR (0,length(xs)-1) gen :: (Int, StdGen)


myRandSelect :: [a] -> Int -> [a]
myRandSelect xs num
		| num < 0 = []
		| otherwise = myRandSelectHelper xs num (mkStdGen 1000)

--Problem 24: Random Range
myRandomRange :: Int -> Int -> [Int]
myRandomRange 0 _ = []
myRandomRange _ 0 = []
myRandomRange num max
		| num < 0 = []
		| num > max = [1..max]
		| otherwise = myRandSelect [1..max] num

--Problem 25: Random Perm
myRandomPerm :: [a] -> [a]
myRandomPerm [] = []
myRandomPerm xs = myRandSelect xs (length xs)

--Problem 26: Subsets of a list
mySubsetHelper :: [a] -> Int -> [a] -> [[a]]
mySubsetHelper [] k work
		| k == 0 = [work]
		| otherwise = []
mySubsetHelper (x:xs) 0 work = [work]
mySubsetHelper (x:xs) k work = (mySubsetHelper xs (k-1) (work ++ [x])) ++ (mySubsetHelper xs k work)

mySubsets :: [a] -> Int -> [[a]]
mySubsets [] _ = []
mySubsets _ 0 = []
mySubsets xs k
	| k < 0 = []
	| otherwise = mySubsetHelper xs k []

--Problem 27: Multinomial
data MultiTree a = EmptyTree | Node a ([] (MultiTree a)) deriving (Show)
makeMultiTree :: (Eq a) => [Int] -> [a] -> [MultiTree [a]]
makeMultiTree [] _ = []
makeMultiTree _ [] = []
makeMultiTree (k:ks) xs = map (\x -> Node x (makeMultiTree ks (xs \\ x))) (mySubsets xs k)

flattenMultiTree :: MultiTree [a] -> [[a]] -> [[[a]]] -> [[[a]]]
flattenMultiTree (Node a []) work ans = ans ++ [(work ++ [a])]
flattenMultiTree (Node a xs) work ans = concat $ map (\x -> flattenMultiTree x (work ++ [a]) ans) xs

flattenMultiTreeList :: [MultiTree [a]] -> [[[a]]]
flattenMultiTreeList xs = concat $ map (\x -> flattenMultiTree x [] []) xs

myMultiChoose :: (Eq a) => [Int] -> [a] -> [[[a]]]
myMultiChoose [] _ = []
myMultiChoose _ [] = []
myMultiChoose nums all
		| sum /= (length all) = []
		| otherwise = flattenMultiTreeList $ makeMultiTree nums all
		where sum = (foldr (\x y -> x + y) 0 nums)

--Problem 28: Lsort and Lfsort
myMerge :: [a] -> [a] -> (a -> a -> Bool) -> [a]
myMerge [] [] _ = []
myMerge a [] _ = a
myMerge [] b _ = b
myMerge a@(x:xs) b@(y:ys) f
		| f x y = y : myMerge a ys f
		| otherwise = x : myMerge xs b f

myMergeSort :: [a] -> (a -> a -> Bool) -> [a]
myMergeSort [] _ = []
myMergeSort (x:[]) _ = [x]
myMergeSort xs f = myMerge (myMergeSort front f) (myMergeSort back f) f
		where (front, back) = splitAt (quot (length xs) 2) xs

myLSort :: [[a]] -> [[a]]
myLSort xs = myMergeSort xs (\x y -> (length x > length y))

myGetFreqs :: (Num a) => (Map.Map Int a) -> [[b]] -> (Map.Map Int a)
myGetFreqs map [] = map
myGetFreqs map (x:xs) = myGetFreqs newMap xs
		where newMap = if (Map.member (length x) map) then (Map.update (\x -> Just (x+1)) (length x) map) else (Map.insert (length x) 1 map)

myFreqComp :: (Ord a, Ord k) => Map.Map k a -> k -> k -> Bool
myFreqComp map a b = (map Map.! a) > (map Map.! b)

myLFSort :: [[a]] -> [[a]]
myLFSort xs = myMergeSort xs (\x y -> (myFreqComp (myGetFreqs Map.empty xs)) (length x) (length y))

