Haskell 99 problems.hs

Haskell 99 problems.hs

import Data.List
import System.Random
import Control.Applicative
import Control.Monad.Writer

-- 1
myLast :: [a] -> a
myLast [x]    = x
myLast (_:xs) = myLast xs
 
myLast' = head . reverse
 
 
-- 2
myButLast :: [a] -> a
myButLast [x,_] = x
myButLast (_:xs)   = myButLast xs
 
myButLast' xs = head $ drop (length xs - 2) xs
 
myButLast'' = last . init
 
 
-- 3
elementAt :: [a] -> Int -> a
elementAt xs pos = head $ drop (pos-1) xs
 
elementAt' xs pos = xs !! (pos-1)
 
 
-- 4
myLength :: [a] -> Int
myLength []     = 0
myLength (_:xs) = 1 + myLength xs
 
myLength' = sum . map (const 1)
 
 
-- 5
myReverse :: [a] -> [a]
myReverse []     = []
myReverse (x:xs) = myReverse xs ++ [x]
 
myReverse' xs = scanr1 (\x acc -> acc) xs
 
 
-- 6
isPalindrome xs = reverse xs == xs
 
 
-- 7
data NestedList a = Elem a | List [NestedList a] deriving (Show)
 
-- flatten (List [Elem 1, Elem 8, List [Elem 2, List [Elem 3, Elem 4], Elem 5]])
flatten :: NestedList a -> [a]
flatten (Elem a)        = [a]
flatten (List (x:xs))   = flatten x ++ flatten (List xs)
flatten (List [])       = []
 
 
-- 8
compress :: (Eq a) => [a] -> [a]
compress (x:y:xs)
    | x == y    = compress $ y:xs
    | otherwise = x:(compress $ y:xs)
compress (x:[]) = [x] 
compress []     = []
 
compress' :: Eq a => [a] -> [a]
compress' = map head . group
 
compress'' :: Eq a => [a] -> [a]
compress'' (x:xs) = x : (compress $ dropWhile (x ==) xs)

-- 10
encode :: (Eq a) => [a] -> [(Int, a)]
encode xs = zip (map length grouped) (map head grouped)
    where grouped = group xs

encode' :: (Eq a) => [a] -> [(Int, a)]
encode' = map (\xs -> (length xs, head xs)) . group

encode'' xs = [(length ys, head ys) | ys <- group xs]

-- 11
data SuperList a = Multiple Int a | Single a deriving (Show)

encodeModified :: (Eq a) => [a] -> [SuperList a]
encodeModified = map magic . group
    where
        magic (x:[]) = Single x
        magic xs     = Multiple (length xs) (head xs)


-- 12
decodeModified :: [SuperList a] -> [a]
decodeModified = concatMap magic
    where
        magic (Multiple n x) = replicate n x
        magic (Single x)     = [x]

-- 14
dupli :: [a] -> [a]
dupli = concatMap (\x -> [x,x])

dupli' []     = []
dupli' (x:xs) = x:x:(dupli xs)

-- 15
repli :: [a] -> Int -> [a]
repli xs n = concatMap (replicate n) xs

repli' = flip $ concatMap . replicate

-- 16
dropEvery :: [a] -> Int -> [a]
dropEvery xs n = dropEvery' xs n n
    where
        dropEvery' []     _ _ = []
        dropEvery' (_:xs) 1 m = (dropEvery' xs m m)
        dropEvery' (x:xs) n m = x:(dropEvery' xs (n-1) m)

--17
split :: [a] -> Int -> ([a], [a])
split xs n = (take n xs, drop n xs)

split' = flip splitAt



--18
slice :: [a] -> Int -> Int -> [a]
slice xs start end = take (end - start') (drop start' xs)
    where start' = start-1

