Ninety-nine Haskell problem (translated from Scheme)

Nnhp.hs

------------------------------------------------------
------------------------------------------------------
-- Ninety-nine Haskell problems
-- KEDJI Komlan Akpédjé <eric.kedji@gmail.com> 
-- http://erickedji.wordpress.com/ 
-- PHD student at IRIT (Toulouse, FRANCE)
-- 
-- Based on 'Ninety-nine Lisp Problems' 
-- (www.ic.unicamp.br/~meidanis/courses/ 
-- mc336/2006s2/funcional/ 
-- L-99_Ninety-Nine_Lisp_Problems.html),
-- based itself on 'Ninety-nine Prolog
-- problems, by werner.hett@hti.bfh.ch 
-- 
-- Stars after problem numbers represent the 
-- difficulty level.
-- In the solution, I try to use the most
-- idiomatic Haskell I'm aware of, so free
-- feel to flame me if something looks wrong.
------------------------------------------------------
------------------------------------------------------
-- 
module Nnhp where

import Data.List
import Control.Arrow
--
------------------------------------------------------
-- Manipulation de listes 
------------------------------------------------------
-- 
------------------------------------------------------
--
-- P01 (*) Trouver la dernière cellule d'une liste.
-- Exemple:
-- * (my-last '(a b c d))
-- (d)
------------------------------------------------------
-- 
-- La dernière cellule d'une liste à 1|0 élément est la liste elle même.
-- La dernière cellule d'une liste à plus d'un élément est identique à
-- la dernière cellule de son cdr
myLast :: [a] -> [a]
myLast [] = []
myLast [x] = [x]
myLast (x:xs) = myLast xs
--(define (my-last liste)
--  (if (or (null? liste)
--          (null? (cdr liste)))
--      liste
--      (my-last (cdr liste))))
-- 
--(my-last '(a b c d))
-- 
------------------------------------------------------
--
-- P02 (*) Trouver l'avant dernière cellule d'une liste.
-- Exemple:
-- * (my-but-last '(a b c d))
-- (c d)
------------------------------------------------------
-- 
myButLast :: [a] -> [a]
myButLast [] = []
myButLast [x] = [x]
myButLast [x, y] = [x, y]
myButLast (x:xs) = myButLast xs
--(define (my-but-last liste)
--  (if (or (null? liste)
--          (null? (cdr liste))
--          (null? (cddr liste)))
--      liste
--      (my-but-last (cdr liste))))
-- 
--(my-but-last '(a b c d))
-- 
------------------------------------------------------
--
-- P03 (*) Trouver le Kieme élément d'une liste.
-- Le premier élément de la liste porte le numéro 1
-- Exemple:
-- * (element-at '(a b c d e) 3)
-- c
------------------------------------------------------
-- 
-- L'élément à la position 1 dans une liste est le car
-- L'élément à la position k dans une liste est à la position k-1
-- dans son cdr
elementAt :: [a] -> Int -> a
elementAt (x:xs) 1 = x
elementAt (x:xs) n = elementAt xs (n-1)
-- Note: In Haskell, the indexing operator is `!!', so this is
-- better written: elementAt list n = list !! (n - 1)
--(define (element-at liste numero)
--  (if (= 1 numero)
--      (car liste)
--      (element-at (cdr liste) (- numero 1))))
-- 
--(element-at '(a b c d e) 3)
-- 
------------------------------------------------------
--
-- P04 (*) Trouver le nombre d'éléments d'une liste.
-- * (number-of-elements '(1 2 3 4))
-- 4
-- * (number-of-elements '(1 (2 3) 4))
-- 3
------------------------------------------------------
-- 
numberOfElements :: [a] -> Int
numberOfElements = foldr (\ x -> (+) 1) 0 
-- Note:
--  * using the prelude: numberOfElements = length
--  * with a left fold, the accumulator should be
--    uncurried, that is:
--  numberOfElements = foldl' (\ n x -> x + 1) 0
--    or it must be flipped:
--  numberOfElements = foldl' (flip (\ x -> (+) 1)) 0
--    but the latter is less readable.
--  * what about: numberOfElements = sum . map (\ x -> 1)
--
--(define (number-of-elements liste)
--  (if (null? liste)
--      0
--      (+ 1 (number-of-elements (cdr liste)))))
-- 
--(number-of-elements '(a b h j (k t) l l j))
-- 
-- Version iterative (c'est une technique générale pour
-- transformer la récursivité non-terminale en récusivité
-- terminale (tail-recursion))
-- Au lieu de laisser les appels récursifs construire le résultat,
-- on accumule explicitement le résultat dans un paramètre.
-- Tout comme les boucles classiques dans les langages impératifs.
-- 
-- In Haskell, foldl' sidesteps the languages laziness (by 
-- eager evaluation of the args to the combinator function),
-- and compiles down to an imperative loop.
numberOfElementsIter :: [a] -> Int
numberOfElementsIter = foldl' (\ n x -> n + 1) 0
--(define (number-of-elements2 liste)
--  (define (noe-iter reste-liste count)
--    (if (null? reste-liste)
--        count
--        (noe-iter (cdr reste-liste) (+ 1 count))))
--  (noe-iter liste 0))
-- 
--(number-of-elements2 '(a b (c ge f) d e))
-- 
-- compter le nombre d'atomes (ie le nombre
-- d'éléments qui ne sont pas des paires)
-- * (number-of-atoms '(1 (2 3) 4)
-- 4
-- * (number-of-atoms '(1 (2 . 3) 4)
-- 4
-- * (number-of-atoms '(1 2 3 (4 5 6 . 7) 8))
-- 8
--
-- Haskell's static typing does not allow to mix
-- atoms and lists in the same list, so I guess
-- this exercice does not apply. I'll return to 
-- it if there is future contrary evidence
--
--(define (number-of-atoms liste)
--  (define (atom? x) (not (pair? x)))
--  (define (notnull? x) (not (null? x)))
--  (if (null? liste)
--      0
--      (let ((tete (car liste))
--            (queue (cdr liste)))
--        (+ (if (atom? tete)
--               1
--               (number-of-atoms tete))
--           (if (and (atom? queue) (notnull? queue)) ; une paire: (a . b)
--               1
--               (number-of-atoms (cdr liste)))))))
-- 
--(number-of-atoms '(a b h j (k t) l l (e (e) (a b) j))) ; => 13
--(number-of-atoms '(1 2 (3 4 . 5) 6)) ; => 6
-- 
------------------------------------------------------
--
-- P05 (*) Inverser l'ordre des éléments d'une liste.
-- * (my-reverse '(1 2 3))
-- (3 2 1)
-- * (my-reverse '(1 (2 3) 4))
-- (4 (2 3) 1)
------------------------------------------------------
-- 
myReverse :: [a] -> [a]
myReverse = foldl' (flip (:)) []
-- Note: using the prelude: myReverse = reverse
--(define (my-reverse liste)
--  (if (null? liste)
--      '()
--      (append (my-reverse (cdr liste))
--              (list (car liste)))))
-- 
-- par accumulation
-- - copier en tête de la liste source
-- - coller en tête de la liste cible
--
-- No difference, Haskell is a lazy beast.
--
--(define (my-reverse2 liste)
--  (define (mr-iter reste-liste result)
--    (if (null? reste-liste)
--        result
--        (mr-iter (cdr reste-liste)
--                 (cons (car reste-liste) result))))
--  (mr-iter liste '()))
-- 
--(my-reverse '(s ff k h (k l) l t))
--(my-reverse2 '(s ff k h (k l) l t))
-- 
-- deep-reverse: inverser l'ordre dans les sous-listes
-- aussi (récursivement). Toutes les listes sont garanties
-- se terminer par nil (ie par de dotted pair du style (... a . b))
-- * (deep-reverse '(a (b c) d))
-- (d (c b) a)
-- 
-- Not interresting in the case of Haskell, as we know up front
-- the type of the elements in the list.
--
--(define (deep-reverse liste)
--  (cond ((null? liste) '())
--        ((null? (cdr liste)) (if (not (list? (car liste)))
--                                 liste
--                                 (list (deep-reverse (car liste)))))
--        (else (append (deep-reverse (cdr liste))
--                      (deep-reverse (list (car liste)))))))
-- 
--(deep-reverse '(1 2 (3 4) 5 (6 (7 8 (9)) 10) 11))
------------------------------------------------------
--
-- P06 (*) Déterminer si une liste est palindrome.
-- Un palindrome peut être lu aussi bien d'avant en arrière que
-- d'arrière en avant, comme (x a m a x).
------------------------------------------------------
--
-- I start using type-inference. Also note how the definition is 
-- succinct and uncluttered, compared to scheme. +1 for Haskell!
isPalindrome list = list == reverse list
--
--(define (is-palindrome liste)
--  (equal? liste (reverse liste)))
-- 
--(is-palindrome '(x (a b) a m a (a b) x))
-- 
------------------------------------------------------
--
-- P07 (**) Aplatir une structure de listes imbriquées.
-- Transformer une liste, contenant potentiellement des listes
-- comme éléments en une liste 'plate', en remplaçant chaque
-- liste par ses éléments (récursivement).
--
-- Exemple:
-- * (my-flatten '(a (b (c d) e)))
-- (a b c d e)
--
-- Indication: Utiliser les fonctions prédéfinies list et append.
------------------------------------------------------
-- Not really challenging, in Haskell, as the closer you can get
-- is to flatten a list of lists of <a>s which is trivial.
-- Note that whenever we repeat an argument verbatim in
-- the body of a function, we should instead use composition. In
-- academic parlance, this is called an "Eta reduce".
-- flattenIntListsList list = foldl (++) [] list
flattenList = foldl (++) []
-- Note: using the prelude: flattenList = concat
-- 
--(define (my-flatten liste)
--  (if (null? liste)
--      '()
--      (append (if (list? (car liste))
--                  (my-flatten (car liste))
--                  (list (car liste)))
--              (my-flatten (cdr liste)))))
-- 
--(my-flatten '(a (b (c d) e)))
-- 
------------------------------------------------------
--
-- P08 (**) Eliminer les répétitions consécutives dans une liste.
-- Si une liste contient des éléments répétés (consécutifs),
-- les remplacer par une seule copie. L'ordre des éléments
-- ne doit pas être modifié.
--
-- Exemple:
-- * (compress '(a a a a b c c a a d e e e e))
-- (a b c a d e)
------------------------------------------------------
-- 
-- Notice the "Eq a" used as the context for the type
-- signature for compress: equality must be defined
-- for the list elements.
compress :: Eq a => [a] -> [a]
compress [] = []
compress (x:xs) = x : compress (dropWhile (== x) xs)
-- Note: a more basic version, without `dropWhile'
--  compress :: Eq a => [a] -> [a]
--  compress [] = []
--  compress [x] = [x]
--  compress (y:x:xs) 
--    | x == y    = compress (x:xs)
--    | otherwise = y : compress (x:xs)
--
--(define (compress liste)
--  (if (or (null? liste) (null? (cdr liste)))
--      liste
--      (let ((compressed-cdr (compress (cdr liste))))
--        (if (equal? (car liste) (car compressed-cdr))
--            compressed-cdr
--            (cons (car liste) compressed-cdr)))))
-- 
--(compress '(a a a a b (c c) (c c) (a b) (a b) a a d e e e e))
-- 
-- Proper tail-recursive version
-- 
-- The Haskell version serves only to illustrate the use of
-- `where' (forward declaration)
compressAcc :: Eq a => [a] -> [a]
compressAcc list = reverse (compressAccHelper list [])
  where
    compressAccHelper [] compressedList = compressedList
    compressAccHelper (x:xs) [] = compressAccHelper xs [x]
    compressAccHelper (x:xs) (y:ys)
      | x == y = compressAccHelper xs (y:ys)
      | otherwise = compressAccHelper xs (x:y:ys)
--(define (iterative-compress liste)
--  (define (ic-helper reste-liste reversed-result)
--    (if (null? reste-liste)
--        reversed-result
--        (if (equal? (car reste-liste) (car reversed-result))
--            (ic-helper (cdr reste-liste) reversed-result)
--            (ic-helper (cdr reste-liste)
--                    (cons (car reste-liste) reversed-result)))))
--  (reverse (ic-helper (cdr liste) (list (car liste)))))
-- 
--(iterative-compress '(a a a a b (c c) (a b) (a b) a a d e e e e))
-- 
------------------------------------------------------
--
-- P09 (**) Regrouper les répétitions consécutives d'éléments d'une
-- liste en des sous-listes
--
-- Exemple:
-- * (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))
------------------------------------------------------
-- 
pack :: Eq a => [a] -> [[a]]
pack [] = []
pack list@(x:xs) = [takeWhile (== x) list] ++ pack (dropWhile (== x) xs)
-- (I love how the last line reads as english)
-- Note: more verbose version, illustrates the use of `case ... of'
--  pack :: Eq a => [a] -> [[a]]
--  pack [] = []
--  pack [x] = [[x]]
--  pack (x:xs) =
--    let packedTail = pack xs in
--      case packedTail of
--        (list@(y:ys):lists) ->
--          if y == x
--            then (x:y:ys):lists
--            else [x]:list:lists
--
--(define (pack liste)
--  (if (null? liste)
--      (list liste) ; cas trivial
--      (let ((packed-cdr (pack (cdr liste))))
--        (cond ((null? (car packed-cdr)) ; packed-cdr provient du cas trivial
--               (list (list (car liste))))
--              ((equal? (car liste) (caar packed-cdr)) ; même élément: ajout à la sous-liste
--               (cons (cons (car liste)
--                           (car packed-cdr))
--                     (cdr packed-cdr)))
--              (else (cons (list (car liste)) ; nouvel élément: nouvelle sous-liste
--                          packed-cdr))))))
-- 
--(pack '(a a a a b c c a a d e (e) (e) e))
-- 
------------------------------------------------------
--
-- P10 (*) Compression d'une liste par `run-length encoding'
-- Utiliser le résultat du problème P09 to implémenter la
-- technique de compression de données connue sous le nom
-- de run-length encoding. Les répétitions consécutives
-- d'éléments sont codés en listes de la forme (N E), où
-- N est le nombre de répétitions de l'élément E.
--
-- Exemple:
-- * (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))
------------------------------------------------------
-- 
-- Note the function composition. map is curried, to yield
-- a function expecting only the list (as the transformer 
-- is already given). The resulting function is composed
-- with pack, so as to pack the list given to encode, prior
-- to the mapping.
-- Hard to read for the beginner, but a known pattern for 
-- the seasoned haskeller.
-- (I love how encode in Haskell reads as english)
encode :: Eq a => [a] -> [(Int, a)]
encode = map (length &&& head) . pack
-- with parens for added clarity: (map (length &&& head)) . pack
-- same as: encode = map (\ lst -> (length lst, head lst)) . pack
--
--(define (encode liste)
--  (define (encode-helper packed-list)
--    (if (null? packed-list)
--        '()
--        (cons (list (length (car packed-list))
--                    (caar packed-list))
--              (encode-helper (cdr packed-list)))))
--  (encode-helper (pack liste)))
-- 
--(encode '(a a a a b c c a a d e e e e))
-- 
------------------------------------------------------
--
-- P11 (*) Amélioration de run-length encoding.
-- Modifier le résultat du problème P10, de telle sorte que les
-- éléments non dupliqués soient tout simplement copiés. Seuls les
-- éléments dupliqués sont mis sous la forme (N E).
--
-- Exemple:
-- * (encode-modified '(a a a a b c c a a d e e e e))
-- ((4 a) b (2 c) (2 a) d (4 e))
------------------------------------------------------
--
-- Inapplicable à Haskell (fort typage)
--
--(define (encode-modified liste)
--  (define (simplify encoded-list)
--    (if (null? encoded-list)
--        '()
--        (cons (if (= 1 (caar encoded-list))
--                  (cadar encoded-list)
--                  (car encoded-list))
--              (simplify (cdr encoded-list)))))
--  (simplify (encode liste)))
-- 
--(encode-modified '(a a a a b c c a a d e e e e))
-- 
------------------------------------------------------
--
-- P12 (**) Decoder une liste compressée par run-length encoding.
-- Etant donné une liste compressée comme spécifié dans le
-- le problème P11, retrouver la liste originale.
------------------------------------------------------
-- 
-- For Haskell, we suppose the list is encoded with P10
--
decodeRl :: [(Int, a)] -> [a]
decodeRl list = concat (map expand list)
  where
    expand tuple = replicate (fst tuple) (snd tuple)
-- as readable as it gets; compare to this verbose version:
--  decodeRl :: [(Int, a)] -> [a]
--  decodeRl list = foldl (++) [] (map expand list)
--    where
--      expand :: (Int, a) -> [a]
--      expand (1, x) = [x]
--      expand (n, x) = x : expand (n-1, x)
--
--(define (decode-rl encoded-list)
--  (define (expand element count)
--    (if (= count 0)
--        '()
--        (cons element
--              (expand element (- count 1)))))
--  (cond ((null? encoded-list) '())
--        ((not (list? (car encoded-list)))
--         (append (list (car encoded-list))
--                 (decode-rl (cdr encoded-list))))
--        (else (append (expand (cadar encoded-list)
--                              (caar encoded-list))
--                      (decode-rl (cdr encoded-list))))))
-- 
--(decode-rl (encode-modified '(a a a a b c c a a d e e e e)))
-- 
------------------------------------------------------