3. Consider the following recursive datatype, used to represent arthmetic expressions.

  data Expr
    = Number Int
    | Add Expr Expr

Now, implement a function

  adds :: Expr -> Int

that counts the number of additions in the tree.

Examples:

  Main> adds (Number 3)
  0

  Main> adds (Add (Number 7) (Add (Number 1) (Number 3)))
  2

4. Anna is writing a QuickCheck property involving the functions reverse and ++. She has written:

  prop_Reverse_Append :: [Int] -> [Int] -> Bool
  prop_Reverse_Append xs ys =
    reverse (xs ++ ys) == ...

But then she got stuck.

Can you help Anna by giving a Haskell expression you can write instead of the ... which makes the property correct? (It should be something different than the left-hand side of course.)

5. Write a function

  duplicateFile :: FilePath -> IO ()

which takes a file name as an argument, and creates a duplicate of that file, which is a copy of the file with the same contents, but with a different name. The name of the duplicate is the original name with the string "(copy)" attached at the end.

Example:

  Main> readFile "apa.txt"
  "abracadabra"

  Main> duplicateFile "apa.txt"

  Main> readFile "apa.txt(copy)"
  "abracadabra"

Hint:

Part II

Do not work on this part if you only want to get a 3 or a G!

If you want to get a 4, you have to do Part I, plus one of the following assignments.

If you want to get a 5 or a VG, you have to do Part I, plus both of the following assignments.

6. A "word snake" is a sequence of words where each word starts with the letter that the previous word ends with. An example is:

  hola  ahoy  yahoo  obrigado  okay

This is a word snake because "hola" ends with an "a" and "ahoy" starts with an "a"; "ahoy" ends with a "y" and "yahoo" starts with a "y"; etc.

One way to represent a word snake in Haskell is by a list of Strings:

  type Snake = [String]

Implement a function:

  snake :: [String] -> Snake

that, given a list of words, finds the longest word snake that can be built from using these words. ("Longest" refers to counting the number of words in a word snake.) Each word in the list can only be used once (and some words might never be used).

You may assume that (1) all given words are non-empty, and that (2) no word occurs more than once in the word-list.

Examples:

  Main> snake ["ahoy", "hola", "okay", "yahoo", "obrigado", "haskell"]
  ["hola","ahoy","yahoo","obrigado","okay"]

  Main> snake ["george","michael","jackson","eminem"]
  ["george","eminem","michael"]

You do not have to optimize your function for efficiency.

Hints: You may benefit from defining the following functions:

  -- build the longest snake that starts with a given letter
  snakeWith :: Char -> [String] -> Snake

  -- given a list of snakes, find the longest snake in the list
  longest :: [Snake] -> Snake

But you do not have to define or use these.

7. The HyperText Markup Language, better known as HTML, is a language for describing documents. All webpages are written using HTML.

Documents written in HTML have a structure that is determined by the use of tags. We can enclose a certain part of our document within certain tags, in order to indicate this structure. To enclose a part of a document in tags, we use matching open tags and close tags. For example:

Here is an example of HTML code:

Welcome to my website!<P><B>My hobbies are <EM>Haskell</EM> programming and playing <EM>Myst</EM>.</B></P><P>Thanks for visiting! <EM>anna@gmail.com</EM></P>

Welcome to my website!

My hobbies are Haskell programming and playing Myst.

Thanks for visiting! anna@gmail.com

  type Doc = [DocPart]

There are two kinds of document parts: (1) A piece of text, (2) A whole document enclosed in a certain kind of tag.

  data DocPart
    = Text String
    | Tag String Doc

The example piece of HTML above can be represented by the following Haskell expression:

  annasSida :: Doc
  annasSida =
    [ Text "Welcome to my website!"
    , Tag "P" [ Tag "B" [ Text "My hobbies are "
                        , Tag "EM" [ Text "Haskell" ]
                        , Text " programming and playing "
                        , Tag "EM" [ Text "Myst" ]
                        , Text "."
                        ] ]
    , Tag "P" [ Text "Thanks for visiting! "
              , Tag "EM" [ Text "anna@gmail.com" ]
              ]
    ]

Define a function:

  removeTag :: String -> Doc -> Doc

Example:

  Main> showDoc (removeTag "B" (removeTag "EM" annasSida))
  "Welcome to my website!<P>My hobbies are Haskell programming and 
  playing Myst.</P><P>Thanks for visiting! anna@gmail.com</P>"

