Functional programming exercises/examples in Scheme

recursion_examples.scm

;; fact -- Returns the factorial of a given positive integer.
(define fact
 (lambda (n)
   (if (eq? n 0) 1 (* n (fact (- n 1))))))


;; list-length - return length of a list.
(define list-length
  (lambda (L)
    (if (null? L)
	0
	(+ 1 (list-length (cdr L))))))

;; fact with helper, tail recursion, and accumulator
(define factacc
  (lambda (n)
    (factacc* n 1)))

(define factacc*
  (lambda (n acc)
    (cond
     [(eq? n 1) acc]
     [else (factacc* (- n 1) (* acc n))])))

;; Exercise
;; Write a function (reverse ls) which takes a list ls and returns the
;; list in reverse order.
;; E.g., (reverse '()) => (),  (reverse '(1 2 3 4)) => (4 3 2 1)

;; Question: What is the running time of your function?

;; Running time = O(n^2), assuming append runs in O(n) time.
(define reverse 
  (lambda (ls)
    (cond 
     [(null? ls) '()]
     [else (let ([head (car ls)]
		 [tail (cdr ls)])
	     (append (reverse tail) (list head)))])))

;; Question: Can we do better? Yes!

;; Running time = O(n) using accumulator
(define reverse-acc
  (lambda (ls)
    (reverse-acc* ls '())))

(define reverse-acc*
  (lambda (ls acc)
    (cond
     [(null? ls) acc]
     [else
      (let ([head (car ls)]
	    [tail (cdr ls)])
	(reverse-acc* tail (cons head acc)))])))
	    

;; Tracing is a powerful debugging tool
(trace reverse reverse-acc reverse-acc*)

;; reverse is _not_ tail recursive
;; ------------------------
;; > (reverse '(1 2 3))
;; |(reverse (1 2 3))
;; | (reverse (2 3))
;; | |(reverse (3))
;; | | (reverse ())
;; | | ()
;; | |(3)
;; | (3 2)
;; |(3 2 1)
;; (3 2 1)
;; ------------------------

;; reverse-acc is tail recursive
;; -------------------------------
;; > (reverse-acc '(1 2 3))
;; |(reverse-acc (1 2 3))
;; |(reverse-acc* (1 2 3) ())
;; |(reverse-acc* (2 3) (1))
;; |(reverse-acc* (3) (2 1))
;; |(reverse-acc* () (3 2 1))
;; |(3 2 1)
;; (3 2 1)
;; ------------------------------


;; Exercise
;; Write a function (fib n) computing the nth Fibonacci number
;; E.g., (fib 0) => 0, (fib 1) => 1, (fib 2) => 1, (fib 5) => 5 ...

;; Question: What is the running time of your function

;; Fibonacci - brute force - O(2^n)
(define fib
  (lambda (n)
    (cond 
     [(eq? 0 n) 0]
     [(eq? 1 n) 1]
     [else (+ (fib (- n 1)) (fib (- n 2)))])))

;; Question: How can we do better?

;; Fibonacci - tail recursion - O(n)
(define fib-tail
  (lambda (n)
    (cond 
     [(eq? 1 n) 0]
     [else (fib-tail* 0 1 2 n)])))

(define fib-tail*
  (lambda (f_i-1 f_i i n)
    (cond 
     [(eq? i n) f_i]
     [else (fib-tail* f_i (+ f_i-1 f_i) (+ i 1) n)])))


;; Exercise - Dual recursion
;; What do the following pair of function compute?
;; And what is their running time?
(define even?
  (lambda (x)
    (cond
     [(eq? x 0) #t]
     [else (odd? (- x 1))])))

(define odd?
  (lambda (x)
    (cond
     [(eq? x 0) #f]
     [else (even? (- x 1))])))

(trace odd? even?)


;; You can define "private" recursive functions using the syntactic
;; form letrec.  Its just like the syntactic form let, but allows you
;; to define variables storing recursive functions.

(define even
	(lambda (x)
	  (letrec 
	      ([_even
		(lambda (x) 
		  (cond
		   [(eq? x 0) #t]
		   [else (_odd (- x 1))]))]
	       [_odd
		(lambda (x)
		  (cond
		   [(eq? x 0) #f]
		   [else (_even (- x 1))]))])
	    (_even x))))

	 
;; Higher-Order Functions (HOF)
;; 
;;   Functions are "first-class values" in Scheme.  It's one of the
;;   most defining features of functional languages.  First-class
;;   values are values that can be passed into functions and returned
;;   from functions.

;;   Higher-order functions are functions which take as an argument
;;   and / or return a value which is a function.

;;   For example, the map function from Exercise 29 of HW 1 is a HOF,
;;   because it takes a function as an input.

(define map 
  (lambda (f ls)
    (cond
     [(null? ls) '()]
     [else (cons (f (car ls)) (map f (cdr ls)))]
     )))

(define ls+1 
	(lambda (ls)
		(map (lambda (x) (+ x 1)) ls)))

;;  Here's an example of another HOF which is usage for writing
;;  tail-recursive accumulating functions. It is called "folding" or
;;  "reducing" in other functional languages.

(define fold-left
  (lambda (f acc ls)
    (cond
     [(null? ls) acc]
     [else (fold-left f (f acc (car ls)) (cdr ls))])))

;; An example usage:

(define list-length
  (lambda (ls)
    (fold-left (lambda (acc head) (+ acc 1)) 0 ls)))

(define reverse
  (lambda (ls)
    (fold-left (lambda (acc head) (cons head acc)) '() ls)))

;; Here are some examples from HW1 implemented using map and fold-left.

(define member
  (lambda (e ls)
    (fold-left (lambda (acc head) (or (equal? e head) acc)) #f ls))) 

(define append
  (lambda (ls1 ls2)
    (fold-left (lambda (acc head) (cons head acc)) ls2 (reverse ls1))))

(define flatten
  (lambda (lls)
    (fold-left (lambda (acc head) (append acc head)) '() lls)))

(define map
  (lambda (fn ls)
    (fold-left (lambda (acc head) (cons (fn head) acc)) '() (reverse ls))))

(define filter
  (lambda (p? ls)
    (fold-left (lambda (acc head) (if (p? head) (cons head acc) acc)) '() (reverse ls))))

(define counts
  (lambda (p? ls)
    (fold-left (lambda (acc head) (if (p? head) (+ acc 1) acc)) 0 ls)))

(define insert
  (lambda (num ls)
    (append
     (filter (lambda (head) (>= num head)) ls)
     (cons num (filter (lambda (head) (< num head)) ls)))))

(define sort ;; insertion sort
  (lambda (ls)
    (fold-left (lambda (acc head) (insert head acc)) '() ls)))
    
;;  The following is an example of a HOF function which returns a
;;  function.

(define poly
  (lambda (n)
    (cond 
     [(= n 0) (lambda (x) 1)]
     [else (lambda (x) (+ (* n (expt x n)) ((poly (- n 1)) x)))])))

;; Exercises
;; - What does (poly 1) return?
;; - What does (poly 3) return?
;; - What does ((poly 3) 2) return?