[99p]Lists(Complete)

import System.Random
import Control.Monad (replicateM)

-- problem 1
myLast :: [c] -> c
myLast = head . reverse

-- problem 2
myButLast :: [c] -> c
myButLast = head. tail . reverse

-- problem 3
elementAt :: Int -> [c] -> c
elementAt x =myLast . take x

-- problem 4
myLength :: Num a => [t] -> a
myLength [] = 0
myLength (x:xs) = 1 + myLength xs

-- problem 5
rev :: [a] -> [a]
rev [] = []
rev (x:xs) = rev xs ++ [x]

-- problem 6
isPalindrome :: Eq a => [a] -> Bool
isPalindrome xs = (reverse xs == id xs)

-- problem 7
data LiL a = Elem a | List [LiL a]
flatten :: LiL a -> [a]
flatten (Elem a) = [a]
flatten (List []) = []
flatten (List (x:xs)) = flatten x ++ flatten (List xs)

-- problem 8
compress :: Eq a => [a] -> [a]
compress [] =[]
compress [x] = [x]
compress (x:xs)
  | x == head xs   = compress xs
  | x /= head xs   = x : compress xs

-- problem 9
pack :: Eq a => [a] -> [[a]]
pack [] = []
pack [x] = [[x]]
pack (x:xs)
  | x == head (head (pack xs))  = (x : (head (pack xs))) : (tail (pack xs))
  | x /= head (head (pack xs))  = [x] : (pack xs)

-- problem 10
encode :: (Num a, Eq b) =>[b] -> [(a,b)]
encode [] = []
encode xs = zip (lenlist xs) (compress xs)
            where lenlist xs =  map myLength (pack xs)

-- problem 11
data LI a = S a | M Int a
    deriving (Show)
encodeM :: Eq a => [a] -> [LI a]
encodeM = map encodeM0 . encode
    where
      encodeM0 (1,x) = S x
      encodeM0 (n,x) = M n x

-- problem 12
decode :: Eq a => [LI a] -> [a]
decode = concatMap decodeM0
        where decodeM0 (S x) = [x]
              decodeM0 (M n x) = replicate n x

-- problem 13
lenlistD :: (Num a, Eq a1) => [a1] -> [a]
lenlistD [] = []
lenlistD [x] = [1]
lenlistD (x:xs)
   | x == (head xs)    = head(lenlistD xs) + 1 : tail(lenlistD xs)
   | otherwise         = 1 : lenlistD xs
encodeD :: Eq a => [a] -> [LI a]
encodeD xs = map encodeM0 (zip (lenlistD xs) (compress xs))
                 where
                   encodeM0 (1,x) = S x
                   encodeM0 (n,x) = M n x

-- problem 14
dupli :: [a] -> [a]
dupli [] =[]
dupli (x:xs) = x:x:dupli xs

-- problem 15
repli :: [a] -> Int -> [a]
repli [] n = []
repli (x:xs) n = replicate n x ++ repli xs n

-- problem 16
dropEvery :: [a] -> Int -> [a]
dropEvery [] n = []
dropEvery xs n  = take (n-1) xs ++ dropEvery (drop n xs) n

-- problem 17
splitD :: [a] -> Int -> ([a], [a])
splitD [] n = ([], [])
splitD xs 0 = ([],xs)
splitD (x:xs) n = (x:fst(splitD xs (n-1)),snd(splitD xs (n-1)))

-- problem 18
slice :: [a] -> Int -> Int -> [a]
slice xs m n = fst (splitD (drop (m-1) xs) (n-m+1))

-- problem 19
rotate :: [a] -> Int -> [a]
rotate [] _ = []
rotate xs m
    | m >= 0   = snd(splitD xs m) ++ fst(splitD xs m)
    | m < 0    = snd(splitD xs (length(xs)+m)) ++ fst(splitD xs (length(xs)+m))

-- problem 20
removeAt :: Int -> [a] -> ([a],[a])
removeAt n xs
    = ( (take 1 (rotate xs (n-1))), rotate (drop 1 (rotate xs (n-1))) (1-n) )


-- problem 21
insertAt :: a-> [a] -> Int -> [a]
insertAt x xs n
    = fst(splitAt (n-1) xs)++[x]++snd(splitAt (n-1) xs)

-- problem 22
range :: Int -> Int -> [Int]
range m n
   |m==n  = [m]
   |m<n   = m : (range (m+1) n)
   |m>n   = m : (range (m-1) n)

-- problem 23
rnd_select :: [a] -> Int -> IO [a]
rnd_select [] _ = return []
rnd_select l  n
    | n<0 = error "n cant be neg"
    | otherwise = do pos <- replicateM n $
                            getStdRandom $ randomR (0, (length l)-1)
                     return [l!!p | p <- pos]

-- problem 24
diff_select n m = diff_sel n [1..m]
diff_sel :: Num a => a -> [a1] -> IO [a1]
diff_sel 0 _  = return []
diff_sel _ [] = error "not enuff elements"
diff_sel n xs = do g <- randomRIO (0,(length xs)-1)
                   let remaining = take g xs ++ drop (g+1) xs
                   rest <- diff_sel (n-1) remaining
                   return ((xs!!g) : rest)

-- problem 25
rnd_permu :: [a] -> IO [a]
rnd_permu xs = diff_sel len xs
                   where len = length xs

-- problem 26

cmb :: Int-> [a] -> [[a]]
cmb 0 _ = []
cmb 1 xs = map f xs
               where f x = [x]
cmb n (x:xs)
    | n<length(xs)+1  =(map (x: ) (cmb (n-1) xs)) ++ (cmb n xs)
    | n==length(xs)+1  =[x:xs]
    | n>length(xs)+1  = error "not enuff elements"

-- problem 27
listminus :: Eq a => [[a]] -> [a] ->[[a]]
listminus [] ys = []
listminus xs [] = xs
listminus (x:xs) ys = filter (`notElem` x) ys : (listminus xs ys)
cmb_rest :: Eq a => Int -> [a] -> [([a],[a])]
cmb_rest n xs = zip (cmb n xs) (listminus (cmb n xs) xs)

group :: Eq a => [Int] -> [a] -> [[[a]]]
group [] _ = [[]]
group (x:xs) ys  | sum (x:xs) /= (length ys)    = error "not compatible"
                 | sum (x:xs) == (length ys)    = [ z:zs | (z,ws) <- cmb_rest x ys
                                                  , zs <- group xs ws ]

{- quicksort
quicksort :: Ord a => [a] -> [a]
quicksort [] = []
quicksort (x:xs) = quicksort small ++ (x : quicksort large)
   where small = [ y | y <- xs, y <= x]
         large = [ y | y <- xs, y > x]
-}

-- problem 28
---- sortlength
sortlength :: Ord a => [[a]] -> [[a]]
sortlength [] = []
sortlength (x:xs) = sortlength small ++ (x : sortlength large)
   where small = [ y | y <- xs, length y <= length x]
         large = [ y | y <- xs, length y > length x]
---- sortfreq
lenfreq :: [[a]] -> [a] -> Int
lenfreq [] x = 0
lenfreq (y:ys) x = (if length x == length y then 1 else 0) + lenfreq ys x
sortfreq :: [[a]] -> [[a]]
sortfreq [] = []
sortfreq (x:xs) =  sortfreq small ++ (x : sortfreq large)
         where small = [ y | y <- xs, lenfreq (x:xs) y < lenfreq (x:xs) x]
               large = [ y | y <- xs, lenfreq (x:xs) y >= lenfreq (x:xs) x]