SICP Exercise 2.17

(defun last-pair (list)
  (if (null (cdr list))
      list
      (last-pair (cdr list))))

SICP Exercise 2.18

(defun rev (list)
  (if (null (cdr list))
      list
      (cons (car (last list))
        (rev (butlast list)))))

SICP Exercise 2.19

(defparameter *us-coins* (list 50 25 10 5 1))
(defparameter *uk-coins* (list 100 50 20 10 5 1 0.5))

(defun count-change (amount coin-values)
  (cc amount coin-values))

(defun cc (amount coin-values)
  (cond ((= amount 0) 1)
     ((or (< amount 0) (no-more-p coin-values)) 0)
     (t (+ (cc amount
           (except-first-denomination coin-values))
             (cc (- amount
               (first-denomination coin-values))
           coin-values)))))

(defun no-more-p (coin-values)
  (null coin-values))

(defun except-first-denomination (coin-values)
  (cdr coin-values))

(defun first-denomination (coin-values)
  (car coin-values))

SICP Exercise 2.20

(defun same-parity (integer &rest integers)
  (cond ((null integers) integer)
    ((evenp integer) (append (list integer)
                                 (remove-if-not #'evenp integers)))
    (t (append (list integer) (remove-if-not #'oddp integers)))))

SICP Exercise 2.21

defun square-list-1 (items)
  (if (null items)
      nil
      (cons (expt (car items) 2)
     (square-list-1 (cdr items)))))

(defun square-list-2 (items)
  (mapcar (lambda (x) (* x x))
   items))

SICP Exercise 2.23

(defun for-each (proc items)
  (when (consp items)
    (funcall proc (car items))
    (for-each proc (cdr items))))

SICP Exercise 2.27

(defparameter x (list (list 1 2) (list 3 4)))

(defun last-element (list)
  "Returns the last element of LIST."
  (car (last list)))

(defun deep-rev (list)
  (cond ((and (= 1 (length list)) (not (listp (car list)))) list)
 ((= 1 (length list)) (list (deep-rev (car list))))
 ((listp (last-element list))
  (cons (deep-rev (last-element list))
        (deep-rev (butlast list))))
 (t (cons (last-element list)
   (deep-rev (butlast list))))))

SICP Exercise 2.28

(defun fringe (list)
  (when list
    (if (atom list)
 (list list)
 (append (fringe (car list))
  (fringe (cdr list))))))

SICP Exercise 2.29

;; a.
(defun make-mobile (left right)
  (list left right))

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

(defun left-branch (mobile)
  (first mobile))

(defun right-branch (mobile)
  (second mobile))

(defun branch-length (branch)
  (first branch))

(defun branch-structure (branch)
  (second branch))

;; b.
(defun mobilep (structure)
  (listp structure))

(defun total-weight (mobile)
  (+ (total-branch-weight (left-branch mobile))
     (total-branch-weight (right-branch mobile))))

(defun total-branch-weight (branch)
  (let ((branch-structure (branch-structure branch)))
    (if (mobilep branch-structure)
 (total-weight branch-structure)
 branch-structure)))

;;; c.
(defun torque (branch)
  (* (branch-length branch)
     (total-branch-weight branch)))

(defun balanced-mobile-p (mobile)
  (let ((left (left-branch mobile))
 (right (right-branch mobile)))
    (cond
      ;; Return false if the left and right torques are unequal.
      ((/= (torque left) (torque right)) nil)
      ;; The mobile is balanced at this level.  Return true if there
      ;; are no more submobiles.
      ((and (not (mobilep left))
     (not (mobilep right)))
       t)
      ;; Submobiles exist.  Check their balance.
      (t (and (if (mobilep (branch-structure left))
    (balanced-mobile-p (branch-structure left))
    t)
       (if (mobilep (branch-structure right))
    (balanced-mobile-p (branch-structure right))
    t))))))

;;; d. For section a, we need to replace the first and second
;;; functions with car and cdr respectively.  The remaining sections
;;; can be left intact.

SICP Exercise 2.30

(defun square-tree-1 (tree)
  (cond ((null tree) nil)
 ((not (listp tree)) (* tree tree))
 (t (cons (square-tree-1 (car tree))
   (square-tree-1 (cdr tree))))))

(defun square-tree-2 (tree)
  (mapcar (lambda (sub-tree)
     (if (listp sub-tree)
  (square-tree-2 sub-tree)
  (* sub-tree sub-tree)))
   tree))

SICP Exercise 2.31

(defun tree-map (proc tree)
  (mapcar (lambda (sub-tree)
     (if (listp sub-tree)
  (tree-map proc sub-tree)
  (funcall proc sub-tree)))
   tree))

(defun square (x)
  (* x x))

(defun square-tree-3 (tree)
  (tree-map #'square tree))

SICP Exercise 2.32

(defun subsets (s)
  (if (null s)
      (list nil)
      (let ((rest (subsets (cdr s))))
 (append rest (mapcar (lambda (x)
          (cons (car s) x))
        rest)))))

SICP Exercise 2.33

(defun accumulate (op initial sequence)
  (if (null sequence)
      initial
      (funcall op (car sequence)
        (accumulate op initial (cdr sequence)))))

(defun my-map (p sequence)
  (accumulate (lambda (x y)
  (cons (funcall p x) y))
       nil
       sequence))

(defun my-append (seq1 seq2)
  (accumulate #'cons seq2 seq1))

(defun my-length (sequence)
  (accumulate (lambda (x y)
  ;; Avoid style warnings by telling the compiler to
  ;; ignore X.
  (declare (ignore x))       
  (+ 1 y))
       0 sequence))

SICP Exercise 2.34

(defun horner-eval (x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms)
  (+ this-coeff
     (* x higher-terms)))
       0
       coefficient-sequence))

SICP Exercise 2.35

(defun count-leaves (tree)
  (accumulate #'+
       0
       (mapcar (lambda (sub-tree)
   (if (listp sub-tree)
       (count-leaves sub-tree)
       1))
        tree)))

SICP Exercise 2.36

(defun accumulate-n (op init seqs)
  (if (null (car seqs))
      nil
      (cons (accumulate op init (mapcar #'car seqs))
     (accumulate-n op init (mapcar #'cdr seqs)))))

SICP Exercise 2.37

(defun dot-product (v w)
  (accumulate #'+ 0 (mapcar #'* v w)))

(defun matrix-*-vector (m v)
  (mapcar (lambda (row)
     (dot-product row v))
   m))

(defun transpose (mat)
  (accumulate-n #'cons nil mat))

(defun matrix-*-matrix (m n)
  (let ((cols (transpose n)))
    (mapcar (lambda (row)
       (matrix-*-vector cols row))
     m)))

SICP Exercise 2.39

(defun fold-left (op initial sequence)
  (labels ((iter (result rest)
      (if (null rest)
   result
   (iter (funcall op result (car rest))
         (cdr rest)))))
    (iter initial sequence)))

(defun fold-right (op initial sequence)
  (accumulate op initial sequence))

(defun reverse-1 (sequence)
  (fold-right (lambda (x y)
  (append y (list x)))
       nil
       sequence))

(defun reverse-2 (sequence)
  (fold-left (lambda (x y)
        (append (list y) x))
      nil
      sequence))

SICP Exercise 2.40

(defun flatmap (proc seq)
  (accumulate #'append nil (mapcar proc seq)))

(defun enumerate-interval (x y)
  "Returns the list from X to Y"
  (loop for i from x to y collect i))

(defun unique-pairs (n)
  (flatmap 
   (lambda (i)
     (mapcar (lambda (j)
        (list i j))
      (enumerate-interval 1 (- i 1))))
   (enumerate-interval 1 n)))

;;; Definitions for prime?

(defun dividesp (a b) (zerop (mod b a)))

(defun find-divisor (n test-divisor)
  (cond ((> (square test-divisor) n) n)
 ((dividesp test-divisor n) test-divisor)
 (t (find-divisor n (+ test-divisor 1)))))

(defun smallest-divisor (n)
  (find-divisor n 2))

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

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

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

(defun prime-sum-pairs (n)
  (mapcar #'make-pair-sum
   (remove-if-not #'prime-sum?
    (unique-pairs n))))

SICP Exercise 2.41

(defun triples (n s)
  (remove-if-not (lambda (list) (= s (reduce #'+ list)))
   (flatmap
    (lambda (i)
      (flatmap
       (lambda (j)
         (mapcar (lambda (k) (list i j k))
          (enumerate-interval 1 (- j 1))))
       (enumerate-interval 1 (- i 1))))
    (enumerate-interval 1 n))))

SICP Exercise 2.42

(defparameter empty-board nil)

(defun board-position (row col)
  "Represents a chess piece's position on the board."
  (list row col))

(defun adjoin-position (row col set-of-positions)
  "Adjoins a new row-column position to a set of positions."
  (append set-of-positions (list (board-position row col))))

(defun get-column (position)
  "Returns the column of the board-position POSITION."
  (cadr position))

(defun get-row (position)
  "Returns the row of the board position POSITION."
  (car position))

(defun get-board-position (col positions)
  "Returns the board position in column COL."
  (car (remove-if-not (lambda (position)
   (= col (get-column position)))
        positions)))

(defun in-same-row? (col positions)
  "Returns true if the queen in column COL shares the same row with
another queen in the position set POSITIONS."
  (let ((row (get-row (get-board-position col positions))))
    (some (lambda (position)
     (and (/= col (get-column position))
   (= row (get-row position))))
   positions)))

(defun in-diagonal? (col positions)
  "Returns true if the queen in column COL resides in the diagonal 
of another queen in the position set POSITIONS."
  (let ((row (get-row (get-board-position col positions))))
    (some (lambda (position)
     (when (/= col (get-column position))
       (= 1 (abs (/ (- row (get-row position))
      (- col (get-column position)))))))
   positions)))

(defun safe? (new-queen old-queens)
  "Returns true if the NEW-QUEEN does not reside in the same row
or diagonal of any of the OLD-QUEENS."
  (cond
    ;; Return true when no OLD-QUEENS exist.
    ((null old-queens) t)
    ;; Test if NEW-QUEEN resides on the same row.
    ((in-same-row? new-queen old-queens) nil)
    ;; Test if NEW-QUEEN resides on the same diagonal.
    ((in-diagonal? new-queen old-queens) nil)
    ;; Return true if all the tests pass.
    (t t)))

(defun queens (board-size)
  (labels ((queen-cols (k)
      (if (= k 0)
   (list empty-board)
   (remove-if-not
    (lambda (positions) (safe? k positions))
    (flatmap
     (lambda (rest-of-queens)
       (mapcar (lambda (new-row)
          (adjoin-position new-row
      k
      rest-of-queens))
        (enumerate-interval 1 board-size)))
     (queen-cols (- k 1)))))))
    (queen-cols board-size)))

SICP Exercise 2.44

(defun up-split (painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
 (below painter (beside smaller smaller)))))

SICP Exercise 2.45

(defun split (proc1 proc2)
  (labels ((do-split (painter n)
      (if (= n 0)
   painter
   (let ((smaller (do-split painter (- n 1))))
     (funcall proc1 painter
       (funcall proc2 smaller smaller))))))
    (lambda (painter n)
      (do-split painter n))))

SICP Exercise 2.46

(defun make-vect (x y)
  (cons x y))

(defun xcor-vect (v)
  (car v))

(defun ycor-vect (v)
  (cdr v))

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

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

(defun scale-vect (s v)
  (make-vect (* s (xcor-vect v))
      (* s (ycor-vect v))))