Tests for vector functions
This commit is contained in:
parent
8dbf44a9f0
commit
65a60a2a65
3 changed files with 58 additions and 1 deletions
|
|
@ -56,7 +56,8 @@
|
|||
|
||||
;; Export vector functions
|
||||
(export vector-= vector-+ vector-- vector-* vector-/
|
||||
vector-magnitude vector-normalize)
|
||||
vector-magnitude vector-normalize vector-dot
|
||||
vector-angle-between)
|
||||
|
||||
;; TODO: make this function accept any number of vectors
|
||||
(define (vector-= vec1 vec2)
|
||||
|
|
@ -126,6 +127,29 @@
|
|||
(sqrt (+ (expt (vector-x vec) 2)
|
||||
(expt (vector-y vec) 2))))))
|
||||
|
||||
(define (vector-dot vec1 vec2)
|
||||
(assert (and (record? vec1)
|
||||
(record? vec2)))
|
||||
(assert (eq? (rtd-name (record-rtd vec1))
|
||||
(rtd-name (record-rtd vec2))))
|
||||
(assert (any (lambda (pred) (pred vec1)) (list vector2?)))
|
||||
(cond
|
||||
((vector2? vec1)
|
||||
(+ (* (vector-x vec1) (vector-x vec2))
|
||||
(* (vector-y vec1) (vector-y vec2))))))
|
||||
|
||||
(define (vector-angle-between vec1 vec2)
|
||||
(assert (and (record? vec1)
|
||||
(record? vec2)))
|
||||
(assert (eq? (rtd-name (record-rtd vec1))
|
||||
(rtd-name (record-rtd vec2))))
|
||||
(assert (any (lambda (pred) (pred vec1)) (list vector2?)))
|
||||
(cond
|
||||
((vector2? vec1)
|
||||
(acos (/ (vector-dot vec1 vec2)
|
||||
(* (vector-magnitude vec1)
|
||||
(vector-magnitude vec2)))))))
|
||||
|
||||
;; Normalization
|
||||
(define (vector-normalize vec)
|
||||
(assert (any (lambda (pred) (pred vec)) (list vector2?))) ;; TODO: This assertion should be moved out of here
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue