Labs

The goal of this lab is to make the students familiar with the IDE we will use for scheme and help them write first simple programs.

The IDE can be downloaded for free for Linux, Winows, MAC from: https://racket-lang.org/ The students can use the one installed in the lab computers. The teacher may help the students (to a reasonable degree) to get the IDE running on students’ laptops. Explain the language (scheme variant) selection options. 1. Choose in the environment 2. #lang {scheme|r5rs|…}

Students should understand that learning functional programming is important for improving their programming skills. It helps them master recursion and functional patterns are increasingly common in mainstream programming languages.

Start interaction in REPL. Scheme uses prefix notation for all functions. Let students compute simple formulas, e.g., 2+3/5. For the following exercises, I suggest first explaining the task. Than leaving the students to work on it individually for a few minutes. Discuss their ideas and approach to the problem. Afterwards, a randomly selected student will explain the solution to everyone on the whiteboard with help from the teacher and the other students.

Exercise 1: Use scheme REPL to compute a discriminant of the following quadratic function.

(- (* -3 -3) (* 4 4 5))
=> -71

Exercise 2: Write a function D for computing the discriminant of a quadratic form based of coefficients a, b, c.

(define (D a b c)
  (- (* b b) (* 4 a c)))

Exercise 3: Write a function roots that will use the previously defined computation of the discriminant to return the roots of the quadratic function.

(define (roots a b c)
  (list 
    (/ (+ (- b) (sqrt (D a b c))) (* 2 a))
    (/ (- (- b) (sqrt (D a b c))) (* 2 a))
  )
)

Exercise 4: Write a recursive function my-even that decides whether a number is even using only functions +, -, = (without indirect recursion).

