SICP Exercise 2.2
Consider the problem of representing line segments in a plane. Each segment is represented as a pair of points: a starting point and an ending point. Define a constructor make-segment and selectors start-segment and end-segment that define the representation of segments in terms of points. Furthermore, a point can be represented as a pair of numbers: the x coordinate and the y coordinate. Accordingly, specify a constructor make- point and selectors x-point and y-point that define this representation. Finally, using your selectors and constructors, define a procedure midpoint-segment that takes a line segment as argument and returns its midpoint (the point whose coordinates are the average of the coordinates of the endpoints). To try your procedures, you'll need a way to print points: (define
(print-point p)
(newline)
(display "(")
(display (x-point p))
(display ",")
(display (y-point p))
(display ")"))

;;; Utility functions
(defun average (x y)
  (/ (+ x y)
     2))

;;; Point and segment functions
(defun make-point (x y)
  (cons x y))

(defun x-point (point)
  (car point))

(defun y-point (point)
  (cdr point))

(defun make-segment (start end)
  (cons start end))

(defun start-segment (segment)
  (car segment))

(defun end-segment (segment)
  (cdr segment))

(defun 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)))))

(defun print-point (p)
  (format t "x=~D y=~D~%"
   (x-point p)
   (y-point p)))

SICP Exercise 2.3
Implement a representation for rectangles in a plane. (Hint: You may want to make use of exercise 2.2.) In terms of your constructors and selectors, create procedures that compute the perimeter and the area of a given rectangle. Now implement a different representation for rectangles. Can you design your system with suitable abstraction barriers, so that the same perimeter and area procedures will work using either representation?

(defun make-rec (lower-left-pt upper-right-pt)
  (cons lower-left-pt upper-right-pt))

(defun rec-upper-right (rec)
  (cdr rec))

(defun rec-lower-left (rec)
  (car rec))

(defun rec-upper-left (rec)
  (make-point (x-point (rec-lower-left rec))
               (y-point (rec-upper-right rec))))

(defun rec-lower-right (rec)
  (make-point (x-point (rec-upper-right rec))
               (y-point (rec-lower-left rec))))
 
(defun rec-len (rec)
  (- (y-point (rec-upper-left rec))
     (y-point (rec-lower-left rec))))

(defun rec-width (rec)
  (- (x-point (rec-lower-right rec))
     (x-point (rec-lower-left rec))))

(defun area-rec (rec)
  (* (rec-len rec)
      (rec-width rec)))

(defun perimeter-rec (rec)
  (* 2
     (+ (rec-len rec)
   (rec-width rec))))

;;; Alternative representation of rectangles

(defun alt-make-rec (bottom-seg left-seg)
  (cons bottom-seg left-seg))

(defun alt-upper-left (rec)
  (end-segment (cdr rec)))

(defun alt-lower-left (rec)
  (start-segment (car rec)))

(defun alt-lower-right (rec)
  (end-segment (cdr rec)))

(defun alt-upper-right (rec)
  (make-point (x-point (alt-lower-right rec))
               (y-point (alt-upper-left rec))))

SICP Exercise 2.4
Here is an alternative procedural representation of pairs. For this representation, verify that (car (cons x y)) yields x for any objects x and y.

(define (cons x y)
(lambda (m) (m x y)))
(define (car z)
(z (lambda (p q) p)))

What is the corresponding definition of cdr? (Hint: To verify that this works, make use of the substitution model of section 1.1.5.)

;;; Redefine Scheme functions in CL
(defun alt-cons (x y)
  (lambda (m) (funcall m x y)))

(defun alt-car (z)
  (funcall z (lambda (p q) p)))

(defun alt-cdr (z)
  (funcall z (lambda (p q) q)))

SICPSICP Exercise 2.5
Show that we can represent pairs of nonnegative integers using only numbers and arithmetic operations if we represent the pair a and b as the integer that is the product 2^a*3^b. Give the corresponding definitions of the procedures cons, car, and cdr.

(defun alt2-cons (a b)
  (* (expt 2 a) (expt 3 b)))

