; test of math functions
(setf eps 1.e-7 x  (list 1 2 3 4 -1 -2)	y (list -4.5 6.03 -7.7 2.00 3))

(check #'= (abs 4.7) (abs 4.7))
(check #'= (abs -6.3) (abs 6.3))
(check #'= (floor x) (ceiling x))
(check #'= (- (ceiling (+ x eps)) (floor (+ x eps))) 1)
(check #'= (truncate (* x (+ 1 eps))) x)
(check #'= (cumsum (combine (select x 0) (difference x))) x)
(check #'= (min x y (uniform-rand 77)) (min (min x) (min y)))
(check #'= (max x y (uniform-rand 77)) (max (max x) (max y)))
(check #'= (pmax (iseq 1 6) (iseq 0 5) (iseq -3 2)) (iseq 1 6))
(check #'= 
       (pmin (+ (iseq 1 6) eps) (+ (iseq 0 5) eps) (+ (iseq -3 2) eps)) 
       (+ (iseq -3 2) eps))
(check #'= (median y) (quantile y .5))
(check #'< (abs (- (sum y) (first (last (cumsum y))))) eps)
(check #'= (prod x) (apply #'* x))

(check #'< (abs (- (^ 3 (log x 3)) x)) eps)
(check #'< (abs (- (^ 10 (log y 10)) y)) eps)
(check #'< (abs (- (sqrt y) (^ 10 (* (/ 1 2) (log y 10))))) eps)
(check #'< (abs (- (exp 1) (/ 1 (exp -1)))) eps)
(check #'< (abs (- (cumsum (log (iseq 1 10))) (log-gamma (iseq 2 11)))) eps)

(labels ((cis (theta) (exp (* #c(0 1) theta)))
         (norm (z) (sqrt (/ (realpart (sum (* z (conjugate z)))) (length z))))
         (texp (z) 
	   (combine (- (log (abs (exp z))) (realpart z))
		    (- (phase (exp z)) (phase (cis (imagpart z))))))
         (tlog (z) 
           (combine (- (log (abs z)) (realpart (log z)))
		    (- (phase z) (imagpart (log z)))))
         (tpow (z w) (- (^ z w) (exp (* w (log z)))))
         (reldiff (x y) (/ (- x y) (pmax 1 (abs x) (abs y))))
         (tsin (z)
           (reldiff (sin z) (/ (- (exp (* #c(0 1) z))
				  (exp (* #c(0 -1) z))) #c(0 2))))
         (tcos (z)
           (reldiff (cos z) (/ (+ (exp (* #c(0 1) z))
				  (exp (* #c(0 -1) z))) 2)))
         (ttan (z) (- (tan z) (/ (sin z) (cos z))))
         (tasin (z)
           (+ (asin z) 
	      (* #c(0 1) (log (+ (* #c(0 1) z) (sqrt (- 1 (* z z))))))))
         (tacos (z) 
           (+ (acos z)
	      (* #c(0 1) (log (+ z (* #c(0 1) (sqrt (- 1 (* z z)))))))))
         (tatan (z)
	   (+ (atan z)
	      (* #c(0 1) 
		 (log (* (+ 1 (* #c(0 1) z)) (sqrt (/ 1 (+ 1 (* z z))))))))))
  (let* ((n 500)
         (z1 (+ (/ (normal-rand n) (uniform-rand n))
		(* #c(0 1) (/ (normal-rand n) (uniform-rand n)))))
         (z2 (+ (- (* (uniform-rand n) 100) 50)
		(* #c(0 1) (- (* (uniform-rand n) 100) 50))))
         (z3 (+ (normal-rand n) (* #c(0 1) (normal-rand n))))
         (w3 (+ (normal-rand n) (* #c(0 1) (normal-rand n))))
         (r (tan (* (uniform-rand n) (/ pi 2))))
         (e2 (exp z2))
         (l1 (log z1))
         (b1 (list (+ 1 r) (- -1 r)))
         (b2 (list -1 1))
         (eps 1e-9))
    (check #'eq
	   (combine (= (phase 0) 0) (= (norm (- (phase (- r)) pi)) 0)
		    (>= (phase z1) (- pi)) (<= (phase z1) pi)
		    (< (norm (- (* (abs z1) (cis (phase z1))) z1)) eps))
	   t)
    (check #'< (norm (texp z2)) eps)
    (check #'< (norm (tpow z3 w3)) eps) 
    (check #'< (combine (norm (tsin z2)) (norm (tcos z2)) (norm (ttan z2)))
	   eps)
    (check #'< (combine (norm (tsin z3)) (norm (tcos z3)) (norm (ttan z3))) 
	   eps)
    (check #'< (combine (norm (tasin z1)) (norm (tacos z1)) (norm (tatan z1)))
	   eps)
    (check #'< (combine (norm (tasin b1)) (norm (tacos b1)) (norm (tatan b1)))
	   eps)
    (check #'<  (combine (norm (tasin b2)) (norm (tacos b2))) eps)))


syntax highlighted by Code2HTML, v. 0.9.1