Ninety-Nine Haskell problems (Haskell)

00_overview.md

My attempt to work through ninety-nine Haskell problems

http://www.haskell.org/haskellwiki/99_questions

01_to_10.hs

import Test.HUnit

main = runTestTT $ TestList [test01, test02, test03, test04, test05, test06, test08, test09, test10]

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

-- 01 Find the last element of a list.
myLast :: [a] -> a
myLast (x:[]) = x
myLast (x:xs) = myLast xs

test01 = TestCase $ do assertEqual "int list" 4 $ myLast [1,2,3,4]
                       assertEqual "string" 'z' $ myLast "xyz"

-- 02 Find the last but one element of a list.
myButLast :: [a] -> a
myButLast xs = xs !! ((length xs) - 2)

test02 = TestCase $ do assertEqual "int list" 3 $ myButLast [1,2,3,4]
                       assertEqual "string" 'y' $ myButLast "xyz"

-- 03 Find the K'th element of a list. The first element in the list is number 1.
elementAt :: [a] -> Int -> a
-- BUG: Indexes past the end of the list just return the last item :(
elementAt xs n = last $ take n xs

test03 = TestCase $ do assertEqual "int list" 2 $ elementAt [1,2,3] 2
                       assertEqual "string" 'e' $ elementAt "haskell" 5

-- 04 Find the number of elements of a list.
myLength :: [a] -> Integer
myLength [] = 0
myLength xs = foldl (\acc _ -> succ acc) 0 xs

test04 = TestCase $ do assertEqual "int list" 3 $ myLength [123, 456, 789]
                       assertEqual "string" 13 $ myLength "Hello, world!"

-- 05 Reverse a list.
myReverse :: [a] -> [a]
myReverse [] = []
myReverse (x:xs) = (myReverse xs) ++ [x]

test05 = TestCase $ do assertEqual "string" "!amanap ,lanac a ,nalp a ,nam A" $ myReverse "A man, a plan, a canal, panama!"
                       assertEqual "int list" [4,3,2,1] $ myReverse [1,2,3,4]

-- 06 Find out whether a list is a palindrome. A palindrome can be read forward or backward; e.g. (x a m a x).
isPalindrome :: Eq a => [a] -> Bool
isPalindrome xs = and $ zipWith (==) xs $ reverse xs

test06 = TestCase $ do assertEqual "int list not" False $ isPalindrome [1,2,3]
                       assertBool "string" $ isPalindrome "madamimadam"
                       assertBool "int list" $ isPalindrome [1,2,4,8,16,8,4,2,1]

{- 07
  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).

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

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

-- Let's not bother with this, since it makes little sense to flatten in Haskell.

{- 08
  (**) 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.
-}

compress :: Eq a => [a] -> [a]
compress xs = foldl (\acc i -> if null acc || i /= last acc then acc ++ [i] else acc) [] xs

test08 = TestCase $ do assertEqual "repeated strings" ["a","b","c","a","d","e"] $ compress ["a","a","a","a","b","c","c","a","a","d","e","e","e","e"]

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

pack :: Eq a => [a] -> [[a]]
pack xs = foldl pack' [] xs
  where pack' acc i = if null acc then [[i]]
                      else if i == last (last acc) then (init acc) ++ [(last acc) ++ [i]]
                      else acc ++ [[i]]

test09 = TestCase $ do assertEqual "repeated strings" ["aaaa","b","cc","aa","d","eeee"] $ pack "aaaabccaadeeee"


{- 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.
-}

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

test10 = TestCase $ do assertEqual "string" [(4,'a'),(1,'b'),(2,'c'),(2,'a'),(1,'d'),(4,'e')] $ encode "aaaabccaadeeee"

11_to_20.hs

import Test.HUnit

main = runTestTT $ TestList [test14, test15, test16, test17, test18, test19, test20]

-- http://www.haskell.org/haskellwiki/99_questions/11_to_20

{- 11
  (*) Modified run-length encoding.

  Modify the result of problem 10 in such a way that if an element has no duplicates it is simply copied into the result list. Only elements with duplicates are transferred as (N E) lists.

    encodeModified "aaaabccaadeeee"
[Multiple 4 'a',Single 'b',Multiple 2 'c', Multiple 2 'a',Single 'd',Multiple 4 'e']
-}

-- Doesn't translate into Haskell well

{- 12
  (**) Decode a run-length encoded list.

  Given a run-length code list generated as specified in problem 11. Construct its uncompressed version.

    decodeModified
           [Multiple 4 'a',Single 'b',Multiple 2 'c',
            Multiple 2 'a',Single 'd',Multiple 4 'e']
    #=> "aaaabccaadeeee"

-}

-- Doesn't translate into Haskell well

{- 13
  (**) Run-length encoding of a list (direct solution).

  Implement the so-called run-length encoding data compression method directly. I.e. don't explicitly create the sublists containing the duplicates, as in problem 9, but only count them. As in problem P11, simplify the result list by replacing the singleton lists (1 X) by X.

    encodeDirect "aaaabccaadeeee"
    #=> [Multiple 4 'a',Single 'b',Multiple 2 'c', Multiple 2 'a',Single 'd',Multiple 4 'e']
-}

-- Doesn't translate into Haskell well

{- 14
  (*) Duplicate the elements of a list.

    dupli [1, 2, 3]
    #=> [1,1,2,2,3,3]
-}

dupli :: [a] -> [a]
dupli = foldl (\acc x -> acc ++ [x, x]) []
-- Better would be foldr with x:x:acc, since that is cheaper than ++
dupli' :: [a] -> [a]
dupli' = foldr (\x acc -> x:x:acc) []

test14 = TestCase $ do assertEqual "dupli" [1,1,2,2,3,3] $ dupli [1, 2, 3]
                       assertEqual "dupli'" [1,1,2,2,3,3] $ dupli' [1, 2, 3]

{- 15
  (**) Replicate the elements of a list a given number of times.

    repli "abc" 3
    #=> "aaabbbccc"

-}
repli :: [a] -> Int -> [a]
repli xs n = foldl (\acc x -> acc ++ replicate n x) [] xs

test15 = TestCase $ do assertEqual "repli" "aaabbbccc" $ repli "abc" 3

{- 16
  (**) Drop every N'th element from a list.

    dropEvery "abcdefghik" 3
    #=> "abdeghk"
-}
dropEvery :: [a] -> Int -> [a]
dropEvery xs n = foldr helper [] $ zip xs [1..]
  where helper (x, i) acc = if i `mod` n == 0 then acc
                            else x:acc
-- better using cycle - saves on modding
dropEvery' :: [a] -> Int -> [a]
dropEvery' xs n = foldr helper [] $ zip xs $ cycle [1..n]
  where helper (x, i) acc = if i == n then acc
                            else x:acc

test16 = TestCase $ do assertEqual "dropEvery" "abdeghk" $ dropEvery "abcdefghik" 3
                       assertEqual "dropEvery'" "abdeghk" $ dropEvery' "abcdefghik" 3

{- 17
  (*) Split a list into two parts; the length of the first part is given.

  Do not use any predefined predicates.

    split "abcdefghik" 3
    #=> ("abc", "defghik")
-}
split :: [a] -> Int -> ([a], [a])
split xs n = foldr helper ([], []) $ zip xs [1..]
  where helper (x, i) (before, after) = if i <= n then (x:before, after)
                                        else (before, x:after)

test17 = TestCase $ do assertEqual "split" ("abc", "defghik") $ split "abcdefghik" 3

{- 18
  (**) Extract a slice from a list.

  Given two indices, i and k, the slice is the list containing the elements between
  the i'th and k'th element of the original list (both limits included).
  Start counting the elements with 1.

    slice ['a','b','c','d','e','f','g','h','i','k'] 3 7
    #=> "cdefg"
-}
slice :: [a] -> Int -> Int -> [a]
slice xs from to = foldr helper [] $ zip xs [1..]
  where helper (x, i) acc = if i >= from && i <= to then x:acc
                            else acc

slice' :: [a] -> Int -> Int -> [a]
slice' xs from to = drop (from - 1) $ take to xs

test18 = TestCase $ do assertEqual "slice" "cdefg" $ slice "abcdefghik" 3 7
                       assertEqual "slice'" "cdefg" $ slice' "abcdefghik" 3 7

{- 19
  (**) Rotate a list N places to the left.

  Hint: Use the predefined functions length and (++).

    rotate ['a','b','c','d','e','f','g','h'] 3
    #=> "defghabc"

    rotate ['a','b','c','d','e','f','g','h'] (-2)
    #=> "ghabcdef"

    rotate ['a','b','c','d','e','f','g','h'] 0
    #=> "abcdefgh"
-}
rotate :: [a] -> Int -> [a]
rotate xs 0 = xs
rotate xs n
  | n > 0 = let m = n `mod` len in drop m xs ++ take m xs
  | otherwise = rotate xs $ len + n
  where len = length xs

test19 = TestCase $ do let str = "abcdefgh"
                       assertEqual "rotate left" "defghabc" $ rotate str 3
                       assertEqual "rotate right" "ghabcdef" $ rotate str (-2)
                       assertEqual "rotate none" str $ rotate str 0
                       assertEqual "large rotate left" "defghabc" $ rotate str 11

{- 20
  (*) Remove the K'th element from a list.

    removeAt 2 "abcd"
    #=> ('b',"acd")
-}
removeAt :: Int -> [a] -> (a, [a])
removeAt n xs = foldr helper (undefined, []) $ zip [1..] xs
  where helper (i, x) (deleted, residue) = if i == n then (x, residue)
                                           else (deleted, x:residue)

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

test20 = TestCase $ do assertEqual "removeAt" ('b',"acd") $ removeAt 2 "abcd"
                       assertEqual "removeAt'" ('b',"acd") $ removeAt' 2 "abcd"

21_to_28.hs

import Test.HUnit
import Data.List (sortBy)
--import System.Random

{- 21
  Insert an element at a given position into a list.

    insertAt 'X' "abcd" 2
    #=> "aXbcd"
-}

insertAt :: a -> [a] -> Int -> [a]
insertAt x xs index = let n = index - 1 in take n xs ++ [x] ++ drop n xs

test21 = TestCase $ do assertEqual "at middle" "aXbcd" $ insertAt 'X' "abcd" 2
                       assertEqual "at start" "Xabcd" $ insertAt 'X' "abcd" 1
                       assertEqual "at empty" "X" $ insertAt 'X' "" 1
                       assertEqual "at end" "abcdX" $ insertAt 'X' "abcd" 5

{- 22
  Create a list containing all integers within a given range.

    range 4 9
    #=> [4,5,6,7,8,9]
-}
range :: Integer -> Integer -> [Integer]
range from to
  | from == to = [from]
  | from < to = from:range (from + 1) to
  | otherwise = from:range (from - 1) to

test22 = TestCase $ do assertEqual "ascending" [4,5,6,7,8,9] $ range 4 9
                       assertEqual "descending" [3,2,1,0,-1] $ range 3 (-1)
                       assertEqual "single" [4] $ range 4 4

{- 23
  Extract a given number of randomly selected elements from a list.

    rnd_select "abcdefgh" 3
    #=> "eda"
-}

--rnd_select :: [a]-> Integer -> [a]
--rnd_select xs 0 = []
-- Haven't the slightest bit of will left to jump through the Monad hoops needed here!
--rnd_select xs n = do let lastIndex = (length xs) - 1
--                     r <- randomRIO (0, lastIndex)
--                     return []

--test23 = TestCase $ do let str = "abcdefgh"
--                       assertEqual "empty list with no count" [] $ rnd_select str 0
--                       assertEqual "length is expected" 3 $ length $ rnd_select str 3
--                       assertBool  "contents are all elements of list" $ all (`elem` str) $ rnd_select str 3

{- 24 -}
-- More crazy monad pain

{- 25 -}
-- More crazy monad pain

{- 26
  (**) Generate the combinations of K distinct objects chosen from the N elements of a list

  In how many ways can a committee of 3 be chosen from a group of 12 people?
  We all know that there are C(12,3) = 220 possibilities
  (C(N,K) denotes the well-known binomial coefficients).
  For pure mathematicians, this result may be great.
  But we want to really generate all the possibilities in a list.

    combinations 3 "abcdef"
    #=> ["abc","abd","abe",...]
-}

combinations :: Int -> [a] -> [[a]]
combinations 0 xs = []
combinations n xs = [xs] -- Yeah, I haven't finished yet!

test26 = TestCase $ do let str = "abcdef"
                       assertEqual "None selected" [] $ combinations 0 str
                       assertEqual "All selected" [str] $ combinations 6 str
                       assertEqual "Some selected" ["ab","ac","bc"] $ combinations 2 "abc"

{- 27
  Group the elements of a set into disjoint subsets.

  a) In how many ways can a group of 9 people work in 3 disjoint subgroups of 2, 3 and 4 persons? Write a function that generates all the possibilities and returns them in a list.

  b) Generalize the above predicate in a way that we can specify a list of group sizes and the predicate will return a list of groups.

  Note that we do not want permutations of the group members; i.e. ((ALDO BEAT) ...) is the same solution as ((BEAT ALDO) ...). However, we make a difference between ((ALDO BEAT) (CARLA DAVID) ...) and ((CARLA DAVID) (ALDO BEAT) ...).

  You may find more about this combinatorial problem in a good book on discrete mathematics under the term "multinomial coefficients".

  P27> group [2,3,4] ["aldo","beat","carla","david","evi","flip","gary","hugo","ida"]
  [[["aldo","beat"],["carla","david","evi"],["flip","gary","hugo","ida"]],...]
  (altogether 1260 solutions)

  27> group [2,2,5] ["aldo","beat","carla","david","evi","flip","gary","hugo","ida"]
  [[["aldo","beat"],["carla","david"],["evi","flip","gary","hugo","ida"]],...]
  (altogether 756 solutions)
