hw4/hw4.hs

   1 {-# OPTIONS_GHC -Wall #-}
   2
   3 module Hw4 where
   4
   5 import qualified Data.List as L
   6
   7 -- wholemeal programming
   8 {- |
   9
  10 1. fun1 :: [Integer] -> Integer
  11 fun1 [] = 1
  12 fun1 (x:xs)
  13      | even x    = (x - 2) * fun1 xs
  14      | otherwise = fun1 xs
  15
  16 2. fun2 :: Integer -> Integer fun2 1 = 0
  17    fun2n | even n = n + fun2 (n ‘div‘ 2)
  18          | otherwise = fun2 (3 * n + 1)
  19 Hint: For this problem you may wish to use the functions
  20       iterate and takeWhile. Look them up in the Prelude
  21       documentation to see what they do.
  22 -}
  23
  24 fun1 :: [Integer] -> Integer
  25 fun1 [] = 1
  26 fun1 (x:xs)
  27      | even x    = (x - 2) * fun1 xs
  28      | otherwise = fun1 xs
  29
  30 fun1' :: [Integer] -> Integer
  31 fun1' = product . (map (\x -> x - 2)) . filter even
  32
  33 fun2 :: Integer -> Integer
  34 fun2 1 = 0
  35 fun2 n | even n = n + fun2 (n `div` 2)
  36        | otherwise = fun2 (3 * n + 1)
  37
  38 fun2' :: Integer -> Integer
  39 fun2' n = sum $ filter even $ takeWhile (/= 1) $ iterate gen n
  40     where gen x | even x = x `div` 2
  41                 | otherwise = 3 * x + 1
  42
  43 -- exercise 2
  44 -- folding with trees
  45
  46 data Tree a = Leaf
  47             | Node Integer (Tree a) a (Tree a)
  48               deriving (Show, Eq)
  49
  50 -- generate balanced binary tree using foldr
  51 height :: Tree a -> Integer
  52 height Leaf = 0
  53 height (Node h _ _ _) = h
  54
  55 balanced :: Tree a -> Bool
  56 balanced Leaf = True
  57 balanced (Node _ lt _ rt) = abs (height lt - height rt) <= 1 &&
  58                             balanced lt && balanced rt
  59
  60 insert :: a -> Tree a -> Tree a
  61 insert x Leaf = Node 0 Leaf x Leaf
  62 insert x (Node h lt v rt) | h1 < h2 = Node h (insert x lt) v rt
  63                           | h1 > h2 = Node h lt v (insert x rt)
  64                           | otherwise = Node (newh + 1) lt v (insert x rt)
  65                           where h1 = height lt
  66                                 h2 = height rt
  67                                 newh = height (insert x rt)
  68
  69 foldTree :: [a] -> Tree a
  70 foldTree = foldr f Leaf
  71     where f x acc = insert x acc
  72
  73 -- exercise 3
  74 -- xor
  75 xor :: [Bool] -> Bool
  76 xor bs = foldr f False bs
  77     where f False False = False
  78           f False True  = True
  79           f True False  = True
  80           f True True   = False
  81
  82 -- implement map as a fold
  83 map' :: (a -> b) -> [a] -> [b]
  84 map' f = foldr f' []
  85     where f' x acc = (f x) : acc
  86
  87 -- exercise 5
  88 -- Sieve of Sundaram
  89
  90 cartProd :: [a] -> [b] -> [(a,b)]
  91 cartProd xs ys = [(x, y) | x <- xs, y <- ys]
  92
  93 genList :: Integer -> [Integer]
  94 genList n = [1..n]
  95
  96 sieveSundaram :: Integer -> [Integer]
  97 sieveSundaram n = map (\x -> (2*x + 1)) $ (L.\\) xs $ L.sort $ f (cartProd xs xs)
  98     where xs = genList n
  99           f ps =  L.nub $ filter (<= n) $ map (\(i,j) -> i + j + 2*i*j) ps