(In the above example, we use the function:

  showDoc :: Doc -> String

This is a list of selected functions from the standard Haskell modules: Prelude, Data.List, Data.Maybe, Data.Char. You may use these in your solutions. If you want to use any other standard Haskell function, you have to implement it yourself.

--------------------------------------------------------------------------
-- standard type classes

class Show a where
  show :: a -> String 

class Eq a where
  (==), (/=) :: a -> a -> Bool

class (Eq a) => Ord a where
  (<), (<=), (>=), (>) :: a -> a -> Bool
  max, min             :: a -> a -> a

class (Eq a, Show a) => Num a where
  (+), (-), (*)    :: a -> a -> a
  negate           :: a -> a
  abs, signum      :: a -> a
  fromInteger      :: Integer -> a

class (Num a, Ord a) => Real a where
  toRational       ::  a -> Rational

class (Real a, Enum a) => Integral a where
  quot, rem        :: a -> a -> a   
  div, mod         :: a -> a -> a
  toInteger        :: a -> Integer

class (Num a) => Fractional a where
  (/)              :: a -> a -> a
  fromRational     :: Rational -> a

--------------------------------------------------------------------------
-- numerical functions

even, odd        :: (Integral a) => a -> Bool
even n           = n `rem` 2 == 0
odd              = not . even

--------------------------------------------------------------------------
-- monadic functions

sequence     :: Monad m => [m a] -> m [a] 
sequence     = foldr mcons (return [])
                    where mcons p q = do x <- p; xs <- q; return (x:xs)

sequence_    :: Monad m => [m a] -> m () 
sequence_ xs = do sequence xs; return ()

--------------------------------------------------------------------------
-- functions on functions

id               :: a -> a
id x             = x

const            :: a -> b -> a
const x _        = x

(.)              :: (b -> c) -> (a -> b) -> a -> c
f . g            = \ x -> f (g x)

flip             :: (a -> b -> c) -> b -> a -> c
flip f x y       = f y x

($) :: (a -> b) -> a -> b
f $  x           = f x

--------------------------------------------------------------------------
-- functions on Bools

data Bool = False | True

(&&), (||)       :: Bool -> Bool -> Bool
True  && x       = x
False && _       = False
True  || _       = True
False || x       = x

not              :: Bool -> Bool
not True         = False
not False        = True

--------------------------------------------------------------------------
-- functions on Maybe

data Maybe a = Nothing | Just a

isJust                 :: Maybe a -> Bool
isJust (Just a)        =  True
isJust Nothing         =  False

isNothing              :: Maybe a -> Bool
isNothing              =  not . isJust

fromJust               :: Maybe a -> a
fromJust (Just a)      =  a

maybeToList            :: Maybe a -> [a]
maybeToList Nothing    =  []
maybeToList (Just a)   =  [a]

listToMaybe            :: [a] -> Maybe a
listToMaybe []         =  Nothing
listToMaybe (a:_)      =  Just a
 
--------------------------------------------------------------------------
-- functions on pairs

fst              :: (a,b) -> a
fst (x,y)        =  x

snd              :: (a,b) -> b
snd (x,y)        =  y

curry            :: ((a, b) -> c) -> a -> b -> c
curry f x y      =  f (x, y)

uncurry          :: (a -> b -> c) -> ((a, b) -> c)
uncurry f p      =  f (fst p) (snd p)

--------------------------------------------------------------------------
-- functions on lists

map :: (a -> b) -> [a] -> [b]
map f xs = [ f x | x <- xs ]

(++) :: [a] -> [a] -> [a]
xs ++ ys = foldr (:) ys xs

filter :: (a -> Bool) -> [a] -> [a]
filter p xs = [ x | x <- xs, p x ]

concat :: [[a]] -> [a]
concat xss = foldr (++) [] xss

concatMap :: (a -> [b]) -> [a] -> [b]
concatMap f = concat . map f

head, last       :: [a] -> a
head (x:_)       = x

last [x]         = x
last (_:xs)      = last xs

tail, init       :: [a] -> [a]
tail (_:xs)      = xs

init [x]         = []
init (x:xs)      = x : init xs

null             :: [a] -> Bool
null []          = True
null (_:_)       = False

length           :: [a] -> Int
length []        = 0
length (_:l)     = 1 + length l

(!!)             :: [a] -> Int -> a
(x:_)  !! 0      = x
(_:xs) !! n      = xs !! (n-1)

foldr            :: (a -> b -> b) -> b -> [a] -> b
foldr f z []     =  z
foldr f z (x:xs) =  f x (foldr f z xs)

foldl            :: (a -> b -> a) -> a -> [b] -> a
foldl f z []     =  z
foldl f z (x:xs) =  foldl f (f z x) xs

iterate          :: (a -> a) -> a -> [a]
iterate f x      =  x : iterate f (f x)

repeat           :: a -> [a]
repeat x         =  xs where xs = x:xs

replicate        :: Int -> a -> [a]
replicate n x    =  take n (repeat x)

cycle            :: [a] -> [a]
cycle []         =  error "Prelude.cycle: empty list"
cycle xs         =  xs' where xs' = xs ++ xs'

take, drop             :: Int -> [a] -> [a]
take n _      | n <= 0 =  []
take _ []              =  []
take n (x:xs)          =  x : take (n-1) xs

drop n xs     | n <= 0 =  xs
drop _ []              =  []
drop n (_:xs)          =  drop (n-1) xs

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

takeWhile, dropWhile    :: (a -> Bool) -> [a] -> [a]
takeWhile p []          =  []
takeWhile p (x:xs) 
            | p x       =  x : takeWhile p xs
            | otherwise =  []

dropWhile p []          =  []
dropWhile p xs@(x:xs')
            | p x       =  dropWhile p xs'
            | otherwise =  xs

lines, words     :: String -> [String]
-- lines "apa\nbepa\ncepa\n" == ["apa","bepa","cepa"]
-- words "apa  bepa\n cepa"  == ["apa","bepa","cepa"]

unlines, unwords :: [String] -> String
-- unlines ["apa","bepa","cepa"] == "apa\nbepa\ncepa"
-- unwords ["apa","bepa","cepa"] == "apa bepa cepa"

reverse          :: [a] -> [a]
reverse          =  foldl (flip (:)) []

and, or          :: [Bool] -> Bool
and              =  foldr (&&) True
or               =  foldr (||) False

any, all         :: (a -> Bool) -> [a] -> Bool
any p            =  or . map p
all p            =  and . map p

elem, notElem    :: (Eq a) => a -> [a] -> Bool
elem x           =  any (== x)
notElem x        =  all (/= x)

lookup           :: (Eq a) => a -> [(a,b)] -> Maybe b
lookup key []    =  Nothing
lookup key ((x,y):xys)
    | key == x   =  Just y
    | otherwise  =  lookup key xys

sum, product     :: (Num a) => [a] -> a
sum              =  foldl (+) 0  
product          =  foldl (*) 1

maximum, minimum :: (Ord a) => [a] -> a
maximum []       =  error "Prelude.maximum: empty list"
maximum xs       =  foldl1 max xs

minimum []       =  error "Prelude.minimum: empty list"
minimum xs       =  foldl1 min xs

zip              :: [a] -> [b] -> [(a,b)]
zip              =  zipWith (,)

zipWith          :: (a->b->c) -> [a]->[b]->[c]
zipWith z (a:as) (b:bs)
                 =  z a b : zipWith z as bs
zipWith _ _ _    =  []

unzip            :: [(a,b)] -> ([a],[b])
unzip            =  foldr (\(a,b) ~(as,bs) -> (a:as,b:bs)) ([],[])

nub              :: Eq a => [a] -> [a]
nub []           = []
nub (x:xs)       = x : nub [ y | y <- xs, y /= x ]

delete           :: Eq a => a -> [a] -> [a]
delete y []      = []
delete y (x:xs)  = if x == y then xs else x : delete y xs

(\\)             :: Eq a => [a] -> [a] -> [a]
(\\)             =  foldl (flip delete)

union            :: Eq a => [a] -> [a] -> [a]
union xs ys      = xs ++ (ys \\ xs)    

intersect        :: Eq a => [a] -> [a] -> [a]
intersect xs ys  = [ x | x <- xs, x `elem` ys ]

intersperse      :: a -> [a] -> [a]
-- intersperse 0 [1,2,3,4] == [1,0,2,0,3,0,4]

partition        :: (a -> Bool) -> [a] -> ([a],[a])
partition p xs   = (filter p xs, filter (not . p) xs)

group            :: Eq a => [a] -> [[a]]
-- group "aapaabbbeee" == ["aa","p","aa","bbb","eee"]

isPrefixOf, isSuffixOf   :: Eq a => [a] -> [a] -> Bool
isPrefixOf []     _      =  True
isPrefixOf _      []     =  False
isPrefixOf (x:xs) (y:ys) =  x == y && isPrefixOf xs ys

isSuffixOf x y           =  reverse x `isPrefixOf` reverse y

sort              :: (Ord a) => [a] -> [a]
sort              = foldr insert []

insert            :: (Ord a) => a -> [a] -> [a]
insert x []       = [x]
insert x (y:xs)   = if x <= y then x:y:xs else y:insert x xs

--------------------------------------------------------------------------
-- functions on Char

type String = [Char]

toUpper, toLower :: Char -> Char
-- toUpper 'a' == 'A'
-- toLower 'Z' == 'z'

isUpper, isLower :: Char -> Char
-- isLower 'a' == not (isUpper 'a') == True
-- isUpper 'Z' == not (isLower 'Z') == True

digitToInt :: Char -> Int
-- digitToInt '8' == 8

intToDigit :: Int -> Char
-- intToDigit 3 == '3'

ord :: Char -> Int
chr :: Int  -> Char

--------------------------------------------------------------------------
-- functions on IO

-- output
putStr   :: String -> IO ()       -- displays a string on the screen
putStrLn :: String -> IO ()       -- displays a line on the screen
print    :: Show a => a -> IO ()  -- displays anything showable

-- input
getChar :: IO Char    -- reads one keystroke of user input
getLine :: IO String  -- reads one line of user input

-- file IO
readFile  :: FilePath -> IO String        -- reads the contents of a file
writeFile :: FilePath -> String -> IO ()  -- writes the contents of a file

--------------------------------------------------------------------------