-}

{- 28
  Sorting a list of lists according to length of sublists

  a) We suppose that a list contains elements that are lists themselves.
     The objective is to sort the elements of this list according to their length.
     E.g. short lists first, longer lists later, or vice versa.

  lsort ["abc","de","fgh","de","ijkl","mn","o"]
  #=> ["o","de","de","mn","abc","fgh","ijkl"]

  b) Again, we suppose that a list contains elements that are lists themselves.
     But this time the objective is to sort the elements of this list according
     to their length frequency; i.e., in the default, where sorting is done
     ascendingly, lists with rare lengths are placed first, others with a
     more frequent length come later.

  lfsort ["abc", "de", "fgh", "de", "ijkl", "mn", "o"]
  #=> ["ijkl","o","abc","fgh","de","de","mn"]
-}
lsort :: [[a]] -> [[a]]
lsort xs = sortBy (\x y -> (length x) `compare` (length y)) xs

lfsort :: [[a]] -> [[a]]
lfsort xs = xs -- Er, yes, well.

test28a = TestCase $ do assertEqual "lsort" ["o","de","de","mn","abc","fgh","ijkl"] $ lsort ["abc","de","fgh","de","ijkl","mn","o"]
test28b = TestCase $ do assertEqual "lfsort" ["ijkl","o","abc","fgh","de","de","mn"] $ lfsort ["abc", "de", "fgh", "de", "ijkl", "mn", "o"]

