(require-extension quaternions)
(require-extension srfi-78)

(define (to-5-dp f)
  (/ (round (* f 100000)) 100000))

(define (=5 n1 n2)
  (= (to-5-dp n1) (to-5-dp n2)))

(define (=mod-pi a1 a2)
  (define PI 3.14159265)
  (define (make-positive n)
    (if (>= n 0) 
      n
      (make-positive (+ n PI))))
  (= (to-5-dp (modulo (make-positive a1) PI))
     (to-5-dp (modulo (make-positive a2) PI))))

(let ((q1 (make-rectangular 0))
      (q2 (make-rectangular 0 1))
      (q3 (make-rectangular 0 1 2 3)))
  (check (number? q1) => #t)
  (check (number? q2) => #t)
  (check (number? q3) => #t)
  (check (quaternion? q1) => #t)
  (check (quaternion? q2) => #t)
  (check (quaternion? q3) => #t)
  (check (real-part q1) => 0)
  (check (real-part q2) => 0)
  (check (imag-part q2) => 1)
  (check (real-part q3) => 0)
  (check (imag-part q3) => 1)
  (check (jmag-part q3) => 2)
  (check (kmag-part q3) => 3)
  (check (magnitude 4) => 4.0)
  (check (magnitude (make-rectangular 1 2)) (=> =5) 2.23606797749979)
  (check (magnitude q3) (=> =5) 3.74165738677394)
  (check (angle 2+2i) (=> =5) 0.785398163397448)
  (check (angle q3) (=> =5) 1.5707963267949)
  (check (= 3 3) => #t)
  (check (= q1 0) => #t)
  (check (= q2 0+1i) => #t)
  (check (= q3 (make-rectangular 0 1 2 3)) => #t)
  (check (= q1 q2) => #f)
  (check (= q2 q3) => #f)
  (check (= q3 (make-rectangular 0 1 2 4)) => #f)
  (check (= q3 (make-rectangular 0 1 4 3)) => #f)
  (check (+ q3 q3) (=> =) (make-rectangular 0 2 4 6))
  (check (+ 1+2i q3) (=> =) (make-rectangular 1 3 2 3))
  (check (- q3 1+2i) (=> =) (make-rectangular -1 -1 2 3))
  (check (* 2 q3) (=> =) (make-rectangular 0 2 4 6))
  (check (/ (make-rectangular 2 4 6 8) 2) (=> =) (make-rectangular 1 2 3 4))
  (let ((q (make-polar 1 2 3 4)))
    (check (magnitude q) (=> =5) 1.0)
    (check (angle q) (=> =mod-pi) 2.0)
    (check (colatitude q) (=> =mod-pi) 3.0)
    (check (longitude q) (=> =mod-pi) 4.0))
  (let ((q1 (make-rectangular 0 1 2 3))
        (q2 (make-rectangular 0 6 3 2)))
    (check (dot-product q1 q2) (=> =) (- (real-part (* q1 q2))))
    (check (cross-product q1 q2) (=> =) (vector-part (* q1 q2))))
  )

; (check-report)
(if (check-passed? 37)
  'ok
  (error "failed test suite"))