codepad

Language:

; collinearity

(define sort #f)
(define merge #f)
(let ()
  (define dosort
    (lambda (pred? ls n)
      (if (= n 1)
          (list (car ls))
          (let ((i (quotient n 2)))
            (domerge pred?
                     (dosort pred? ls i)
                     (dosort pred? (list-tail ls i) (- n i)))))))
  (define domerge
    (lambda (pred? l1 l2)
      (cond
        ((null? l1) l2)
        ((null? l2) l1)
        ((pred? (car l2) (car l1))
         (cons (car l2) (domerge pred? l1 (cdr l2))))
        (else (cons (car l1) (domerge pred? (cdr l1) l2))))))
  (set! sort
    (lambda (pred? l)
      (if (null? l) l (dosort pred? l (length l)))))
  (set! merge
    (lambda (pred? l1 l2)
      (domerge pred? l1 l2))))

(define (naive-collinear? px py qx qy rx ry)
  (let* ((m (/ (- qy py) (- qx px))) (b (- py (* m px))))
    (= ry (+ (* m rx) b))))

(display (naive-collinear? 1 2 3 4 5 6)) (newline)
(display (naive-collinear? 1 2 3 4 5 7)) (newline)
(display (naive-collinear? 1 1 2 1 3 1)) (newline)
; (display (naive-collinear? 1 1 1 2 1 3)) (newline) ; exception
(newline)

(define (slope px py qx qy)
  (if (= px qx) #f (/ (- qy py) (- qx px))))

(define (intercept px py qx qy)
  (let ((m (slope px py qx qy)))
    (if m (- py (* m px)) #f)))

(define (less-naive-collinear? px py qx qy rx ry)
  (let ((m (slope px py qx qy))
        (b (intercept px py qx qy)))
    (if m (= ry (+ (* m rx) b)) (= px rx))))

(display (less-naive-collinear? 1 2 3 4 5 6)) (newline)
(display (less-naive-collinear? 1 2 3 4 5 7)) (newline)
(display (less-naive-collinear? 1 1 2 1 3 1)) (newline)
(display (less-naive-collinear? 1 1 1 2 1 3)) (newline)
(newline)

(define (mm-collinear? px py qx qy rx ry)
  (equal? (slope px py qx qy) (slope qx qy rx ry)))

(display (mm-collinear? 1 2 3 4 5 6)) (newline)
(display (mm-collinear? 1 2 3 4 5 7)) (newline)
(display (mm-collinear? 1 1 2 1 3 1)) (newline)
(display (mm-collinear? 1 1 1 2 1 3)) (newline)
(newline)

(define (typed-mm-collinear? px py qx qy rx ry)
  (let ((pq-slope (slope px py qx qy))
        (qr-slope (slope qx qy rx ry)))
    (or (and pq-slope qr-slope (= pq-slope qr-slope))
        (and (not pq-slope) (not qr-slope)))))

(display (typed-mm-collinear? 1 2 3 4 5 6)) (newline)
(display (typed-mm-collinear? 1 2 3 4 5 7)) (newline)
(display (typed-mm-collinear? 1 1 2 1 3 1)) (newline)
(display (typed-mm-collinear? 1 1 1 2 1 3)) (newline)
(newline)

(define (distance px py qx qy)
  (define (square x) (* x x))
  (sqrt (+ (square (- qx px)) (square (- qy py)))))

(define (triangle-collinear? px py qx qy rx ry)
  (let ((pq (distance px py qx qy))
        (qr (distance qx qy rx ry))
        (rp (distance rx ry px py)))
    (let ((sidelist (sort > (list pq qr rp))))
      (= (car sidelist) (+ (cadr sidelist) (caddr sidelist))))))

(display (triangle-collinear? 1 2 3 4 5 6)) (newline)
(display (triangle-collinear? 1 2 3 4 5 7)) (newline)
(display (triangle-collinear? 1 1 2 1 3 1)) (newline)
(display (triangle-collinear? 1 1 1 2 1 3)) (newline)
(display (let ((x #e1e100)) (triangle-collinear? 0 0 x 1 (* 2 x) 0))) (newline)
(display (let ((x #e1e500)) (triangle-collinear? 0 0 x 1 (* 2 x) 0))) (newline)
(newline)

(define (area-collinear? px py qx qy rx ry)
  (= (* (- px rx) (- qy ry)) (* (- qx rx) (- py ry))))

(display (area-collinear? 1 2 3 4 5 6)) (newline)
(display (area-collinear? 1 2 3 4 5 7)) (newline)
(display (area-collinear? 1 1 2 1 3 1)) (newline)
(display (area-collinear? 1 1 1 2 1 3)) (newline)
(display (let ((x #e1e100)) (area-collinear? 0 0 x 1 (* 2 x) 0))) (newline)
(display (let ((x #e1e500)) (area-collinear? 0 0 x 1 (* 2 x) 0))) (newline)

Private [?]

Run code