## October 25, 2009

at Sunday, October 25, 2009 Labels: , , Posted by Billy

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 withanother 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 rowor 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))))`