hw4/hw4.hs

   1 {-# OPTIONS_GHC -Wall #-}
   2
   3 module Hw4 where
   4
   5 -- wholemeal programming
   6 {- |
   7
   8 1. fun1 :: [Integer] -> Integer
   9 fun1 [] = 1
  10 fun1 (x:xs)
  11      | even x    = (x - 2) * fun1 xs
  12      | otherwise = fun1 xs
  13
  14 2. fun2 :: Integer -> Integer fun2 1 = 0
  15    fun2n | even n = n + fun2 (n ‘div‘ 2)
  16          | otherwise = fun2 (3 * n + 1)
  17 Hint: For this problem you may wish to use the functions
  18       iterate and takeWhile. Look them up in the Prelude
  19       documentation to see what they do.
  20 -}
  21
  22 fun1 :: [Integer] -> Integer
  23 fun1 [] = 1
  24 fun1 (x:xs)
  25      | even x    = (x - 2) * fun1 xs
  26      | otherwise = fun1 xs
  27
  28 fun1' :: [Integer] -> Integer
  29 fun1' = product . (map (\x -> x - 2)) . filter even
  30
  31 fun2 :: Integer -> Integer
  32 fun2 1 = 0
  33 fun2 n | even n = n + fun2 (n `div` 2)
  34        | otherwise = fun2 (3 * n + 1)
  35
  36 fun2' :: Integer -> Integer
  37 fun2' n = sum $ filter even $ takeWhile (/= 1) $ iterate gen n
  38     where gen x | even x = x `div` 2
  39                 | otherwise = 3 * x + 1
  40
  41 -- exercise 2
  42 -- folding with trees
  43
  44 data Tree a = Leaf
  45             | Node Integer (Tree a) a (Tree a)
  46               deriving (Show, Eq)
  47
  48 -- generate balanced binary tree using foldr
  49 height :: Tree a -> Integer
  50 height Leaf = 0
  51 height (Node h _ _ _) = h
  52
  53 balanced :: Tree a -> Bool
  54 balanced Leaf = True
  55 balanced (Node _ lt _ rt) = abs (height lt - height rt) <= 1 &&
  56                             balanced lt && balanced rt
  57
  58 insert :: a -> Tree a -> Tree a
  59 insert x Leaf = Node 0 Leaf x Leaf
  60 insert x (Node h lt v rt) | h1 < h2 = Node h (insert x lt) v rt
  61                           | h1 > h2 = Node h lt v (insert x rt)
  62                           | otherwise = Node (newh + 1) lt v (insert x rt)
  63                           where h1 = height lt
  64                                 h2 = height rt
  65                                 newh = height (insert x rt)
  66
  67 foldTree :: [a] -> Tree a
  68 foldTree = foldr f Leaf
  69     where f x acc = insert x acc
  70
  71