191 lines
5.4 KiB
Scheme
191 lines
5.4 KiB
Scheme
(load "shared/util.scm")
|
|
|
|
(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))))
|
|
|
|
(define (make-rat n d)
|
|
(let ((g (gcd n d)))
|
|
(cons (/ n g) (/ d g))))
|
|
(define (numer x) (car x))
|
|
(define (denom x) (cdr x))
|
|
|
|
(define (print-rat x)
|
|
(newline)
|
|
(display (numer x))
|
|
(display "/")
|
|
(display (denom x)))
|
|
|
|
; Examples
|
|
; (define one-half (make-rat 1 2))
|
|
; (print-rat one-half)
|
|
; (define one-third (make-rat 1 3))
|
|
; (print-rat (add-rat one-half one-third))
|
|
; (print-rat (mul-rat one-half one-third))
|
|
; (print-rat (add-rat one-third one-third))
|
|
|
|
(display "ex-2.1")
|
|
|
|
(define (make-rat n d)
|
|
(let ((g (gcd n d)))
|
|
(if (< (* n d) 0)
|
|
(cons (- (abs (/ n g))) (abs (/ d g)))
|
|
(cons (abs (/ n g)) (abs (/ d g))))))
|
|
|
|
(print-rat (make-rat 3 9))
|
|
(print-rat (make-rat -3 9))
|
|
(print-rat (make-rat 3 -9))
|
|
(print-rat (make-rat -3 -9))
|
|
|
|
; More elegant (but harder to read?) solution
|
|
(define (make-rat n d)
|
|
(let ((g ((if (< d 0) - +) (abs (gcd n d)))))
|
|
(cons (/ n g) (/ d g))))
|
|
|
|
(display "\n\nex-2.2")
|
|
|
|
(define (make-point x y) (cons x y))
|
|
(define (x-point p) (car p))
|
|
(define (y-point p) (cdr p))
|
|
|
|
(define (make-segment a b) (cons a b))
|
|
(define (start-segment s) (car s))
|
|
(define (end-segment s) (cdr s))
|
|
|
|
(define (midpoint-segment s)
|
|
(make-point (average (x-point (start-segment s)) (x-point (end-segment s)))
|
|
(average (y-point (start-segment s)) (y-point (end-segment s)))))
|
|
|
|
(define (print-point p)
|
|
(newline)
|
|
(display "(")
|
|
(display (x-point p))
|
|
(display ", ")
|
|
(display (y-point p))
|
|
(display ")"))
|
|
|
|
(define s (make-segment (make-point 1 2) (make-point 7 4)))
|
|
(print-point (midpoint-segment s))
|
|
|
|
(display "\n\nex-2.3\n")
|
|
|
|
; The first representation takes the two opposite corners of the rectangle.
|
|
; This assumes that the rectangle is aligned in parallel to the X and Y axis.
|
|
; If we use segments to represent two sides originating from the same point we
|
|
; would first have to calculate the length of each of these sides. I am not
|
|
; changing the code now but it shows how engineering decisions limit what can
|
|
; be accomplished, but also make the problem more trivial.
|
|
(define (make-rectangle p1 p2) (cons p1 p2))
|
|
(define (corner-1-rectangle r) (car r))
|
|
(define (corner-2-rectangle r) (cdr r))
|
|
|
|
(define (x-length-rectangle r)
|
|
(abs (- (x-point (corner-1-rectangle r)) (x-point (corner-2-rectangle r)))))
|
|
|
|
(define (y-length-rectangle r)
|
|
(abs (- (y-point (corner-1-rectangle r)) (y-point (corner-2-rectangle r)))))
|
|
|
|
(define (area-rectangle r)
|
|
(* (x-length-rectangle r) (y-length-rectangle r)))
|
|
|
|
(define (perimeter-rectangle r)
|
|
(* 2 (+ (x-length-rectangle r) (y-length-rectangle r))))
|
|
|
|
(define r (make-rectangle (make-point -2 -2) (make-point -8 -10)))
|
|
(display (area-rectangle r)) (newline)
|
|
(display (perimeter-rectangle r)) (newline)
|
|
|
|
; The second representation takes one corner and the size of the rectangle.
|
|
; The consequence is that we have to calculate the second point for the
|
|
; corner-2 getter.
|
|
(define (make-rectangle p1 size) (cons p1 size))
|
|
(define (corner-1-rectangle r) (car r))
|
|
(define (corner-2-rectangle r)
|
|
(make-point (+ (x-point (car r)) (x-point (cdr r)))
|
|
(+ (y-point (car r)) (y-point (cdr r)))))
|
|
|
|
; Our higher level functions still deliver the same result even though the
|
|
; underlying presentation of the rectangle is different.
|
|
(define r (make-rectangle (make-point -2 -2) (make-point -6 -8)))
|
|
(display (area-rectangle r)) (newline)
|
|
(display (perimeter-rectangle r)) (newline)
|
|
|
|
(display "\nex-2.4\n")
|
|
|
|
(define (cons x y)
|
|
(lambda (m) (m x y)))
|
|
|
|
(define (car z)
|
|
(z (lambda (p q) p)))
|
|
|
|
(define (cdr z)
|
|
(z (lambda (p q) q)))
|
|
|
|
; Process with substitution model.
|
|
(let ((x 1) (y 2))
|
|
(car (cons x y))
|
|
(car (lambda (m) (m x y)))
|
|
((lambda (m) (m x y)) (lambda (p q) p))
|
|
((lambda (p q) p) x y)
|
|
x)
|
|
|
|
(display (car (cons 1 2))) (newline)
|
|
(display (cdr (cons 1 2))) (newline)
|
|
|
|
(display "\nex-2.5\n")
|
|
|
|
(define (cons-ari a b)
|
|
(cond ((and (>= a 0) (>= b 0))
|
|
(* (expt 2 a) (expt 3 b)))
|
|
(else (error "Negative integers not allowed" a b))))
|
|
|
|
(define (count-factor n f)
|
|
(if (and (> n 0) (= (remainder n f) 0))
|
|
(+ 1 (count-factor (/ n f) f))
|
|
0))
|
|
|
|
(define (car-ari p) (count-factor p 2))
|
|
(define (cdr-ari p) (count-factor p 3))
|
|
|
|
(define p (cons-ari 13 3))
|
|
|
|
(display (car-ari p)) (newline)
|
|
(display (cdr-ari p)) (newline)
|
|
|
|
(display "\nex-2.6\n")
|
|
|
|
(define zero (lambda (f) (lambda (x) x)))
|
|
(define one (lambda (f) (lambda (x) (f x))))
|
|
(define two (lambda (f) (lambda (x) (f (f x)))))
|
|
(define (add-1 n) (lambda (f) (lambda (x) (f ((n f) x)))))
|
|
|
|
(display (((add-1 zero) inc) 0)) (newline)
|
|
(display (((add-1 one) inc) 0)) (newline)
|
|
(display (((add-1 (add-1 two)) inc) 0)) (newline)
|
|
|
|
(define (add-church n m)
|
|
(lambda (f) (lambda (x) ((n f) ((m f) x)))))
|
|
|
|
(define (mul-church n m)
|
|
(lambda (f) (lambda (x) ((n (m f)) x))))
|
|
|
|
(define church-five (add-1 (add-church two two)))
|
|
|
|
(display (((add-church church-five two) inc) 0)) (newline)
|
|
(display (((mul-church church-five two) inc) 0)) (newline)
|
|
|