PFP Laboratory 3

Functions working with lists and tuples

Implement following functions:

• Create a function that merge two lists into one list of tuples.

zipThem:: [a] -> [b] -> [(a,b)]

*Main> zipThem [1,2,3] "ABCD"
[(1,'A'),(2,'B'),(3,'C')]

zipThem:: [a] -> [b] -> [(a,b)]
zipThem (x:xs) (y:ys) = (x,y) : zipThem xs ys
zipThem _ _ = []

• Create a function that compute Cartesian product of two vectors.

dotProduct :: [a] -> [b] -> [(a,b)]

*Main> dotProduct [1..4] "ABC"
[(1,'A'),(1,'B'),(1,'C'),(2,'A'),(2,'B'),(2,'C'),(3,'A'),(3,'B'),(3,'C'),(4,'A'),(4,'B'),(4,'C')]

dotProduct :: [a] -> [b] -> [(a,b)]
dotProduct [] _ = []
dotProduct (x:xs) ys = tmp ys ++ dotProduct xs ys where
  tmp [] = []
  tmp (b:bs) = (x,b) : tmp bs

dotProduct' :: [a] -> [b] -> [(a,b)]  
dotProduct' xs ys = [(x,y)|x<-xs, y<-ys]

dotProduct'' :: [a] -> [b] -> [(a,b)]
dotProduct'' x y = 
  zip (concat (map (replicate (length y)) x))
                     (concat (replicate (length x) y))

• Create a function that computes n-th number in the Fibonacci sequence. The function should use tuples in the solution.

fibonacci :: Int -> Int

*Main> fibonacci 12
144

fibonacci :: Int -> Int
fibonacci n = fst (tmp n) where
  fibStep (a,b) = (b,a+b)
  tmp 0 = (0,1)
  tmp x = fibStep (tmp (x-1))

High-order functions

• Create a function that takes a string and converts all characters to upper case letters.

allToUpper :: String -> String

*Main> allToUpper "aAbc"
"AABC"

import Data.Char

allToUpper :: String -> String
allToUpper xs = [toUpper x |x<-xs]                     

allToUpper' :: String -> String
allToUpper' xs = map toUpper xs

• Implement the quicksort algorithm. As a pivot use always the first element in the list. For dividing the list, use the function filter.

quicksort :: (Ord a) => [a] -> [a]

*Main> filter (<5) [1..10]
[1,2,3,4]

*Main> quicksort [1,5,3,7,9,5,2,1]
[1,1,2,3,5,5,7,9]

quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) = let lp = filter (< x) xs
                       rp = filter (>= x) xs
                   in quicksort lp ++ [x] ++ quicksort rp

List comprehension

Using the list comprehension implement following functions:

• Create a function that generates a list of all odd numbers in given interval.

oddList :: Int -> Int -> [Int]

*Main> oddList 1 10   
[1,3,5,7,9]

oddList :: Int -> Int -> [Int]
oddList a b = [ x |x<-[a..b], odd x]

• Create a function that removes all upper case letters from a string.

removeAllUpper :: String -> String

*Main> removeAllUpper "ABCabcABC"
"abc"

import Data.Char

removeAllUpper :: String -> String
removeAllUpper xs = [ x |x<-xs, not (isUpper x)]

• Create functions that computes union and intersection of two sets.

union :: Eq a => [a] -> [a] -> [a]
intersection :: Eq a => [a] -> [a] -> [a]

*Main> union [1..5] [3..10]
[1,2,3,4,5,6,7,8,9,10]
*Main> intersection [1..5] [3..10]
[3,4,5]

union :: Eq a => [a] -> [a] -> [a]
union xs ys = xs ++ [y| y<-ys, not (elem y xs)]

intersection ::  Eq a =>  [a] -> [a] -> [a]
intersection xs ys = [y| y<-ys, elem y xs]

More complex functions

• Create a function that count the number of occurrences of all characters from a given string.

countThem :: String -> [(Char, Int)]

*Main>countThem "hello hello hello"
[('h',3),('e',3),('l',6),('o',3),(' ',2)]

unique :: String -> String
unique n = reverse(tmp n "") where
  tmp [] store = store
  tmp (x:xs) store | x `elem` store = tmp xs store
                   | otherwise = tmp xs (x:store)

unique' :: String -> String                   
unique' [] = []
unique' (x:xs) = x: unique' (filter (/=x)xs)

countThem :: String -> [(Char, Int)]
countThem xs = let u = unique xs
               in [(x, length (filter (==x) xs)) |x<-u]

• Create a function that generates all combinations of given length from the characters from given string. You can assume, that all character are unique and the given length is not bigger then the length of this string.

combinations :: Int -> String -> [String]

*Main> combinations 3 "abcdef"
["abc","abd","abe",...]

combinations :: Int -> String -> [String]
combinations 1 xs = [[x]| x<-xs]
combinations n (x:xs) | n == length (x:xs) = [(x:xs)]
                      |otherwise = [[x] ++ y |y<-combinations (n-1) xs ] 
                                    ++ (combinations n xs)

Operators

• Define following functions that performs corresponding logic operations: not', and', or', nand', xor', impl', equ'
• Define the 'standard' priority for all these functions, if they are used as operators.
• Create a function that prints the truth table of a given logical expression for two variables.

table :: (Bool -> Bool -> Bool) -> IO ()

table (\a b -> (and' a (or' a b)))                                                                              
True  True  True
True  False True
False True  False
False False False

not' :: Bool -> Bool
not' True = False
not' False = True
infixl 5 `not'` 

and' :: Bool -> Bool -> Bool
and' True True = True
and' _ _ = False
infixl 4 `and'` 

or' :: Bool -> Bool -> Bool
or' False False = False
or' _ _ = True
infixl 3 `or'` 

nand' :: Bool -> Bool -> Bool
nand' x y = not' (and' x y)
infixl 4 `nand'` 

xor' :: Bool -> Bool -> Bool
xor' x y = x/=y
infixl 3 `xor'` 

impl' :: Bool -> Bool -> Bool
impl' True False = False
impl' _ _ = True
infixl 2 `impl'` 

equ' :: Bool -> Bool -> Bool
equ' x y = x == y
infixl 7 `equ'` 

table :: (Bool -> Bool -> Bool) -> IO ()
table expr = putStr (concat [nicePrint [x,y,(expr x y)] |x<-[True,False], y<-[True,False]])

nicePrint :: [Bool] -> String
nicePrint xs = concat [show x++"\t"| x<-xs] ++ "\n"

• Extend the previously defined function to accept any number of variables (the number of variables will be given as a first parameter).

tablen :: Int -> ([Bool] -> Bool) -> IO ()

 tablen 3 (\[a,b,c] -> a `and'` (b `or'` c) `equ'` a `and'` b `or'` a `and'` c)
True   True   True   => True
True   True   False  => True
True   False  True   => True
True   False  False  => False
False  True   True   => False
False  True   False  => False
False  False  True   => False
False  False  False  => False

tablen :: Int -> ([Bool] -> Bool) -> IO ()
tablen n f = putStr(concat [nicePrint x ++ " => " ++ show(f x) ++ "\n" |x<-allValues n]) where 
  allValues 1 = [[True], [False]]
  allValues n = [x:y| x<-[True,False], y<-allValues (n-1)]

  nicePrint :: [Bool] -> String
  nicePrint xs = concat [show x++"\t"| x<-xs]