(defun alt2-car (z)
  (do ((i 0 (1+ i))
         (n z (/ n 2)))
      ((> (mod n 2) 0) i)))

(defun alt2-cdr (z)
  (do ((i 0 (1+ i))
         (n z (/ n 3)))
      ((> (mod n 3) 0) i)))

SICP Exercise 2.6
In case representing pairs as procedures wasn't mind-boggling enough, consider that, in a language that can manipulate procedures, we can get by without numbers (at least insofar as nonnegative integers are concerned) by implementing 0 and the operation of adding 1 as

(define zero (lambda (f) (lambda (x) x)))

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

This representation is known as Church numerals, after its inventor, Alonzo Church, the logician who invented the calculus. Define one and two directly (not in terms of zero and add-1). (Hint: Use substitution to evaluate (add-1 zero)). Give a direct definition of the addition procedure + (not in terms of repeated application of add-1).

;;; Redefine Scheme functions in CL
(defun zero ()
  (lambda (f)
    (lambda (x) x)))

(defun add-1 (n)
  (lambda (f)
    (lambda (x)
      (funcall f (funcall (funcall n f) x)))))

;;; Definitions of one and two
(defun one ()
  (lambda (f)
    (lambda (x)
      (funcall f x))))

(defun two ()
  (lambda (f)
    (lambda (x)
      (funcall f (funcall f x)))))

