158 lines
3.7 KiB
Common Lisp
158 lines
3.7 KiB
Common Lisp
(defun add-rat (x y)
|
|
(make-rat (+ (* (numer x) (denom y))
|
|
(* (numer y) (denom x)))
|
|
(* (denom x) (denom y))))
|
|
|
|
(defun sub-rat (x y)
|
|
(make-rat (- (* (numer x) (denom y))
|
|
(* (numer y) (denom x)))
|
|
(* (denom x) (denom y))))
|
|
|
|
(defun mul-rat (x y)
|
|
(make-rat (* (numer x) (numer y))
|
|
(* (denom x) (denom y))))
|
|
|
|
(defun div-rat (x y)
|
|
(make-rat (* (numer x) (denom y))
|
|
(* (numer y) (denom x))))
|
|
|
|
(defun equal-ratp (x y)
|
|
(= (* (numer x) (denom y))
|
|
(* (numer y) (denom x))))
|
|
|
|
(defun make-rat (n d)
|
|
(let ((g (gcd n d)))
|
|
(cons (/ n g) (/ d g))))
|
|
|
|
(defun numer (x) (car x))
|
|
(defun denom (x) (cdr x))
|
|
|
|
(defun print-rat (x)
|
|
(format t "~a/" (numer x))
|
|
(format t "~a~%" (denom x)))
|
|
|
|
;; Exercise 2.2
|
|
(defun make-segment (start end)
|
|
(cons
|
|
(make-point (x-point start) (y-point start))
|
|
(make-point (x-point end) (y-point end))))
|
|
|
|
(defun start-segment (segment) (car segment))
|
|
(defun end-segment (segment) (cdr segment))
|
|
|
|
(defun average (x y)
|
|
(/ (+ x y) 2))
|
|
(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 make-point (x y)
|
|
(cons x y))
|
|
|
|
(defun x-point (point) (car point))
|
|
(defun y-point (point) (cdr point))
|
|
|
|
(defun print-point (p)
|
|
(format t "(~a,~a)~%" (x-point p) (y-point p)))
|
|
|
|
;; Exercise 2.7
|
|
(defun make-interval (a b)
|
|
(cons a b))
|
|
|
|
(defun lower-bound (x)
|
|
(car x))
|
|
|
|
(defun upper-bound (x)
|
|
(cdr x))
|
|
|
|
(defun add-interval (a b)
|
|
(make-interval (+ (lower-bound a) (lower-bound b))
|
|
(+ (upper-bound a) (upper-bound b))))
|
|
|
|
(defun mul-interval (a b)
|
|
(let ((p1 (* (lower-bound a) (lower-bound b)))
|
|
(p2 (* (lower-bound a) (upper-bound b)))
|
|
(p3 (* (upper-bound a) (lower-bound b)))
|
|
(p4 (* (upper-bound a) (upper-bound b))))
|
|
(make-interval (min p1 p2 p3 p4)
|
|
(max p1 p2 p3 p4))))
|
|
|
|
(defun div-interval (a b)
|
|
(mul-interval
|
|
a
|
|
(make-interval (/ 1.0 (upper-bound b))
|
|
(/ 1.0 (lower-bound b)))))
|
|
|
|
;; Exercise 2.8
|
|
(defun sub-interval (a b)
|
|
(make-interval (- (lower-bound b) (lower-bound a))
|
|
(- (upper-bound b) (upper-bound a))))
|
|
|
|
;; Exercise 2.9
|
|
(defun width-interval (x)
|
|
"Calculate width of an interval as half of the distance between lower
|
|
and upper bound."
|
|
(/ (- (upper-bound x) (lower-bound x))
|
|
2.0))
|
|
|
|
;; Exercise 2.10
|
|
(defun div-interval (a b)
|
|
(if (zerop (width-interval b))
|
|
(error "Cannot divide by 0 width interval")
|
|
(mul-interval
|
|
a
|
|
(make-interval (/ 1.0 (upper-bound b))
|
|
(/ 1.0 (lower-bound b))))))
|
|
|
|
;; Exercise 2.12
|
|
(defun make-center-width (c w)
|
|
(make-interval (- c w) (+ c w)))
|
|
(defun center (i)
|
|
(/ (+ (lower-bound i) (upper-bound i) 2.0)))
|
|
(defun width (i)
|
|
(/ (- (upper-bound i) (lower-bound i) 2.0)))
|
|
|
|
(defun make-center-percent (c p)
|
|
(make-interval (* c (- 1 (/ p 100)))
|
|
(* c (+ 1 (/ p 100)))))
|
|
|
|
;; Exercise 2.17
|
|
(defun last-pair (l)
|
|
(if (null (cdr l))
|
|
l
|
|
(last-pair (cdr l))))
|
|
|
|
;; Exercise 2.18
|
|
(defun reverse-user (l)
|
|
(if (null l)
|
|
()
|
|
(append (reverse-user (cdr l)) (list (car l)))))
|
|
|
|
;; Exercise 2.21
|
|
(defun square-list (items)
|
|
(if (null items)
|
|
nil
|
|
(cons (* (car items) (car items)) (square-list (cdr items)))))
|
|
|
|
(defun square-list-map (items)
|
|
(map 'list #'(lambda (x) (* x x)) items))
|
|
|
|
(defun square-list-mapcar (items)
|
|
(mapcar #'(lambda (x) (* x x)) items))
|
|
|
|
;; Exercise 2.23
|
|
(defun for-each (func thing)
|
|
(mapcar func thing))
|
|
|
|
;; Exercise 2.25
|
|
(defvar list-1 (list 1 3 (list 5 7) 9))
|
|
(defun pick-7-list-1 () (car (cdr (car (cddr list-1)))))
|
|
|
|
(defvar list-2 (list (list 7)))
|
|
(defun pick-7-list-2 () (car (car list-2)))
|
|
|
|
(defvar list-3 (list 1 (list 2 (list 3 (list 4 (list 5 (list 6 7)))))))
|
|
(defun pick-7-list-3 () (cadr (cadr (cadr (cadr (cadr (cadr list-3)))))))
|