Add 2.2, 2.3 and 2.4
This commit is contained in:
parent
5240b593c2
commit
4ef752dd47
28
2_2.sch
Normal file
28
2_2.sch
Normal file
|
@ -0,0 +1,28 @@
|
|||
(define (make-point x y) (cons x y))
|
||||
|
||||
(define (x-point p) (car p))
|
||||
(define (y-point p) (cdr p))
|
||||
|
||||
(define (make-segment start end) (cons start end))
|
||||
(define (start-segment s) (car s))
|
||||
(define (end-segment s) (cdr s))
|
||||
|
||||
(define (mid-point s)
|
||||
(let ((start-x (x-point (start-segment s)))
|
||||
(start-y (y-point (start-segment s)))
|
||||
(end-x (x-point (end-segment s)))
|
||||
(end-y (y-point (end-segment s))))
|
||||
(make-point
|
||||
(average start-x end-x)
|
||||
(average start-y end-y))))
|
||||
|
||||
(define (print-point p)
|
||||
(display "(")
|
||||
(display (x-point p))
|
||||
(display ",")
|
||||
(display (y-point p))
|
||||
(display ")")
|
||||
(newline))
|
||||
|
||||
(define (average x y)
|
||||
(/ (+ x y) 2.0))
|
40
2_3.sch
Normal file
40
2_3.sch
Normal file
|
@ -0,0 +1,40 @@
|
|||
(load "2_2.sch")
|
||||
|
||||
(define (make-rect-corners top-left bottom-right)
|
||||
(let ((top-right
|
||||
(make-point (x-point bottom-right) (y-point top-left)))
|
||||
(bottom-left
|
||||
(make-point (x-point top-left) (y-point bottom-right))))
|
||||
(list top-left top-right bottom-right bottom-left)))
|
||||
|
||||
(define (make-rect-size bottom-left width height)
|
||||
(let ((top-left
|
||||
(make-point (x-point bottom-left)
|
||||
(+ height (y-point bottom-left))))
|
||||
(top-right
|
||||
(make-point (+ width (x-point bottom-left))
|
||||
(+ height (y-point bottom-left))))
|
||||
(bottom-right
|
||||
(make-point (+ width (x-point bottom-left))
|
||||
(y-point bottom-left))))
|
||||
(list top-left top-right bottom-right bottom-left)))
|
||||
|
||||
|
||||
(define (rect-top-left r) (car r))
|
||||
(define (rect-top-right r) (cadr r))
|
||||
(define (rect-bottom-right r) (caddr r))
|
||||
(define (rect-bottom-left r) (cadddr r))
|
||||
|
||||
(define (perimeter r)
|
||||
(let ((tl (rect-top-left r))
|
||||
(br (rect-bottom-right r)))
|
||||
(+
|
||||
(* 2 (abs (- (x-point br) (x-point tl))))
|
||||
(* 2 (abs (- (y-point br) (y-point tl)))))))
|
||||
|
||||
(define (area r)
|
||||
(let ((tl (rect-top-left r))
|
||||
(br (rect-bottom-right r)))
|
||||
(*
|
||||
(abs (- (x-point tl) (x-point br)))
|
||||
(abs (- (y-point tl) (y-point br))))))
|
Loading…
Reference in New Issue
Block a user