;;; We can test our definitions of one and two with the following code:
;;; (funcall (funcall (one) #'1+) 0) => 1
;;; (funcall (funcall (two) #'1+) 0) => 2

;;; Notice the pattern for the definitions of one and two: the natural
;;; number N converts to its corresponding Church numeral by
;;; compositing the function f N times. We can abstract this by
;;; using a macro to define our Church numerals

(defun compose (times)
  (if (= times 1)
      '(funcall f x)
      `(funcall f ,(compose (1- times)))))

(defmacro def-church-numeral (name N)
  `(defun ,name ()
     (lambda (f)
       (lambda (x)
  ,(compose N)))))

;;; Now we can define new Church numerals as follows:
;;; (def-church-numeral three 3)
;;; (funcall (funcall (three) #'1+) 0) => 3

;;; To define an add function for Church numerals, implement the
;;; identity f(m + n)(x) = fm(fn(x)).  The code can look rather
;;; ugly in Common Lisp because the need for funcall, but to 
;;; understand it remember how we call the church numeral 
;;; functions, and see that the code calls the first church
;;; numeral and passes it to the second.

(defun add (m n)
  (lambda (f)
    (lambda (x)
      (funcall (funcall (funcall m) f)
           (funcall (funcall (funcall n) f) x)))))

;;; We can test the add function as follows:
;;;(funcall (funcall (add #'one #'three) #'1+) 0) => 4

SICP Exercise 2.7
Alyssa's program is incomplete because she has not specified the implementation of the interval abstraction. Here is a definition of the interval constructor:

(define (make-interval a b) (cons a b))

Define selectors upper-bound and lower-bound to complete the implementation.

;;; Redefine the Scheme functions in CL

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

(defun 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))))

(defun dev-interval (x y)
  (mul-interval x
        (make-interval (/ 1.0 (upper-bound y))
                         (/ 1.0 (lower-bound y)))))

(defun make-interval (a b)
  (cons a b))

;;; End of Scheme definitions

(defun upper-bound (interval)
  (max (car interval) (cdr interval)))

(defun lower-bound (interval)
  (min (car interval) (cdr interval)))

SICP Exercise 2.8
Using reasoning analogous to Alyssa's, describe how the difference of two intervals may be computed. Define a corresponding subtraction procedure, called sub-interval.

(defun sub-interval (x y)
  (add-interval x
        (make-interval (- (upper-bound y))
                         (- (lower-bound y)))))

SICP Exercise 2.9
The width of an interval is half of the difference between its upper and lower bounds. The width is a measure of the uncertainty of the number specified by the interval. For some arithmetic operations the width of the result of combining two intervals is a function only of the widths of the argument intervals, whereas for others the width of the combination is not a function of the widths of the argument intervals. Show that the width of the sum (or difference) of two intervals is a function only of the widths of the intervals being added (or subtracted). Give examples to show that this is not true for multiplication or division.

(defun interval-width (interval)
  (abs (/ (- (upper-bound interval) (lower-bound interval))
       2.0)))

SICP Exercise 2.11
In passing, Ben also cryptically comments: ‘‘By testing the signs of the endpoints of the intervals, it is possible to break mul-interval into nine cases, only one of which requires more than two multiplications.’’ Rewrite this procedure using Ben’s suggestion.

(defun sym-signum (n)
  "Calls signum and returns + or - instead of 1, -1, 0.  0 is
considered postive for the sake of this exercise"
  (let ((sign (signum n)))
    (cond ((eq sign 1) '+)
       ((eq sign -1) '-)
       ((eq sign 0) '+))))

(defun list-signs (lst)
  "Given a list of numbers, returns a list of the number's signs"
  (mapcar #'sym-signum lst))

(defmacro make-interval-if (signs &body body)
  "Cleans up the definition of new-mul-interval by removing lots
of repeated code"
  `(cond ,@(mapcar #'(lambda (statement)
         (let ((test-signs (first statement))
         (lower-bound (second statement))
         (upper-bound (third statement)))
    `((equal ,signs ',test-signs)
       (make-interval (* ,(first lower-bound)
                     ,(second lower-bound))
                 (* ,(first upper-bound)
                     ,(second upper-bound))))))
     body)))



(defun new-mul-interval (x y)
  (let* ((ux (upper-bound x))
     (lx (lower-bound x))
     (uy (upper-bound y))
     (ly (lower-bound y))
     (signs (list-signs (list lx ux ly uy)))
            ;; max and min are needed for the special case
     (max (max (* lx ly) (* lx uy) (* ux uy) (* ux ly)))
     (min (min (* lx ly) (* lx uy) (* ux uy) (* ux ly))))
    (make-interval-if signs
      ((+ + + +) (lx ly) (ux uy))
      ((+ + - +) (ux ly) (ux uy))
      ((+ + - -) (ux ly) (lx uy))
      ((- + + +) (uy lx) (uy ux))
      ((- + - -) (ux ly) (lx ly))
      ((- - + +) (lx uy) (ly ux))
      ((- - - +) (lx uy) (ly lx))
      ((- - - -) (ux uy) (ly lx))
      ;; special case:
      ((- + - +) (min 1) (max 1)))))

SICP Exercise 2.12
Define a constructor make-center-percent that takes a center and a percentage tolerance and produces the desired interval. You must also define a selector percent that produces the percentage tolerance for a given interval. The center selector is the same as the one shown above.

(defun make-center-percent (center percent)
  (let ((percent (/ percent 100.0)))
    (cons (- center (* center percent))
      (+ center (* center percent)))))

(defun center (interval)
  (/ (+ (lower-bound interval) (upper-bound interval)) 2))

(defun percent (interval)
  (let ((center (center interval))
   (lb (lower-bound interval)))
    (* (/ (- center lb)
   center)
       100)))

The sequence of triangle numbers is generated by adding the natural numbers. So the 7th triangle number would be
1 + 2 + 3 + 4 + 5 + 6 + 7 = 28.
The first ten terms would be:
1, 3, 6, 10, 15, 21, 28, 36, 45, 55, ...

Let us list the factors of the first seven triangle numbers:

1: 1
3: 1,3
6: 1,2,3,6
10: 1,2,5,10
15: 1,3,5,15
21: 1,3,7,21
28: 1,2,4,7,14,28

We can see that 28 is the first triangle number to have over five divisors.

What is the value of the first triangle number to have over five hundred divisors?

(defun num-of-divisors (num)
  "Returns the number of divisors of num for num > 1"
  (let ((square-root (sqrt num))
          (result 0))
    (do ((x 1 (1+ x)))
           ((> x square-root) result)
      (when (zerop (mod num x))
             (setf result (+ 2 result))))))

(defun euler-12 (&optional (tri-num 1) (tri-val 1))
    (if (> (num-of-divisors tri-val) 500)
         tri-val
         (euler-12 (1+ tri-num) (+ 1 tri-num tri-val))))