h-99-1-10.hs

-- http://www.haskell.org/haskellwiki/99_questions/1_to_10

import Test.Hspec
import Control.Monad

main = do
  hspec $ forM_ (zip [1..] specs) $ \(n,s) ->
    describe ("Problem " ++ show n ++ ":") s

specs = [myLastSpec
        ,myButLastSpec
        ,elementAtSpec
        ,myLengthSpec
        ,myReverseSpec
        ,isPalindromeSpec
        ,flattenSpec
        ,compressSpec
        ,packSpec
        ,encodeSpec]

-- 1 Problem 1
-- (*) Find the last element of a list.

-- (Note that the Lisp transcription of this problem is incorrect.)

-- Example in Haskell:

-- Prelude> myLast [1,2,3,4]
-- 4
-- Prelude> myLast ['x','y','z']
-- 'z'

myLast :: [a] -> a
myLast = head' . reverse'

head' :: [a] -> a
head' []    = error "empty list"
head' (x:_) = x
reverse' :: [a] -> [a]
reverse' = foldl' (flip' (:)) []
foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' _ acc []     = acc
foldl' f acc (x:xs) = foldl' f (f acc x) xs
flip' :: (a -> b -> c) -> (b -> a -> c)
flip' f = (\x y -> f y x)

myLastSpec :: Spec
myLastSpec = do
  describe "myLast" $ do
    it "Find the last element of a list" $ do
      myLast [1,2,3,4] `shouldBe` 4
      myLast ['x','y','z'] `shouldBe` 'z'

-- 2 Problem 2
-- (*) Find the last but one element of a list.

-- (Note that the Lisp transcription of this problem is incorrect.)

-- Example in Haskell:

-- Prelude> myButLast [1,2,3,4]
-- 3
-- Prelude> myButLast ['a'..'z']
-- 'y'

myButLast :: [a] -> a
myButLast = head . tail' . reverse

tail' :: [a] -> [a]
tail' []     = error "empty list"
tail' (x:xs) = xs

myButLastSpec :: Spec
myButLastSpec = do
  describe "myButLast" $ do
    it "Find the last but one element of a list" $ do
      myButLast [1,2,3,4] `shouldBe` 3
      myButLast ['a'..'z'] `shouldBe` 'y'

-- 3 Problem 3
-- (*) Find the K'th element of a list. The first element in the list is number 1.

-- Example:

-- * (element-at '(a b c d e) 3)
-- c
-- Example in Haskell:

-- Prelude> elementAt [1,2,3] 2
-- 2
-- Prelude> elementAt "haskell" 5
-- 'e'

elementAt :: [a] -> Int -> a
elementAt xs n = xs `elmAt` (n-1)

-- my !!
elmAt :: [a] -> Int -> a
elmAt []     n = error "out of bounds"
elmAt _      n
  | n <  0     = error "negative index"
elmAt (x:xs) n
  | n == 0     = x
  | otherwise  = xs `elmAt` (n-1)

elementAtSpec :: Spec
elementAtSpec = do
  describe "elementAt" $ do
    it "Find the K'th element of a list. The first element in the list is number 1" $ do
      elementAt [1,2,3] 2 `shouldBe` 2
      elementAt "haskell" 5 `shouldBe` 'e'

-- 4 Problem 4
-- (*) Find the number of elements of a list.

-- Example in Haskell:

-- Prelude> myLength [123, 456, 789]
-- 3
-- Prelude> myLength "Hello, world!"
-- 13

myLength = foldl' (\acc _ -> acc + 1) 0

myLengthSpec :: Spec
myLengthSpec = do
  describe "myLength" $ do
    it "Find the number of elements of a list" $ do
      myLength [123, 456, 789] `shouldBe` 3
      myLength "Hello, world!" `shouldBe` 13

-- 5 Problem 5
-- (*) Reverse a list.

-- Example in Haskell:

-- Prelude> myReverse "A man, a plan, a canal, panama!"
-- "!amanap ,lanac a ,nalp a ,nam A"
-- Prelude> myReverse [1,2,3,4]
-- [4,3,2,1]

myReverse :: [a] -> [a]
myReverse = reverse'

myReverseSpec :: Spec
myReverseSpec = do
  describe "myReverse" $ do
    it "Reverse a list" $ do
      myReverse "A man, a plan, a canal, panama!" `shouldBe` "!amanap ,lanac a ,nalp a ,nam A"
      myReverse [1,2,3,4] `shouldBe` [4,3,2,1]

-- 6 Problem 6
-- (*) Find out whether a list is a palindrome. A palindrome can be read forward or backward; e.g. (x a m a x).

-- Example in Haskell:

-- *Main> isPalindrome [1,2,3]
-- False
-- *Main> isPalindrome "madamimadam"
-- True
-- *Main> isPalindrome [1,2,4,8,16,8,4,2,1]
-- True

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

isPalindromeSpec :: Spec
isPalindromeSpec = do
  describe "isPalindrome" $ do
    it "Find out whether a list is a palindrome. A palindrome can be read forward or backward; e.g. (x a m a x)." $ do
      isPalindrome [1,2,3] `shouldBe` False
      isPalindrome "madamimadam" `shouldBe` True
      isPalindrome [1,2,4,8,16,8,4,2,1] `shouldBe` True

-- 7 Problem 7
-- (**) Flatten a nested list structure.

-- Transform a list, possibly holding lists as elements into a `flat' list by replacing each list with its elements (recursively).

-- Example:

-- * (my-flatten '(a (b (c d) e)))
-- (A B C D E)
-- Example in Haskell:

-- We have to define a new data type, because lists in Haskell are homogeneous.

--  data NestedList a = Elem a | List [NestedList a]
-- *Main> flatten (Elem 5)
-- [5]
-- *Main> flatten (List [Elem 1, List [Elem 2, List [Elem 3, Elem 4], Elem 5]])
-- [1,2,3,4,5]
-- *Main> flatten (List [])
-- []

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

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

flattenSpec :: Spec
flattenSpec = do
  describe "flatten" $ do
    it "Flatten a nested list structure" $ do
      flatten (Elem 5) `shouldBe` [5]
      flatten (List [Elem 1, List [Elem 2, List [Elem 3, Elem 4], Elem 5]]) `shouldBe` [1,2,3,4,5]
      flatten ((List []) :: NestedList ()) `shouldBe` []

-- 8 Problem 8
-- (**) Eliminate consecutive duplicates of list elements.

-- If a list contains repeated elements they should be replaced with a single copy of the element. The order of the elements should not be changed.

-- Example:

-- * (compress '(a a a a b c c a a d e e e e))
-- (A B C A D E)
-- Example in Haskell:

-- > compress "aaaabccaadeeee"
-- "abcade"

compress :: Eq a => [a] -> [a]
compress = map' head' . group'

map' :: (a -> b) -> [a] -> [b]
map' _ []     = []
map' f (x:xs) = f x: map' f xs
group' :: Eq a => [a] -> [[a]]
group' [] = []
group' all@(x:_) =
  let set  = takeWhile' (==x) all
      rest = dropWhile' (==x) all
  in  set : group' rest
takeWhile' :: Eq a => (a -> Bool) -> [a] -> [a]
takeWhile' _ [] = []
takeWhile' p (x:xs)
  | p x       = x : takeWhile' p xs
  | otherwise = []
dropWhile' :: Eq a => (a -> Bool) -> [a] -> [a]
dropWhile' _ [] = []
dropWhile' p all@(x:xs)
  | p x       = dropWhile' p xs
  | otherwise = all

compressSpec :: Spec
compressSpec = do
  describe "compress" $ do
    it "Eliminate consecutive duplicates of list elements." $ do
      compress "aaaabccaadeeee" `shouldBe` "abcade"

-- 9 Problem 9
-- (**) Pack consecutive duplicates of list elements into sublists. If a list contains repeated elements they should be placed in separate sublists.

-- Example:

-- * (pack '(a a a a b c c a a d e e e e))
-- ((A A A A) (B) (C C) (A A) (D) (E E E E))
-- Example in Haskell:

-- *Main> pack ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a',
--              'a', 'd', 'e', 'e', 'e', 'e']
-- ["aaaa","b","cc","aa","d","eeee"]

pack :: Eq a => [a] -> [[a]]
pack = group'

packSpec :: Spec
packSpec = do
  describe "pack" $ do
    it "Pack consecutive duplicates of list elements into sublists. If a list contains repeated elements they should be placed in separate sublists." $ do
      pack ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e', 'e'] `shouldBe` ["aaaa","b","cc","aa","d","eeee"]

-- 10 Problem 10
-- (*) Run-length encoding of a list. Use the result of problem P09 to implement the so-called run-length encoding data compression method. Consecutive duplicates of elements are encoded as lists (N E) where N is the number of duplicates of the element E.

-- Example:

-- * (encode '(a a a a b c c a a d e e e e))
-- ((4 A) (1 B) (2 C) (2 A) (1 D)(4 E))
-- Example in Haskell:

-- encode "aaaabccaadeeee"
-- [(4,'a'),(1,'b'),(2,'c'),(2,'a'),(1,'d'),(4,'e')]

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

encodeSpec :: Spec
encodeSpec = do
  describe "encode" $ do
    it "Run-length encoding of a list. Use the result of problem P09 to implement the so-called run-length encoding data compression method. Consecutive duplicates of elements are encoded as lists (N E) where N is the number of duplicates of the element E." $ do
      encode "aaaabccaadeeee" `shouldBe` [(4,'a'),(1,'b'),(2,'c'),(2,'a'),(1,'d'),(4,'e')]