(define (my-even? n)
  (cond ((= n 0) #t)
        ((= n 1) #f)
        ((> n 0) (my-even? (- n 2)))
        (#t (my-even? (+ n 2)))
   )
)

Students will likely first forget about the negative numbers. Let them find out what happens with negative input. Relate to best practice rules to avoid infinite recursion. This is an example of analytic recursion.

Exercise 5: Write a function that returns the n-th Fibonacci number.

(define (fib n)
  (cond ((= n 0) 0)
        ((= n 1) 1)
        (else (+ (fib (- n 1)) (fib (- n 2))))
   )
)

Let them try to run (fib 100). Discuss that this function is correct, but very inefficient. Why does it take so much memory? Explain that the stop button and rerun will allow them to continue, if you did not get to that already. This is an example of tree recursion.

Exercise 6: Write a function that returns the n-th Fibonacci number effectively.

Lead the students to realize that if they need an extra “variable”, they can add an argument.
(define (fib-hlp last2 last n)
  (if (= 0 n)
      (+ last2 last)
      (fib-hlp last (+ last2 last) (- n 1))))
(define (fib2 n)
  (fib-hlp -1 1 n))

This exercise can be skipped until the next lab if things are going slowly.

Exercise 7: Write a function that returns a list of the first n fibonacci numbers.

(define (fibs n)
  (cond ((= 0 n) '())
        (#t (cons (fib2 n) (fibs (- n 1))))))

Exercise 8: Using the my-even? Predicate defined previously, write a function that will for a list of numbers return a list of only even numbers in the list.

(define (take-even l)
  (cond ((null? l) l)
        ((my-even? (car l)) (cons (car l) (take-even (cdr l))))
        (else (take-even (cdr l)))
   )
)

The goal of this lab is to practice writing recursive functions in scheme and using the accumulator to make the functions more efficient. Furthermore, the students should practice using let and lambda abstraction.

We explained the first homework assignment.

Exercise 1: Write a recursive function that would reverse a list. For example (1 2 3 4) → (4 3 2 1).

(define (my-reverse l)
  (cond ((null? l) l)
        (#t (append (my-reverse (cdr l)) (list (car l))))
   )
)

Understand why this function is inefficient (has quadratic complexity).

Exercise 2: Write the function from Exercise 1 in a linear time complexity.

(define (my-reverse2 l)
  (define (rev-acc l acc)
    (cond ((null? l) acc)
        (#t (rev-acc (cdr l) (cons (car l) acc)))
    )
  ) 
  (rev-acc l '())
)

Note that using the accumulator is a general concept.

Exercise 3: Write a function my-flatten that will take any structure of nested lists and return a list of elements in these lists. For example (a b (c d (e) f ()) g) → (a b c d e f g).

(define (my-flatten l)
  (cond ((null? l) l)
        ((list? (car l)) (append ( my-flatten (car l)) (my-flatten (cdr l))))
        (#t (cons (car l) (my-flatten (cdr l))))
  )
)

This is an example of tree recursion.

Exercise 4: Write a more efficient version of the function from Exercise 3 using accumulator.

(define (my-flatten2 l)
  (define (flatten-acc l acc)
    (cond ((null? l) acc)
          ((list? (car l)) (flatten-acc (car l) (flatten-acc (cdr l) acc)))
          (#t (cons (car l) (flatten-acc (cdr l) acc)))
    )
  ) 
  (flatten-acc l '())
)

Exercise 5: Let 2D vectors be defined as list of coordinates (1,2), (4,1). Write a function to compute the Euclidean distance between two vectors. Make sure no computation is performed twice.

(define (dist p1 p2)
  (let ((dx (- (car p1) (car p2)))
        (dy (- (cadr p1) (cadr p2)))
        )
    (sqrt (+ (* dx dx) (* dy dy)))
   )
)

Remember the function filter explained in the lecture.

Exercise 6: Write a function that removes all duplicate (or more) elements in a list. For example (1 2 3 2 5 1 3 4 2 5 2 1 3) → (1 2 3 5 4). You may use the function filter.

(define (remove-dup l)
   (if (null? l) l
       (cons (car l) 
             (remove-dup (filter (lambda (x) (not (equal? (car l) x))) 
                                 (cdr l)))
       )
   )
)

Exercise 7: Write a function that applies a given function to i-the element of a list. For example (apply-at sqrt ‘(4 4 4 4 4) 3) → (4 4 2 4 4).

(define (apply-at fn list pos)
  (cond ((= pos 0) (cons (fn (car list)) (cdr list)))
        (#t (cons (car list) (apply-at fn (cdr list) (- pos 1))
   )
)

Exercise 8: Use apply-at to increment 2nd position in a list of numbers in REPL.

(apply-at (lambda (x) (+ x 1)) '(1 2 3 4) 2)

Exercise 9: Use apply-at to write a function substitute that substitutes the i-th element of a list with a new value. For example (subst ‘a ‘(1 2 3 4) 2) → (1 a 3 4)

(define (subst new list pos)
  (apply-at (lambda (x) new) list pos)
)

Exercise 9: (If there is still time) Use function apply-at to write a function apply-at-xy, which will apply the function at position (x,y) in a list of lists. (apply-at-xy sqrt ‘((4 4 4) (4 4 4) (4 4 4)) 2 2) → ((4 4 4) (4 2 4) (4 4 4))

(define (apply-xy fn x y list-of-lists)
  (apply-at (lambda (line)
              (apply-at fn line x)
             ) list-of-lists y)
)

The goal of this lab is to understand and practice the built-in higher order functions in scheme.

Try out the following simple commands in REPL.

(map sqrt '(1 4 9 16 25))
(map car '((A B) (C) (D E)))
(map max '(3 9 17) '(2 4 11) '(7 3 2))

Exercise 1: Write a function that returns n-th line of the Pascal triangle as a list.

(define (pascal n)
  (cond ((= n 1) '(1))
        (#t (let ((prev (pascal (- n 1))))
              (map + (cons 0 prev) (append prev '(0)))
            )
        )
  )
)

Exercise 2: Use foldr/foldl to implement a function that multiplies all elements in a list.

(define (mult list)
  (foldr * 1 list)
)

Exercise 3: Use foldl/foldr to write a function that reverses a list.

(define (reverse4 l)
  (foldl cons '() l)
)

Exercise 4: Use foldl/foldr to write a function that returns the minimum of a list.

(define (min list)
  (fold (lambda (x y) (if (< x y) x y)) (car list) (cdr list))
)

Exercise 5: Use map/fold to compute a dot product of two vectors represented as lists.

(define (dot-product v w)
  (fold + 0 (map * v w))
)

Exercise 6: Use map/fold to compute a product of a matrix and a vectors represented as lists.

(define (mxv m v)
  (map (lambda (row) (dot-product row v)) m))

Exercise 7: Use higher order functions to compute transpose of a matrix.

(define (transpose mat)
   (apply map (cons list mat)))

Exercise 8: Use higher order functions to implement multiplication of two matrices.

(define (mxm m n)
  (let ((cols (transpose n)))
    (map (lambda (row) (mxv cols row))
         m)))

The goal of this lab is to practice more complex functions that combine recursion and higher order functions.

We explained the second home assignment.

Exercise 1: Using recursion and higher order functions, write a function that returns a list of all subsets of a given list.

Idea of the algorithm: Take all subsets of a list without first element and return a union of the subsets and the subsets with the removed element added.

(define (power-set s)
  (if (null? s) '(())
      (let ((rest-ps (power-set (cdr s))))
          (append rest-ps (map (lambda (x) (cons (car s) x)) rest-ps)))))

Exercise 2: Using recursion and higher order functions, write a function that returns a list of all permutations of a given list.

Idea of the solution: Take all permutations without one element and put the element to the first position in the result. Do it for all elements in the list and combine the result.

(define (perm-set l)
  (if (null? l) '(())
  (apply append (map (lambda (x)
                  (map (lambda (y) (cons x y)) (perm-set (remove x l)))
                ) l))
))

The goal of this lab is to practice lexical scope, lazy evaluation and infinite streams.

Exercise 1: Draw a schema of variable bindings, closures and references among them during execution of the following code in a way similar to the one shown in the lecture.

(define (f x y)
  (define (g z)
    (if (<= (abs (- x z)) (abs (- y z)))
        x
        y))
  g)
 
(define posneg (f -1 1))
 
(display (posneg 21))
(display (posneg -3))
(display ((f 10 20) 18))

(example taken from https://www.usna.edu/Users/cs/roche/courses/f12si413/)

Solution:PDF

Exercise 2: Define a macro for special form and with lazy evaluation. First write the logics without the macro, then rewrite it to a macro.

(define (my-lazy-and2 a b)
  (if (a) (b) #f))
 
(define-syntax my-mac-and2
  (syntax-rules ()
     ((my-mac-and2) #t)
     ((my-mac-and2 a) e)
     ((my-mac-and2 a b) (my-lazy-and2 (lambda () a) (lambda () b)))))

A good way of testing that the lazy evaluation actually works.

> (my-mac-and2 (begin (display 'a) #t) (begin (display 'b) #t))
ab#t
> (my-mac-and2 (begin (display 'a) #f) (begin (display 'b) #t))
a#f

(The following exercise is taken from https://inst.eecs.berkeley.edu/~cs61as/sp13/lab/11.html)

Exercise 3: An unsolved problem in number theory concerns the following algorithm for creating a sequence of positive integers s1, s2, …       Choose s1 to be some positive integer.        For n > 1,           if sn is odd, then sn+1 is 3sn+1;           if sn is even, then sn+1 is sn/2. No matter what starting value is chosen, the sequence always seems to end with the values 1, 4, 2, 1, 4, 2, 1, … However, it is not known if this is always the case.

a) Write a procedure num-seq that, given a positive integer n as argument, returns the stream of values produced for n by the algorithm just given. For example, (num-seq 7) should return the stream representing the sequence 7, 22, 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1, 4, 2, 1, …

(define (num-seq n)
  (cons n (delay (if (even? n)
                     (num-seq (/ n 2))
                     (num-seq (+ (* n 3) 1))))))

b) Write a procedure seq-length that, given a stream produced by num-seq, returns the number of values that occur in the sequence up to and including the first 1. For example, (seq-length (num-seq 7)) should return 17. You should assume that there is a 1 somewhere in the sequence.

(define (seq-len s)
  (if (= (first s)1)
      1
      (+ 1 (seq-len (rest s)))))

Exercise 4: Define an infinite stream of Fibonacci numbers without higher order functions.

(define (fibs)
  (define (fib-hlp a b)
    (cons a (delay (fib-hlp b (+ a b)))))
  (fib-hlp 0 1))

Exercise 5: Write a function sappend that appends two streams.

(define (sappend a b)
 (if (null? a)
     b
     (cons (car a) (sappend (rest a) b))))

Exercise 6: Define lazy filter, which works exactly like the function filter, but accepts a stream as an input and returns a stream as the output.

(define (lazy_filter pred list)
  (cond ((null? list) list)
        ((pred (car list)) 
           (cons (car list) 
                 (delay (lazy_filter pred (rest list)))))
        (#t (lazy_filter pred (rest list)))
   )
)

The goal of this lab is to practice imperative paradigms in scheme.

(The following exercise is from https://www.usna.edu/Users/cs/roche/courses/f12si413/l03/index.html)

Exercise 1: Write a function make-stack that creates “stack objects”. Your stack should allow the following messages: 'size: Returns the number of elements in the stack. 'pop: Removes the top element of the stack and returns it. (You can assume that the size of the stack is at least 1 before this method is called.) 'push x1 x2 …: Takes any number of additional objects and puts them on the stack. Note: normally “push” puts a single new object on the top of the stack. Your stack will allow an arbitrary number of arguments, and the effect will be to add them as if they had been pushed individually from right to left.

Here's an example:
> (define S1 (make-stack))
> (S1 'size)
0
> (S1 'push 3 'a 2.1)
> (S1 'pop)
3
> (S1 'push 'x)
> (S1 'pop)
x
> (S1 'pop)
a
> (S1 'size)
1

(define (make-stack)
  (let ((data '()))
    (define (size)
      (length data))
    (define (push . args)
      (set! data (append args data)))
    (define (pop)
      (let ((out (car data)))
        (set! data (cdr data))
        out))
    (define (dispatch m)
      (cond ((eq? m 'size) size)
            ((eq? m 'push) push)
            ((eq? m 'pop) pop)))
    (lambda args (apply (dispatch (car args)) (cdr args)))))

(The following exercise is from https://inst.eecs.berkeley.edu/~cs61as/sp13/lab/9.html)

Exercise 2: Provide the arguments for the two set-cdr! operations in the blanks below to produce the indicated effect on list1 and list2. Do not create any new pairs; just rearrange the pointers to the existing ones.

> (define list1 (list (list 'a) 'b))
list1
> (define list2 (list (list 'x) 'y))
list2
> (set-cdr! ________ ________)
okay
> (set-cdr! ________ ________)
okay
> list1
((a x b) b)
> list2
((x b) y)

(set-cdr! (car list2) (cdr list1))
(set-cdr! (car list1) (car list2))

(The following exercise is from https://mitpress.mit.edu/sicp/full-text/book/book-Z-H-22.html)

Exercise 3: Devise a correct version of the count-pairs procedure that returns the number of distinct pairs in any structure.

(define (count-pairs d)
  (define (ineq? p list)
    (if (null? list) #f
        (or (eq? p (car list)) (ineq? p (cdr list)))))
  (define (hlp d seen)
    (cond ((null? d) seen)
          ((not (pair? d)) seen)
          ((ineq? d seen) seen)
          (#t (let ((seen2 (hlp (car d) (cons d seen))))
                  (hlp (cdr d) seen2)
                ))))
  (length (hlp d '()))
)

Exercise 4: Write vector-append, which takes two vectors as arguments and returns a new vector containing the elements of both arguments, analogous to append for lists.

(define (vector-append v1 v2)
  (let* ((lv1 (vector-length v1))
         (lv2 (vector-length v2))
         (v (make-vector (+ lv1 lv2))))
    (do ((i 0 (+ i 1)))
      ((= i lv1) #f)
      (vector-set! v i (vector-ref v1 i)))
    (do ((i 0 (+ i 1)))
      ((= i lv2) #f)
      (vector-set! v (+ lv1 i) (vector-ref v1 i)))
    v
))

But

The goal of this lab is to practice lambda calculus and the connection to scheme.

Exercise 1: Make a derivation of expression 2S1 in lambda calculus.

Exercise 2: Define True, False, And, Or, from lambda calculus in scheme.

(define T (lambda (x y) x))
(define F (lambda (x y) y))
 
(define-syntax lif
  (syntax-rules ()
    ((lif c a b) (c (lambda () a) (lambda () b)))))
 
(define (mand a b)
  (a b F))
 
(define (mor a b)
  (a T b))

Exercise 3: Define zero and the successor functions form lambda calculus in scheme.

(define M0
  (lambda (s)
    (lambda (z) z)))
 
(define succ
  (lambda (w)
    (lambda (y)
      (lambda (x)
        (y ((w y) x))))))

You can test it as:

(((succ (succ (succ M0))) (lambda (x) (+ x 1))) 0)
(((succ (succ (succ M0))) (lambda (x) (cons 'I x))) '())

Exercise 4: Define recursive function factorial without using define.

(lambda (x)
    (let ((rec-fun (lambda (rec n)
                     (if (= 0 n) 1
                         (* n (rec rec (- n 1)))))))
      (rec-fun rec-fun x)))

Without let

(lambda (n)
    ((lambda (rec-fun par1) (rec-fun rec-fun par1))
     (lambda (fact-hlp m)
       (if (= m 0) 1
           (* m (fact-hlp fact-hlp (- m 1))))) n)

Exercise 5: Generalize the function to a variant of the Y combinator for scheme.

(define Y
  (lambda (f)
    ((lambda (d) (d d))
     (lambda (r) (f (lambda (arg) ((r r) arg)))))))

You can use it to recursively call a factorial function.

((Y (lambda (f) (lambda (x) (if (= x 1) 1 (* x (f (- x 1))))))) 5)

The goal of this lab is to get familiar with Haskell interpreter and basics of Haskell programming.

Exercise 1: Write a function for the n-th Fibonacci number using pattern matching.

fib 0 = 1
fib 1 = 1
fib n = fib (n-1) + fib (n-2)

Exercise 2: Write a function for the n-th Fibonacci number using one definition and if-then-else.

fib1 n = if n==0 then 1
         else if n==1 then 1
         else fib1 (n-1) + fib1 (n-2)

Exercise 3: Write a function for the n-th Fibonacci number using guards.

fib2 n | n==0 = 1
       | n==1 = 1
       | otherwise = fib2 (n-1) + fib2 (n-2)

Exercise 4: Write a function for computing roots of a quadratic equations with storing the intermediate results using let and where.

roots1 a b c =
  let sd = sqrt(b^2 - 4*a*c)
      aa = 2*a
  in ((-b+sd)/aa,(-b-sd)/aa)
 
roots2 a b c = ((-b+sd)/aa,(-b-sd)/aa)
  where sd = sqrt(b^2 - 4*a*c)
        aa = 2*a

Exercise 5: Write a function for the n-th Fibonacci number effectively using only one function definition in the top level scope.

fib3 n = x
  where (_,x) = hlp n
          where hlp 1 = (0,1)
                hlp n = (b,a+b)
                  where (a,b) = hlp (n-1)

Exercise 6: Write the standard function take, which returns a list of the first n elements of a list.

take’ 1 (x:_) = [x]
take’ n (x:xs) = [x] ++ take’ (n-1) xs

Exercise 7: Write the standard function reverse, which reverses a list.

reverse’ xs = rev_acc xs [] where
   rev_acc [] acc = acc
   rev_acc (x:xs) acc = rev_acc xs (x:acc)

Further, the students will write merge sort. Exercise 8: Write the function split, which splits the elements in a list to two equally long lists.

split [] = ([],[])
split [x] = ([x],[])
split (x:y:xs) = (x:fs,y:ss) where (fs,ss) = split xs

Exercise 9: Write the function merge, which merges two sorted lists.

merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys) | x<y       = (x:merge xs (y:ys))
                    | otherwise = (y:merge (x:xs) ys)

Exercise 10: Write the function msort, which uses the previous functions to implement the mergesort.

msort [] = []
msort [x] = [x]
msort xs = merge (msort ls) (msort rs) 
   where (ls,rs) = split xs

The goal of this lab is to practice writing Haskell functions, understand the build-in types in Haskell, type signatures, creating own type definitions and working with them.

Exercise 1: Write type declarations for the functions form the last lab.

fib :: Int -> Int
roots1 :: Floating a => a -> a -> a -> (a,a)
split :: [a] -> ([a],[a])
merge :: Ord a => [a] -> [a] -> [a]
mergesort :: Ord a => [a] -> [a]

Exercise 2: Write a one line function for a list of all Fibonacci numbers.

fibs :: [Int]
fibs = 1:1:[a+b | (a,b) <- zip fibs (tail fibs)]

Exercise 3: Write a two line function for a list of all prime numbers numbers based on the sieve of Eratosthenes.

primes :: [Int]
primes = sieve [2..]
  where sieve (p:xs) = p:sieve [x | x<-xs,  x `mod` p /= 0]

Exercise 4: Make an own type for representing colours: Red, Green, Blue (use deriving for Show and Eq). Define a predicate isred determining whether a color is red.

data Colors = Red | Green | Blue deriving (Eq, Show)
 
isred :: Colors -> Bool
isred Red = True
isred _ = False
 
isred2 c = (c == Red)

Exercise 5: Make your own type for representing lists of arbitrary elements (use deriving for Show and Eq). Implement list2myList, length for MyList.

data MyList a = Nil | Cons a (MyList a) deriving (Show, Eq)
 
list2my :: [a] -> (MyList a)
list2my [] = Nil
list2my (x:xs) = Cons x (list2my xs)
 
len :: (MyList a) -> Int
len Nil = 0
len (Cons x xs) = 1 + len xs

Exercise 6: Make a function that creates a binary search tree containing elements of a list and implement an efficient search in the binary search tree.

data BSTree a = BSNil | BSNode (BSTree a) a (BSTree a) deriving Show
 
makeSTree :: (Ord a) => [a] -> (BSTree a)
makeSTree [] = BSNil
makeSTree (x:xs) = BSNode (makeSTree [y | y <-xs, y<x]) 
                          x
                          (makeSTree [y | y <-xs, y>x])  
 
occurs2 :: Ord a => a -> BSTree a -> Bool
occurs2 x BSNil = False
occurs2 x (BSNode l y r) | x == y = True
                         | x < y  = occurs2 x l
                         | x > y  = occurs2 x r

The goal of this lab is to understand Haskell type classes and practice writing own instances.

Exercise 1: Write explicit definition of instances of Show and Eq for Colors and MyList from the last lab.

instance Show Colors where
  show Red = "red"
  show Green = "green"
  show Blue = "blue"
 
instance Eq Colors where
  Red == Red = True
  Green == Green = True
  Blue == Blue = True
  _    == _    = False
 
instance (Show a) => Show (MyList a) where
  show Nil = ""
  show (Cons x Nil) = show x
  show (Cons x xs) = (show x) ++ ", " ++ (show xs)
 
instance (Eq a) => Eq (MyList a) where
  Nil == Nil = True
  (Cons x xs) == (Cons y ys) = x==y && xs==ys
  _ == _ = False

Exercise 2: Write explicit definition of instance of Show for BSTree from the last lab, so that it is displayed clearly on multiple lines using proper indentation.

instance (Show a) => Show (BSTree a) where
  show t = disp 0 t
    where
      indent n str = take n [' ',' '..] ++ str ++ "\n"
      disp n BSNil = ""
      disp n (BSNode l x r) = indent n (show x)
                              ++ disp (n+4) l
                              ++ disp (n+4) r

Exercise 3: Define infix operator += that adds a new element into a BSTree. Start with the type declaration.

(+=) :: (Ord a) => (BSTree a) -> a -> (BSTree a)
BSNil += x = BSNode BSNil x BSNil
t@(BSNode l x r) += y | x==y = t
                      | x<y  = BSNode l x (r += y)
                      | otherwise = BSNode (l += y) x r

Exercise 4: Define a higher order function treeFold that allows computing the number of elements in a tree, sum of the elements, depth. Assuming it is not a proper search tree also maximum, minimum. Define all these functions using a suitable lambda functions and ending elements.

treeFold :: (a -> b -> b -> b) -> b -> (BSTree a) -> b
treeFold f e BSNil = e
treeFold f e (BSNode l x r) = f x (treeFold f e l) (treeFold f e r)
 
treeSum = treeFold (\x y z -> x+y+z) 0 
 
treeDepth :: (BSTree a) -> Int
treeDepth = treeFold (\x y z -> 1 + max y z) 0
 
treeNumElems :: (Num a) => (BSTree a) -> a
treeNumElems = treeFold (\x y z -> 1 + y + z) 0
 
treeMin :: (Ord a) => (BSTree a) -> Maybe a
treeMin BSNil = Nothing
treeMin t@(BSNode l e r) = Just (treeFold (\x y z -> min x (min y z)) e t)
 
treeMax :: (Ord a) => (BSTree a) -> Maybe a
treeMax BSNil = Nothing
treeMax t@(BSNode l e r) = Just (treeFold (\x y z -> max x (max y z)) e t)

Exercise 1: Define functions for determining whether a BSTree form previous lecture is balanced.

isBalanced :: (BSTree a) -> Bool
isBalanced BSNil = True
isBalanced (BSNode l y r) = isBalanced l && isBalanced r && abs (treeDepth l - treeDepth r) <= 1

Exercise 2: Make BSTree an instance of the Functor class.

instance Functor BSTree where
  fmap f BSNil = BSNil
  fmap f (BSNode l x r) = BSNode (fmap f l) (f x) (fmap f r)

Exercise 3: Use function sections to increment all elements in the tree by 5.

fmap (+5) t

Exercise 4: Make the binary search tree and the related functions a separate module. Use it from another file with qualification T. Replace the treeMin implementation by a more efficient one in the new file.

Add to the beginning of the file 'module BST where' and save the file to BST.hs

import BST as T hiding (treeMin)
 
t = makeSTree [15,20,9,1,16,13,3,17,8,10,11] += 14 += 99
 
treeMin :: (Ord a) => (T.BSTree a) -> Maybe a
treeMin T.BSNil = Nothing
treeMin (T.BSNode T.BSNil x _) = Just x
treeMin (T.BSNode l _ _) = treeMin l

Exercise 5: Write a program that reads from the standard input one line and outputs the number of characters in that line.

main :: IO ()
main = do putStr "Enter a string: \n"
          xs <- getLine
          putStr "The string has "
          putStr (show (length xs))
          putStrLn " characters."

Exercise 6: Rewrite the program from Exercise 5 without do notation.

main :: IO ()
main = putStr "Enter a string: \n" >>
       getLine >>= \xs
       -> putStr "The string has " >>
       putStr (show (length xs)) >>
       putStrLn " characters."

Exercise 1: Implement a standalone program that allows two players to play Nim against each other.

import Data.Char
 
 
type Board = [Int]
 
initial :: Board
initial = [5,4,3,2,1]
 
data Player = P1 | P2 deriving Show
nextPlayer P1 = P2
nextPlayer P2 = P1
 
 
move :: Board -> Int -> Int -> Board
move board row num = take (row-1) board
                     ++ [(board !! (row-1)) - num]
                     ++ drop row board
 
putRow :: Int -> Int -> IO ()
putRow row num = do putStr (show row)
                    putStr ": "
                    putStrLn ['*' | x <- [1..num]]
 
putBoard :: Board -> IO ()
putBoard board = sequence_ [putRow i n | (i,n) <- zip [1..length board] board]
 
isFinished :: Board -> Bool
isFinished b = all (<=0) b
 
getDigit :: String -> IO Int
getDigit msg = do putStrLn msg
                  line <- getLine
                  let x = (line!!0)
                  if length line == 1 && isDigit x then
                    return (digitToInt x)
                  else
                    do putStrLn "Not a digit!!!"
                       getDigit msg
 
play :: Board -> Player -> IO ()
play board player =
  do putBoard board
     if isFinished board then
       do putStrLn ("\nPlayer " ++ (show player) ++ " wins!!!")
     else
       do putStrLn ("\n" ++ (show player))
          row <- getDigit "Enter a row number: "
          num <- getDigit "Stars to remove: "
          play (move board row num) (nextPlayer player)
 
main :: IO ()
main = play initial P1