;; Exercise 3.50
;;
(define-syntax cons-stream
  (syntax-rules ()
  ((_ A B) (cons A (delay B)))))

(define (stream-map proc . argstreams)
  (if (stream-null? (car argstreams))
      the-empty-stream
      (cons-stream
       (apply proc (map stream-car argstreams))
       (apply stream-map
              (cons proc (map stream-cdr argstreams))))))


;; Exercise 3.56
;;
(define hammings 
  (cons-stream 
   1 
   (merge (scale-stream hammings 2)
          (merge (scale-stream hammings 3)
                 (scale-stream hammings 5)))))


;; Exercise 3.59a
;;
(define (integrate-series coeffs)
  (stream-map / coeffs integers))


;; Exercise 3.59b
;;
(define cosine-series
  (cons-stream 1 (integrate-series sine-series)))
(define sine-series
  (cons-stream 0 (scale-stream (integrate-series cosine-series) -1)))


;; Exercise 3.62
;;
(define (div-series num denom)
  (let ((denom-const (stream-car denom)))
    (if (zero? denom-const)
        (error ("DIV-SERIES -- denominator constant term must be non-zero" ))
        (mul-series num 
                    (scale-stream ; restore the scaling factor 
                     (invert-unit-series  ; requires a stream that has a unit constant term
                      (scale-stream denom (/ 1 denom-const)))
                     denom-const)))))

(define tan-series (div-series sine-series 
                               cosine-series))


;; Exercise 3.62
;;
(define (ln-summands n)
  (cons-stream (/ 1.0 n)
               (stream-map - (ln-summands (+ n 1)))))

(define ln-stream
  (partial-sum (ln-summands 1)))

(stream-ref ln-stream 5)
0.6166666666666666
(stream-ref (euler-transform ln-stream) 5)
0.6928571428571428
(stream-ref (accelerated-sequence euler-transform ln-stream) 5)
0.6931471806635636


;; Exercise 3.71
;;
(define (ramujan-numbers)
  (define (sum-cubed x)
    (let ((i (car x)) (j (cadr x)))
      (+ (* i i i) (* j j j))))
  (define (ramujans all-sum-cubes)
    (let* ((current (stream-car all-sum-cubes))
           (next (stream-car (stream-cdr all-sum-cubes)))
           (ramujan-candidate (sum-cubed current)))
      (cond ((= ramujan-candidate
                (sum-cubed next))
             (cons-stream (list ramujan-candidate current next)
                          (ramujans (stream-cdr (stream-cdr all-sum-cubes)))))
            (else (ramujans (stream-cdr all-sum-cubes))))))
  (ramujans (weighted-pairs integers 
                            integers 
                            sum-cubed)))


;; Exercise 3.74
;;
(define (sign-change-detector current previous)
  (cond ((and (>= current 0) 
              (< previous 0)) 1)
        ((and (< current 0) 
              (>= previous 0)) -1)
        (else 0)))

(define zero-crossings
  (stream-map sign-change-detector 
              sense-data 
              (cons-stream 0 sense-data)))


;; Exercise 3.77
;;
(define (solve f y0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (stream-map f y))
  y)

(define (integral delayed-integrand initial-value dt)
  (cons-stream initial-value
               (if (stream-null? delayed-integrand)
                   the-empty-stream
                   (let ((integrand (force delayed-integrand)))
                     (integral (delay (stream-cdr integrand))
                               (+ (* dt (stream-car integrand))
                                  initial-value)
                               dt)))))


;; Exercise 3.80
;;
(define (solve-2nd f dt y0 dy0)
  (define y (integral (delay dy) y0 dt))
  (define dy (integral (delay ddy) dy0 dt))
  (define ddy (stream-map f dy y))
  y)

