;;; qtest.cl v. 1.1
;;;
;;; Ronald Parr - parr@cs.berkeley.edu
;;; Last Modification 8/27/96
;;;
;;; This code is (c) 1996 Ronald Parr.  It is distributed with no warranty
;;; of any kind.  Use at your own risk.  You may distribute this code
;;; freely as long as you do not charge for it.
;;;
;;; Compile and load this file after compiling and loading quick-arrays.cl
;;;
;;; This code performs some simple tests to compare the performance of
;;; quick arrays against the performance of standard arrays on a simple
;;; matrix multiplication problem.  Activate the tests by executing the
;;; form:
;;; 
;;; (qtest)
;;;
;;; qtest uses the time form.  This should print out timing results
;;; automatically.
;;;
;;; The performance is evaluated in several
;;; different scenarios:
;;;
;;; standard arrays with whatever the default optimization settings are
;;; in your environment
;;;
;;; standard arrays with type declarations and high optimization settings
;;;
;;; standard arrays with the element-type field used in the initialization
;;; and optimization settings
;;; 
;;; quick arrays using qaref (function) access
;;; 
;;; quick arrays using qaref (function) acces, declarations, and optimization
;;;
;;; quick arrays using qref (macro) access
;;;
;;; quick arrays using qref with declarations and optimization
;;;
;;; Depending upon your lisp, you may get a 2-3 times speedup with qref
;;; over standard, untyped arrays.  qaref is usually a poor performer and
;;; should be used only in situations where it is impossible to use the
;;; qref macro.  Interestingly, use the of element-type keyword in
;;; make-array appears to slow things down in some implementations but
;;; dramatically improve things (if done correctly!) in others.
;;;

(in-package :common-lisp-user)

(defconstant *test-size* 100)

(defun qmm (a b c)
  "Puts a X b in c, using quick-arrays."
  (let ((arows (qarray-dimension a 1))
        (acolumns (qarray-dimension a 0))
        (bcolumns (qarray-dimension b 1)))
  (dotimes (i arows)
    (dotimes (j bcolumns)
      (setf (qref c i j) 0d0)
      (dotimes (k acolumns)
        (incf (qref c i j)
              (* (qref a i k)
                 (qref b k j))))))))

