; Scheme and the Art of Programming
; Chapter 4

; --- Exercise 4.1
; Define a procedure insert-left with parameters new, old, 
; and ls that builds a list obtained by inserting the item  
; new to the left of each top-level occurence of the item 
; old in the list ls.

(define (insert-left new old ls)
  (cond
   ((null? ls) '())
   ((eq? (car ls) old) (cons new (cons old (insert-left new old (cdr ls)))))
   (else (cons (car ls) (insert-left new old (cdr ls))))))

(insert-left 'z 'a '(a b a c a))
; Value: (z a b z a c z a)

(insert-left 0 1 '(0 1 0 1))
; Value: (0 0 1 0 0 1)

(insert-left 'dog 'cat '(my dog is fun))
; Value: (my dog is fun)

(insert-left 'two 'one '())
; Value: ()


; -- Exercise 4.2
; Define a procedure insert-right with parameters new, old, 
; and ls that builds a list obtained by inserting the item 
; new to the right of each top-level occurence of the item 
; old in the list ls.

(define (insert-right new old ls)
  (cond
   ((null? ls) '())
   ((eq? (car ls) old) (cons old (cons new (insert-right new old (cdr ls)))))
   (else (cons (car ls) (insert-right new old (cdr ls))))))

(insert-right 'z 'a '(a b a c a))
; Value: (a z b a z c a z)

(insert-right 0 1 '(0 1 0 1))
; Value: (0 1 0 0 1 0)

(insert-right 'dog 'cat '(my dog is fun))
; Value: (my dog is fun)

(insert-right 'two 'one '())
; Value: ()


; -- Exercise 4.3
; Define a procedure subs with parameters new, old, and 
; ls that builds a list obtained by replacing each top-level 
; occurence of the item old in the list ls by the item new.

(define (subst new old ls)
  (cond
   ((null? ls) '())
   ((eq? (car ls) old) (cons new (subst new old (cdr ls))))
   (else (cons (car ls) (subst new old (cdr ls))))))

(subst 'z 'a '(a b a c a))
; Value: (z b z c z)

(subst 0 1 '(0 1 0 1))
; Value: (0 0 0 0)

(subst 'dog 'cat '(my dog is fun))
; Value: (my dog is fun)

(subst 'two 'one '())
; Value: ()


; -- Exercise 4.4
; Define a procedure deepen-1 with parameter ls that wraps 
; a pair of parens around each top-level item in ls.

(define (deepen-1 ls)
  (if (null? ls) 
      '()
      (cons (list (car ls)) (deepen-1 (cdr ls)))))

(deepen-1 '(a b c d))
; Value: ((a) (b) (c) (d))

(deepen-1 '((a b) (c (d e)) f))
; Value: (((a b)) ((c (d e))) (f))

(deepen-1 '())
; Value: ()


; -- Exercise 4.5
; Define a procedure subst-all with call structure 
; (subst-all new old ls) that replaces each occurence 
; of the item old in a list ls with the item new.

(define (subst-all new old ls)
  (cond
   ((null? ls) '())
   ((equal? (car ls) old)
    (cons new (subst-all new old (cdr ls))))
   ((pair? (car ls))
    (cons (subst-all new old (car ls)) (subst-all new old (cdr ls))))
   (else 
    (cons (car ls) (subst-all new old (cdr ls))))))

(subst-all 'z 'a '(a (b (a c)) (a (d a))))
; Value: (z (b (z c)) (z (d z)))

(subst-all 0 '(1) '(((1) (0))))
; Value: ((0 (0)))

(subst-all 'one 'two '())
; Value: ()

(define (substq-all new old ls)
  (cond
   ((null? ls) '())
   ((eq? (car ls) old)
    (cons new (substq-all new old (cdr ls))))
   ((pair? (car ls))
    (cons (substq-all new old (car ls)) (substq-all new old (cdr ls))))
   (else 
    (cons (car ls) (substq-all new old (cdr ls))))))

(substq-all 'z 'a '(a (b (a c)) (a (d a))))
; Value: (z (b (z c)) (z (d z)))

(substq-all 0 '(1) '(((1) (0))))
; Value: (((1) (0)))

(substq-all 'one 'two '())
; Value: ()


; -- Exercise 4.6
; Define a procedure insert-left-all with call structure 
; (insert-left-all new old ls) that inserts the item new 
; to the left of each occurence of the item old in the 
; list ls.

(define (insert-left-all new old ls)
  (cond
   ((null? ls) '())
   ((equal? (car ls) old) 
    (cons new (cons old (insert-left-all new old (cdr ls)))))
   ((pair? (car ls))
    (cons (insert-left-all new old (car ls)) 
	  (insert-left-all new old (cdr ls))))
   (else
    (cons (car ls) (insert-left-all new old (cdr ls))))))

(insert-left-all 'z 'a '(a ((b a) ((a (c))))))
; Value: (z a ((b z a) ((z a (c)))))

(insert-left-all 'z 'a '(((a))))
; Value: (((z a)))

(insert-left-all 'z 'a '())
; Value: ()


; -- Exercise 4.7
; Define a procedure sum-all that finds the sum of the 
; numbers in a list that may contain nested sublists.

(define (sum-all lon)
  (cond
   ((null? lon) 0)
   ((pair? (car lon))
    (+ (sum-all (car lon)) (sum-all (cdr lon))))
   (else 
    (+ (car lon) (sum-all (cdr lon))))))

(sum-all '((1 3) (5 7) (9 11)))
; Value: 36

(sum-all '(1 (3 (5 (7 (9))))))
; Value: 25

(sum-all '())
; Value: 0


; -- Exercise 4.8
; Write the definition of a procedure count-parens-all 
; that takes a list as the argument and counts the 
; number of opening and closing parentheses in the list.

(define (count-parens-all ls)
  (cond
   ((null? ls) 2)
   ((list? (car ls)) (+ (count-parens-all (car ls)) (count-parens-all (cdr ls))))
   (else (count-parens-all (cdr ls)))))

(count-parens-all '())
; Value: 2

(count-parens-all '((a b) c))
; Value: 4

(count-parens-all '(((a () b) c) () ((d) e)))
; Value: 14


; -- Exercise 4.9
; Define a procedure count-background-all that takes as its
; arguments item and a list ls and returns the numbers of 
; items in list ls that are not the same as item.

(define (count-background-all item ls)
  (cond
   ((null? ls) 0)
   ((pair? (car ls)) (+ (count-background-all item (car ls)) 
			(count-background-all item (cdr ls))))
   ((not (eq? item (car ls))) (+ 1 (count-background-all item (cdr ls))))
   (else (count-background-all item (cdr ls)))))

(count-background-all 'a '((a) b (c a) d))
; Value: 3

(count-background-all 'a '((((b (((a)) c))))))
; Value: 2

(count-background-all 'b '())
; Value: 0


; -- Exercise 4.10
; Define a procedure left-most that takes a nonempty list as 
; its argument and returns the left-most atomic item in the list.

(define (left-most ls)
  (cond
   ((null? ls) '())
   ((pair? (car ls)) (left-most (car ls)))
   (else (car ls))))

(left-most '((a b) (c (d e))))
; Value: a

(left-most '((((c ((e f) g) h)))))
; Value: c

(left-most '(() a))
; Value: ()


; -- Exercise 4.11
; Define a procedure right-most that takes a nonempty list as 
; its argument and returns the right-most atomic item in the list.

(define (right-most ls)
  (cond
   ((null? ls) '())
   ((and (pair? (car ls)) (null? (cdr ls))) (right-most (car ls)))
   ((null? (cdr ls)) (car ls))
   (else (right-most (cdr ls)))))

(right-most '((a b) (d (c d (f (g h) i) m n) u) v))
; Value: v

(right-most '((((((b (c))))))))
; Value: c

(right-most '(a ()))
; Value: ()


; -- Exercise 4.12
; Write a procedure fact which takes as input a number n 
; and calculates the factorial.  Write a proper recursive 
; and an iterative version of the function.

(define (fact n) (fact-iter n 1))

(define (fact-iter n accum)
  (if (< n 1) accum (fact-iter (- n 1) (* n accum))))
(define (fact-rec n)
  (if (< n 1) 1 (* n (fact-rec (- n 1)))))

(fact 5)
(fact 10)
(fact 50)
(fact 100)


; -- Exercise 4.13
; What happens when you invoke (fact 3.5)?
(fact 3.5)
; Because we use (< n 1) to end the recursion, the result 
; is simply (* 3.5 2.5 1.5) since (- 1.5 -1) => 0.5 which 
; is less than 1.
; Value: 13.125


; -- Exercise 4.14
; Define an iterative procedure harmonic-sum-it that sums 
; the first n terms of the harmonic series
; 1 + (1/2) + (1/3) + (1/4) + (1/5) + ...

(define (harmonic-sum-it n) (harmonic-sum-helper n 0))

(define (harmonic-sum-helper n accum)
  (if (= n 0) accum (harmonic-sum-helper (- n 1) (+ accum (/ 1 n)))))

; Verify that 
; (1/2) + (1/3) + ... + (1/n) <= log n <= 1 + (1/2) + (1/3) + (1/n-1)
(define (verify n)
  (and (< (- (harmonic-sum-it n) 1) (log n)) 
       (< (log n) (harmonic-sum-it (- n 1)))))

; Test using n = 10, 100, 1000, 10000
(define (test n) (if (> n 10000) #t (and (verify n) (test (* n 10)))))

(test 10)
; Value: #t


; -- Exercise 4.15
; Write a recursive procedure for computing fibonacci

(define (fib-rec int)
  (if (< int 2)
      int
      (+ (fib (- int 1)) (fib (- int 2)))))

; The number of recursively calls grows roughly at 2^int - 1, 
; corresponding to the number of vertices in a binary tree.


; -- Exercise 4.16
; Write an iterative procedure for computing fibonacci
; and compare the number of procedure calls to the 
; recursive function written above.

(define (fib-it int acc1 acc2)
  (if (= int 1) acc2 (fib-it (- int 1) acc2 (+ acc1 acc2))))

(define (fib int) (if (zero? int) 0 (fib-it int 0 1)))

; The number of calls in this procedure grows linearly.


; -- Exercise 4.17
; Reproduce Table 4.22

(define (calls-fib n) (+ 1 (* 2 (- (fib (+ n 1)) 1))))
(define (adds-fib n) (- (fib (+ n 1)) 1))

(define echo (lambda (x) x))

(define (tabulate f n)
  (if (< n 0) 
      (newline) 
      (begin (display (f (- 10 n))) (display "\t") (tabulate f (- n 1)))))

(define make-table 
  (lambda () 
    (begin 
      (newline)
      (display "n\t\t") (tabulate echo 10)
      (display "(fib n)\t\t") (tabulate fib 10)
      (display "(calls n)\t") (tabulate calls-fib 10)
      (display "(adds n)\t") (tabulate adds-fib 10))))

(make-table)


; -- Exercise 4.18
; Write an iterative version length-it of the procedure length 
; that computes the length of a list.

(define (length-it ls) (length-it-aux ls 0))

(define (length-it-aux ls accum)
  (if (null? ls) accum (length-it-aux (cdr ls) (+ accum 1))))


; -- Exercise 4.19
; Write an iterative procedure mk-asc-list-of-ints that, 
; for any integer n, produces a list of the integers from 
; 1 to n in ascending order.  Then write an iterative 
; procedure mk-desc-list-of-ints that, for any integer n, 
; produces a list of integers from n to 1 in descending order.

(define (mk-asc-list-of-ints n)
  (mk-desc-list-of-ints-aux n '()))
(define (mk-asc-list-of-ints-aux n ls)
  (if (= n 0) ls (mk-desc-list-of-ints-aux (- n 1) (cons n ls))))

(mk-asc-list-of-ints 10)

(define (mk-desc-list-of-ints n)
  (mk-desc-list-of-ints-aux n 1 '()))
(define (mk-desc-list-of-ints-aux n count ls)
  (if (> count n) ls (mk-desc-list-of-ints-aux n (+ count 1) (cons count ls))))

(mk-desc-list-of-ints 10)


; -- Exercise 4.20
; Define both recursive and iterative versions of a procedure 
; occurs that counts the number of times an item occurs at the 
; top level in a list.

(define (occurs-rec item ls)
  (cond
   ((null? ls) 0)
   ((equal? item (car ls)) (+ 1 (occurs item (cdr ls))))
   (else (occurs item (cdr ls)))))

(define (occurs-iter item ls)
  (occurs-iter-aux item 0 ls))
(define (occurs-iter-aux item count ls)
  (cond
   ((null? ls) count)
   ((equal? item (car ls)) (occurs-iter-aux item (+ count 1) (cdr ls)))
   (else (occurs-iter-aux item count (cdr ls)))))

(define occurs occurs-iter)

(occurs 'a '(a b a c a d))

(occurs 'a '(b c a (b a) c a))

(occurs 'a '(b (c d)))