Yet Another Haskell Tutorial の続き

Yet Another Haskell Tutorial のExerciseの続きです。
型を自分で定義するところに入ってきて、多少考えないと解けなくなってきました。

Exercise 3.7 The fibonacci sequence is defined by:

Write a recursive function fib that takes a positive integer n as a parameter and
calculates Fn.

fib 1 = 1
fib 2 = 1
fib n = fib (n-2) + fib (n-1)

Exercise 3.8 Define a recursive function mult that takes two positive integers a and
b and returns a*b, but only uses addition (i.e., no fair just using multiplication). Begin
by making a mathematical definition in the style of the previous exercise and the rest of
this section.

mult a 0 = 0
mult a 1 = a
mult a b = a + mult a (b-1)

Exercise 3.9 Define a recursive function my map that behaves identically to the stan-
dard function map.

my_map f [] = []
my_map f (x:xs) = f(x) : my_map f xs

Exercise 3.10 Write a program that will repeatedly ask the user for numbers until she
types in zero, at which point it will tell her the sum of all the numbers, the product of
all the numbers, and, for each number , its factorial. For instance, a session might look
like:

Give me a number (or 0 to stop):
5
Give me a number (or 0 to stop):
8
Give me a number (or 0 to stop):
2
Give me a number (or 0 to stop):
0
The sum is 15
The product is 80
5 factorial is 120
8 factorial is 40320
2 factorial is 2

module Main
    where

import IO

main = do
  hSetBuffering stdin LineBuffering
  numbers <- getNumbers
  putStrLn ("The sum is " ++ show (foldr (+) 0 numbers))
  putStrLn ("The product is " ++ show (foldr (*) 1 numbers))
  showFact numbers

getNumbers = do
  putStrLn "Give me a number (or 0 to stop): "
  give <- getLine
  let num = read give
  if num == 0
    then return []
    else do rest <- getNumbers
            return (num : rest)

showFact [] = return ()
showFact (x:xs) = do
  putStrLn (show(x) ++ " factorial is " ++ show(factorial x))
  showFact xs

factorial 1 = 1
factorial n = n * factorial (n-1)

Exercise 4.1 Figure out for yourself, and then verify the types of the following expres-
sions, if they have a type. Also note if the expression is a type error:

Hugs> :t 'h':'e':'l':'l':'o':[]
"hello" :: [Char]
Hugs> :t [5,'a']
ERROR - Cannot infer instance
*** Instance   : Num Char
*** Expression : [5,'a']

Hugs> :t (5,'a')
(5,'a') :: Num a => (a,Char)
Hugs> :t (5::Int) + 10
5 + 10 :: Int
Hugs> :t (5::Int) + (10::Double)
ERROR - Type error in application
*** Expression     : 5 + 10
*** Term           : 5
*** Type           : Int
*** Does not match : Double

Exercise 4.2 Figure out for yourself, and then verify the types of the following expres-
sions, if they have a type. Also note if the expression is a type error:

Hugs> :t snd
snd :: (a,b) -> b
Hugs> :t head
head :: [a] -> a
Hugs> :t null
null :: [a] -> Bool
Hugs> :t head . tail
head . tail :: [a] -> a
Hugs> :t head . head
head . head :: [[a]] -> a

Exercise 4.3 Figure out for yourself, and then verify the types of the following expres-
sions, if they have a type. Also note if the expression is a type error:

1. \x -> [x]
  a -> [a]

2. \x y z -> (x,y:z:[])
 a -> b -> b -> (a,[b])

3. \x -> x + 5
 (Num a) => a -> a

4. \x -> "hello, world"
 a -> [Char]

5. \x -> x 'a'
 (Char -> a) -> a

6. \x -> x x
 type error!

7. \x -> x + x
 (Num a) => a -> a

Exercise 4.4 Write a data type declaration for Triple, a type which contains three
elements, all of different types. Write functions tripleFst, tripleSnd and tripleThr
to extract respectively the first, second and third elements.

module Triple
    where

data Triple a b c = Triple a b c

tripleFst (Triple a b c) = a
tripleSnd (Triple a b c) = b
tripleThr (Triple a b c) = c

Exercise 4.5 Write a datatype Quadruple which holds four elements. However , the
first two elements must be the same type and the last two elements must be the same
type. Write a function firstTwo which returns a list containing the first two elements
and a function lastTwo which returns a list containing the last two elements. Write
type signatures for these functions

module Quadruple
    where

data Quadruple a b = Quadruple a a b b

firstTwo :: Quadruple a b -> [a]
firstTwo (Quadruple x y z w) = [x,y]
lastTwo :: Quadruple a b -> [b]
lastTwo  (Quadruple x y z w) = [z,w]