(defun qmmopt (a b c)
  "Puts a X b in c, usign quick-arrays, optimization and declarations."
  (declare (inline svref))
  (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
  (declare (type (simple-vector *) a b c))
  (let ((arows (qarray-dimension a 1))
        (acolumns (qarray-dimension a 0))
        (bcolumns (qarray-dimension b 1)))
    (declare (fixnum arows acolumns bcolumns))
    (dotimes (i arows)
      (declare (fixnum i))
      (dotimes (j bcolumns)
	(declare (fixnum j))
	(setf (qref c i j) 0d0)
	(dotimes (k acolumns)
	  (declare (fixnum k))
	  (incf (the double-float (qref c i j))
		(* (the double-float (qref a i k))
      		   (the double-float (qref b k j)))))))))
      

(defun qamm (a b c)
  "Puts a X b in c."
  (let ((arows (qarray-dimension a 1))
        (acolumns (qarray-dimension a 0))
        (bcolumns (qarray-dimension b 1)))
    (dotimes (i arows)
      (dotimes (j bcolumns)
	(setf (qref c i j) 0d0)
      (dotimes (k acolumns)
        (incf (qaref c i j)
              (* (qaref a i k)
                 (qaref b k j))))))))

(defun qamm-opt (a b c)
  "Puts a X b in c."
  (declare (inline qaref set-qaref))
  (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
  (declare (type (simple-vector *) a b c))
  (let ((arows (qarray-dimension a 1))
        (acolumns (qarray-dimension a 0))
        (bcolumns (qarray-dimension b 1)))
    (declare (fixnum arows acolumns bcolumns))
    (dotimes (i arows)
      (declare (fixnum i))
      (dotimes (j bcolumns)
	(declare (fixnum j))
	(setf (qref c i j) 0d0)
	(dotimes (k acolumns)
	  (declare (fixnum k))
	  (incf (the double-float (qaref c i j))
		(* (the double-float (qaref a i k))
		   (the double-float (qaref b k j)))))))))

(defun mm (a b c)
  "Puts a X b in c."
  (let ((arows (array-dimension a 1))
        (acolumns (array-dimension a 0))
        (bcolumns (array-dimension b 1)))
    (dotimes (i arows)
      (dotimes (j bcolumns)
	(setf (aref c i j) 0d0)
	(dotimes (k acolumns)
	  (incf (aref c i j)
		(* (aref a i k)
		   (aref b k j))))))))

(defun mmopt (a b c)
  "Puts a X b in c with optimization declarations."
  (declare (inline aref))
  (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
  (declare (simple-array a b c))
  (let ((arows (array-dimension a 1))
        (acolumns (array-dimension a 0))
        (bcolumns (array-dimension b 1)))
    (declare (fixnum arows acolumns bcolumns))
    (dotimes (i arows)
      (declare (fixnum i))
      (dotimes (j bcolumns)
	(declare (fixnum j))
	(setf (aref c i j) 0d0)
	(dotimes (k acolumns)
	  (declare (fixnum k))
	  (incf (aref c i j)
		(* (the double-float (aref a i k))
		   (the double-float (aref b k j)))))))))


(defun mmopt-type (a b c)
  "Puts a X b in c with typed arrays, optimization and declarations."
  (declare (inline aref))
  (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
  (declare (type (simple-array double-float (* *)) a b c))
  (let ((arows (array-dimension a 1))
        (acolumns (array-dimension a 0))
        (bcolumns (array-dimension b 1)))
    (declare (fixnum arows acolumns bcolumns))
    (dotimes (i arows)
      (declare (fixnum i))
      (dotimes (j bcolumns)
	(declare (fixnum j))
	(setf (aref c i j) 0d0)
	(dotimes (k acolumns)
	  (declare (fixnum k))
	  (incf (aref c i j)
		(* (aref a i k)
		   (aref b k j))))))))


(defun rand-qmat (r c)
  "Returns a matrix of size r X c filled with random numbers on [0.0 100.0)"
  (let ((m (qmake-array (list r c))))
    (dotimes (i r)
      (dotimes (j c)
        (setf (qref m i j) (random 100.0d0))))
    m))

(defun rand-mat (r c)
  "Returns a matrix of size r X c filled with random numbers on [0.0 100.0)"
  (let ((m (make-array (list r c))))
    (dotimes (i r)
      (dotimes (j c)
        (setf (aref m i j) (random 100.0d0))))
    m))

(defun qcompare (q a)
  "Compares a quick array matrix with a regular one."
  (let ((result t))
    (dotimes (i (qarray-dimension q 0))
      (dotimes (j (qarray-dimension q 1))
        (setf result
              (and result (= (aref a i j) (qref q i j))))))
    result))

(defun qacompare (q a)
  "Compares a quick array matrix with a regular one."
  (let ((result t))
    (dotimes (i (qarray-dimension q 0))
      (dotimes (j (qarray-dimension q 1))
        (setf result
              (and result (= (aref a i j) (qaref q i j))))))
    result))

(defun acompare (a1 a2)
  "Compares a quick array matrix with a regular one."
  (let ((result t))
    (dotimes (i (array-dimension a1 0))
      (dotimes (j (array-dimension a1 1))
        (setf result
              (and result (= (aref a2 i j) (aref a1 i j))))))
    result))


(defun qcheck (q a)
  "qcompare with output."
  (format t "~%Verifying Consistency...")
  (if (qcompare q a)
    (format t "Check!")
   (format t "Failed!")))

(defun qacheck (q a)
  (format t "~%Verifying Consistency...")
  (if (qacompare q a)
    (format t "Check!")
    (format t "Failed!")))

(defun acheck (a1 a2)
  "acompare with output."
  (format t "~%Verifying Consistency...")
  (if (acompare a1 a2)
    (format t "Check!")
    (format t "Failed!")))

(defun qclear (q)
  "Clears out a quick-array marix."
  (dotimes (i (qarray-dimension q 0))
    (dotimes (j (qarray-dimension q 1))
      (setf (qref q i j) nil))))

(defun qtest ()
  (let* (
         (lsize (list *test-size* *test-size*))
         (a (rand-mat *test-size* *test-size*))
         (b (rand-mat *test-size* *test-size*))
         (c (make-array lsize))
         (ctest (make-array lsize))
         (at (make-array lsize :element-type 'double-float))
         (bt (make-array lsize :element-type 'double-float))
         (ct (make-array lsize :element-type 'double-float))
         (qa (qmake-array lsize))
         (qb (qmake-array lsize))
         (qc (qmake-array lsize)))
    (dotimes (i *test-size*)
      (dotimes (j *test-size*)
        (setf (aref at i j) (the double-float (aref a i j)))
        (setf (aref bt i j) (the double-float (aref b i j)))
        (setf (qref qa i j) (the double-float (aref a i j)))
        (setf (qref qb i j) (the double-float (aref b i j)))))
    (format t "~%~%Running standard array implementation.")
    (gc)
    (time (mm a b c))
    (format t "~%Running optimized standard array implementation.")
    (gc)
    (time (mmopt a b ctest))
    (format t "~%~%Running optimized standard array implementation ")
    (format t "with typed arrays.")
    (gc)
    (time (mmopt-type at bt ct))
    (acheck c ctest)
    (format t "~%~%Running quick arrays using qaref.")
    (gc)
    (time (qamm qa qb qc))
    (qacheck qc c)
    (format t "~%~%Running optimized quick arrays using qaref.")
    (qclear qc)
    (gc)
    (time (qamm-opt qa qb qc))
    (qacheck qc c)
    (format t "~%~%Running quick arrays using qref.")
    (qclear qc)
    (gc)
    (time (qmm qa qb qc))
    (qcheck qc c)
    (format t "~%~%Running optimized quick arrays using qref.")
    (qclear qc)
    (gc)
    (time (qmmopt qa qb qc))
    (qcheck qc c)
    ))