Skip to content

Instantly share code, notes, and snippets.

@nalzok

nalzok/ex2.3-1.scm

Created February 18, 2017 14:02
Show Gist options
  • Save nalzok/12cbf608e45805be674afe941d74904f to your computer and use it in GitHub Desktop.
Save nalzok/12cbf608e45805be674afe941d74904f to your computer and use it in GitHub Desktop.
Download ZIP
My solution to SICP exercise 2.3
Raw
ex2.3-1.scm
;;; Exercise 2.3 part 1
;;; ===================
(define (peri-rect r)
(* 2 (+ (length-rect r)
(width-rect r))))
(define (area-rect r)
(* (length-rect r)
(width-rect r)))
;; Representation 1: two line segments
; Abstraction barrier
(define (length-rect r)
(len-segment (side1-rect r)))
(define (width-rect r)
(len-segment (side2-rect r)))
(define (print-rect r)
(print-segment (side1-rect r))
(print-segment (side2-rect r)))
; Abstraction barrier
(define (make-rect s1 s2)
(cond ((not (segment-commonend? s1 s2))
(error "Line segments have no common endpoint"))
((not (segment-perpend? s1 s2))
(error "Line segments not prependicular to each other"))
(else
(cons s1 s2))))
(define (side1-rect r)
(car r))
(define (side2-rect r)
(cdr r))
; Abstraction barrier
(define (len-segment s)
(dist (start-segment s)
(end-segment s)))
(define (segment-commonend? s1 s2)
(or (point-equal? (start-segment s1)
(start-segment s2))
(point-equal? (start-segment s1)
(end-segment s2))
(point-equal? (end-segment s1)
(start-segment s2))
(point-equal? (end-segment s1)
(end-segment s2))))
(define (segment-perpend? s1 s2)
(vector-perpend? (make-vector s1)
(make-vector s2)))
(define (print-segment s)
(print-point (start-segment s))
(print-point (end-segment s)))
; Abstraction barrier
(define (dotproduct-vector v1 v2)
(+ (* (x-point v1) (x-point v2))
(* (y-point v1) (y-point v2))))
(define (vector-perpend? v1 v2)
(= (dotproduct-vector v1 v2) 0))
(define (print-vector v)
(print-point (x-vector v))
(print-point (y-vector v)))
; Abstraction barrier
(define (make-vector s)
(cons (- (x-point (end-segment s))
(x-point (start-segment s)))
(- (y-point (end-segment s))
(y-point (start-segment s)))))
(define (x-vector v)
(car v))
(define (y-vector v)
(cdr v))
; Abstraction barrier
(define (make-segment p1 p2)
(cons p1 p2))
(define (start-segment s)
(car s))
(define (end-segment s)
(cdr s))
; Abstraction barrier
(define (dist p1 p2)
(sqrt (+ (square (- (x-point p1)
(x-point p2)))
(square (- (y-point p1)
(y-point p2))))))
(define (point-equal? p1 p2)
(and (= (x-point p1) (x-point p2))
(= (y-point p1) (y-point p2))))
(define (print-point p)
(newline)
(display "(")
(display (x-point p))
(display ",")
(display (y-point p))
(display ")"))
; Abstraction barrier
(define (make-point x y)
(cons x y))
(define (x-point p)
(car p))
(define (y-point p)
(cdr p))
; Testing
(define p1 (make-point 0 0))
(define p2 (make-point 2 2))
(define p3 (make-point 0 0))
(define p4 (make-point 1 -1))
(print-point p1)
;(0,0)
(define seg1 (make-segment p1 p2))
(define seg2 (make-segment p3 p4))
(print-segment seg1)
;(0,0)
;(2,2)
(define rect (make-rect seg1 seg2))
(print-rect rect)
;(0,0)
;(2,2)
;(0,0)
;(1,-1)
(peri-rect rect)
;Value: 8.485281374238571
(area-rect rect)
;Value: 4.000000000000001
Raw
ex2.3-2.scm
;;; Exercise 2.3 part 2
;;; ===================
(define (peri-rect r)
(* 2 (+ (length-rect r)
(width-rect r))))
(define (area-rect r)
(* (length-rect r)
(width-rect r)))
;; Representation 2: two vectors and one center point
; Abstraction barrier
(define (length-rect r)
(len-vector (side1-rect r)))
(define (width-rect r)
(len-vector (side2-rect r)))
(define (side1-rect r)
(add-vector (v1-rect r)
(v2-rect r)))
(define (side2-rect r)
(sub-vector (v1-rect r)
(v2-rect r)))
(define (print-rect r)
(print-point (p-rect r))
(print-vector (side1-rect r))
(print-vector (side2-rect r)))
; Abstraction barrier
(define (make-rect p v1 v2)
(cond ((not (= (len-vector v1)
(len-vector v2)))
(error "Vectors have different length"))
((vector-equal? v1 v2)
(error "Vectors are identical"))
(else
(cons p (cons v1 v2)))))
(define (v1-rect r)
(car (cdr r)))
(define (v2-rect r)
(cdr (cdr r)))
(define (p-rect r)
(car r))
; Abstraction barrier
(define (vector-equal? v1 v2)
(and (= (x-vector v1)
(x-vector v2))
(= (y-vector v1)
(y-vector v2))))
(define (add-vector v1 v2)
(make-vector (+ (x-vector v1)
(x-vector v2))
(+ (y-vector v1)
(y-vector v2))))
(define (sub-vector v1 v2)
(make-vector (- (x-vector v1)
(x-vector v2))
(- (y-vector v1)
(y-vector v2))))
(define (len-vector v)
(sqrt (+ (square (x-vector v))
(square (y-vector v)))))
(define (dotproduct-vector v1 v2)
(+ (* (x-point v1) (x-point v2))
(* (y-point v1) (y-point v2))))
(define (vector-perpend? v1 v2)
(= (dotproduct-vector v1 v2) 0))
(define (print-vector v)
(newline)
(display "[")
(display (x-vector v))
(display ",")
(display (y-vector v))
(display "]"))
; Abstraction barrier
(define (make-vector x y)
(cons x y))
(define (x-vector v)
(car v))
(define (y-vector v)
(cdr v))
; Abstraction barrier
(define (point-equal? p1 p2)
(and (= (x-point p1) (x-point p2))
(= (y-point p1) (y-point p2))))
(define (print-point p)
(newline)
(display "(")
(display (x-point p))
(display ",")
(display (y-point p))
(display ")"))
; Abstraction barrier
(define (make-point x y)
(cons x y))
(define (x-point p)
(car p))
(define (y-point p)
(cdr p))
; Testing
(define p (make-point 0 0))
(print-point p)
;(0,0)
(define v1 (make-vector 1 1))
(define v2 (make-vector -1 1))
(print-vector v1)
;[1,1]
(define rect (make-rect p v1 v2))
(print-rect rect)
;(0,0)
;[0,2]
;[2,0]
(peri-rect rect)
;Value: 8
(area-rect rect)
;Value: 4
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment