Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

109 lines (82 sloc) 3.124 kB
#lang racket
;;point
(define (make-point x y)
(cons x y))
(define (x-point point)
(car point))
(define (y-point point)
(cdr point))
;;segment
(define (make-segment start end)
(cons start end))
(define (start-segment segment)
(car segment))
(define (end-segment segment)
(cdr segment))
(define (midpoint-segment segment)
(let ([start (start-segment segment)]
[end (end-segment segment)])
(make-point (+ (x-point start) (x-point end))
(+ (y-point start) (y-point end)))))
;; rectangle
(define make-rectangle ;;isn't it bad to work directly with coordinates?
(case-lambda
[(tl br) (list (x-point tl) (y-point tl) (x-point br) (y-point br))]
[(tlx tly brx bry) (list tlx tly brx bry)]))
;;
(define (left-top-point rect)
(make-point (first rect) (second rect)))
(define (right-bottom-point rect)
(make-point (third rect) (fourth rect)))
(define (right-top-point rect)
(make-point (third rect) (second rect)))
(define (left-bottom-point rect)
(make-point (first rect) (fourth rect)))
(define (left-side rect)
(make-segment (left-bottom-point rect) (left-top-point rect)))
(define (top-side rect)
(make-segment (left-top-point rect) (right-top-point rect)))
(define (right-side rect)
(make-segment (right-top-point rect) (right-bottom-point rect)))
(define (bottom-side rect)
(make-segment (right-bottom-point rect) (left-bottom-point rect)))
(define (length segment)
(let ([start (start-segment segment)]
[end (end-segment segment)])
(sqrt (+ (sqr (- (x-point end) (x-point start)))
(sqr (- (y-point end) (y-point start)))))))
(define (square rect)
(* (length (left-side rect))
(length (top-side rect))))
;;tests
(define (times num f)
(when (num . > . 0)
(f)
(times (- num 1) f)))
(require rackunit)
(times 10 (lambda ()
(let ([r (random 1000)])
(test-equal? "make-point"
r
(x-point (make-point r 0))))))
(times 10 (lambda ()
(let ([x-s (random 1000)]
[x-e (random 1000)]
[y-s (random 1000)]
[y-e (random 1000)])
(test-equal? "md-seg"
(make-point (+ x-s x-e) (+ y-s y-e))
(midpoint-segment (make-segment (make-point x-s y-s)
(make-point x-e y-e)))))))
(test-case "rect points"
(let ([the-rect (make-rectangle (make-point 10 20) (make-point 30 40))])
(check-equal? (make-point 10 20) (left-top-point the-rect))
(check-equal? (make-point 10 40) (left-bottom-point the-rect))
(check-equal? (make-point 30 20) (right-top-point the-rect))
(check-equal? (make-point 30 40) (right-bottom-point the-rect))))
(test-equal? "segment length"
10
(length (make-segment (make-point 10 10) (make-point 20 10))))
(test-equal? "rect area"
100
(square (make-rectangle (make-point 10 10) (make-point 20 0))))
Jump to Line
Something went wrong with that request. Please try again.