--

main = runTestTT $ TestList [test21, test22, test26, test28a, test28b]

31_to_41.hs

import Test.HUnit

-- Arithmetic


-- 31 (**) Determine whether a given integer number is prime.

isPrime :: Int -> Bool
isPrime n
  | n <= 0 = error "Don't be a silly arse; can't have a non-positive prime!"
  | n == 1 = False
  | n == 2 = True
  | otherwise = not $ any (\x -> (n `mod` x) == 0) [2..half]
  where half = (n `div` 2)

test31 = TestCase $ do assertEqual "is a prime" True $ isPrime 7
                       assertEqual "not a prime" False $ isPrime 6
                       assertEqual "not a prime" False $ isPrime 2345
                       assertEqual "1" False $ isPrime 1
                       assertEqual "2" True $ isPrime 2
                       assertEqual "3" True $ isPrime 3

{- 32
  (**) Determine the greatest common divisor of two positive integer numbers.
  Use Euclid's algorithm => http://en.wikipedia.org/wiki/Euclidean_algorithm

  [myGCD 36 63, myGCD (-3) (-6), myGCD (-3) 6]
  [9,3,3]
-}

myGCD :: Int -> Int -> Int
myGCD a b = if b == 0 then abs a else myGCD b $ a `mod` b
-- Could have used a guard for that ;(

test32 = TestCase $ do assertEqual "positives" 9 $ myGCD 36 63
                       assertEqual "negatives" 3 $ myGCD (-3) (-6)
                       assertEqual "negative and positive" 3 $ myGCD (-3) 6

{- 33
  (*) Determine whether two positive integer numbers are coprime. Two numbers are coprime if their greatest common divisor equals 1.

  * coprime 35 64
  True
-}
coprime :: Int -> Int -> Bool
coprime a b = myGCD a b == 1

test33 = TestCase $ do assertEqual "Yep" True $ coprime 35 64
                       assertEqual "No" False $ coprime 3 6


{- 34
  (**) Calculate Euler's totient function phi(m).

  Euler's so-called totient function phi(m) is defined as the number of positive integers r (1 <= r < m) that are coprime to m.

  Example: m = 10: r = 1,3,7,9; thus phi(m) = 4. Note the special case: phi(1) = 1.


  totient 10
  4
-}

totient :: Int -> Int
totient 1 = 1
totient x = foldr (\y acc -> if (coprime x y) then acc + 1 else acc) 0 [1..(x - 1)]

test34 = TestCase $ do assertEqual "10" 4 $ totient 10
                       assertEqual "1" 1 $ totient 1
                       assertEqual "2" 1 $ totient 2
                       assertEqual "3" 2 $ totient 3

{- 35
  (**) Determine the prime factors of a given positive integer.
  Construct a flat list containing the prime factors in ascending order.

  primeFactors 315
  [3, 3, 5, 7]
-}

primeFactors :: Int -> [Int]
primeFactors x = [] -- unfinished

test35 = TestCase $ do assertEqual "315" [3, 3, 5, 7] $ primeFactors 315

--

main = runTestTT $ TestList [test31, test32, test33, test34, test35]

95_to_99.hs

import Test.HUnit

import Data.Char (digitToInt)
import Data.List (intercalate)

-- http://www.haskell.org/haskellwiki/99_questions/95_to_99

main = runTestTT $ TestList [test95]

{-
 Question 95
  (**) English number words

  On financial documents, like cheques, numbers must sometimes be written in full words. Example: 175 must be written as one-seven-five. Write a predicate full-words/1 to print (non-negative) integer numbers in full words.

  Example in Haskell:

  > fullWords 175
  one-seven-five
-}

fullWords :: Integer -> String
fullWords x = intercalate "-" $ map (intToString . digitToInt) $ show x
  where digitNames = ["zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"]
        intToString n = digitNames !! n

test95 = TestCase $ do assertEqual "Three digits" "one-seven-five" $ fullWords 175
                       assertEqual "Zero" "zero" $ fullWords 0