work-site/content/courses/h4life/h4life-funcs.hs

{- funcs.hs

This file contains some of the examples to be shown in the first class
of the course "Haskell for Life", by Sergiu Ivanov (sivanov@lacl.fr):

  http://lacl.fr/~sivanov/doku.php?id=en:haskell_for_life

This file is distributed under the Creative Commons Attribution Alone
licence.-}


{- The examples shown in the first part. -}

add x y = x + y

factorial :: Int -> Int
factorial x = if x == 0
              then 1
              else x * factorial (x-1)

fibonacci :: Int -> Int
fibonacci n = if n == 1
              then 1
              else if n == 2
                   then 1
                   else fibonacci (n-1)
                        + fibonacci (n-2)
  
myNot :: Bool -> Bool
myNot x = if x == True then False else True

myNot1 :: Bool -> Bool
myNot1 True = False
myNot1 False = True

factorial1 :: Int -> Int
factorial1 0 = 1
factorial1 n = n * factorial1 (n-1)

fibonacci1 :: Int -> Int
fibonacci1 1 = 1
fibonacci1 2 = 1
fibonacci1 n = fibonacci1 (n-1) + fibonacci1 (n-2)

fibonacci2 :: Int -> Int
fibonacci2 n | n <= 2 = 1
fibonacci2 n | n > 2 = fibonacci2 (n-1) + fibonacci2 (n-2)

myHead :: [a] -> a
myHead (h:_) = h

myTail :: [a] -> [a]
myTail (_:xs) = xs


{- The fun starts here.

This section contains implementations of the functions from Data.List
and Prelude.  Our implementation of the function foo is called
myFoo.-}

-- | Check whether the list is empty.
myNull :: [a] -> Bool
myNull [] = True
myNull _ = False

-- | Compute the length of the list.
myLength :: [a] -> Int
myLength [] = 0
myLength (x:xs) = 1 + length xs

-- | Get the last element of the list.
--
-- list = myInit list ++ [myLast list]
myLast :: [a] -> a
myLast [x] = x
myLast (x:xs) = myLast xs

-- | Get all elements of the list, but the last one.
--
-- list = myInit list ++ [myLast list]
myInit :: [a] -> [a]
myInit [x] = []
myInit (x:xs) = x : myInit xs

-- | append = (++)
append :: [a] -> [a] -> [a]
append [] ys = ys
append (x:xs) ys = x:append xs ys


-- | Reverses the list.
--
-- In typical functional implementations, '(++)' needs to traverse the
-- first list entirely (cf. 'append').  So this implementation of
-- "reverse" would need to traverse the list at every recursive call.
-- The overall complexity would thus be O(n^2/2).
--
-- In Haskell, '(++)' is implemented with optimisation and may take
-- constant time to run.
badReverse :: [a] -> [a]
badReverse [] = []
badReverse (x:xs) = badReverse xs ++ [x]

-- | Reverses the list.
--
-- This implementation only traverses the list once.
myReverse :: [a] -> [a]
myReverse xs = reverse' xs []
  where reverse' [] acc = acc
        reverse' (x:xs) acc = reverse' xs (x:acc)


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

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


-- | Glues two lists together.
--
-- myZip [1,2] [3,4] == [(1,2),(3,4)]
myZip :: [a] -> [b] -> [(a,b)]
myZip [] _ = []
myZip _ [] = []
myZip (x:xs) (y:ys) = (x,y):myZip xs ys

-- | Checks whether an element is part of the list.
--
-- 'Eq a =>' requires that objects of type 'a' can be "compared".
--
-- We add two pattern guards to handle the cases when 'y == x' and
-- 'y /= x'.  'otherwise' is a condition which is always true.
myElem :: Eq a => a -> [a] -> Bool
myElem _ [] = False
myElem y (x:xs) | y == x = True
                | otherwise = myElem y xs


-- | Given a function and a list, returns a list containing the
-- elements for which the function is true.
--
-- myFilter odd [1..5] == [1,3,5].
--
-- 'odd' is the function returning 'True' for odd numbers.
myFilter :: (a -> Bool) -> [a] -> [a]
myFilter _ [] = []
myFilter p (x:xs) | p x = x:myFilter p xs
                  | otherwise = myFilter p xs


-- | Applies a function to all elements of a list and returns the
-- results.
myMap :: (a -> b) -> [a] -> [b]
myMap _ [] = []
myMap f (x:xs) = f x:myMap f xs

myFoldr :: (a -> b -> b) -> b -> [a] -> b
myFoldr _ r0 [] = r0
myFoldr f r0 (x:xs) = f x (myFoldr f r0 xs)


{- This section contains the reimplementations of some of the
functions from Data.List and the standard Prelude using folds.  Our
implementation of the function foo is called fldFoo.-}

-- | Sums up the elements of the list.
fldSum :: [Int] -> Int
fldSum xs = foldl (+) 0 xs

-- | Checks whether the given function returns 'True' for all elements
-- of the given list.
fldAll :: (a -> Bool) -> [a] -> Bool
fldAll f xs = foldl (\r x -> (f x) && r) True xs

-- | Checks whether the given function returns 'True' for at least one
-- element of the list.
fldAny :: (a -> Bool) -> [a] -> Bool
fldAny f xs = foldl (\r x -> (f x) || r) False xs

-- | Concatenates all the lists in the given list.
--
-- [[1,2],[3,4]] = [1,2,3,4]
fldConcat :: [[a]] -> [a]
fldConcat xs = foldl (++) [] xs


fldFilter :: (a -> Bool) -> [a] -> [a]
fldFilter f xs = reverse (foldl test [] xs)
  where test r x | f x = x:r
                 | otherwise = r

fldMap' :: (a -> b) -> [a] -> [b]
fldMap' f xs = reverse (foldl (\r x -> f x:r) [] xs)


-- The clever Pentalog guy showed me this solution.
fldMap :: (a -> b) -> [a] -> [b]
fldMap f = foldr ((:) . f) []



-- Bubble sort.
bubblesort :: Ord a => [a] -> [a]
bubblesort xs = iterate bubble xs !! (length xs - 1)
  where bubble [] = []
        bubble [x] = [x]
        bubble (x:y:xs) | x < y = x : bubble (y:xs)
                        | otherwise = y : bubble (x:xs)