練習解 Haskell 99 題目。 http://www.haskell.org/haskellwiki/99_questions

99Q.hs

{-# LANGUAGE TemplateHaskell #-} 

import Test.QuickCheck
import Test.QuickCheck.All

{-
  Problem 01 
  
  Find the last element of a list.

  Result:
  > solution01 [1,2,3,4]
  4

-}
solution01 :: [a] -> a
solution01 (x:[]) = x
solution01 (_:xs) = solution01 xs

prop_solution01 xs = not( null xs ) ==> solution01 xs == last xs

{- 
  Problem 02

  Find the last but one element of a list.

  Result:
  > solution02 [1,2,3,4]
  3

-}
solution02 :: [a] -> a
solution02 (x:[_]) = x
solution02 (_:xs) = solution02 xs

prop_solution02 xs = ( length xs ) > 1 ==> solution02 xs == last (init xs)

{- 
  Problem 03

  Find the K'th element of a list. The first element in the list is number 1.

  Result:
  >elementAt [1,2,3] 2
  2

-}
solution03 :: [a] -> Int -> a
solution03 list i = list !! (i-1)

prop_solution03 xs i = (length xs >= i) && (i > 0)  ==> solution03 xs i == (xs !! (i-1))

{-
  Problem 04

  Find the number of elements of a list.  

  Exmaple:
  > solution04 [123, 456, 798]
  3

-}
solution04 :: [a] -> Int
solution04 = foldr (\_ n-> n+1 ) 0

prop_solution04 xs = solution04 xs == length xs

{-
  Problem 05

  Reverse a list.

  Exmaple:
  > solution05 [1,2,3,4]
  [4,3,2,1]

-}
solution05 :: [a] -> [a]
solution05 = foldl (flip(:)) []

prop_solution05 xs = solution05 xs == reverse xs

{-
  Problem 06

  Find out whether a list is a palindrome. 
  A palindrome can be read forward or backward; e.g. (x a m a x).
  
  Example:
  > solution06 [1,2,4,8,16,8,4,2,1]
  True

-}
solution06 :: Eq a => [a] -> Bool
solution06 list = list == reverse list

prop_solution06 xs = solution06 xs == (xs == reverse xs)

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

  Example:
  > solution07 (Elem 5)
  [5]
  > solution07 (List [Elem 1, List [Elem 2, List [Elem 3, Elem 4], Elem 5]])
  [1,2,3,4,5]
  > solution07 (List [])
  []
  
-}
data NestedList a = Elem a | List [NestedList a]
solution07 :: NestedList a -> [a]
solution07 (Elem a) = [a]
solution07 (List []) = []
solution07 (List (x:xs)) = solution07 x ++ solution07 (List xs)

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

  Example:
  > solution08 "aaaabccaadeeee"
  "abcade"

-}
solution08::[Char] -> [Char]
solution08 x = foldl (\a b -> if (last a) == b then a else a ++ [b]) [head x] x
      

{-
  Problem 09

  Pack consecutive duplicates of list elements into sublists. 
  If a list contains repeated elements they should be placed in separate sublists.

  Example:
  > solution09 ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e', 'e']
  ["aaaa","b","cc","aa","d","eeee"]

-}
solution09::Eq a => [a] -> [[a]]
solution09 x = foldl (\a b -> if take 1 (last a) == [b] then (init a) ++ [last a ++ [b]] else a ++ [[b]]) [[head x]] (tail x)


{-
  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:
  > solution10 "aaaabccaadeeee"
  [(4,'a'),(1,'b'),(2,'c'),(2,'a'),(1,'d'),(4,'e')]
  
-}
solution10::Eq a => [a] -> [(Int, a)]
solution10 xs = (enc . solution09) xs
  where enc = foldr (\x acc -> (length x, head x): acc) []

{-
  Problem 11 

  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.

  Example:
  > solution11 "aaaabccaadeeee"
  [Multiple 4 'a',Single 'b',Multiple 2 'c', Multiple 2 'a',Single 'd',Multiple 4 'e']

-}
data ElementType a = Multiple Int a | Single a deriving (Show)
solution11::Eq a => [a] -> [ElementType a]
solution11 = map enc . solution10
  where enc (1, x) = Single x
        enc (n, x) = Multiple n x

{-
  Problem 12

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

  Example:
  > solution12 [Multiple 4 'a',Single 'b',Multiple 2 'c',Multiple 2 'a',Single 'd',Multiple 4 'e']
  "aaaabccaadeeee"
  
-}
solution12::Eq a => [ElementType a] -> [a]
solution12 = concatMap decodeHelper
  where decodeHelper (Single x) = [x]
        decodeHelper (Multiple n x) = replicate n x