;; Exercise 3.47a
(define (make-sempahore n)
  (let ((count n)
        (the-mutex (make-mutex)))
    (define (the-sempahore m)
      (cond ((eq? m 'acquire)
             (the-mutex 'acquire)
             (if (zero? count)
                 (begin
                   (the-mutex 'release)
                   (the-semaphore 'acquire))
                 (begin
                   (set! count (- count 1))
                   (the-mutex 'release))))
            ((eq? m 'release)
             (the-mutex 'acquire)
             (if (= count n)
                 (the-mutex 'release)
                 (begin
                   (set! count (+ count 1))
                   (the-mutex 'release))))))
    the-sempahore))

;; Exercise 3.47b
(define (make-sempahore n)
  (let ((count n)
        (cell (list false)))
    (define (the-sempahore m)
      (cond ((eq? m 'acquire)
             (if (test-and-set! cell)
                 (the-semaphore 'acquire)
                 (if (zero? count)
                     (clear! cell)
                     (begin
                       (set! count (- count 1))
                       (clear! cell)))))
            ((eq? m 'release)
             (if (test-and-set! cell)
                 (the-semaphore 'release)
                 (if (= count n)
                     (clear! cell)
                     (begin
                       (set! count (+ count 1))
                       (clear! cell)))))))
    the-sempahore))

;;Exercise 3.48
(define (make-account balance acct-num)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (let ((balance-serializer (make-serializer)))
    (define (dispatch m)
      (cond ((eq? m 'withdraw) withdraw)
            ((eq? m 'deposit) deposit)
            ((eq? m 'balance) balance)
            ((eq? m 'serializer) balance-serializer)
            ((eq? m 'acct-num) acct-num)
            (else (error "Unknown request -- MAKE-ACCOUNT"
                         m))))
    dispatch))

(define (exchange account1 account2)
  (let ((difference (- (account1 'balance)
                       (account2 'balance))))
    ((account1 'withdraw) difference)
    ((account2 'deposit) difference)))

(define (serialized-exchange account1 account2)
  (let ((serializer1 (account1 'serializer))
        (serializer2 (account2 'serializer))
        (id1 (account1 'acct-num))
        (id2 (account2 'acct-num)))
    (if (< id1 id2)
        ((serializer2 (serializer1 exchange))
         account1
         account2)
        ((serializer1 (serializer2 exchange))
         account1
         account2))))

;; Exercise 3.17
(define count-pairs
  (let ((seen null))
    (lambda (x)
      (cond ((not (pair? x)) 0)
            ((memq x seen) 0)
            (else (set! seen (cons x seen))
                  (+ (count-pairs (car x))
                     (count-pairs (cdr x))
                     1))))))


;; Exercise 3.19
(define (has-cycle? xs)
  (define (seen-last-pair? x)
    (or (null? x) (null? (cdr x))))
  (define (chase turtle rabbit)
    (cond ((or (null? turtle) (null? rabbit)) #f)
           ((eq? (car turtle) (car rabbit)) #t)
           ((seen-last-pair? (cdr rabbit)) #f)
           (else (chase (cdr turtle) (cddr rabbit)))))
  (if (seen-last-pair? xs)
      #f
      (chase xs (cdr xs))))


;; Exercise 3.21
(define (print-queue q)
  (display (front-ptr q))
  (newline))


;; Exercise 3.23
(define (make-deque)
  (define front null)
  (define rear null)

  (define (set-front! item) (set! front item))
  (define (set-rear! item)  (set! rear item))
  (define (empty-deque?) (null? front))
  (define (insert-front! item)
    (let ((new-front (cons (cons item null) front)))
      (cond ((empty-deque?) (set-front! new-front)
                            (set-rear!  new-front)
                            dispatch)
            (else (set-cdr! (car front) new-front)
                  (set-front! new-front)
                  dispatch))))
  (define (insert-rear! item)
    (let ((new-rear (cons (cons item rear) null)))
      (cond ((empty-deque?) (set-front! new-rear)
                            (set-rear!  new-rear)
                            dispatch)
            (else (set-cdr! rear new-rear)
                  (set-rear! new-rear)
                  dispatch))))
  (define (delete-front!)
    (cond ((empty-deque?) (error "DELETE-FRONT! called on empty queue" front))
          (else (set-front! (cdr front))
                (unless (empty-deque?)
                  (set-cdr!  (car front) null))
                dispatch)))
  (define (delete-rear!)
    (cond ((empty-deque?) (error "DELETE-REAR! called on empty queue" front))
          (else (set-rear! (cdar rear))
                (if (null? rear)
                    (set-front! null)
                    (set-cdr! rear null))
                dispatch)))
  (define (print-queue)
    (define (print-end) (display ")") (newline))
    (display "(")
    (let print-next ((next front))
      (cond ((null? next) (print-end))
            ((null? (cdr next)) (display (caar next))
                                 (print-end))
            (else (display (caar next))
                  (display " ")
                  (print-next (cdr next))))))
  (define (dispatch m)
    (cond ((eq? m 'insert-front!) insert-front!)
          ((eq? m 'insert-rear!)  insert-rear!)
          ((eq? m 'delete-front!) (delete-front!))
          ((eq? m 'delete-rear!)  (delete-rear!))
          ((eq? m 'front)         front)
          ((eq? m 'rear)          rear)
          ((eq? m 'print)         (print-queue))
          (else (error "DEQUEUE -- Unknown instruction" m))))
  dispatch)


;; Exercise 3.25
(define (make-table)
  (define local-table (list '*table*))

  (define (assoc key records)
    (cond ((null? records) #f)
          ((equal? key (caar records)) (car records))
          (else (assoc key (cdr records)))))

  (define (lookup keys)
    (let ((record (assoc keys (cdr local-table))))
      (if record
          (cdr record)
          #f)))

  (define (insert! keys value)
    (let ((record (assoc keys (cdr local-table))))
      (if record
          (set-cdr! record value)
          (set-cdr! local-table (cons (cons keys value) (cdr local-table))))))

  (define (dispatch m)
    (cond ((eq? m 'lookup) lookup)
          ((eq? m 'insert!) insert!)
          (else (error "Unknown operation -- TABLE" m))))
  dispatch)


;; Exercise 3.29
(define (or-gate a1 a2 output)
  (define (or-action-procedure)
    (let ((~a1 (make-wire))
          (~a2 (make-wire))
          (~a1^~a2 (make-wire)))
      (inverter a1 ~a1)
      (inverter a2 ~a2)
      (and-gate ~a1 ~a2 ~a1^~a2)
      (inverter ~a1^~a2 output)))
  (add-action! a1 or-action-procedure)
  (add-action! a2 or-action-procedure)
  'ok)


;; Exercise 3.33
(define (averager a b average)
  (let ((summed (make-connector))
        (two (make-connector)))
    (constant 2 two)
    (adder a b summed)
    (multiplier two average summed)))

;; Exercise 3.35
(define (squarer a b)
  (define (process-new-value)
    (if (has-value? b)
        (if (< (get-value b) 0)
            (error "square less than 0 -- SQUARER" (get-value b))
            (set-value! a (sqrt (get-value b)) me))
        (set-value! b (* (get-value a) (get-value a)) me)))
  (define (process-forget-value) 
    (forget-value! a me)
    (forget-value! b me)
    (process-new-value))
  (define (me request) 
    (cond ((eq? request 'I-have-a-value)
           (process-new-value))
          ((eq? request 'I-lost-my-value)
           (process-forget-value))
          (else
           (error "Unknown request -- SQUARER" request))))
  (connect a me)
  (connect b me)
  me)


;; Exercise 3.37
(define (c+ x y)
  (let ((z (make-connector)))
    (adder x y z)
    z))

(define (c* x y)
  (let ((z (make-connector)))
    (multiplier x y z)
    z))

(define (c/ x y)
  (let ((z (make-connector)))
    (multiplier z y x)
    z))

(define (c- x y)
  (let ((z (make-connector)))
    (multiplier z y x)
    z))

(define (cv x)
  (let ((z (make-connector)))
    (constant x z)
    z))

(define (celsius-fahrenheit-converter x)
  (c+ (c* (c/ (cv 9) (cv 5))
          x)
      (cv 32)))

#lang racket

;; Ex 3.01
;;
(define (make-accumulator delta)
  (lambda (amount)
    (set! delta (+ delta amount))
    delta))

;; Ex 3.02
;;
(define (make-monitored proc)
  (let ((calls 0))
    (lambda (arg)
      (cond ((eq? arg 'how-many-calls?) calls)
            ((eq? arg 'reset-count) (set! calls 0) calls)
            (else (set! calls (+ calls 1))
                  (proc arg))))))

;; Ex 3.03
;;
(define (make-account balance password)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch key m)
    (cond ((not (eq? key password)) 
           (error "Incorrect password -- MAKE-ACCOUNT"))
          ((eq? m 'withdraw) withdraw) 
          ((eq? m 'deposit) deposit)
          (else (error "Unknown request -- MAKE-ACCOUNT" m))))
  dispatch)


;; Ex 3.04
;;
(define (call-the-cops) 
  (display "Calling the cops")
  (error "Too many bad passwords"))

(define (make-alarm-account balance password)
  (define bad-passwords 0)
  (define (withdraw amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)
    (set! balance (+ balance amount))
    balance)
  (define (dispatch key m)
    (cond ((not (eq? key password)) (set! bad-passwords (+ bad-passwords 1))
                                    (if (> bad-passwords 7)
                                        (lambda (v) (call-the-cops))
                                        (lambda (v) "Incorrect password")))
          ((eq? m 'withdraw) (set! bad-passwords 0) 
                             withdraw) 
          ((eq? m 'deposit) (set! bad-passwords 0)
                            deposit)
          ((eq? m 'balance) balance)
          (else (error "Unknown request -- MAKE-ACCOUNT" m))))
  dispatch)


;; Ex 3.05
;;

(define (rand-update x) (random (expt 2 31)))
(define (random-init) (rand-update 0))

(define rand
  (let ((x (random-init)))
    (lambda ()
      (set! x (rand-update x))
      x)))

(define (estimate-pi trials)
  (sqrt (/ 6 (monte-carlo trials cesaro-test))))
(define (cesaro-test)
  (= (gcd (rand) (rand)) 1))
(define (monte-carlo trials experiment)
  (define (iter trials-remaining trials-passed)
    (cond ((= trials-remaining 0)
           (/ trials-passed trials))
          ((experiment)
           (iter (- trials-remaining 1) (+ trials-passed 1)))
          (else
           (iter (- trials-remaining 1) trials-passed))))
  (iter trials 0))

(define (square x) (* x x))
(define (random-in-range low high)
  (let ((range (- high low)))
    (+ low (random range))))

(define (estimate-integral x1 y1 x2 y2 pred? trials)
  (monte-carlo trials 
               (lambda () 
                 (pred? (random-in-range x1 x2)
                        (random-in-range y1 y2)))))


(define (estimate-integral-pi trials)
   (define radius 1000)
  
  (define (circle-test x y) 
    (<= (+ (square x)
           (square y))
        (square radius)))
  
  (exact->inexact 
   (* 4
      (estimate-integral 
       (- radius) (- radius) radius radius
       circle-test 
       trials))))

;; Ex 3.06
;;
(define initial-seed 317)
(define (rand-update-seed x)
  (random (expt 2 31)))

(define (random-init-seed)
  (rand-update-seed (random-seed initial-seed)))

(define rand-seed
  (let ((x (random-init-seed)))
    (lambda (action)
      (cond ((eq? action 'generate) 
             (set! x (rand-update-seed x))
             x)
            ((eq? action 'reset) 
             (lambda (new-seed) 
               (rand-update-seed (random-seed new-seed))))))))

;; Ex 3.07
;;
(define (make-joint acc password joint-password)
  (define (dispatch key m)
    (cond ((not (eq? key joint-password)) 
           (error "Incorrect password -- MAKE-JOINT"))
          ((eq? m 'withdraw) (acc password 'withdraw))
          ((eq? m 'deposit)  (acc password 'deposit))
          (else (error "Unknown request -- MAKE-JOINT" m))))
  dispatch)

;; Ex 3.08
;;
(define f
  (let ((seen-zero? #f))
    (lambda (x)
      (cond (seen-zero? 0)
            (else (set! seen-zero? #t) 
                   x)))))

#lang planet neil/sicp

;; ======================================================================
;;
;; To test the exercises I need an implementation of put and get.
;; These are taken directly from section 3.3.3 of the book 
;; http://mitpress.mit.edu/sicp/full-text/book/book-Z-H-22.html#%_sec_3.3.3
;;
;; ======================================================================

(define (make-table)
  (let ((local-table (list '*table*)))
    (define (lookup key-1 key-2)
      (let ((subtable (assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable))))
              (if record
                  (cdr record)
                  false))
            false)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (assoc key-1 (cdr local-table))))
        (if subtable
            (let ((record (assoc key-2 (cdr subtable))))
              (if record
                  (set-cdr! record value)
                  (set-cdr! subtable
                            (cons (cons key-2 value)
                                  (cdr subtable)))))
            (set-cdr! local-table
                      (cons (list key-1
                                  (cons key-2 value))
                            (cdr local-table)))))
      'ok)    
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc!) insert!)
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))

(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))

;;
;; Other procedures taken from the book that support the exercise in section 2.4 
;;
(define variable? symbol?)
(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (=number? exp num)
  (and (number? exp) (= exp num)))
(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list '+ a1 a2))))
(define addend car)
(define augend cadr)

(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else (list '* m1 m2))))
(define multiplier car)
(define multiplicand cadr)

(define (make-exponentiation base exponent)
  (cond ((eq? base 0) 0)
        ((= exponent 0) 1)
        ((= exponent 1) base)
        (else (list '** base exponent))))
(define base car)
(define exponent cadr)


;; Ex 2.73 a
;;
(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp) (if (same-variable? exp var) 1 0))
        (else ((get 'deriv (operator exp)) (operands exp) var))))
(define (operator exp) (car exp))
(define (operands exp) (cdr exp)) 

; The deriv here replaces the explicit check of expression's type and the call to the appropriate procedure to
; actually perform the deriv of the expression with a generic dispatch to a deriv operation installed as a procedure 
; in the dispatch table.
; 
; the get returns a procedure (assuming that the correct deriv procedures are installed) and the retrieved 
; procedure is called passing it the operands also taken from the expression.
;
; Neither number nor variable expressions use an operator or operands so we can't use the same generic diospatch 
; mechanism using the procedures operator and operands. 
;
; It is possible to work around this by changing both procedures and 
; writing 2 new procedures deriv-number and deriv-varibale and installing 
; them into the operations table, but it obfuscates the nature of the problem. 
; i.e. deriving number and variable expression is inherently different from the rest
; 
;
;  (define (operator-b exp)
;    (cond ((number? exp) 'num)
;          ((variable? exp) 'var)
;          (else (car exp))))
;  (define (operands-b exp)
;    (cond ((number? exp) nil)
;          ((variable? exp) nil)
;          (else (cdr exp))))
;  (define (deriv-number exp var) 0)
;  (define (deriv-variable exp var) 
;   (if (same-variable? exp var)
;       1
;       0))
;  (put 'deriv 'num deriv-number)
;  (put 'deriv 'var deriv-variable)
;


;; Ex 2.73 b
;;
(define (deriv-sum exp var) 
  (make-sum (deriv (addend exp) var)
            (deriv (augend exp) var)))

(define (deriv-product exp var) 
  (make-sum (make-product (multiplier exp)
                          (deriv (multiplicand exp) var))
            (make-product (deriv (multiplier exp) var)
                          (multiplicand exp))))

(define (install-deriv)
  (put 'deriv '+ deriv-sum)
  (put 'deriv '* deriv-product)
  'done)

;; Ex 2.73 c
;;
(define (deriv-exponentiation expr var)
  (let ((base (base expr))
        (exponent (exponent expr)))
    (make-product exponent
                  (make-product (make-exponentiation base (make-sum exponent -1))
                                (deriv base var)))))

(define (install-exponentiation-extension)
  (put 'deriv '** deriv-exponentiation)
  'done)

;; Ex 2.73 d
;;
; changing to ((get (operator exp) 'deriv) (operands exp) var)
; means the only changes necessary are to alter each use of put 
; similarly in the installation procedure
;  (put '** 'deriv deriv-exponentiation)
;  (put '+ 'deriv deriv-sum )
;  (put '* 'deriv deriv-product)


;; Ex 2.74a
;;
; Each division has their own file and to needs to provide headquarters with a 

(define (make-hq-file division file)
  (cons division file))
(define (file-division hq-file)
  (car hq-file))
(define (original-file hq-file)
  (cdr hq-file))

(define (get-record employee hq-file)
  ((get 'get-record (file-division hq-file))
   employee (original-file hq-file)))

(define (has-record? employee division)
  ((get 'has-record? division) employee))

;; Ex 2.74b
;;
(define (get-salary hq-file)
  ((get 'get-salary (file-division hq-file))
   (original-record hq-file)))

; The hq record needs the division and the division's record.
(define (make-hq-record division record)
  (cons division record))
(define (record-division hq-record)
  (car hq-record))
(define (original-record hq-record)
  (cdr hq-record))

;; Ex 2.74c
;;
(define (find-employee-record employee files)
  (cond ((null? files) (error "find-employee-record : no such employee." employee))
        ((has-record? employee (file-division (car files)))
         (get-record employee (car files)))
        (else (find-employee-record
               employee (cdr files)))))

;; Ex 2.74d
;;
; Each new company must have it's own unique division identifier (presumable given to them by Insatitable)
; and uses that to provide and install their own specific versions of
;   get-record 
;   has-record?
;   get-salary 
; 
(define (install-ultra-mega-corp)
  (put 'ultra-mega-corp 'get-record ultra-mega-corp-get-record)
  (put 'ultra-mega-corp 'has-record? ultra-mega-corp-has-record?)
  (put 'ultra-mega-corp 'get-salary ultra-mega-corp-get-salary))

(define (ultra-mega-corp-get-record employee file) #t)
(define (ultra-mega-corp-has-record? employee file) #t)
(define (ultra-mega-corp-get-salary employee record) #t)

;; Ex 2.75
;;
(define (make-from-mag-ang x y)
  (define (dispatch op)
    (cond ((eq? op 'real-part) (* x (cos y)))
          ((eq? op 'imag-part) (* x (sin y)))
          ((eq? op 'magnitude) x)
          ((eq? op 'angle)     y)
          (else
           (error "Unknown op -- MAKE-FROM-MAG-ANG" op))))
  dispatch)

#lang planet neil/sicp

;; Ex 2.17
;;
(define (last-pair xs)
  (cond ((null? xs) (error "last-pair expects a non-empty list"))
        ((null? (cdr xs)) xs)
        (else (last-pair (cdr xs)))))

(define (last-pair-b xs)
  (cond ((null? xs) (error "last-pair expects a non-empty list"))
        (else (cons (list-ref xs (- (length xs) 1))
                    nil))))


;; Ex 2.18
;;
(define (reverse-ls xs)
  (define (reverse-loop items result)
    (cond ((null? items) result)
          (else (reverse-loop (cdr items) (cons (car items) result)))))
  (reverse-loop xs nil))

;; Ex 2.19
;;
(define us-coins (list 50 25 10 5 1))
(define uk-coins (list 200 100 50 20 10 5 2 1))   

(define (cc amount coin-values)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (no-more? coin-values)) 0)
        (else
         (+ (cc amount
                (except-first-denomination coin-values))
            (cc (- amount
                   (first-denomination coin-values))
                coin-values)))))

(define first-denomination car)
(define except-first-denomination cdr) 
(define no-more? null?)

;; Ex 2.20
;;
(define (same-parity head . tail)
  
  (define (parity-filter same-parity? others)
    (cond ((null? others) nil)
          ((same-parity? (car others)) (cons (car others)
                                             (parity-filter same-parity? (cdr others))))
          (else (parity-filter same-parity? (cdr others)))))
  
  (cons head (parity-filter (if (even? head) 
                                even?
                                odd?)
                            tail)))

;; Ex 2.21
;;
(define (square x) (* x x))

(define (square-list items)
  (if (null? items)
      nil
      (cons (square (car items)) 
            (square-list (cdr items)))))

(define (square-list-2 items)
  (map square items))

;; Ex 2.22
;;pair?
(define (square-list-louis items)
  (define (iter things answer)
    (if (null? things)
        answer
        (iter (cdr things) 
              (cons (square (car things))
                    answer))))
  (iter items nil))

; The result is built iteratively by appending 
; the square of each item onto the front of the current result list
; but the argument is processed from the beginning in order.
; The result is therefore reversed
(define (square-list-louis-oh-dear items)
  (define (iter things answer)
    (if (null? things)
        answer
        (iter (cdr things)
              (cons answer
                    (square (car things))))))
  (iter items nil))

; This also fails because at each stage a new pair is made from a list and a non-null atom
; - which doesn't produce a valid list structure   


(define (for-each proc items)
  (cond ((null? items) #t)
        (else (proc (car items))
              (for-each proc (cdr items)))))

;; Ex 2.24
;;
(define (count-leaves x)
  (cond ((null? x) 0)  
        ((not (pair? x)) 1)
        (else (+ (count-leaves (car x))
                 (count-leaves (cdr x))))))

; (list 1 (list 2 (list 3 4)))
; (1 (2 (3 4)))
;
;  --------
; | 1 |   |
;  --------
;       |
;       v
;      -------
;     | 2 |   |
;      -------
;          |
;          v
;         -------      ---------
;        | 3     |-->| 4 | nil |
;         -------      ---------
;
;       1
;      /
;     2
;    / \
;   3   4

;; Ex 2.25
;;
(define a '(1 3 (5 7) 9))
(define b '((7)))
(define c '(1 (2 (3 (4 (5 (6 7))))) ))

(define a7 (car (cdr (car (cdr (cdr a))))))
(define b7 (car (car b)))
(define c7 (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr (car (cdr c)))))))))))))

;; Ex 2.26
;;
(define x (list 1 2 3))
(define y (list 4 5 6))
; (append x y) 
; -> (1 2 3 4 5 6)
; (cons x y)
; -> ((1 2 3) 4 5 6)
; (list x y)
; -> ((1 2 3) (4 5 6))

;; Ex 2.27
;;
(define (deep-reverse xs)
  
  (define (reverse-iter items result)
    (if (null? items) 
        result
        (let ((head (car items)))
          (reverse-iter (cdr items) 
                        (cons (if (pair? head)
                                  (deep-reverse head)
                                  head)
                              result)))))
  (reverse-iter xs nil))

(define (deep-reverse-b tree)
  (if (pair? tree) 
      (reverse (map deep-reverse-b tree))
      tree))

;(define dx (list (list 1 2) (list 3 4)))
;(display dx)
;((1 2) (3 4))
;(display (deep-reverse dx))
;((4 3) (2 1))
;(display (deep-reverse-b dx))
;((4 3) (2 1))

;; Ex 2.28
;;
(define (fringe tree)
  (cond ((null? tree) nil)
        ((pair? tree) (append (fringe (car tree))
                              (fringe (cdr tree))))
        (else (list tree))))

;(display (fringe dx))
;(1 2 3 4)

;; Ex 2.29 a
;;
(define (make-mobile left right)
  (list left right))

(define (make-branch length structure)
  (list length structure))

(define (left-branch mobile) (car mobile))
(define (right-branch mobile) (car (cdr mobile)))
(define (branch-length branch) (car branch))
(define (branch-structure branch) (car (cdr branch)))

;; Ex 2.29 b
;;
; Is a branch-structure a mobile?
(define (mobile? s) (pair? s))
; ... or a weight?
(define (weight? s) 
  (and (not (mobile? s))
       (number? s)))

(define (mobile-weight mobile)
  (+ (branch-weight (left-branch  mobile)) 
     (branch-weight (right-branch mobile))))

(define (branch-weight branch)
  (let ((structure (branch-structure branch)))
    (if (mobile? structure) 
        (mobile-weight branch)
        structure)))

;; Ex 2.29 c
;;
(define (mobile-balanced? mobile)
  
  (define (branch-torque branch)
    (* (branch-length branch) (branch-weight branch)))
  
  (define (branch-balanced? branch)
    (let ((structure (branch-structure branch)))
      (or (weight? structure)  
          (mobile-balanced? structure))))
  
  (let ((left  (left-branch  mobile))
        (right (right-branch mobile)))
    (and (branch-balanced? left)
         (branch-balanced? right)
         (= (branch-torque (left-branch  mobile))
            (branch-torque (right-branch mobile))))))


(define balanced-r-branch (make-branch 4 100))
(define unbalanced-r-branch (make-branch 4 10))
(define balanced-l-branch (make-branch 8 50))

(define 2-balanced (make-mobile balanced-l-branch balanced-r-branch))
(define 2-unbalanced (make-mobile balanced-l-branch unbalanced-r-branch))


;; Ex 2.29 d
;;
(define (make-mobile-b left right)
  (cons left right))
(define (make-branch-b length structure)
  (cons length structure))

; Using these new constructors and replacing just 2 selectors we can use
; all of the programs unmodified.
; -> new mobile selector
(define (right-branch-b m) (cdr m))

; -> new branch selector
(define (branch-structure-b b) (cdr b))


;; Ex 2.30
;;
(define (scale-tree tree factor)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (* tree factor))
        (else (cons (scale-tree (car tree) factor)
                    (scale-tree (cdr tree) factor)))))

(define (scale-tree-b tree factor)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (scale-tree-b sub-tree factor)
             (* sub-tree factor)))
       tree))

;(display (scale-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))
;            10))
; => (10 (20 (30 40) 50) (60 70))
;(display (scale-tree-b (list 1 (list 2 (list 3 4) 5) (list 6 7))
;            10))
; => (10 (20 (30 40) 50) (60 70))

(define (square-tree tree)
  (cond ((null? tree) nil)
        ((not (pair? tree)) (square tree))
        (else (cons (square-tree (car tree))
                    (square-tree (cdr tree))))))


(define (square-tree-b tree)
  (map (lambda (sub-tree)
         (if (pair? sub-tree)
             (square-tree-b sub-tree)
             (square sub-tree)))
       tree))
;(display (square-tree (list 1 (list 2 (list 3 4) 5) (list 6 7))))
; => (1 (4 (9 16) 25) (36 49))
;(display (square-tree-b (list 1 (list 2 (list 3 4) 5) (list 6 7))))
; => (1 (4 (9 16) 25) (36 49))


;; Ex 2.31
;;
(define (leaf? x) (not (pair? x)))

(define (tree-map proc tree)
  (cond ((null? tree) nil)
        ((leaf? tree) (proc tree))
        (else (cons (tree-map proc (car tree))
                    (tree-map proc (cdr tree))))))


(define (tree-map-b proc tree)
  (map (lambda (sub-tree)
         (if (leaf? sub-tree)
             (proc sub-tree) 
             (tree-map-b proc sub-tree)))
       tree))


;; Ex 2.32
;;
(define (subsets s)
  (if (null? s)
      (list nil)
      (let ((rest (subsets (cdr s))))
        (append rest (map (lambda (subset) 
                            (cons (car s) subset)) 
                          rest)))))

;(display (subsets (list 1 2 3)))
; => (() (3) (2) (2 3) (1) (1 3) (1 2) (1 2 3))

;; Let L be a list.
; Let H be the first item of list L and T be the remaining items.
; All subsets = LH + LT
; LH = list of all H + LTi - where LTi is a member of LT
; LT = list of all subsets of T

;; Ex 2.33
;;
(define (filter predicate sequence)
  (cond ((null? sequence) nil)
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence) 
          (accumulate op initial (cdr sequence)))))

(define (map-b p sequence)
  (accumulate (lambda (x y) 
                (cons (p x) y)) 
              nil 
              sequence))

(define (append-b seq1 seq2)
  (accumulate cons seq2 seq1))

(define (length-b sequence)
  (accumulate (lambda (a b) 
                (+ b 1)) 
              0 
              sequence))

;; Ex 2.34
;;
(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms) 
                (+ this-coeff (* higher-terms x)))
              0
              coefficient-sequence))


;; Ex 2.35
;;
(define (count-leaves-b t)
  (accumulate +
              0 
              (map (lambda (root)
                     (if (leaf? root)
                         1
                         (count-leaves-b root)))
                   t)))


;; Ex 2.36
;;
(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      nil
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))


;; Ex 2.37
;;
(define (dot-product v w)
  (accumulate + 0 (map * v w)))

(define (matrix-*-vector m v)
  (map (lambda (m-row) 
         (dot-product m-row v)) 
       m))

(define (transpose mat)
  (accumulate-n cons nil mat))

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (m-vector) 
           (matrix-*-vector cols m-vector)) 
         m)))

;; Ex 2.38
;;
(define fold-right accumulate)

(define (fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest)
        result
        (iter (op result (car rest))
              (cdr rest))))
  (iter initial sequence))

;
;(fold-right / 1 '(1 2 3))
; => 1 1/2
;(fold-left / 1 '(1 2 3))
; => 1/6
;(display (fold-right list nil '(1 2 3)))
; => (1 (2 (3 ())))
;(display (fold-left list nil '(1 2 3)))
; => (((() 1) 2) 3)
;

;; Ex 2.39
;;
(define (reverse-r sequence)
  (fold-right (lambda (x y) (append y (list x))) 
              nil 
              sequence))

(define (reverse-l sequence)
  (fold-left (lambda (x y) (cons y x)) 
             nil 
             sequence))

;; Ex 2.40
;;
; Helper procedures from the book text
(define (prime? n)
  (define (smallest-divisor n)
    (define (find-divisor n test-divisor)
      (define (divides? a b) (= (remainder b a) 0))
      (cond ((> (square test-divisor) n) n)
            ((divides? test-divisor n) test-divisor)
            (else (find-divisor n (+ test-divisor 1)))))
    (find-divisor n 2))
  (= n (smallest-divisor n)))

(define (flatmap proc seq)
  (accumulate append nil (map proc seq)))

(define (prime-sum? pair)
  (prime? (+ (car pair) (cadr pair))))

(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (flatmap
                (lambda (i)
                  (map (lambda (j) (list i j))
                       (enumerate-interval 1 (- i 1))))
                (enumerate-interval 1 n)))))


(define (unique-pairs n)
  (flatmap (lambda (i) 
             (map (lambda (j) (list i j))
                  (enumerate-interval 1 (- i 1))))
           (enumerate-interval 1 n)))

(define (prime-sum-pairs-us n)
  (map make-pair-sum
       (filter prime-sum?
               (unique-pairs n))))


;; Ex 2.41
;;
(define (unique-triples n)
  (flatmap (lambda (i) 
             (flatmap (lambda (j) 
                        (map (lambda (k)
                               (list i j k))
                             (enumerate-interval 1 (- j 1)))) 
                      (enumerate-interval 1 (- i 1))))
           (enumerate-interval 1 n)))

(define (sum-of-triple triple)
  (fold-right + 0 triple))

(define (make-triple-sum triple)
  (append triple (list (sum-of-triple triple))))

(define (triple-sum-to-n n sum)
  (map make-triple-sum
       (filter (lambda (triple) 
                 (= (sum-of-triple triple) sum))
               (unique-triples n))))


;; Ex 2.42
;;

(define (queens board-size)
  ; some helper procedures
  (define empty-board nil)
  (define (adjoin-position row positions)
    (cons row positions))
  (define (safe? position)
    
    (define (safe-diagonal? columns)
      
      (define (check-diagonal up down remaining-columns)   
        
        (define (attacked? column up down)
          
          (define (on-board? column) 
            (and (> column 0) 
                 (<= column board-size)))
          
          (or (and (on-board? up)   (= column up))
              (and (on-board? down) (= column down))))
        
        (cond ((null? remaining-columns) #t)
              ((attacked? (car remaining-columns) up down) #f)
              (else (check-diagonal (+ up 1) 
                                    (- down 1)
                                    (cdr remaining-columns)))))
      (let ((k (car columns))) 
        (check-diagonal (+ k 1) (- k 1) (cdr columns))))
    
    (define (safe-horizontal? columns)
      (not (member (car columns) (cdr columns))))
    
    (or (= (length position) 1)  ; the first column is always safe
        (and (safe-horizontal? position) 
             (safe-diagonal?   position))))
  
  ; the main 
  (define (queen-cols k)  
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? positions))
         (flatmap
          (lambda (rest-of-queens)
            (map (lambda (new-row)
                   (adjoin-position new-row rest-of-queens))
                 (enumerate-interval 1 board-size)))
          (queen-cols (- k 1))))))
  
  (queen-cols board-size))

(define (present-solutions solutions)
  (define (present-solution rows)
    (define (present columns rows)
      (cond ((null? rows) nil)
            (else (cons (list (car columns) (car rows))
                        (present (cdr columns) (cdr rows))))))
    (present '(a b c d e f g h) rows))
  
  (map present-solution solutions))


;; Ex 2.43
;;
;(define (queens board-size)
;  ...
;  ...
;  (define (queen-cols k)  
;    (if (= k 0)
;        (list empty-board)
;        (filter
;         (lambda (positions) (safe? positions))
;         (flatmap
;          (lambda (rest-of-queens)
;            (map (lambda (new-row)
;                   (adjoin-position new-row rest-of-queens))
;                 (queen-cols (- k 1))))
;          (enumerate-interval 1 board-size)))))
;  
;  (queen-cols board-size))

;queen-cols original is called N+1 times (last call is escape clause N=0)
;adjoin position is called N times so run-time is
;N(N+1) : O(N^2)
;
;Loius' queen-cols:
;For each call to queen-cols there are N calls to queen-cols (N-1)
;QN  : N*(QN-1)
;QN-1: N*(QN-2)
;QN-2: N*(QN-3)
;...
;Q3  : N*(Q2)
;Q2  : N*(Q1)
;Q1  : N
;N^N : O(N^N)
;N^(N-2)T
;


;; Supporting procedures from the book text
;; 
(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))))

(define (corner-split painter n)
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
            (right (right-split painter (- n 1))))
        (let ((top-left (beside up up))
              (bottom-right (below right right))
              (corner (corner-split painter (- n 1))))
          (beside (below painter top-left)
                  (below bottom-right corner))))))

(define (square-limit painter n)
  (let ((quarter (corner-split painter n)))
    (let ((half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))




;; Ex 2.44
;; 
(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))

;; Ex 2.45
;; 
(define (split compose-large compose-small)
  (lambda (splitter painter n)
    (if (= n 0)
        painter
        (let ((smaller (splitter painter (- n 1))))
          (compose-large painter (compose-small smaller smaller))))))

(define right-split-b (split beside below))
(define up-split-b (split below beside))

;; Ex 2.46
;; 
; The sicp language procedures have different names for vector selectors
(define xcor-vect vector-xcor)
(define ycor-vect vector-ycor)

(define (add-vect v1 v2)
  (make-vect (+ (xcor-vect v1)
                (xcor-vect v2))
             (+ (ycor-vect v1)
                (ycor-vect v2))))

(define (sub-vect v1 v2)
  (make-vect (- (xcor-vect v1)
                (xcor-vect v2))
             (- (ycor-vect v1)
                (ycor-vect v2))))

(define (scale-vect n v)
  (make-vect (* (xcor-vect v) n)
             (* (ycor-vect v) n)))


;; Ex 2.47
;; 
;; version 1 selectors
(define (frame-1-origin frame)
  (car frame))

(define (frame-1-edge-1 frame)
  (car (cdr frame)))

(define (frame-1-edge-2 frame)
  (car (cdr (cdr frame))))

;; version 2 selectors
(define (frame-2-origin frame)
  (car frame))

(define (frame-2-edge-1 frame)
  (car (cdr frame)))

(define (frame-2-edge-2 frame)
  (cdr (cdr frame)))

;; Ex 2.48
;; 
; The sicp language already has make-segment, segment-start and segment-end 
;(define (make-segment v1 v2)
;  (list v1 v2))
;
;(define (start-segment segment)
;  (car segment))
;
;(define (end-segment segment)
;  (car (cdr segment)))


;; Ex 2.49a
;;
(define outline-painter
  (segments->painter (list (make-segment (make-vect 0 0) (make-vect 0 1))
                           (make-segment (make-vect 0 1) (make-vect 1 1))
                           (make-segment (make-vect 1 1) (make-vect 1 0))
                           (make-segment (make-vect 1 0) (make-vect 0 0)))))

;; Ex 2.49b
;;
(define x-painter-segments (list (make-segment (make-vect 0 0) (make-vect 1 1))
                                 (make-segment (make-vect 0 1) (make-vect 1 0))))

(define x-painter (segments->painter x-painter-segments))
;; Ex 2.49c
;;
(define diamond-painter-segments (list (make-segment (make-vect 0 0.5) (make-vect 0.5 1))
                                       (make-segment (make-vect 0.5 1) (make-vect 1 0.5))
                                       (make-segment (make-vect 1 0.5) (make-vect 0.5 0))
                                       (make-segment (make-vect 0.5 0) (make-vect 0 0.5))))
(define diamond-painter (segments->painter diamond-painter-segments))

;; Ex 2.49d
;;
(define wave-painter-segments (list (make-segment (make-vect 0.2 0.0) (make-vect 0.4 0.4))
                                    (make-segment (make-vect 0.4 0.4) (make-vect 0.3 0.5))
                                    (make-segment (make-vect 0.3 0.5) (make-vect 0.1 0.3))
                                    (make-segment (make-vect 0.1 0.3) (make-vect 0.0 0.6))
                                    (make-segment (make-vect 0.0 0.8) (make-vect 0.1 0.5))
                                    (make-segment (make-vect 0.1 0.5) (make-vect 0.3 0.6))
                                    (make-segment (make-vect 0.3 0.6) (make-vect 0.4 0.6))
                                    (make-segment (make-vect 0.4 0.6) (make-vect 0.3 0.8))
                                    (make-segment (make-vect 0.3 0.8) (make-vect 0.4 1.0))
                                    (make-segment (make-vect 0.6 1.0) (make-vect 0.7 0.8))
                                    (make-segment (make-vect 0.7 0.8) (make-vect 0.6 0.6))
                                    (make-segment (make-vect 0.6 0.6) (make-vect 0.8 0.6))
                                    (make-segment (make-vect 0.8 0.6) (make-vect 1.0 0.4))
                                    (make-segment (make-vect 1.0 0.2) (make-vect 0.6 0.4))
                                    (make-segment (make-vect 0.6 0.4) (make-vect 0.8 0.0))
                                    (make-segment (make-vect 0.7 0.0) (make-vect 0.5 0.3))
                                    (make-segment (make-vect 0.5 0.3) (make-vect 0.3 0.0))))
(define wave-painter (segments->painter wave-painter-segments))

;; Ex 2.50
;;
(define (shrink-to-upper-right painter)
  (transform-painter painter
                     (make-vect 0.5 0.5)
                     (make-vect 1.0 0.5)
                     (make-vect 0.5 1.0)))

(define (squash-inwards painter)
  (transform-painter painter
                     (make-vect 0.0 0.0)
                     (make-vect 0.65 0.35)
                     (make-vect 0.35 0.65)))

; again, these are already defined in the sicp language
(define (flip-horiz-b painter)
  (transform-painter painter
                     (make-vect 1.0 0.0)   ; new origin
                     (make-vect 0.0 0.0)   ; new end of edge1
                     (make-vect 1.0 1.0))) ; new end of edge2

(define (rotate180-b painter)
  (transform-painter painter
                     (make-vect 1.0 1.0)   ; new origin
                     (make-vect 0.0 1.0)   ; new end of edge1
                     (make-vect 1.0 0.0))) ; new end of edge2

(define (rotate270-b painter)
  (transform-painter painter
                     (make-vect 0.0 1.0)   ; new origin
                     (make-vect 0.0 0.0)   ; new end of edge1
                     (make-vect 1.0 1.0))) ; new end of edge2

;; Ex 2.51
;;
(define (below-b1 painter1 painter2)
  (let ((split-point (make-vect 0.0 0.5)))
    (let ((paint-down
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              (make-vect 1.0 0.0)
                              split-point))
          (paint-up
           (transform-painter painter2
                              split-point
                              (make-vect 1.0 0.5)
                              (make-vect 0.0 1.0))))
      (lambda (frame)
        (paint-down frame)
        (paint-up frame)))))

(define (below-b2 painter1 painter2)
  (rotate90 (beside (rotate270 painter1)
                    (rotate270 painter2))))


;; Ex 2.52
;;
(define (split-b2 large small)
  (define (splitter painter n)
    (if (= n 0)
        painter
        (let ((smaller (splitter painter (- n 1))))
          (large painter (small smaller smaller)))))
  splitter)

(define right-split-b2 (split-b2 beside below))
(define up-split-b2 (split-b2 below beside))

(define (corner-split-b2 painter n)
  (if (= n 0)
      painter
      (let ((up (up-split-b2 painter (- n 1)))
            (right (right-split-b2 painter (- n 1))))
        (let ((top-left (beside up up))
              (bottom-right (below right right))
              (corner (corner-split-b2 painter (- n 1))))
          (beside (below painter top-left)
                  (below bottom-right corner))))))

(define (square-limit-b2 painter n)
  (let ((quarter (corner-split-b2 painter n)))
    (let ((half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))

(define (square-of-four-b2 tl tr bl br)
  (lambda (painter)
    (let ((top (beside (tl painter) (tr painter)))
          (bottom (beside (bl painter) (br painter))))
      (below bottom top))))

(define (flipped-pairs-b2 painter)
  (let ((combine4 (square-of-four-b2 identity flip-vert
                                  identity flip-vert)))
    (combine4 painter)))

(define (square-limit-b3 painter n)
  (let ((combine4 (square-of-four-b2 flip-horiz identity
                                  rotate180 flip-vert)))
    (combine4 (corner-split-b2 painter n))))

(define smile (list
               (make-segment (make-vect 0.4 0.9) (make-vect 0.45 0.9))
               (make-segment (make-vect 0.6 0.9) (make-vect 0.55 0.9))
               (make-segment (make-vect 0.4 0.8) (make-vect 0.5  0.7))
               (make-segment (make-vect 0.6 0.8) (make-vect 0.5  0.7))))
(define wave-smile-painter (segments->painter 
                            (append wave-painter-segments smile)))

(define (corner-split-b4 painter n)
  (if (= n 0)
      painter
      (let ((up (up-split-b2 painter (- n 1)))
            (right (right-split-b2 painter (- n 1))))
        (let ((top-left up)
              (bottom-right right)
              (corner (corner-split-b2 painter (- n 1))))
          (beside (below painter top-left)
                  (below bottom-right corner))))))

(define (square-limit-b4 painter n)
  (let ((combine4 (square-of-four-b2 flip-vert flip-horiz 
                                  rotate90 rotate270)))
    (combine4 (corner-split-b2 painter n))))

(define (mirror-pairs-b4 painter)
  (let ((combine4 (square-of-four-b2 identity identity
                                  flip-vert  flip-vert)))
    (combine4 painter)))


(define j-body-1
  (list
   (make-segment (make-vect 0.4 0.0)   (make-vect 0.0 0.1))
   (make-segment (make-vect 0.0 0.1)   (make-vect 0.4 0.3))
   (make-segment (make-vect 0.4 0.3)   (make-vect 0.0 0.7))
   (make-segment (make-vect 0.0 0.7)   (make-vect 0.0 0.9))
   (make-segment (make-vect 0.0 0.9)   (make-vect 0.05 0.75))
   (make-segment (make-vect 0.05 0.75) (make-vect 0.1 0.8))
   (make-segment (make-vect 0.1 0.8)   (make-vect 0.2 0.6))
   (make-segment (make-vect 0.2 0.6)   (make-vect 0.35 0.5))
   (make-segment (make-vect 0.35 0.5)  (make-vect 0.25 0.7))
   (make-segment (make-vect 0.25 0.7)  (make-vect 0.4 1.0))
   (make-segment (make-vect 0.4 1.0)   (make-vect 0.55 0.7))
   (make-segment (make-vect 0.55 0.7)  (make-vect 0.45 0.55))
   (make-segment (make-vect 0.45 0.55) (make-vect 0.85 0.9))
   (make-segment (make-vect 0.85 0.9)  (make-vect 0.85 0.95))
   (make-segment (make-vect 0.85 0.95) (make-vect 0.9 1.0))
   (make-segment (make-vect 0.9 1.0)   (make-vect 0.9 0.9))
   (make-segment (make-vect 0.9 0.9)   (make-vect 0.8 0.7))
   (make-segment (make-vect 0.8 0.7)   (make-vect 0.6 0.55))
   (make-segment (make-vect 0.5 0.5)   (make-vect 0.6 0.55))
   (make-segment (make-vect 0.5 0.5)   (make-vect 0.95 0.05))
   (make-segment (make-vect 0.8 0.05)  (make-vect 0.95 0.05))
   (make-segment (make-vect 0.8 0.05)  (make-vect 0.6 0.3))
   (make-segment (make-vect 0.4 0.0)  (make-vect 0.6 0.3))))

(define j-face-1 
  (list
   (make-segment (make-vect 0.35 0.65) (make-vect 0.5 0.7))
   (make-segment (make-vect 0.3 0.8) (make-vect 0.35 0.8))
   (make-segment (make-vect 0.4 0.8) (make-vect 0.45 0.8))))

(define j-painter-1 (segments->painter (append j-body-1 j-face-1)))

(define k-boat-shape
  (list
   (make-segment (make-vect 0.2 0.3) (make-vect 0.1 0.5))
   (make-segment (make-vect 0.2 0.5) (make-vect 0.1 0.5))
   (make-segment (make-vect 0.2 0.5) (make-vect 0.2 0.6))
   (make-segment (make-vect 0.4 0.6) (make-vect 0.2 0.6))
   (make-segment (make-vect 0.4 0.6) (make-vect 0.4 0.8))
   (make-segment (make-vect 0.5 0.8) (make-vect 0.4 0.8))
   (make-segment (make-vect 0.5 0.8) (make-vect 0.5 0.6))
   (make-segment (make-vect 0.7 0.6) (make-vect 0.5 0.6))
   (make-segment (make-vect 0.7 0.6) (make-vect 0.7 0.5))
   (make-segment (make-vect 0.9 0.5) (make-vect 0.7 0.5))
   (make-segment (make-vect 0.9 0.5) (make-vect 0.7 0.3))
   (make-segment (make-vect 0.2 0.3) (make-vect 0.7 0.3))))

(define k-boat-windows
  (list
   (make-segment (make-vect 0.3 0.4) (make-vect 0.3 0.5))
   (make-segment (make-vect 0.4 0.5) (make-vect 0.3 0.5))
   (make-segment (make-vect 0.4 0.5) (make-vect 0.4 0.4))
   (make-segment (make-vect 0.3 0.4) (make-vect 0.4 0.4))
   (make-segment (make-vect 0.5 0.4) (make-vect 0.5 0.5))
   (make-segment (make-vect 0.6 0.5) (make-vect 0.5 0.5))
   (make-segment (make-vect 0.6 0.5) (make-vect 0.6 0.4))
   (make-segment (make-vect 0.5 0.4) (make-vect 0.6 0.4))))

(define k-boat-smoke
  (list
   (make-segment (make-vect 0.45 0.85) (make-vect 0.5 0.9))
   (make-segment (make-vect 0.45 0.9) (make-vect 0.5 0.95))
   (make-segment (make-vect 0.45 0.95) (make-vect 0.5 1.0))))

(define k-boat-painter 
  (segments->painter 
   (append k-boat-shape
           k-boat-windows
           k-boat-smoke)))

(define ai
  (list
   (make-segment (make-vect 0.3 0.7) (make-vect 0.6 0.75))
   (make-segment (make-vect 0.4 0.75) (make-vect 0.4 0.65))
   (make-segment (make-vect 0.5 0.775) (make-vect 0.5 0.675))
   (make-segment (make-vect 0.35 0.6) (make-vect 0.6 0.3))
   (make-segment (make-vect 0.65 0.3) (make-vect 0.6 0.3))
   (make-segment (make-vect 0.55 0.6) (make-vect 0.5 0.5))
   (make-segment (make-vect 0.4 0.4) (make-vect 0.5 0.5))
   (make-segment (make-vect 0.4 0.4) (make-vect 0.2 0.3))))

(define ai-painter (segments->painter ai))

#lang planet neil/sicp

;; Supporting procedures
(define (average a b) (/ (+ a b) 2))
(define (square x) (* x x))
(define (gcd a b)
  (if (= b 0)
      a
      (gcd b (remainder a b))))
(define (make-rat n d)
  (let ((g (gcd n d)))
    (cons (/ n g) (/ d g))))
(define (numer rat) (car rat))
(define (denom rat) (cdr rat))
(define (print-rat x)
  (newline)
  (display (numer x))
  (display "/")
  (display (denom x)))
(define (add-rat x y)
  (make-rat (+ (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))
(define (sub-rat x y)
  (make-rat (- (* (numer x) (denom y))
               (* (numer y) (denom x)))
            (* (denom x) (denom y))))
(define (mul-rat x y)
  (make-rat (* (numer x) (numer y))
            (* (denom x) (denom y))))
(define (div-rat x y)
  (make-rat (* (numer x) (denom y))
            (* (denom x) (numer y))))
(define (equal-rat? x y)
  (= (* (numer x) (denom y))
     (* (numer y) (denom x))))

;;;  Ex 2.1
;;;
(define (bh-make-rat n d)
  (let ((g (abs (gcd n d)))
        (signed-n (if (negative? d) (- n) n)) 
        (signed-d (abs d)))
    (cons (/ signed-n g) (/ signed-d g))))

;;;  Ex 2.2
;;;
(define (make-segment start-segment end-segment) 
  (cons start-segment end-segment))
(define (start-segment segment) 
  (car segment))
(define (end-segment segment) 
  (cdr segment))
(define (segment-length segment)
  (let ((a (start-segment segment))
        (b (end-segment segment)))
    (sqrt (+ (square (- (x-point b)
                        (x-point a)))
             (square (- (y-point b)
                        (y-point a)))))))

(define (make-point x y)
  (cons x y))

(define (x-point point)
  (car point))
(define (y-point point)
  (cdr point))
(define (print-point p)
  (newline)
  (display "(")
  (display (x-point p))
  (display ",")
  (display (y-point p))
  (display ")"))


(define (midpoint-segment segment)
  (make-point (average (x-point (start-segment segment))
                       (x-point (end-segment segment)))
              (average (y-point (start-segment segment))
                       (y-point (end-segment segment)))))

;;;  Ex 2.3
;;;
;; utilities
(define (perimiter rectangle)
  (* 2 (+ (rect-width rectangle)
          (rect-height rectangle))))
(define (area rectangle)
  (* (rect-width rectangle)
     (rect-height rectangle)))

;; representation 1
;;
;;   .------------------------.
;;   |                        |
;;   |<--left-segment         |
;;   |                        |
;;   .------------------------.
;;                  ^
;;                  |
;;                  |
;;            bottom-segment
;;
(define (make-rectangle left-segment bottom-segment)
  (cons left-segment bottom-segment))

;; selectors
(define (left-segment rectangle)
  (car rectangle))
(define (bottom-segment rectangle)
  (cdr rectangle))

;; utilities
(define (rect-width rectangle)
  (segment-length (bottom-segment rectangle)))
(define (rect-height rectangle)
  (segment-length (left-segment rectangle)))
;
;;
;;(b).------------------------------.(top-right)
;;   |                              |
;;   |                              |
;;   |                              |
;;   |                              |
;;   |                              |
;;   .------------------------------.(d)
;; (bottom-left)


; hmmm the SICP language doesn't allow redefinition of existing procedures
; so these all have a unique suffix
(define (make-rectangle-2 bottom-left top-right)
  (cons bottom-left top-right))

;; selectors
(define (bottom-left-2 rectangle)
  (car rectangle))
(define (top-right-2 rectangle)
  (cdr rectangle))

; not necessary but they make the utilities easier to read
(define (top-left-2 rectangle)
  (make-point (x-point (bottom-left-2 rectangle))
              (y-point (top-right-2 rectangle))))  
(define (bottom-right-2 rectangle)
  (make-point (x-point (top-right-2 rectangle))
              (y-point (bottom-left-2 rectangle))))  

;; utilities
(define (rect-width-2 rectangle)
  (segment-length (make-segment (bottom-left-2 rectangle)
                                (bottom-right-2 rectangle))))

(define (rect-height-2 rectangle)
  (segment-length (make-segment (bottom-left-2 rectangle)
                                (top-left-2 rectangle))))


; Ex 2.4
;
; again - can't redefine existing procedures
;
(define (cons-2 x y)
  (lambda (m) (m x y)))

(define (car-2 z)
  (z (lambda (p q) p)))

(define (cdr-2 z)
  (z (lambda (p q) q)))

;(car-2 (cons-2 x y))
;-> ((cons x y) (lambda (p q) p))
;-> ((lambda (m) (m x y)) (lambda (p q) p))
;-> ((lambda (p q) p) x y)
;-> x

;; Ex 2.5
;;
(define (cons-int x y)
  (* (expt 2 x)
     (expt 3 y)))

(define (log-reduce n base)
  (cond ((not (zero? (remainder n base))) 0)
        (else (+ (log-reduce (/ n base) base) 1))))

(define (car-int z)
  (log-reduce z 2))

(define (cdr-int z)
  (log-reduce z 3))


;; Ex 2.5
;;
(define zero (lambda (f) (lambda (x) x)))

(define (add-1 n)
  (lambda (f) (lambda (x) (f ((n f) x)))))

;-> (add-1 zero)
;(lambda (f) (lambda (x) (f ((zero f) x))))
;(lambda (f) (lambda (x) (f (((lambda (g) (lambda (y) y)) f) x))))
;(lambda (f) (lambda (x) (f ((lambda (y) y) x))))
;(lambda (f) (lambda (x) (f x)))

(define one (lambda (f) (lambda (x) (f x))))

;(add-1 one)
;(lambda (f) (lambda (x) (f ((one f) x))))
;(lambda (f) (lambda (x) (f (((lambda (g) (lambda (y) (g y))) f) x))))
;(lambda (f) (lambda (x) (f ((lambda (y) (f y)) x))))
;(lambda (f) (lambda (x) (f (f x))))

;(define two (lambda (x) (f (f x))))

; no idea how to do this so I looked up a solution on the internet
; and I still donlt understand it
;(define (add a b)
;  (lambda (f)
;    (lambda (x)
;      ((a f) ((b f) x)))))



;; Ex 2.7
;;
(define (make-interval a b) (cons a b))
(define (lower-bound i) (car i))
(define (upper-bound i) (cdr i))

(define (add-interval x y)
  (make-interval (+ (lower-bound x) (lower-bound y))
                 (+ (upper-bound x) (upper-bound y))))

(define (mul-interval x y)
  (let ((p1 (* (lower-bound x) (lower-bound y)))
        (p2 (* (lower-bound x) (upper-bound y)))
        (p3 (* (upper-bound x) (lower-bound y)))
        (p4 (* (upper-bound x) (upper-bound y))))
    (make-interval (min p1 p2 p3 p4)
                   (max p1 p2 p3 p4))))

(define (div-interval x y)
  (mul-interval x 
                (make-interval (/ 1.0 (upper-bound y))
                               (/ 1.0 (lower-bound y)))))

;; Ex 2.8
;;
; X = (lX uX)
; Y = (lY uY)
; lZ = lX - uY => the min point possible subtracting Y's range from X
; uZ = uX - lY => the max point possible subtracting Y's range from X
(define (sub-interval x y)
  (make-interval (- (lower-bound x) (upper-bound y))
                 (- (upper-bound x) (lower-bound y))))

;; Ex 2.9
;;
(define (width-interval x)
  (/ ( - (upper-bound x) (lower-bound x))
     2))

(define ia (make-interval 20 22))
(define ib (make-interval 37 43))
(define wa (width-interval ia)) ; => 1
(define wb (width-interval ib)) ; => 3
(define wa+b (width-interval (add-interval ia ib))) ; => 4 : wa + wb = wa+b
(define wa-b (width-interval (sub-interval ia ib))) ; => 4 : wa + wb = wa+b
(define wa*b (width-interval (mul-interval ia ib))) ; => 103 
(define wa/b (width-interval (div-interval ia ib))) ; => 0.0647391577624136

;; Ex 2.10
;;
(define (spans-zero? interval)
  (and (>= (upper-bound interval) 0)
       (<= (lower-bound interval) 0)))

(define (bh-div-interval x y)
  (if (spans-zero? y)
      (error "div-interval cannot divide by an interval that spans 0")
      (mul-interval x 
                    (make-interval (/ 1.0 (upper-bound y))
                                   (/ 1.0 (lower-bound y))))))

;; Ex 2.11
;;
(define (mul-interval-signs x y)
  (define (-ve-interval? x) (< (upper-bound x) 0))
  (define (+ve-interval? x) (> (lower-bound x) 0))
  (let ((lx (lower-bound x))
        (ux (upper-bound x))
        (ly (lower-bound y))
        (uy (upper-bound y)))
    (cond ((and (-ve-interval? x)
                (-ve-interval? y)) (make-interval (* ux uy) (* lx ly)))
          ((and (+ve-interval? x)
                (+ve-interval? y)) (make-interval (* lx ly) (* ux uy)))
          ((and (-ve-interval? x)
                (+ve-interval? y)) (make-interval (* lx uy) (* ux ly)))
          ((and (+ve-interval? x)
                (-ve-interval? y)) (make-interval (* ux ly) (* lx uy)))
          ((and (+ve-interval? x)
                (spans-zero?   y)) (make-interval (* ux ly) (* ux uy)))
          ((and (-ve-interval? x)
                (spans-zero?   y)) (make-interval (* lx uy) (* lx ly)))
          ((and (spans-zero?   x)
                (+ve-interval? y)) (make-interval (* lx uy) (* ux uy)))
          ((and (spans-zero?   x)
                (-ve-interval? y)) (make-interval (* ux ly) (* lx ly)))
          (else (make-interval (* (min lx ly) (max ux uy))
                               (max (* ux uy) (* lx ly)))))))


;; Ex 2.12
;;
(define (make-center-width c w)
  (make-interval (- c w) (+ c w)))
(define (center i)
  (/ (+ (lower-bound i) (upper-bound i)) 2))
(define (width i)
  (/ (- (upper-bound i) (lower-bound i)) 2))

(define (make-center-percent c tolerance)
  (make-center-width c (* c (/ tolerance 100))))
(define (percent interval)
  (/ (* 100 (width interval))
     (center interval)))

;; Ex 2.14
;;
(define (par1 r1 r2)
  (div-interval (mul-interval r1 r2)
                (add-interval r1 r2)))

(define (par2 r1 r2)
  (let ((one (make-interval 1 1))) 
    (div-interval one
                  (add-interval (div-interval one r1)
                                (div-interval one r2)))))
;
;(define ina (make-center-percent 10 1))
;(define inb (make-center-percent 20 2))
;(define inc (make-center-percent 20 0))
;
;(par1 ina inb)
; => (6.361967213114754 . 6.9844067796610165)
;(par2 ina inb)
; => (6.5776271186440685 . 6.7554098360655725)
;(center (div-interval ina ina))
; => 1.0002000200020003
;(percent (div-interval ina ina))
; => 1.9998000199979906

#lang planet neil/sicp

;; A few helper procedures 
(define (show x) (display x) (newline))
(define (inc n) (+ n 1))
(define (identity x) x)
(define (square x) (* x x))

;;  Ex 1.29
;;;
(define (sum term a next b)
  (if (> a b)
      0
      (+ (term a)
         (sum term (next a) next b))))
(define (integral f a b dx)
  (define (add-dx x) (+ x dx))
  (* (sum f (+ a (/ dx 2.0)) add-dx b)
     dx))

; Simpson's rule
; (h/3)[Y0 + 4y1 + 2Y2 + 4Y3 + ... + 4Yn-1 + Yn]
; h  = (b-a)/n  
; Yk = f(a+kh)
(define (simpson-integral f a b n)
  (define (y-term k h)  
    (let ((y (f (+ a (* k h)))))
      (cond ((or (zero? k)
                 (= k n)) y)
            ((even? k) (* 2 y))
            (else (* 4 y)))))
  (let ((h (/ (- b a) n)))
    (* (/ h 3)
       (sum (lambda (k) (y-term k h)) 0 inc n))))

;(integral cube 0 1 0.01)
; 0.24998750000000042
;(simpson-integral cube 0 1 100)
; 1/4
;(integral cube 0 1 0.001)
; 0.249999875000001
;(simpson-integral cube 0 1 1000)
; 1/4

;;;  Ex 1.30
;;;
(define (sum-iter term a next b)
  (define (iter a result)
    (if (> a b)
        result
        (iter (next a) (+ result (term a)))))
  (iter a 0))

(define (simpson-integral-iter f a b n)
  (define (y-term k h)  
    (let ((y (f (+ a (* k h)))))
      (cond ((or (zero? k)
                 (= k n)) y)
            ((even? k) (* 2 y))
            (else (* 4 y)))))
  (let ((h (/ (- b a) n)))
    (* (/ h 3)
       (sum-iter (lambda (k) (y-term k h)) 0 inc n))))

;;;  Ex 1.31 a)
;;
(define (product term a next b)
  (if (> a b)
      1
      (* (term a)
         (product term (next a) next b))))

(define (factorial n)
  (cond ((zero? n) 1)
        (else (product identity 1 inc n))))  

(define PI-LIMIT 1000)

(define (almost-pi)
  (define (pi-term k)
    (let* ((numer1 (* 2 k))  
           (denom (+ numer1 1))
           (numer2 (+ denom 1)))
      (/ (* numer1 numer2)
         (square denom))))
  (* 4.0 (product pi-term 1 inc PI-LIMIT)))

;;;  Ex 1.31 b)
;;
(define (product-iter term a next b)
  (define (iter a result)
    (if (> a b)
        result
        (iter (next a) (* result (term a)))))
  (iter a 1))

(define (almost-pi-iter)
  (define (pi-term k)
    (let* ((numer1 (* 2 k))  
           (denom (+ numer1 1))
           (numer2 (+ denom 1)))
      (/ (* numer1 numer2)
         (square denom))))
  (* 4.0 (product-iter pi-term 1 inc PI-LIMIT)))

(define (factorial-iter n)
  (cond ((zero? n) 1)
        (else (product-iter identity 1 inc n))))  

;;;  Ex 1.35
; f(x)=1+ 1/x
; Fixed point f => 
; 1+1/x = x
; x+1=x^2
;x^2-x-1=0
; ax^2+bx+c=0 => a=1 b=-1 c=-1
; solving for reals
; [ -b+sqrt(b^2-4ac) ] / 2a => (1+r5)/2
; =  phi
;
;;
(define phi-tolerance 0.00001)
(define (close-enough? v1 v2 tolerance)
  (< (abs (- v1 v2)) tolerance))

(define (fixed-point f first-guess)
  (define (try guess)
    (let ((next (f guess)))
      (if (close-enough? guess next phi-tolerance)
          next
          (try next))))
  (try first-guess))

(define (phi)
  (fixed-point (lambda (x) (+ 1 (/ 1 x))) 1.0))

;;;  Ex 1.37 a
;;
(define (cont-frac n d k)
  (cond ((zero? k) 0)
        (else (/ (n k)
                 (+ (d k) (cont-frac n d (- k 1)))))))

(define 1/phi-tolerance 0.00005)

(define (1/phi)
  (define (try target k)
    (let ((1/phi-k (cont-frac (lambda (i) 1.0)
                              (lambda (i) 1.0)
                              k)))  
      (cond ((close-enough? target 1/phi-k 1/phi-tolerance)
             (show k)
             1/phi-k)
            (else (try target (+ k 1))))))
  (try (/ 1 (phi)) 1))

;;;  Ex 1.37 b
;;
(define (cont-frac-iter n d k)
  (define (iter k result)
    (cond ((zero? k) result)
          (else (iter (- k 1) 
                      (/ (n k)
                         (+ (d k) result))))))
  (iter k 0))

(define (1/phi-iter)
  (define (try target k)
    (let ((1/phi-k (cont-frac-iter (lambda (i) 1.0)
                                   (lambda (i) 1.0)
                                   k)))  
      (cond ((close-enough? target 1/phi-k 1/phi-tolerance)
             (show k)
             1/phi-k)
            (else (try target (+ k 1))))))
  (try (/ 1 (phi)) 1))

;(/ 1 (phi))
;0.6180344478216819
;(1/phi)
;11
;0.6180555555555556
; k = 11
;(1/phi-iter)
;11
;0.6180555555555556
; k = 11


;;;  Ex 1.39
;;
(define (tan-cf x k)
  (cont-frac-iter (lambda (i) 
                    (if (= i 1) x (- (square x))))
                  (lambda (i) 
                    (- (* 2 i) 1))
                  k))

;;;  Ex 1.41
;;
(define (double f)
  (lambda (x) 
    (f (f x))))

;(((double (double double)) inc) 5)
;21

;;;  Ex 1.42
;;
(define (compose f g)
  (lambda (x)
    (f (g x))))

;;;  Ex 1.43
;;
(define (repeated f n)
  (if (= n 1)
      f
      (compose f (repeated f (- n 1)))))

(define (repeated-iter f n)
  (define (iter k result)
    (cond ((= k 1) result)
          (else (compose f (repeated f (- k 1))))))
  (iter n f))

#lang planet neil/sicp

;;;  Ex 1.9
;;

;(define (+ a b)
;  (if (= a 0)
;      b
;      (inc (+ (dec a) b))))

;(+ 4 5)
;(inc (+ (dec 4) 5))
;(inc (+ 3 5))
;(inc (inc (+ (dec 3) 5)))
;(inc (inc (+ 2 5)))
;(inc (inc (inc (+ (dec 2) 5))))
;(inc (inc (inc (+ 1 5))))
;(inc (inc (inc (inc (+ 0 5)))))
;(inc (inc (inc (inc 5))))
;(inc (inc (inc 6)))
;(inc (inc 7))
;(inc 8)
;9 => recursive


;
;(define (+ a b)
;  (if (= a 0)
;      b
;      (+ (dec a) (inc b))))

;(+ 4 5)
;(+ (dec 4) (inc 5))))
;(+ 3 6))
;(+ (dec 3) (inc 6))
;(+ 2 7)
;(+ (dec 2) (inc 7))))
;(+ 1 8)
;(+ (dec 1) (inc 8))))
;(+ 0 9)
;9 => iterative


;;;  Ex 1.10
;;
(define (A x y)
  (cond ((= y 0) 0)
        ((= x 0) (* 2 y))
        ((= y 1) 2)
        (else (A (- x 1)
                 (A x (- y 1))))))

; (A 1 10) => 1024
; (A 2 4)  => 65536
; (A 3 3)  => 65536

(define (f n) (A 0 n))
(define (g n) (A 1 n))
(define (h n) (A 2 n))
(define (k n) (* 5 n n))

; (f n) = 2n
; (g n) = 2^n
; (h n) = 2^(2^(2^....)) or 2^[h(n-1)]
; (k n) = 5n^2

;;;  Ex 1.11
;; f(n) = n if n<3 and f(n) = f(n - 1) + 2f(n - 2) + 3f(n - 3) if n> 3.
;;
(define (f1 n) (f-rec n))
(define (f2 n) 
  (if (< n 3) 
      n
      (f-iter 0 1 2 (- n 2))))

(define (f-rec n)
  (if (< n 3) 
      n
      (+ (* 1 (f-rec (- n 1)))
         (* 2 (f-rec (- n 2)))
         (* 3 (f-rec (- n 3))))))

(define (f-iter a b c count)
  (if (zero? count) 
      c
      (f-iter b 
              c  
              (+ c (* 2 b) (* 3 a))
              (- count 1))))

;;;  Ex 1.12
;; 
(define (pascal row col)
  (cond ((= row 1) 1)
        ((= col 1) 1)
        ((= col row) 1)
        (else (+ (pascal (- row 1) (- col 1))
                 (pascal (- row 1) col)))))


;;;  Ex 1.13
;
; r5 = sqrt 5
; ? = (1+r5)/2
; ? = (1-r5)/2
; 
; ?^2 = (1+r5)^2/4 = (1 + 2r5 + 5)/4 = (3+r5)/2  (1)
; ?^2 = (1-r5)^2/4 = (3-r5)/2                    (2)
;
; Induction:
; Base cases:
; Fib(0)= (?^0 - ?^0)/r5 = 0
; Fib(1)= (? - ?)/r5 = [(1+r5)/2 - (1-r5)/2] / r5 = 1
;
; Fib(k)   = (?^k - ?^k)/r5             (3)
; Fib(k+1) = (?.?^k-?.?^k)/r5           (4)
; Fib(k+2) = [?^k(1+?)-?^k(1+?)] / r5   (3) + (4)
; (1+?) = 1 + (1+r5)/2 = (3+r5)/2 = ?^2     from (1)
; (1+?) = 1 + (1-r5)/2 = (3-r5)/2 = ?^2     from (2)
; Fib(k+2) = ?^k.?^2-?^k.?^2 / r5 = (?^k+2 - ?^k+2) / r5
;
; ? = (1-r5)/2
; 4 < 5 < 9         => 2 < r5 < 3
; -1 > (1-r5) > -2  => |?| < 1
; as n -> inf (1-?)^n -> 0
; Fib(n) -> (? - 0)^n/r5 
; Fib(n) -> ?^n/r5



;;;  Ex 1.14
;; 
(define (count-change amount)
  (cc amount 5))

(define (cc amount kinds-of-coins)
  (cond ((= amount 0) 1)
        ((or (< amount 0) (= kinds-of-coins 0)) 0)
        (else (+ (cc amount
                     (- kinds-of-coins 1))
                 (cc (- amount
                        (first-denomination kinds-of-coins))
                     kinds-of-coins)))))

;; US coins
(define (first-denomination kinds-of-coins)
  (cond ((= kinds-of-coins 1) 1)
        ((= kinds-of-coins 2) 5)
        ((= kinds-of-coins 3) 10)
        ((= kinds-of-coins 4) 25)
        ((= kinds-of-coins 5) 50)))

;;; UK coins
;(define (first-denomination kinds-of-coins)
;  (cond ((= kinds-of-coins 1) 1)
;        ((= kinds-of-coins 2) 2)
;        ((= kinds-of-coins 3) 5)
;        ((= kinds-of-coins 4) 10)
;        ((= kinds-of-coins 5) 20)
;        ((= kinds-of-coins 6) 50)
;        ((= kinds-of-coins 7) 100)
;        ((= kinds-of-coins 8) 200)))

;;;  Ex 1.15
;;

(define (cube x) (* x x x))
(define (p x) (- (* 3 x) (* 4 (cube x))))
(define (sine angle)
   (if (not (> (abs angle) 0.1))
       angle
       (p (sine (/ angle 3.0)))))

; a) p is applied 5 times for (sine 12.15)  with values 4.05, ~1.35 ~0.45 ~0.15, ~0.05
; b) since the angle is being divided by 3 each time the space is (log n)
;    since this is a tail recursive procedure time will also be (log n)

;;;  Ex 1.16
;;;
(define (square x) (* x x))

(define (expt b n)
  (expt-iter b n 1))

(define (expt-iter b counter product)
  (if (= counter 0)
      product
      (expt-iter b
                 (- counter 1)
                 (* b product)))) 

; b^n = [ b^(n/2) ]^ 2 : even n
;     = b.b^(n-1)      : odd n
(define (fast-expt b n)
  (cond ((= n 0) 1)
        ((even? n) (square (fast-expt b (/ n 2))))
        (else (* b (fast-expt b (- n 1))))))

(define (fast-expt-iter b n a)
  (cond ((= n 0) a)
        ((even? n) (fast-expt-iter (square b) (/ n 2) a))
        (else (fast-expt-iter b (- n 1) (* a b)))))

;;;  Ex 1.17
;;;
(define (my-* a b)
  (if (= b 0)
      0
      (+ a (my-* a (- b 1)))))

(define (double n) (+ n n))
(define (halve n) (/ n 2))

(define (fast-* b n)
  (cond ((= n 0) 0)
        ((even? n) (double (fast-* b (halve n))))
        (else (+ b (fast-* b (- n 1))))))

;;;  Ex 1.18
;;;
(define (fast-*-iter b n a)
  (cond ((= n 0) a)
        ((even? n) (fast-*-iter (double b) (halve n) a))
        (else (fast-*-iter b (- n 1) (+ a b)))))


;;;  Ex 1.19
;;;
(define (fib-rec n)
  (cond ((= n 0) 0)
        ((= n 1) 1)
        (else (+ (fib-rec (- n 1))
                 (fib-rec (- n 2))))))

(define (fib n)
  (fib-iter 1 0 0 1 n))

(define (fib-iter a b p q count)
  (cond ((= count 0) b)
        ((even? count)
         (fib-iter a
                   b
                   (+ (square p) (square q))  ; p'
                   (+ (* 2 p q)  (square q))  ; q'
                   (/ count 2)))
        (else (fib-iter (+ (* b q) (* a q) (* a p))
                        (+ (* b p) (* a q))
                        p
                        q
                        (- count 1)))))

;;;  Ex 1.20
;;;
(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (+ test-divisor 1)))))
(define (divides? a b)
  (= (remainder b a) 0))

(define (gcd a b)
  (if (= b 0)
      a
      (gcd b (remainder a b))))

; normal order
; =============
; (gcd 206 40)
;01: zero? 40 
;(gcd 40 (remainder 206 40))
;02: zero? (remainder 206 40)                                                  
;(gcd (remainder 206 40) (remainder 40 (remainder 206 40)))
;03: zero? (remainder 40 (remainder 206 40))                                   
;04: zero? (remainder 40 6)
;zero? 4                                                                   
;(gcd (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
;05: zero? (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))    
;06: zero? (remainder 6 (remainder 40 (remainder 206 40)))                     
;07: zero? (remainder 6 (remainder 40 6))                                      
;08: zero? (remainder 6 4)                                                     
;zero? 2
;(gcd (remainder (remainder 206 40) (remainder 40 (remainder 206 40))) (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))))
;09: zero? (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
;10: zero? (remainder (remainder 40 6) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))  
;11: zero? (remainder 4 (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))                 
;12: zero? (remainder 4 (remainder (remainder 206 40) (remainder 40 6)))                                  
;13: zero? (remainder 4 (remainder (remainder 206 40) 4))                                                 
;14: zero? (remainder 4 (remainder 6 4))                                                                  
;15: zero? (remainder 4 2)                                                                                
;zero? 2                                                                                              
;(gcd (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40)))) 
;     (remainder (remainder (remainder 206 40) (remainder 40 (remainder 206 40))) (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
;16: zero? (remainder (remainder (remainder 206 40) (remainder 40 (remainder 206 40))) (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
;17: zero? (remainder (remainder 6 (remainder 40 (remainder 206 40))) (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
;18: zero? (remainder (remainder 6 (remainder 40 6)) (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
;19: zero? (remainder (remainder 6 4) (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
;20: zero? (remainder 2 (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
;21: zero? (remainder 2 (remainder (remainder 40 6) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
;22: zero? (remainder 2 (remainder 4 (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))))
;23: zero? (remainder 2 (remainder 4 (remainder 6 (remainder 40 (remainder 206 40)))))
;24: zero? (remainder 2 (remainder 4 (remainder 6 (remainder 40 6))))
;25: zero? (remainder 2 (remainder 4 (remainder 6 4)))
;26: zero? (remainder 2 (remainder 4 2))
;27: zero? (remainder 2 2)
;zero? 0
;-> (remainder (remainder 40 (remainder 206 40)) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
;28: -> (remainder (remainder 40 6) (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
;29: -> (remainder 4 (remainder (remainder 206 40) (remainder 40 (remainder 206 40))))
;30: -> (remainder 4 (remainder 6 (remainder 40 (remainder 206 40))))
;31: -> (remainder 4 (remainder 6 (remainder 40 6)))
;32: -> (remainder 4 (remainder 6 4))
;32: -> (remainder 4 2)
;33: -> (remainder 4 2)
;-> 2
;
; applicative order
; ==================
; (gcd 206 40)
;(gcd 206 40)
;
;zero? 40
;(gcd (40 (remainder 206 40)))
;rc 01:: (gcd 40 6)
;zero? 6
;(gcd 6 (remainder 40 6))
;rc 02:: (gcd 6 4)
;(gcd 6 4)
;zero? 4
;(gcd 4 (remainder 6 4))
;rc 03:: (gcd 4 2)
;zero? 2
;(gcd 2 (remainder 4 2))
;rc 04:: (gcd 2 2)
;zero? 2
;(gcd (2 (remainder 2 2)))
;rc 05:: (gcd (2 0))
;zero? 0
;-> 2


;;;  Ex 1.21
;;;
(define (smallest-divisor n)
  (define (find-divisor n test-divisor)
    (define (divides? a b) (= (remainder b a) 0))
    (cond ((> (square test-divisor) n) n)
          ((divides? test-divisor n) test-divisor)
          (else (find-divisor n (+ test-divisor 1)))))
  (find-divisor n 2))

;(smallest-divisor 199)
;199
;(smallest-divisor 1999)
;1999
;(smallest-divisor 19999) 
;7


;;;  Ex 1.22
;;;
(define null '())

(define (prime? n)
  (= n (smallest-divisor n)))

(define (timed-prime-test n)
  (newline)
  (display n)
  (start-prime-test n (runtime)))
(define (start-prime-test n start-time)
  (if (prime? n)
      (report-prime (- (runtime) start-time))))
(define (report-prime elapsed-time)
  (display " *** ")
  (display elapsed-time))

(define (search-for-primes start max-primes)
  (define (primes-from n count)
    (cond ((zero? count) null)
          ((prime? n) (cons n (primes-from (+ n 2) (- count 1))))
          (else (primes-from (+ n 2) count))))
  (primes-from (if (even? start) 
                   (+ 1 start) 
                   start)
               max-primes))

;;;  Ex 1.23
;;;
(define (smallest-odd-divisor n)
  (find-odd-divisor n 2))

(define (find-odd-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (next-divisor test-divisor)))))

(define (next-divisor n)
  (+ n (if (= n 2) 1 2)))

(define (prime-odd? n)
  (= n (smallest-odd-divisor n)))

(define (search-for-odd-primes start max-primes)
  (define (primes-from n count)
    (cond ((zero? count) null)
          ; ((timed-odd-prime? n) (cons n (primes-from (+ n 2) (sub1 count))))
          ((prime? n) (cons n (primes-from (+ n 2) (- count 1))))
          (else (primes-from (+ n 2) count))))
  (primes-from (if (even? start) 
                   (+ 1 start) 
                   start)
               max-primes))

;;;  Ex 1.1
;;;

10                       
;  10

(+ 5 3 4)                
;  12

(- 9 1)                  
;  8

(/ 6 2)                  
; 3

(+ (* 2 4) (- 4 6))      
; 6

(define a 3)
(define b (+ a 1))
(+ a b (* a b))          
; 19

(= a b)                  
; #f

(if (and (> b a) (< b (* a b)))
    b
    a)                   
; 4

(cond ((= a 4) 6)
      ((= b 4) (+ 6 7 a))
      (else 25))         
; 16

(+ 2 (if (> b a) b a))   
; 6

(* (cond ((> a b) a)
         ((< a b) b)
         (else -1))
   (+ a 1))
; 16


;;;  Ex 1.2
;;;
(/ (+ 5 4 (- 2 (- 3 (+ 6 (/ 4 5)))))
   (* 3 (- 6 2) (- 2 7)))

;;;  Ex 1.3
;;;
            
(define (sum-larger-squares a b c)
  (cond ((and (<= a b) (<= a c) (+ (* b b) (* c c))))
        ((and (<= b a) (<= b c) (+ (* a a) (* c c))))
        (else (+ (* a a) (* b b)))))

;;;  Ex 1.4
;;;  
(define (a-plus-abs-b a b)
  ((if (> b 0) + -) a b))
;  b is added to a when b is positive 
;  otherwise it is subtracted which is equivalent to adding the absolute value of b

;;;  Ex 1.5
;;
(define (p) (p))
(define (test x y)
  (if (= x 0)
      0
      y))

; Applicative order: (test 0 (p)) => 0
; Normal order: (test 0 (p)) => infinite loop

(define (sqrt x)
  (sqrt-iter 1.0 x))

(define (sqrt-iter guess x)
  (if (good-enough? guess x)
      guess
      (sqrt-iter (improve guess x)
                 x)))

(define (improve guess x)
  (average guess (/ x guess)))

(define (average x y)
  (/ (+ x y) 2))

(define (good-enough? guess x)
  (< (abs (- (square guess) x)) 0.001))

(define (square x) (* x x))

;;;  Ex 1.6
;;
(define (new-if predicate then-clause else-clause)
  (cond (predicate then-clause)
        (else else-clause)))

;(define (sqrt-iter guess x)
;  (new-if (good-enough? guess x)
;      guess
;      (sqrt-iter (improve guess x)
;                 x)))
;

; sqrt-iter will never terminate : the first call to new-if will evaluate the else clause which is a call to sqrt-iter
; sqrt-iter
;   new-if
;     sqrt-iter
;       ...  


;;;  Ex 1.7
;;

; good-enough? isn't accurate for values much smaller than the tolerance level.

(define (sqrt-gap x)
  (sqrt-iter-gap 1.0 0 x))

(define (sqrt-iter-gap guess last-guess x)
  (if (good-enough-gap? guess last-guess x)
      guess
      (sqrt-iter-gap (improve guess x) 
                     guess
                     x)))

(define (good-enough-gap? guess last-guess x)
  (< (abs (- guess last-guess)) (/ guess 100000)))

;;;  Ex 1.8
;;
(define (cube-root x)
  (cube-root-iter 1.0 0 x))

(define (cube-root-iter guess last-guess x)
  (if (good-enough-gap? guess last-guess x)
      guess
      (cube-root-iter (improve-cube guess x) 
                      guess
                      x)))

(define (improve-cube guess x)
  (/ (+ (/ x (square guess))
        (* 2 guess))
     3))