Plaster

common-lisp
(defun swilk-alnorm (x upper) "Evaluates the tail area of the standardized normal curve from X to infinity if UPPER is true or from minus infinity to X if UPPER is false." (let ((CONA 1.28D0) (LTONEA 7.0D0) (UTZEROA 18.66D0) (PA 0.398942280444D0) (QA 0.39990348504D0) (RA 0.398942280385D0) (AA1 5.75885480458D0) (AA2 2.62433121679D0) (AA3 5.92885724438D0) (BA1 -29.8213557807D0) (BA2 48.6959930692D0) (CA1 -3.8052D-8) (CA2 3.98064794D-4) (CA3 -0.151679116635D0) (CA4 4.8385912808D0) (CA5 0.742380924027D0) (CA6 3.99019417011D0) (DA1 1.00000615302D0) (DA2 1.98615381364D0) (DA3 5.29330324926D0) (DA4 -15.1508972451D0) (DA5 30.789933034D0)) (let ((up upper) (z x)) (when (< z 0.0) (setf up (not up)) (setf z (- z))) (let ((fn-val 0.0)) (cond ((and (> z LTONEA) (or (not up) (> z UTZEROA))) (setf fn-val 0.0)) (t (let ((y (* 0.5 (square z)))) (setf fn-val (if (<= z CONA) (- 0.5 (* z (- PA (/ (* QA y) (+ y AA1 (/ BA1 (+ y AA2 (/ BA2 (+ y AA3))))))))) (* RA (/ (exp (- y)) (+ z CA1 (/ DA1 (+ z CA2 (/ DA2 (+ z CA3 (/ DA3 (+ z CA4 (/ DA4 (+ z CA5 (/ DA5 (+ z CA6))))))))))))))) (if (not up) (- 1.0 fn-val) fn-val))))))))