(setf eps 1e-10)

(setf x '#2a((1 2)(3 4)(5 6)(7 8)))
(setf y '#2a((9 10 11) (12 13 14)))
(setf xv '#(15 16))
(setf yv '#(18 19))


(defun mm (x y)
  (let* ((m (array-dimension x 0))
	 (k (array-dimension x 1))
	 (n (array-dimension y 1))
	 (z (make-array (list m n) :initial-element 0)))
    (dotimes (i m)
      (dotimes (j n)
        (dotimes (l k)
          (incf (aref z i j) (* (aref x i l) (aref y l j))))))
    z))

(defun mv (x y)
  (let* ((m (array-dimension x 0))
	 (n (array-dimension x 1))
	 (z (make-array m :initial-element 0)))
    (dotimes (i m)
      (dotimes (j n)
          (incf (aref z i) (* (aref x i j) (aref y j)))))
    z))

(defun vm (x y)
  (let* ((m (array-dimension y 0))
	 (n (array-dimension y 1))
	 (z (make-array n :initial-element 0)))
    (dotimes (i m)
      (dotimes (j n)
        (incf (aref z j) (* (aref x i) (aref y i j)))))
    z))

(defun ip (x y &optional (conj t))
  (sum (* x (if conj (conjugate y) y))))

(defun test-report (name val)
  ;(format t "~&~a: ~9t~f~%" name val)
  (check #'< val eps)
  )


(test-report "MATMULT"
	     (let ((cx (complex x (* 2 x)))
		   (cy (complex y (* 3 y)))
		   (cxv (complex xv (* 4 xv)))
		   (cyv (complex yv (* 5 yv))))
	       (max (abs (- (matmult x y) (mm x y)))
		    (abs (- (matmult cx cy) (mm cx cy)))
		    (abs (- (matmult x yv) (mv x yv)))
		    (abs (- (matmult cx cyv) (mv cx cyv)))
		    (abs (- (matmult xv y) (vm xv y)))
		    (abs (- (matmult cxv cy) (vm cxv cy)))
		    (abs (- (matmult xv yv) (ip xv yv)))
		    (abs (- (matmult cxv cyv) (ip cxv cyv nil))))))

(test-report "CROSS-PRODUCT"
	     (max (abs (- (cross-product x) (mm (transpose x) x)))
		  (let ((cx (complex x (* 2 x))))
		    (abs (- (cross-product cx)
			    (mm (transpose cx) (conjugate cx)))))
		  (let ((cx (complex x (* 2 x))))
		    (abs (- (cross-product cx nil)
			    (mm (transpose cx) cx))))))

(test-report "INNER-PRODUCT"
	     (let ((cxv (complex xv (* 4 xv)))
		   (cyv (complex yv (* 5 yv))))
	       (max (abs (- (inner-product xv yv) (ip xv yv)))
		    (abs (- (inner-product cxv cyv) (ip cxv cyv)))
		    (abs (- (inner-product cxv cyv nil) (ip cxv cyv nil))))))

(let* ((x (list (iseq 1 4) (^ (iseq 1 4) 2)))
       (y (^ (iseq 1 4) 3))
       (w (iseq 4 1))
       (m1 (regression-model x y :print nil))
       (mw (regression-model x y :print nil :weights w))
       (xm (apply #'bind-columns (repeat 1 4) x))
       (xmt (transpose xm))
       (wm (diagonal w))
       (b1 (matmult (inverse (matmult xmt xm)) xmt y))
       (bw (matmult (inverse (matmult xmt wm xm)) xmt wm y)))
  (test-report "REGRESS"
	       (max (abs (- (send m1 :coef-estimates) b1))
		    (abs (- (send mw :coef-estimates) bw)))))


syntax highlighted by Code2HTML, v. 0.9.1