{-
  Problem 13

  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.

  Example:
  > solution13 "aaaabccaadeeee"
  [Multiple 4 'a',Single 'b',Multiple 2 'c', Multiple 2 'a',Single 'd',Multiple 4 'e']

-}
solution13'::Eq a => [a] -> [(Int, a)]
solution13' = foldr helper []
  where helper x [] = [(1, x)]
        helper x (y@(a, b):ys)
          | x == b = (1+a, b):ys
          | otherwise = (1,x):y:ys

solution13::Eq a => [a] -> [ElementType a]
solution13 = map encodeHelper . solution13'
  where encodeHelper (1, x) = Single x
        encodeHelper (n, x) = Multiple n x


{-
  Problem 14 

  Duplicate the elements of a list.

  Example:
  > solution14 [1, 2, 3]
  > [1,1,2,2,3,3]
-}
solution14::[a] -> [a]
solution14 = foldr (\x acc -> x:x:acc) []

{-
  Problem 15

  Replicate the elements of a list a given number of times.

  Example:
  > solution15 "abc" 3
  > "aabbcc"
-}
solution15::String -> Int-> String
solution15 xs n = foldr (\x acc -> repeated' x n ++ acc) [] xs
  where repeated' _ 0 = []
        repeated' x n = x: repeated' x (n-1)

{-
  Problem 16

  Drop every N'th element from a list.

  Example:
  > solution16 "abcdefghik" 3
  > ""abdeghk""
-}
solution16 :: String -> Int-> String
solution16 xs n = [c | (c, i)<- zip xs [1..], mod i n /= 0]


{-
  Problem 17

  Split a list into two parts; the length of the first part is given.

  Do not use any predefined predicates.

  Example:
  > solution17 "abcdefghik" 3
  > ("abc", "defghik")
-}
solution17::String -> Int -> (String,String)
solution17 [] _ = ([], [])
solution17 l@(x:xs) n
  | n > 0 = (x:ys, zs)
  | otherwise = ([], l)
  where (ys, zs) = solution17 xs (n-1)

{-
My first time solution:

solution17 xs n = helper' [] xs n 
  where helper' left right@(r:rs) n
          | n == 0 = (left, right)
          | otherwise = helper' (left ++ [r]) rs (n-1) 
-}

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

  Example:
  > solution18 ['a','b','c','d','e','f','g','h','i','k'] 3 7
  > "cdefg"
-}
solution18::[Char]->Int->Int->[Char]
solution18 [] _ _ = []
solution18 (x:xs) i j
  | i > 1 = solution18 xs (i-1) (j-1)
  | j < 1 = []
  | otherwise = x:solution18 xs (i-1) (j-1)

{-
My first time solution:

solution18 xs a b = keep' (drop' xs drop_n) keep_n
  where 
    (drop_n, keep_n) = (a-1, b-a+1)
    drop' (_:xs) n
      | n == 1 = xs
      | n > 1 = drop' xs (n-1)
    keep' (x:xs) n 
      | n == 0 = []
      | n > 0 = x : keep' xs (n-1) 

-}

{-
  Problem 19:

  Rotate a list N places to the left.

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

  Example:

  > solution19 ['a','b','c','d','e','f','g','h'] 3
  > "defghabc"
 
  > solution19 ['a','b','c','d','e','f','g','h'] (-2)
  > "ghabcdef"
-}
solution19::[Char]->Int->[Char]
solution19 [] _ = []
solution19 xs n = drop len xs ++ take len xs
  where len = n `mod` length xs

{-
  Problem 20:

  Remove the K'th element from a list.

  Example:

  > solution20 2 "abcd"
  > ('b',"acd")
-}
solution20::Int -> [Char]->(Char, [Char])
solution20 1 (x:xs) = (x, xs)
solution20 n (x:xs) = (l, x:r)
  where (l, r) = solution20 (n-1) xs
{-
solution20 n xs = (xs !! (n-1), take (n-1) xs ++ drop n xs)
-}

{-
First time solution:

solution20 n xs = (left xs, right xs)
  where 
    left = last.take n
    right xs = (init.take n) xs ++ (drop n) xs
-}

{-
  Problem 21:

  Insert an element at a given position into a list.

  Example:

  > solution21 'X' "abcd" 2
  > "aXbcd"
-}

solution21::Char->[Char]->Int->[Char]
solution21 c xs n = ls ++ [c] ++ rs
  where ls = take (n-1) xs
        rs = drop (n-1) xs
        
{-
  Main Block

  @author Donald Zhan
-}
main = do
  $quickCheckAll
  return []