Exercise 4.6 Write a datatype Tuple which can hold one, two, three or four elements,
depending on the constructor (that is, there should be four constructors, one for each
number of arguments). Also provide functions tuple1 through tuple4 which take a
tuple and return Just the value in that position, or Nothing if the number is invalid
(i.e., you ask for the tuple4 on a tuple holding only two elements).

Exercise 4.7 Based on our definition of Tuple from the previous exercise, write a
function which takes a Tuple and returns either the value (if it’s a one-tuple), a
Haskell-pair (i.e., (’a’,5)) if it’s a two-tuple, a Haskell-triple if it’s a three-tuple
or a Haskell-quadruple if it’s a four-tuple. You will need to use the Either type to
represent this.

module Tuple
    where

data Tuple a b c d = One   a
                   | Two   a b
                   | Three a b c
                   | Four  a b c d

tuple1 :: Tuple a b c d -> Maybe a
tuple1 (One   a      ) = Just a
tuple1 (Two   a b    ) = Just a
tuple1 (Three a b c  ) = Just a
tuple1 (Four  a b c d) = Just a

tuple2 :: Tuple a b c d -> Maybe b
tuple2 (One   a      ) = Nothing
tuple2 (Two   a b    ) = Just b
tuple2 (Three a b c  ) = Just b
tuple2 (Four  a b c d) = Just b

tuple3 :: Tuple a b c d -> Maybe c
tuple3 (One   a      ) = Nothing
tuple3 (Two   a b    ) = Nothing
tuple3 (Three a b c  ) = Just c
tuple3 (Four  a b c d) = Just c

tuple4 :: Tuple a b c d -> Maybe d
tuple4 (One   a      ) = Nothing
tuple4 (Two   a b    ) = Nothing
tuple4 (Three a b c  ) = Nothing
tuple4 (Four  a b c d) = Just d

convert :: Tuple a b c d -> Either (Either (a) (a,b)) (Either (a,b,c) (a,b,c,d))
convert (One   a      ) = Left (Left (a))
convert (Two   a b    ) = Left (Right (a,b))
convert (Three a b c  ) = Right (Left (a,b,c))
convert (Four  a b c d) = Right (Right (a,b,c,d))

Exercise 4.8 Write functions listHead, listTail, listFoldl and listFoldr
which are equivalent to their Prelude twins, but function on our List datatype. Don’t
worry about exceptional conditions on the first two.

module List
    where

data List a = Nil
            | Cons a (List a)

listLength :: List a -> Int
listLength Nil = 0
listLength (Cons x xs) = 1 + listLength xs

{-
listHead :: List a -> Maybe a
listHead Nil = Nothing
listHead (Cons x xs) = Just x

listTail :: List a -> Maybe (List a)
listTail Nil = Nothing
listTail (Cons x xs) = Just xs
-}
listHead :: List a -> a
listHead (Cons x xs) = x

listTail :: List a -> List a
listTail (Cons x xs) = xs

listFoldl :: (a -> b -> a) -> a -> List b -> a
listFoldl f c Nil = c
listFoldl f c (Cons x xs) = listFoldl f (f c x) xs

listFoldr :: (a -> b -> b) -> b -> List a -> b
listFoldr f c Nil = c
listFoldr f c (Cons x xs) = f x (listFoldr f c xs)

Exercise 4.9 Write a function elements which returns the elements in a BinaryTree
in a bottom-up, left-to-right manner (i.e., the first element returned in the left-most leaf,
followed by its parent’s value, followed by the other child’s value, and so on). The re-
sult type should be a normal Haskell list.

Exercise 4.10 Write a fold function for BinaryTrees and rewrite elements in
terms of it (call the new one elements2).

module BinaryTree
    where

data BinaryTree a
        = Leaf a
        | Branch (BinaryTree a) a (BinaryTree a)

treeSize :: BinaryTree a -> Int
treeSize (Leaf x) = 1
treeSize (Branch left x right) = 1 + treeSize left + treeSize right

elements :: BinaryTree a -> [a]
elements (Leaf x) = [x]
elements (Branch left x right) = elements left ++ x : elements right


treeFoldl :: (a -> b -> a) -> a -> BinaryTree b -> a
treeFoldl f c (Leaf x) = f c x
treeFoldl f c (Branch left x right)
                = treeFoldl f (f (treeFoldl f c left) x) right

treeFoldr :: (a -> b -> b) -> b -> BinaryTree a -> b
treeFoldr f c (Leaf x) = f x c
treeFoldr f c (Branch left x right)
                = treeFoldr f (f x (treeFoldr f c right)) left

elements2 :: BinaryTree a -> [a]
elements2 = treeFoldr (:) []