--19
rotate :: [a] -> Int -> [a]
rotate xs n = (drop n' xs) ++ rest
    where
        n'   = n `mod` (length xs)
        rest = take n' xs


-- 20
removeAt :: Int -> [a] -> (a, [a])
removeAt pos xs = (char pos xs, rest pos xs)
    where
        char 1   (x:xs) = x
        char pos (x:xs) = char (pos-1) xs

        rest _ []         = []
        rest 1   (x:xs)   = (rest 0 xs)
        rest pos (x:xs)   = x:(rest (pos-1) xs)


-- wow, smart lösning
removeAt' 1 (x:xs) = (x, xs)
removeAt' n (x:xs) = (l, x:r)
    where (l, r) = removeAt (n - 1) xs

removeAt'' :: Int -> [a] -> (a, [a])
removeAt'' 1 (x:xs) = (x, xs)
removeAt'' n (x:xs) = (char, x:rest)
    where (char, rest) = removeAt'' (n - 1) xs

-- 21
insertAt :: a -> [a] -> Int -> [a]
insertAt y xs 1     = y:xs
insertAt y (x:xs) n = x:insertAt y xs (n-1)

-- 22
range :: Int -> Int -> [Int]
range s e = [s..e]

range' :: Int -> Int -> [Int]
range' s e
    | s >  e    = reverse (range' e s)
    | s == e    = [e]
    | otherwise = s:(range' (s+1) e)

range'' :: (Enum a) => a -> a -> [a]
range'' = enumFromTo


-- threeCoins
threeCoins :: StdGen -> (Bool, Bool, Bool)
threeCoins gen =
    let
        (coinOne,   gen')  = random gen
        (coinTwo,   gen'') = random gen'
        (coinThree, _)     = random gen''
    in (coinOne, coinTwo, coinThree)


-- randoms
randoms' :: (RandomGen g, Random a) => g -> [a]
randoms' gen =
    let
        (rand, gen') = random gen 
    in
        rand:randoms' gen'

-- 23
rndSelect :: (RandomGen g) => g -> String -> Int -> String
rndSelect gen xs n
    | n == 0         = []
    | length xs == 0 = []
    | otherwise      = rndSelect' gen xs n
    where
        rndSelect' gen xs n =
            let
                (randInt, gen') = randomR (1, length xs) gen
            in
                let (x, xs') = removeAt' randInt xs
                in  x:rndSelect gen' xs' (n-1)

-- 23
-- Fett smart lösning 
rndSelect' :: [a] -> Int -> IO [a]
rndSelect' xs n
    | n > length xs = return []
    | otherwise     = map (xs !!) <$> indices
    where
        indices = take n . nub . randomRs (0, length xs - 1) <$> getStdGen


-- 24
rndSelect2 :: Int -> Int -> IO [Int]
rndSelect2 n max = take n . nub . randomRs (1, max) <$> getStdGen

-- 25
rndPerm :: (RandomGen g) => [a] -> g -> [a]
rndPerm [] _    = []
rndPerm xs gen  =
    let (x, xs') = removeAt' (head $ randomRs (1, length xs) gen) xs
    in  x:rndPerm xs' gen

rndPerm' :: [a] -> IO [a]
rndPerm' xs = rndSelect' xs (length xs)

rndPerm'' :: [a] -> IO [a]
rndPerm'' [] = return []
rndPerm'' xs = do
    index <- randomRIO (1, length xs)

    let (x, xs') = removeAt' index xs
    
    (x:) <$> rndPerm'' xs'


-- 26
--combinations :: Int -> [a] -> [[a]]
--combinations n xs = removeAt' 

combinations :: Int -> [a] -> [[a]]
combinations 0 _  = [ [] ]
combinations n xs = [ y:ys | y:xs' <- tails xs
                           , ys <- combinations (n-1) xs']

combinations' :: Int -> [a] -> [[a]]
combinations' 0 _  = return []
combinations' n xs = do
    y:xs' <- tails xs
    ys    <- combinations' (n-1) xs'
    return (y:ys)

-- Writer
logNumber :: (Show a) => a -> Writer [String] a
logNumber x = writer (x, ["Got nummber: "++ show x ++ " !"])

multWithLog :: Writer [String] Int
multWithLog = do
    xs <- mapM logNumber [1,2,3,4,5]

    return $ foldr1 (*) xs


--combinations'' :: Int -> [a] -> Writer [String] [[a]]
--combinations'' 0 _  = writer ([[]], ["n = 0 now! Returning an empty list."])
--combinations'' n xs = do
--    y:xs' <- tails xs
--    ys    <- combinations'' (n-1) xs'
--    return ( writer ( (y:ys), ["returning from"] ) )


main = do
    gen <- newStdGen

    print $ combinations 3 "abcd"

    --print $ runWriter $ combinations'' 3 "abcde"