external/clem/test/test-clem.cl

   1
   2 (in-package :clem-test)
   3
   4 (defun matrix-test-1 ()
   5   (let ((m (array->matrix #2A((1 2 3)(4 1 6)(7 1 9)))))
   6     (print-matrix (invert-matrix m)))
   7   t)
   8
   9 (defun matrix-test-2 ()
  10   (let ((m (array->matrix #2A((1 2 3)(4 5 6)(7 8 9)))))
  11     (print-matrix m)
  12     (swap-rows m 0 2)
  13     (swap-cols m 0 2)
  14     (print-matrix m)
  15     (let ((q (val m 0 0)))
  16       (map-row m 0 #'(lambda (x) (/ x q)))
  17       (scalar-mult-col m 0 4)
  18       (scalar-divide-col m 0 3)
  19       )
  20     (print-matrix m)
  21     )
  22   t)
  23
  24 (defun matrix-test-3 ()
  25   (let ((m1 (array->matrix #2A((1 2 3)(4 5 6)(7 8 9) (10 11 12)))))
  26     (print-matrix m1)
  27     (print (dim m1))
  28
  29     (let ((t1 (transpose m1)))
  30       (print-matrix t1)
  31       (print (dim t1)))
  32
  33     (let ((m2 (array->matrix #2A((1 2 3 4 5 6 7 8 9)))))
  34       (print m2)
  35       (print-matrix m2)
  36       (print (dim m2))
  37       ))
  38   t)
  39
  40 (defun matrix-test-4 ()
  41   (let ((m3 (array->matrix #2A((1) (2) (3) (4) (5) (6) (7) (8) (9)))))
  42     (print-matrix m3)
  43     (print (dim m3)))
  44   t)
  45
  46 (defun matrix-test-5 ()
  47   (let ((m (array->matrix #2A((1 2 3)(4 5 6)(7 8 9)))))
  48     (print-matrix (mat-mult m m))
  49     (let ((inv (invert-matrix m)))
  50       (if inv (print-matrix (invert-matrix m)))
  51       ))
  52   t)
  53
  54 (defun matrix-test-6 ()
  55   (let ((m (array->matrix #2A((1 2 3)(4 5 6)(7 8 9)))))
  56     (print-matrix (mat-mult m m))
  57     (let ((inv (invert-matrix m)))
  58       (if inv (print-matrix (invert-matrix m)))
  59       ))
  60   t)
  61
  62 (defun matrix-test-7 ()
  63   (let ((m (array->sb8-matrix #2A((1 2 3)(4 5 6)(7 2 8)))))
  64     (print-matrix m)
  65     (print-matrix (mat-mult m m))
  66     (let ((inv (invert-matrix m)))
  67       (if inv (print-matrix inv))
  68       ))
  69   t)
  70
  71 (defparameter m1 (make-instance 'double-float-matrix :rows 1000 :cols 1000))
  72
  73 (defun matrix-test-8 ()
  74   (dotimes (i 1000)
  75     (dotimes (j 1000)
  76       (set-val m1 i j (- i j)))))
  77
  78 (defun matrix-test-9 ()
  79   (let ((m (array->integer-matrix #2A((1 2 3)(4 5 6)(7 2 8)))))
  80     (print-matrix m)
  81     (print-matrix (mat-mult m m))
  82     (let ((inv (invert-matrix m)))
  83       (if inv (print-matrix inv))
  84       ))
  85   t)
  86
  87 (defun matrix-test-10 ()
  88   (let ((m (array->real-matrix #2A((1 2 3)(4 5 6)(7 2 8)))))
  89     (print-matrix m)
  90     (print-matrix (mat-mult m m))
  91     (let ((inv (invert-matrix m)))
  92       (if inv (print-matrix inv))
  93       ))
  94   t)
  95
  96 (defun matrix-test-11 ()
  97   (let ((m (array->t-matrix #2A((1 2 3)(4 5 6)(7 2 8)))))
  98     (print-matrix m)
  99     (print-matrix (mat-mult m m))
 100     (print-matrix (mat-add m m))
 101     (let ((inv (invert-matrix m)))
 102       (if inv (print-matrix inv))
 103       ))
 104   t)
 105
 106 (defun matrix-test-12 ()
 107   (let ((m (array->ub8-matrix #2A((1 2 3)(4 5 6)(7 2 8)))))
 108     (print (mref m 0 0))
 109     (setf (mref m 0 0) 32)
 110     (print (mref m 0 0)))
 111   t)
 112
 113 (defun run-tests ()
 114   (let ((run (ch-util:make-test-run)))
 115     (ch-util:run-test #'matrix-test-1 "matrix-test-1" run)
 116     (ch-util:run-test #'matrix-test-2 "matrix-test-2" run)
 117     (ch-util:run-test #'matrix-test-3 "matrix-test-3" run)
 118     (ch-util:run-test #'matrix-test-4 "matrix-test-4" run)
 119     (ch-util:run-test #'matrix-test-5 "matrix-test-5" run)
 120     (ch-util:run-test #'matrix-test-6 "matrix-test-6" run)
 121     (ch-util:run-test #'matrix-test-7 "matrix-test-7" run)
 122     (ch-util:run-test #'matrix-test-7 "matrix-test-9" run)
 123     (ch-util:run-test #'matrix-test-7 "matrix-test-10" run)
 124     (ch-util:run-test #'matrix-test-7 "matrix-test-11" run)
 125     (format t "~&~A of ~A tests passed" (ch-util:test-run-passed run) (ch-util:test-run-tests run))
 126     ))
 127
 128 (defparameter m2 (make-instance 'double-float-matrix :dimensions '(1000 1000)))