Solution example - haskell 99 problems

Main.hs

{-# LANGUAGE TypeApplications #-}
module Main where

import System.Random.MWC
import Control.Monad


main :: IO ()
main = undefined

-- 01
myLast :: [a] -> a
myLast []       = error "error: empty list."
myLast [x]      = x
myLast (_:y:xs) = myLast (y:xs)

-- 02
myButLast :: [a] -> a
myButLast []         = error "error: empty list"
myButLast [_]        = error "error: single element list"
myButLast [x,_]      = x
myButLast (_:y:z:xs) = myButLast (y:z:xs)

-- 03
elementAt :: [a] -> Int -> a
elementAt [] _     = error "error: out of range"
elementAt (x:_) 1  = x
elementAt (_:xs) n
  | n < 1 = error "error: out of range"
  | otherwise = elementAt xs (n-1)

elementAt' :: [a] -> Int -> a
elementAt' xs n
  | length xs < n = error "error: out of range"
  | otherwise = fst . last $ zip xs [1..n]

-- 04
myLength :: [a] -> Int
myLength = foldr (\_ x -> x + 1) 0

-- 05
myReverse :: [a] -> [a]
myReverse xs = myrev xs []
  where myrev [] zs     = zs
        myrev (y:ys) zs = myrev ys (y:zs)

-- 06
isPalindrome :: Eq a => [a] -> Bool
isPalindrome xs = reverse xs == xs

-- 07
data NestedList a = Elem a
    | List [NestedList a]

flatten :: NestedList a -> [a]
flatten (Elem x)        = [x]
flatten (List [])       = []
flatten (List (nl:nls)) = flatten nl ++ flatten (List nls)

-- 08
compress' :: Eq a => [a] -> [a]
compress' xs = go xs Nothing
  where go [] Nothing = []
        go [] (Just x) = [x]
        go (x:ys) Nothing = go ys (Just x)
        go (x:ys) (Just y)
          | x == y = go xs (Just y)
          | otherwise = y : go ys (Just x)

compress :: Eq a => [a] -> [a]
compress (x:ys@(y:_))
    | x == y    = compress ys
    | otherwise = x : compress ys
compress ys = ys

-- 09
pack :: Eq a => [a] -> [[a]]
pack = go []
  where go xs (a:b:as)
          | a == b = go (a:xs) (b:as)
          | otherwise = (a:xs) : go [] (b:as)
        go [] [a] = [[a]]
        go (x:xs) [a] = if x == a then [a:x:xs] else [x:xs,[a]]

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

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

encodeModified :: Eq a => [a] -> [Encoded a]
encodeModified = map (\(x,y) -> if x == 1 then Single y else Multiple x y) . encode

-- 12
decodeModified :: [Encoded a] -> [a]
decodeModified []                    = []
decodeModified (Single x : rest)     = x : decodeModified rest
decodeModified (Multiple n x : rest) = replicate n x ++ decodeModified rest

-- 13
encodeDirect :: Eq a => [a] -> [Encoded a]
encodeDirect xs = go xs 0 Nothing
  where go [] _ Nothing = []
        go [] n (Just x) = [sorm n x]
        go (x:ys) _ Nothing = go ys 1 (Just x)
        go (x:ys) n (Just y)
          | x == y = go xs (n+1) (Just y)
          | otherwise = sorm n y : go ys 1 (Just x)
        sorm n x = if n == 1 then Single x else Multiple n x

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

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

-- 16
dropEvery :: [a] -> Int -> [a]
dropEvery _ 0 = error "error: every 0 element"
dropEvery xs n = go xs 1
  where go [] _ = []
        go (x:ys) m
          | m == 0 = go ys ((m+1)`mod`n)
          | otherwise = x : go ys ((m+1)`mod`n)

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

-- 18
slice :: [a] -> Int -> Int -> [a]
slice xs l r = take (r-l+1) $ drop (l-1) xs

-- 19
rotate :: [a] -> Int -> [a]
rotate xs n = go (n `mod` length xs)
  where go m = drop m xs <> take m xs

-- 20
removeAt :: Int -> [a] -> [a]
removeAt _ [] = error "Too short list"
removeAt n (x:xs) = case n of
                  1 -> xs
                  _ -> x : removeAt (n-1) xs
                             
-- 21
insertAt :: a -> [a] -> Int -> [a]
insertAt y [] _ = [y]
insertAt y (x:xs) n = case n of
                        1 -> y:x:xs
                        _ -> x : insertAt y xs (n-1)
                               
-- 22
range :: Int -> Int -> [Int]
range n m
  | n > m = []
  | otherwise = n : range (n+1) m

-- 23
rndSelect :: [a] -> Int -> IO [a]
rndSelect xs n = do
  gen <- createSystemRandom
  rs <- forM [1..n] $ \_ -> uniformR @Int (1, n) gen
  return $ fmap (xs!!) rs