Learning Haskell with Ninety-Nine Problems

99-problems.hs

-- Ninety-Nine Haskell Problems

-- Problem 1
myLast :: [a] -> Maybe a
myLast []     = Nothing
myLast [x]    = Just x
myLast (_:xs) = myLast xs

-- Problem 2
myButLast :: [a] -> Maybe a
myButLast []      = Nothing
myButLast [_]     = Nothing
myButLast [x, _]  = Just x
myButLast (_:xs)  = myButLast xs

-- Problem 3
elementAt :: [a] -> Int -> Maybe a
elementAt [] _    = Nothing
elementAt (x:_) 1 = Just x
elementAt (_:xs) n
  | n < 1     = Nothing
  | otherwise = elementAt xs (n - 1)

-- Problem 4
myLength :: [a] -> Int
myLength []     = 0
myLength (_:xs) = 1 + myLength xs

-- Problem 5
myReverse :: [a] -> [a]
myReverse []     = []
myReverse (x:xs) = myReverse xs ++ [x]

-- Problem 6
myCompare :: (Eq a) => [a] -> [a] -> Bool
myCompare [] [] = True
myCompare (x:xs) (y:ys)
  | x == y      = myCompare xs ys
  | otherwise   = False
myCompare _ _   = False

isPalindrome :: (Eq a) => [a] -> Bool
isPalindrome xs = xs `myCompare` (myReverse xs)

-- Problem 7
data NestedList a = Elem a | List [NestedList a]

flatten :: NestedList a -> [a]
flatten (Elem x)  = [x]
flatten (List xs) = foldr (\x y -> flatten x ++ y) [] xs

-- Problem 8
compress :: (Eq a) => [a] -> [a]
compress [x, y]
  | x == y    = [x]
  | otherwise = [x, y]
compress (x:y:xs)
  | x == y    = compress (x:xs)
  | otherwise = x : compress (y:xs)
compress x = x

-- Problem 9
pack :: (Eq a) => [a] -> [[a]]
pack xs = foldr pack' [] xs
  where pack' x []     = [[x]]
        pack' x (y:ys) =
          if x == head y
            then (x:y):ys
            else ([x]:y:ys)

-- Problem 10
encode :: (Eq a) => [a] -> [(Int, a)]
encode []     = []
encode (x:xs) =
  let (first, rest) = span (== x) (x:xs)
    in (length first, x) : encode rest

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

encodeModified :: (Eq a) => [a] -> [ListItem a]
encodeModified = map encode' . encode
  where encode' (1, x) = Single x
        encode' (n, x) = Multiple n x

-- Problem 12
decodeModified :: [ListItem a] -> [a]
decodeModified = concatMap decode'
  where decode' (Single x)     = [x]
        decode' (Multiple n x) = replicate n x

decode :: [(Int, a)] -> [a]
decode = concatMap $ uncurry replicate

-- Problem 13
encodeDirect' :: (Eq a) => [a] -> [(Int, a)]
encodeDirect' = foldr encode' []
  where encode' x ((n, y):ys) | x == y = (n + 1, x):ys
        encode' x ys                   = (1, x):ys

encodeDirect :: (Eq a) => [a] -> [ListItem a]
encodeDirect = map convert' . encodeDirect'
  where convert' (1, x) = Single x
        convert' (n, x) = Multiple n x

-- Problem 14
dupli :: [a] -> [a]
dupli = concatMap $ replicate 2

-- Problem 15
repli :: [a] -> Int -> [a]
repli xs n = concat [replicate n x | x <- xs]

-- Problem 16
dropEvery :: [a] -> Int -> [a]
dropEvery xs n = [x | (x, i) <- zip xs $ cycle [1..n], i /= n]

-- Problem 17
split :: [a] -> Int -> ([a], [a])
split (x:xs) n | n > 0 = let (f, s) = split xs (n - 1) in (x:f, s)
split xs _             = ([], xs)

-- Problem 18
slice :: [a] -> Int -> Int -> [a]
slice xs i j = [x | (x, k) <- zip xs [1..j], k >= i]

-- Problem 19
rotate :: [a] -> Int -> [a]
rotate xs n
  | n >= 0    = drop n xs ++ take n xs
  | otherwise = reverse $ rotate (reverse xs) (-n)

-- Problem 20
removeAt :: Int -> [a] -> (a, [a])
removeAt n xs = (xs !! (n - 1), take (n - 1) xs ++ drop n xs)

-- Problem 21
insertAt :: a -> [a] -> Int -> [a]
insertAt x xs n = take (n - 1) xs ++ (x : drop (n - 1) xs)

-- Problem 22
range :: (Enum a, Ord a) => a -> a -> [a]
range x y
  | x < y     = x : range (succ x) y
  | x > y     = x : range (pred x) y
  | otherwise = [x]

-- Problem 23 (TODO)

-- Problem 24 (TODO)

-- Problem 25 (TODO)

-- Problem 26
combinations :: Int -> [a] -> [[a]]
combinations 0 _      = [[]]
combinations 1 xs     = map (:[]) xs
combinations n (x:xs) = map (x:) (combinations (n - 1) xs) ++ combinations n xs
combinations _ []     = []