; Scheme and the Art of Programming
; Chapter 5

; -- Exercise 5.1
; Find the value of each of the following expressions, 
; writing the local environments for each of the nested 
; let expressions.  Draw arrows from each variable to the 
; parameter to which it is bound using a lambda or let 
; expression.  Also draw an arrow from the parameter to 
; the value to which it is bound.

; (a)
(define a 
  (lambda ()
    (let ((a 5))                            ; Env 1
      (let ((fun (lambda (x) (max x a))))   ; Env 2
	(let ((a 10)                        ; Env 3
	      (x 20))
	  (fun 1))))))

; Env 1
;  a  -->  | 5 |

; Env 2
;     --> Env 1
; fun --> |(lambda (x) (max x a))|

; Env 3
;     --> Env 2
;  a  --> 10
;  x  --> 20

; The application of (fun 1) lambda binds x --> 1
; ==> (max 1 a)
; Recall that the scope of the variable a in the 
; let expression in which (fun 1) is called is ONLY 
; the body of the let expression.  (max 1 a) occurs 
; in a different let expression which means that the 
; value of a must be found in that let expression or 
; a parent environment (i.e. Env 1 in this case).
; ==> (max 1 5)
; The maximum is 5, so the result
; ==> 5

(a)

; (b)
(define b 
  (lambda ()
    (let ((a 1) (b 2))
      (let ((b 3) (c (+ a b)))
	(let ((b 5))
	  (cons a (cons b (cons c '()))))))))

  
; Firstly, the a is not present in the local environment or 
; in the immediate parent, which leads to the parent's 
; parent environment being referenced and a --> 1
; ==> (cons 1 (cons b (cons c '())))
; Local environments take precedence over all others, 
; therefore, the (cons a (cons b (cons c '()))) statement 
; will resolve b --> 5, as it is within the scope of the 
; third let statement
; ==> (cons 1 (cons 5 (cons c '())))
; To resolve c, the parent environment must be referenced. 
; Since a is not defined in the local environment, the 
; parent environment is referenced and a --> 1 
; To resolve b, the parent environment must be referenced. 
; The new mapping for b created in in the let statement is 
; accessible to the body of let, but not the actual 
; declaration statements.  Therefore b --> 2
; ==> (c (+ 1 2))
; Therefore c --> 3
; ==> (cons 1 (cons 5 (cons 3 '())))
; ==> (1 5 3)

(b)


; -- Exercise 5.2
; Find the value of each of the following letrec expressions:

; (a)
(define a 
  (lambda ()
    (letrec 
	((loop
	  (lambda (n k)
	    (cond
	     ((zero? k) n)
	     ((< n k) (loop k n))
	     (else (loop k (remainder n k)))))))
      (loop 9 12))))

; This program will output the result of 
; ((lambda (n k) ()) 9 12)
; In this case, the lambda is an implementation 
; of Euclid's algorithm for finding the gdc.
; ==> 3

(a)

; (b)
(define b
  (lambda ()
    (letrec
	((loop
	  (lambda (n)
	    (if (zero? n)
		0
		(+ (remainder n 10) (loop (quotient n 10)))))))
      (loop 1234))))

; This program will add the individual digits of the number 
; specified as a parameter to loop.
(b)


; -- Exercise 5.3
; Write the two expressions in Parts a and b of 
; Exercise 5.1 as nested lambda expressions without 
; using any let expressions.

; (a)

((lambda (a)
   ((lambda (fun) 
      ((lambda (a x) (fun 1)) 10 20)) 
    (lambda (x) (max x a)))) 5)

; (b)

((lambda (a b)
   ((lambda (b c)
      ((lambda (b)
	 (cons a (cons b (cons c '())))) 5))
    3 (+ a b))) 1 2)
   
; -- Exercise 5.4
; Find the value of the following letrec expression.

(letrec ((mystery
	  (lambda (tuple odds evens)
	    (if (null? tuple)
		(append odds evens)
		(let ((next-int (car tuple)))
		  (if (odd? next-int)
		      (mystery (cdr tuple)
			       (cons next-int odds) evens)
		      (mystery (cdr tuple)
			       odds (cons next-int evens))))))))
  (mystery '(3 16 4 7 9 12 24) '() '()))

; Firstly, the letrec function adds a mapping mystery to a local  
; environment; the scope of this variable will include the 
; variable definition part and the body of the letrec (enabling 
; calls to mystery from within the variable definition part of 
; the letrec form).
; The mystery variable will evaluate to a lambda of three params: 
; tuple, odds, and evens.  It adds a mapping next-int to a new 
; local environment with the value of the first element in tuple.
; If the first element (next-int) is odd, then it adds this to 
; the odds and calls mystery on the rest of the list.
; If the first element (next-int) is even, then it adds this to 
; the evens and calls mystery on the rest of the list.  This will 
; proceed until tuple is null, when mystery will create a single 
; list out of the odds and evens lists.
; This expression, therefore, takes a list of integers tuple and 
; returns a list consisting of the odd numbers in the list 
; followed by the even numbers.

;Value 12: (9 7 3 24 12 4 16)


; -- Exercise 5.5
; We define a procedure mystery as follows:

(define mystery
  (lambda (n)
    (letrec
	((mystery-helper
	  (lambda (n s)
	    (cond
	     ((zero? n) (list s))
	     (else
	      (append
	       (mystery-helper (- n 1) (cons 0 s))
	       (mystery-helper (- n 1) (cons 1 s))))))))
    (mystery-helper n '()))))

; This mystery function will generate all the different 
; arrangments of 1s and 0s of size n.
; Essentially, the list s starts out as a null list and 
; every iteration creates two calls to mystery helper with 
; 0 and a 1 added to each list s in the subsequent call.
; At the end of the recursion, a paren is added to each of 
; created sublists and the subsequent call to append creates 
; a single list with each of the arrangment tuples.
;
;      (0)              (1)           n = 2
; (0 0)   (1 0)    (0 1)   (1 1)      n = 1
;((0 0)) ((1 0))  ((0 1)) ((1 1))     n = 0
;             append
;  ((0 0) (1 0) (0 1) (1 1))

(mystery 2)
;Value 17: ((0 0) (1 0) (0 1) (1 1))


; -- Exercise 5.6
; Rewrite definition of the procedure insert-left-all (see ex. 4.6) 
; using a locally defined procedure that takes the list ls as its 
; only argument

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

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


; -- Exercise 5.7
; Rewrite the definition of the procedure fib-it (see Program 4.24) 
; using a letrec expression to make the iteration local.

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

(fib 6)
; Value: 8


; -- Exercise 5.8
; Program 3.7 is a good definition of list-ref.  Unfortunately, the 
; information displayed upon encountering a reference out of range 
; is not as complete as we might expect.  In the definitions of 
; list-ref, which precede it, however, adequare information is 
; displayed.  Rewrite Program 3.7, using a letrec expression, so 
; that adequate information is displayed.

(define list-ref
  (lambda (ls n)
    (letrec
	((list-ref-helper 
	  (lambda (ls n)
	    (cond
	     ((null? ls) (error "list-ref: Index" n "out of bounds for list" ls))
	     ((zero? n) (car ls))
	     (else (list-ref-helper (cdr ls) (- n 1)))))))
      (if (<= (length ls) n)
	  (error "list-ref: Index" n "out of bounds for list" ls)
	  (list-ref-helper ls n)))))


; -- Exercise 5.9
; Implement the algebra of polynomials in the two ways indicated in 
; the text.

; Version II
; A polynomial is represented symbolically as a list of terms.
; A term is a tuple with the first member being the exponent and the 
; second being the coefficient.
; This version is fully implemented in the text (p. 153)

; Version I
; A polynomial is represented symbolically as a list of coefficients. 
; Any missing terms are assigned a coefficient of zero.
; This version is fully implemented in the text (p. 151)


; -- Exercise 5.10
; Look close at the definition of p+ in the text (see Prog 5.9). 
; When n1 is greater than n2, the variables a2 and rest2 are 
; ignored.  Similarly, when n1 is less than n2, the variables 
; a1 and rest1 are ignored.  Rewrite p+ so that this wasting 
; of effort disappears.
(define textbook-p+
  (lambda (poly1 poly2)
    (cond
     ((zero-poly? poly1) poly2)
     ((zero-poly? poly2) poly1)
     (else (let ((n1 (degree poly1))
		 (n2 (degree poly2)))
	     (cond
	      ((> n1 n2) 
	       (let ((a1 (leading-coef poly1))
		     (rest1 (rest-of-poly poly1)))
		 (poly-cons n1 a1 (p+ rest1 poly2))))
	      ((< n1 n2) 
	       (let ((a2 (leading-coef poly2))
		     (rest2 (rest-of-poly poly2)))
		 (poly-cons n2 a2 (p+ poly1 rest2))))
	      (else
	       (let ((a1 (leading-coef poly1))
		     (rest1 (rest-of-poly poly1))
		     (a2 (leading-coef poly2))
		     (rest2 (rest-of-poly poly2)))
		 (poly-cons n1 (+ a1 a2) (p+ rest1 rest2))))))))))


; -- Exercise 5.11
; Define a procedure poly-quotient that finds the quotient 
; polynomial when poly1 is divided by poly2 and a procedure 
; poly-remainder that finds the remainder polynomial when 
; poly1 is divided by poly2.
(define (poly-scale poly n) (map (lambda (x) (* x n)) poly))

(define (poly-quotient poly1 poly2)
  (let
      ((scale (/ (leading-coef poly1) (leading-coef poly2))))
    (if (< (degree poly1) (degree poly2)) the-zero-poly
	(poly-cons (- (degree poly1) (degree poly2)) scale
	      (poly-quotient (rest-of-poly (p+ (poly-scale poly2 (* scale -1)) poly1))
			     poly2)))))

(define (poly-remainder poly1 poly2)
  (let
      ((scale (/ (leading-coef poly1) (leading-coef poly2))))
    (if (< (degree poly1) (degree poly2)) poly1
	(poly-remainder (rest-of-poly (p+ (poly-scale poly2 (* scale -1)) poly1)) 
		       poly2))))

(poly-quotient '(2 3 1 1 0) '(1 1 0 0))
(poly-remainder '(2 3 1 1 0) '(1 1 0 0))

; -- Exercise 5.12
; Another representation of polynomials as lists that can be 
; used is a list of coefficients in the order of increasing 
; degree.  The list of pairs representation given above can 
; also be written in order of increasing degree.  Consider 
; the advantages or disadvantages of these representations 
; compared to those given above.
(define poly1
  (poly-cons 4 5 (poly-cons 3 -7 (poly-cons 1 2 (poly-cons 0 -4 the-zero-poly)))))
(define poly2
  (poly-cons 3 1 (poly-cons 2 6 (poly-cons 1 -3 the-zero-poly))))

(define poly1 (reverse poly1))
(define poly2 (reverse poly2))

; The polynomial addition function would be optimized, as 
; it could be implemented as a simple pair-wise addition 
; function.  This would reduce the storage allocated to 
; manage the environments, as well as reduce the stack 
; usage by minimizing the number of function calls.
(define (p+ poly1 poly2)
  (cond
   ((null? poly1) poly2)
   ((null? poly2) poly1)
   (else (cons (+ (leading-coef poly1) (leading-coef poly2))
	 (p+ (rest-of-poly poly1) (rest-of-poly poly2))))))
(define (p- poly1 poly2)
  (p+ poly1 (poly-scale poly2 -1)))


(p+ poly1 poly2)
; Value: (-4 -1 6 -6 5)

; This would consequently optimize the subtraction function, 
; and the multiplication function as addition forms a part 
; of both of those functions.
    

; -- Exercise 5.13
; How would the constructors and selectors be defined if we use 
; (cons deg coef) instead of (list deg coef) in our second 
; representation using list of pairs?
(define the-zero-poly (cons 0 0))
(define (degree poly) (caar poly))
(define (leading-coef poly) (cdar poly))
(define (rest-of-poly poly) (cdr poly))

(define (zero-poly? p) (and (zero? (degree p)) (zero? (leading-coef p))))

(define (poly-cons deg coef poly) 
  (cond
   ((null? poly) poly)
   ((and (not (zero? coef)) (>= deg (degree poly))) 
    (cons (cons deg coef) poly))
   (else (cons (car poly) (poly-cons deg coef (rest-of-poly poly))))))


; -- Exercise 5.14
; Explain two benefits of the following program over the p* 
; implementation in the text.

(define p*
  (let
      ((t* (lambda (trm poly)
	     (let ((deg (degree trem))
		   (lc (leading-coef trm)))
	       (letrec
		   ((t*-helper
		     (lambda (poly)
		       (if (zero-poly? poly)
			   the-zero-poly
			   (poly-cons
			    (+ deg (degree poly))
			    (* lc (leading-coef poly))
			    (t*-helper (rest-of-poly poly)))))))
		 (t*-helper poly))))))
    (lambda (poly1 poly2) ...)))

; Correction #1
; (degree trm) and (leading-coef trm) is only evaluated once.
; The scope of the bindings for deg and tl is the body of the 
; let form; this body includes the local definition of the 
; t*-helper lambda.  So the inner letrec will add a new local 
; environment, with the deg and lc bindings in the parent 
; environment.  The recursion takes place entirely in the 
; context of the inner letrec; all references to deg and lc 
; will reference the parent environment, which is not destroyed 
; until the body of the let terminates (or until after the 
; t*-helper function completes).

; Correction #2
; The variable tm does not need to be passed to t*.
; The recursion is localized by the addition of the t*-helper 
; function.  The variable trm is lambda bound by the lambda t*, 
; so it exists in t*-helper's parent environment, from where it 
; can be referenced without requiring it as a formal parameter to 
; the t*-helper function.


; -- Exercise 5.15
; In the textbook version I of poly-cons, the procedure list-of-zeros 
; requires one recursion over the list of zeros and append requires 
; another.  Rewrite the program to require only one recursion over 
; the list of zeros.

(define (poly-cons deg coef poly) 
  (letrec ((pdeg (degree poly))
	   (zero-fill (lambda (n ls) 
			(if (zero? n) ls (cons 0 (zero-fill (- n 1) ls))))))
    (cond
     ((null? poly) the-zero-poly)
     ((< deg pdeg) (cons (car poly) (poly-cons def coef (rest-of-poly poly))))
     ((= deg pdeg) (cons (+ coef (leading-coef poly)) (rest-of-poly poly)))
     ((> deg (+ pdeg 1)) (cons coef (zero-fill (- deg (+ pdeg 1)) poly)))
     (else (cons coef poly)))))


; -- Exercise 5.16
; Convert each of the following decimal numbers to base 2.

(define (decimal->binary num)
  (if (zero? num) '()
      (append (decimal->binary (quotient num 2)) (list (remainder num 2)))))

(decimal->binary 53)
; Value: (1 1 0 1 0 1)

(decimal->binary 404)
; Value: (1 1 0 0 1 0 1 0 0)


; -- Exercise 5.17
; Convert each of the following base 2 numbers to decimals.

(define (binary->decimal num)
  (letrec
      ((helper (lambda (num accum)
		 (cond
		  ((null? (cdr num)) (+ accum (car num)))
		  (else (helper (cdr num) (* 2 (+ (car num) accum))))))))
    (helper num 0)))

(binary->decimal '(1 0 1 0 1 0 1 0))
; Value: 170

(binary->decimal '(1 1 0 1 0 1 1))
; Value: 107


; -- Exercise 5.18
; Define a procedure change-base that changes a number num 
; from base b1 to base b2, where num is a list of digits.

(define (base->decimal num base)
  (letrec
      ((helper (lambda (num accum)
		 (cond
		  ((null? (cdr num)) (+ accum (car num)))
		  (else (helper (cdr num) (* base (+ (car num) accum))))))))
    (helper num 0)))

(define (decimal->base num base)
  (if (zero? num) '()
      (append (decimal->base (quotient num base) base) (list (remainder num base)))))

(define (change-base num b1 b2)
  (decimal->base (base->decimal num b1) b2))

(change-base '(5 11) 16 8)
; Value: (1 3 3)

(change-base '(6 6 2) 8 2)
; Value: (1 1 0 1 1 0 0 1 0)

(change-base '(1 0 1 1 1 1 1 0 1) 2 16)
; Value: (1 7 13)