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

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]