├── README.md ├── bench.lisp ├── gauss.asd ├── src ├── add.lisp ├── class.lisp ├── construct.lisp ├── contagion.lisp ├── declare.lisp ├── mref.lisp ├── mul.lisp ├── package.lisp ├── shortcuts.lisp ├── solve.lisp └── transpose.lisp └── test ├── add.lisp ├── construct.lisp ├── mul.lisp ├── package.lisp ├── run.lisp ├── solve.lisp └── transpose.lisp /README.md: -------------------------------------------------------------------------------- 1 | GAUSS 2 | ===== 3 | 4 | * [Overview](#overview) 5 | * [Future Directions](#future) 6 | * [Defining matrices for a given numeric type](#define) 7 | * [Creating matrices and vectors](#create) 8 | * [Accessing attributes of matrices and vectors](#attribs) 9 | * [Indexing into matrices and vectors](#indexing) 10 | * [Transposing a matrix](#transpose) 11 | * [Adding and multiplying matrices and vectors](#add-mul) 12 | * [Solving linear equations](#solve) 13 | * [Shortcuts](#shortcuts) 14 | 15 | Overview 16 | ------------------------------- 17 | 18 | This package provides simple matrix manipulation in Common Lisp. 19 | There are already a number of packages that do basic matrix 20 | manipulation in Common Lisp. You will prefer this package to the 21 | other such packages if: 22 | 23 | * You do not want to rely on FFI to BLAS 24 | * Boxing and unboxing of numeric types is too much overhead 25 | * Generic function dispatch is too much overhead 26 | 27 | This package employs Robert Smith's [Template][template] library to 28 | avoid boxing and unboxing as much as possible. As such, many of the 29 | functions require a specified list of types. This allows compile-time 30 | dispatch of the appropriately typed function (when the given list of 31 | types is known at compile-time). 32 | 33 | [template]: https://bitbucket.org/tarballs_are_good/template 34 | 35 | All of the public functionality of this library treats matrices and 36 | vectors as immutable. This library does not guarantee correct 37 | behavior if one takes it upon oneself to circumvent that immutability. 38 | In particular, at the moment, if one takes the tranpose of a matrix 39 | and then modifies it, the original matrix will also be modified. 40 | 41 | Future Directions 42 | -------------------------------------- 43 | 44 | This library currently only features the functionality that I 45 | need to implement Kalman filtering. Features that I expect to want 46 | out of this library in the not-too-distant future (tomorrow A.D.) are: 47 | 48 | * Solving multiple linear-equations with the same matrix 49 | * Eigenvectors and eigenvalues 50 | * QR decomposition 51 | * LU decomposition 52 | * Singular-value decomposition 53 | 54 | Defining matrices for a given numeric type 55 | --------------------------------------------------------------- 56 | 57 | To create the functions needed matrices of a given numeric type, one 58 | uses the `DEFINE-MATRIX-TYPE` macro: 59 | 60 | (defmacro define-matrix-type (numeric-type) ...) 61 | 62 | For example, to create functions for `SINGLE-FLOAT` matrices optimized 63 | for speed, one might: 64 | 65 | (in-package :gauss) 66 | (locally 67 | (declare (optimize (speed 3) (safety 1))) 68 | (define-matrix-type single-float)) 69 | 70 | ISSUE: There is currently a limitation which requires one to use this 71 | macro in the `GAUSS` package. 72 | 73 | The `DEFINE-MATRIX-TYPE` creates all of the functions needed for 74 | operating with matrices of the given type. If one wishes to mix 75 | matrix types (e.g. multiplying a single-float matrix by a double-float 76 | vector), one needs to define the mixed-type operations with: 77 | 78 | (defmacro define-mixed-type-matrix-operations (type-a type-b) ...) 79 | 80 | For example: 81 | 82 | (in-package :gauss) 83 | (locally 84 | (declare (optimize (speed 3) (safety 1))) 85 | (define-mixed-type-matrix-operations single-float double-float)) 86 | 87 | ISSUE: There is currently a limitation which requires one to use this 88 | macro in the `GAUSS` package. 89 | 90 | The `GAUSS` package itself declares everything needed to use 91 | `rational`, `single-float`, or `double-float` matrices, but it does 92 | not define any of the operations for mixing and matching between those 93 | types. 94 | 95 | (define-matrix-type rational) 96 | (define-matrix-type single-float) 97 | (define-matrix-type double-float) 98 | 99 | Those operations in the `GAUSS` package are compiled with `(speed 2)` 100 | and `(safety 3)`. Most of the operations in the `GAUSS` package are 101 | such that run-time validation of parameters is omitted if `speed` is 102 | greater than `safety`. I recommend that you use the pre-compiled 103 | settings while coding/debugging and use a `LOCALLY` block as above 104 | to recompile them with `speed` greater than `safety` once you have the 105 | kinks worked out. 106 | 107 | As an example, the following form will cause an assertion if `speed` 108 | is less than or equal to `safety` at the time the matrix operations 109 | are compiled, but will slide through otherwise: 110 | 111 | (gauss:m+ '(single-float single-float) 112 | (gauss:make-vector* '(single-float) 1.0) 113 | (gauss:make-vector* '(single-float) 2.0 5.0)) 114 | 115 | When it slides through, it currently creates a 1x1 matrix: 116 | 117 | # 119 | 120 | However, I do not guarantee that any behavior which would `ASSERT` 121 | when compiled with `speed` less than or equal to `safety` will behave 122 | consistently across versions or compilers when `speed` is greater than 123 | `safety`. In other words, if your code does not work when compiled 124 | with `speed` less than or equal to `safety`, then you should not be 125 | relying on the results you obtain when `speed` is greater than 126 | `safety`. 127 | 128 | Creating matrices and vectors 129 | -------------------------------------------------- 130 | 131 | One can create a matrix from a list of values or from explicit values: 132 | 133 | (defun make-matrix (type-list rows cols list-of-values) ...) 134 | (defun make-matrix* (type-list rows cols &rest values) ...) 135 | 136 | Similarly, one can create a vector from a list of values or from 137 | explicit values: 138 | 139 | (defun make-vector (type-list list-of-values) ...) 140 | (defun make-vector* (type-list &rest values) ...) 141 | 142 | All of the above return a structure of type `MATRIX`. 143 | 144 | For example, to create a `SINGLE-FLOAT` matrix and a commensurate 145 | vector, one might: 146 | 147 | (let ((matrix (gauss:make-matrix '(single-float) 148 | 2 3 149 | '(1.0 2.0 3.0 150 | 2.0 3.0 4.0))) 151 | (vector (gauss:make-vector* '(single-float) 1.5 2.5))) 152 | (values matrix vector)) 153 | 154 | Which would yield the values: 155 | 156 | # 159 | # 162 | 163 | Accessing attributes of matrices and vectors 164 | ------------------------------------------------------------------ 165 | 166 | One can query the number of rows and columns in a matrix: 167 | 168 | (defun mrows (matrix) ...) 169 | (defun mcols (matrix) ...) 170 | 171 | One can query the numeric type of a matrix: 172 | 173 | (defun mtype (matrix) ...) 174 | 175 | The library also defines several predicates which can be useful when 176 | asserting pre-conditions: 177 | 178 | (defun square-matrix-p (matrix) ...) 179 | (defun commensuratep (matrix-a matrix-b) ...) 180 | (defun column-vector-p (matrix) ...) 181 | 182 | The function `COMMENSURATEP` returns true if one could multiply 183 | `MATRIX-A` by `MATRIX-B`, in that order. In other words, the number 184 | of columns in `MATRIX-A` must equal the number of rows in `MATRIX-B`. 185 | 186 | Indexing into matrices and vectors 187 | --------------------------------------------------------- 188 | 189 | To retrieve elements from a matrix, one can use `MREF`. To retrieve 190 | elements from a vector, one can use `VREF`. To retrieve elements from 191 | a transposed vector, one can use `VTREF`. 192 | 193 | (defun mref (types-list matrix row col) ...) 194 | (defun vref (types-list column-vector row) ...) 195 | (defun vtref (types-list row-vector col) ...) 196 | 197 | For example: 198 | 199 | (let ((vector (gauss:make-vector* '(single-float) 1.5 2.5))) 200 | (+ (gauss:vref '(single-float) vector 0) 201 | (gauss:mref '(single-float) vector 1 0))) 202 | 203 | Transposing a matrix 204 | -------------------------------------------- 205 | 206 | The `TRANSPOSE` function can be used to calculate the transpose of a 207 | matrix. 208 | 209 | (defun transpose (type-list matrix) ...) 210 | 211 | For example: 212 | 213 | (gauss:transpose '(single-float) 214 | (gauss:make-vector* '(single-float) 1.0 2.0 3.0 4.0)) 215 | 216 | Which yields: 217 | 218 | # 220 | 221 | Adding and multiplying matrices and vectors 222 | --------------------------------------------------------------- 223 | 224 | One can add matrices with `M+` (or `V+`), subtract matrices with `M-` 225 | (or `V-`), and multiply them with `M*`. The list of types for these 226 | functions contains two types, one for the first matrix and one for the 227 | second matrix. 228 | 229 | (defun m+ (types-list matrix-a matrix-b) ...) 230 | (defun m- (types-list matrix-a matrix-b) ...) 231 | (defun m* (types-list matrix-a matrix-b) ...) 232 | 233 | (defun v+ (types-list vector-a vector-b) ...) 234 | (defun v- (types-list vector-a vector-b) ...) 235 | 236 | For example: 237 | 238 | (let ((m (gauss:make-matrix* '(single-float) 239 | 2 2 240 | 1.0 2.0 241 | 3.0 4.0)) 242 | (v (gauss:make-vector* '(single-float) 0.5 0.5))) 243 | (gauss:m* '(single-float single-float) 244 | m 245 | (gauss:v+ '(single-float single-float) v v))) 246 | 247 | Which yields: 248 | 249 | # 252 | 253 | One can also scale a matrix by a scalar factor: 254 | 255 | (defun scale (types-list matrix scalar) ...) 256 | 257 | For example: 258 | 259 | (let ((v (gauss:make-vector* '(single-float) 1.0 2.0))) 260 | (gauss:scale '(single-float single-float) v 3.0)) 261 | 262 | Which yields: 263 | 264 | # 267 | 268 | 269 | Solving linear equations 270 | -------------------------------------------- 271 | 272 | One can use the `SOLVE` function to solve a system of linear 273 | equations. Given a matrix `M` and a commensurate vector `V`, the 274 | `SOLVE` function returns a vector `X` such that `M * X = V`. 275 | 276 | (defun solve (types-list matrix vector) ...) 277 | 278 | The `TYPES-LIST` is a two-element list specifying (first) the numeric 279 | type of the matrix and (second) the numeric type of the vector. 280 | 281 | For example: 282 | 283 | (let ((m (gauss:make-matrix* '(single-float) 284 | 2 2 285 | 1.0 2.0 286 | 3.0 4.0)) 287 | (v (gauss:make-vector* '(single-float) 3.0 5.0))) 288 | (gauss:solve '(single-float single-float) m v)) 289 | 290 | Which yields: 291 | 292 | # 295 | 296 | Shortcuts 297 | --------------------------------- 298 | 299 | One can define shortcuts so that one need not include such verbose 300 | type information. One creates shortcuts using the 301 | `DEFINE-MATRIX-OPERATION-SHORTCUTS` macro: 302 | 303 | (defmacro define-matrix-operation-shortcuts (ext-a type-a ext-b type-b) 304 | ...) 305 | 306 | This will create functions: `MAKE-MATRIX/A`, `MREF/A`, `M+/AB`, 307 | `M+/BA`, etc. where `A` and `B` are the given extensions. All 308 | shortcuts are created in the same package as `EXT-A`. 309 | 310 | Note: no shortcuts are made for the functions which do not require a 311 | list of types. There is no `MROWS/A` defined, for example. 312 | 313 | The `GAUSS` package exports shortcuts for `RATIONAL`, `SINGLE-FLOAT`, 314 | and `DOUBLE-FLOAT`. 315 | 316 | (define-matrix-operation-shortcuts q rational q rational) 317 | (define-matrix-operation-shortcuts s single-float s single-float) 318 | (define-matrix-operation-shortcuts d double-float d double-float) 319 | 320 | For example, one could abbreviate the code given in the 321 | [previous section](#solve) as: 322 | 323 | (let ((m (gauss:make-matrix*/s 2 2 324 | 1.0 2.0 325 | 3.0 4.0)) 326 | (v (gauss:make-vector*/s 3.0 5.0))) 327 | (gauss:solve/ss m v)) 328 | 329 | Which yields: 330 | 331 | # 334 | -------------------------------------------------------------------------------- /bench.lisp: -------------------------------------------------------------------------------- 1 | (load "gauss.asd") 2 | (ql:quickload '(:gauss :gauss-test)) 3 | 4 | (asdf:test-system :gauss) 5 | 6 | (in-package :gauss) 7 | 8 | (locally (declare (optimize (speed 3) (safety 1))) 9 | (define-matrix-type single-float)) 10 | 11 | (in-package :cl-user) 12 | 13 | ;;; The following form will cause an assertion if the matrix functions 14 | ;;; were compiled with (<= speed safety), but will slide through, at 15 | ;;; the moment, if (> speed safety). 16 | #+not 17 | (gauss:m+ '(single-float single-float) 18 | (gauss:make-vector* '(single-float) 1.0) 19 | (gauss:make-vector* '(single-float) 1.0 2.0)) 20 | 21 | (template:define-templated-function make-random-matrix (type) (n) 22 | `(let ((vals (loop :repeat (* n n) 23 | :collect (+ 0.1 (random (coerce 1.0 ',type)))))) 24 | (gauss:make-matrix '(,type) n n vals))) 25 | 26 | (template:define-templated-function make-nonsingular-matrix (type) (n) 27 | `(let ((vals (loop :for r :below n 28 | :appending (loop :with v := (coerce (/ r 10) ',type) 29 | :for c :below n 30 | :collecting (expt (1+ c) v))))) 31 | (gauss:make-matrix '(,type) n n vals))) 32 | 33 | (template:define-templated-function make-random-vector (type) (n) 34 | `(let ((vals (loop :repeat n 35 | :collect (random (coerce 0.01 ',type))))) 36 | (gauss:make-vector '(,type) vals))) 37 | 38 | (template:instantiate-templated-function make-random-matrix single-float) 39 | (template:instantiate-templated-function make-nonsingular-matrix single-float) 40 | (template:instantiate-templated-function make-random-vector single-float) 41 | 42 | (defmacro bench (op type &optional (iterations 10000)) 43 | (let ((a (gensym "A")) 44 | (b (gensym "B"))) 45 | `(let ((,a (make-random-matrix '(,type) 50)) 46 | (,b (make-random-matrix '(,type) 50))) 47 | (time 48 | (loop :repeat ,iterations 49 | :do (,op '(,type ,type) ,a ,b)))))) 50 | 51 | (bench gauss:m+ single-float 1000) 52 | #+not (bench gauss:m* single-float 1000) 53 | 54 | (defmacro bench-solve (type &optional (iterations 10000)) 55 | (let ((a (gensym "A")) 56 | (b (gensym "B"))) 57 | `(let ((,a (make-nonsingular-matrix '(,type) 25)) 58 | (,b (make-random-vector '(,type) 25))) 59 | (time 60 | (loop :repeat ,iterations 61 | :do (gauss:solve '(,type ,type) ,a ,b)))))) 62 | 63 | (bench-solve single-float 1000) 64 | 65 | (let ((a (make-nonsingular-matrix '(single-float) 25)) 66 | (b (make-random-vector '(single-float) 25))) 67 | (time 68 | (loop :repeat 1000 69 | :do (gauss:solve/ss a b)))) 70 | 71 | (gauss:solve '(single-float single-float) 72 | (make-nonsingular-matrix '(single-float) 25) 73 | (make-random-vector '(single-float) 25)) 74 | -------------------------------------------------------------------------------- /gauss.asd: -------------------------------------------------------------------------------- 1 | ;;;; gauss.asd 2 | 3 | (asdf:defsystem #:gauss 4 | :description "Yet another matrix library." 5 | :author "Patrick Stein " 6 | :version "0.2.20160130" 7 | :license "UNLICENSE" 8 | :depends-on (#:policy-cond #:template) 9 | :in-order-to ((asdf:test-op (asdf:load-op :gauss-test))) 10 | :perform (asdf:test-op (o c) 11 | (uiop:symbol-call :gauss-test :run-all-tests)) 12 | :components 13 | ((:static-file "README.md") 14 | (:module "src" 15 | :components ((:file "package") 16 | (:file "construct" :depends-on ("package")) 17 | (:file "mref" :depends-on ("package")) 18 | (:file "contagion" :depends-on ("package")) 19 | (:file "transpose" :depends-on ("package" 20 | "construct")) 21 | (:file "add" :depends-on ("package" 22 | "construct" 23 | "mref" 24 | "contagion")) 25 | (:file "mul" :depends-on ("package" 26 | "construct" 27 | "mref" 28 | "contagion")) 29 | (:file "solve" :depends-on ("package" 30 | "construct" 31 | "mref" 32 | "contagion")) 33 | (:file "declare" :depends-on ("package" 34 | "construct" 35 | "transpose" 36 | "mref" 37 | "add" 38 | "mul" 39 | "solve")) 40 | (:file "shortcuts" :depends-on ("package" 41 | "construct" 42 | "transpose" 43 | "mref" 44 | "add" 45 | "mul" 46 | "solve")))))) 47 | 48 | (asdf:defsystem #:gauss-test 49 | :description "Tests for the GAUSS package." 50 | :author "Patrick Stein " 51 | :version "0.2.20160130" 52 | :license "UNLICENSE" 53 | :depends-on ((:version #:gauss "0.2.20160130") 54 | #:nst) 55 | :components 56 | ((:module "test" 57 | :components ((:file "package") 58 | (:file "construct" :depends-on ("package")) 59 | (:file "transpose" :depends-on ("package")) 60 | (:file "add" :depends-on ("package")) 61 | (:file "mul" :depends-on ("package")) 62 | (:file "solve" :depends-on ("package")) 63 | (:file "run" :depends-on ("package")))))) 64 | -------------------------------------------------------------------------------- /src/add.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/add.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (template:define-templated-function m+ (type-a type-b) (a b) 6 | `(policy-cond:with-expectations (> speed safety) 7 | ((assertion (= (mrows a) (mrows b))) 8 | (assertion (= (mcols a) (mcols b)))) 9 | (make-matrix '(,(contagion-type type-a type-b)) 10 | (mrows a) (mcols a) 11 | (loop :with av := (mvals a) 12 | :with bv := (mvals b) 13 | :for i :below (* (mrows a) (mcols a)) 14 | :collecting (+ (the ,type-a (aref av i)) 15 | (the ,type-b (aref bv i))))))) 16 | 17 | (template:define-templated-function v+ (type-a type-b) (a b) 18 | `(m+ '(,type-a ,type-b) a b)) 19 | 20 | (template:define-templated-function m- (type-a type-b) (a b) 21 | `(policy-cond:with-expectations (> speed safety) 22 | ((assertion (= (mrows a) (mrows b))) 23 | (assertion (= (mcols a) (mcols b)))) 24 | (make-matrix '(,(contagion-type type-a type-b)) 25 | (mrows a) (mcols a) 26 | (loop :with av := (mvals a) 27 | :with bv := (mvals b) 28 | :for i :below (* (mrows a) (mcols a)) 29 | :collecting (- (the ,type-a (aref av i)) 30 | (the ,type-b (aref bv i))))))) 31 | 32 | (template:define-templated-function v- (type-a type-b) (a b) 33 | `(m- '(,type-a ,type-b) a b)) 34 | -------------------------------------------------------------------------------- /src/class.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/class.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (template:define-templated-function make-matrix (type) (rows cols &rest vals) 6 | `(policy-cond:with-expectations (> speed safety) 7 | ((type (unsigned-byte 1 *) rows) 8 | (type (unsigned-byte 1 *) cols) 9 | (assertion (= (length vals) (* rows cols)))) 10 | (make-array (list rows cols) 11 | :element-type ',type 12 | :initial-contents vals))) 13 | -------------------------------------------------------------------------------- /src/construct.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/construct.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (declaim (inline mrows mcols mvals mtype)) 6 | (defstruct (matrix (:conc-name "M") 7 | (:constructor %matrix) 8 | (:copier nil)) 9 | (rows 0 :type (integer 1 *) :read-only t) 10 | (cols 0 :type (integer 1 *) :read-only t) 11 | (cf 0 :type (integer 1 *) :read-only t) 12 | (rf 0 :type (integer 1 *) :read-only t) 13 | (vals 0 :read-only t)) 14 | 15 | (defun mtype (m) 16 | (check-type m matrix) 17 | (array-element-type (mvals m))) 18 | 19 | (defun copy-matrix (m &optional (new-type (mtype m))) 20 | (check-type m matrix) 21 | (%matrix :rows (mrows m) :cols (mcols m) 22 | :cf (mcf m) :rf (mrf m) 23 | :vals (if (eql new-type (mtype m)) 24 | (copy-seq (mvals m)) 25 | (let* ((mvals (mvals m)) 26 | (mvals (map 'list 27 | (lambda (v) 28 | (coerce v new-type)) 29 | mvals))) 30 | (make-array (length mvals) 31 | :element-type new-type 32 | :initial-contents mvals))))) 33 | 34 | (template:define-templated-function make-matrix (type) (rows cols vals) 35 | `(policy-cond:with-expectations (> speed safety) 36 | ((type (integer 1 *) rows) 37 | (type (integer 1 *) cols) 38 | (assertion (= (length vals) (* rows cols))) 39 | (assertion (every (lambda (v) 40 | (typep v ',type)) 41 | vals))) 42 | (let ((vals-array (make-array (* rows cols) 43 | :element-type ',type 44 | :initial-contents vals))) 45 | (%matrix :rows rows :cols cols 46 | :cf 1 :rf cols 47 | :vals vals-array)))) 48 | 49 | (template:define-templated-function make-matrix* (type) (rows cols &rest vals) 50 | `(make-matrix '(,type) rows cols vals)) 51 | 52 | (template:define-templated-function make-vector (type) (vals) 53 | `(make-matrix '(,type) (length vals) 1 vals)) 54 | 55 | (template:define-templated-function make-vector* (type) (&rest vals) 56 | `(make-vector '(,type) vals)) 57 | -------------------------------------------------------------------------------- /src/contagion.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/contagion.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (defgeneric contagion-type (a b) 6 | (:method ((a (eql 'double-float)) (b (eql 'double-float))) 7 | 'double-float) 8 | (:method ((a (eql 'double-float)) (b (eql 'single-float))) 9 | 'double-float) 10 | (:method ((a (eql 'single-float)) (b (eql 'double-float))) 11 | 'double-float) 12 | (:method ((a (eql 'double-float)) (b (eql 'rational))) 13 | 'double-float) 14 | (:method ((a (eql 'rational)) (b (eql 'double-float))) 15 | 'double-float) 16 | 17 | (:method ((a (eql 'single-float)) (b (eql 'single-float))) 18 | 'single-float) 19 | (:method ((a (eql 'single-float)) (b (eql 'rational))) 20 | 'single-float) 21 | (:method ((a (eql 'rational)) (b (eql 'single-float))) 22 | 'single-float) 23 | 24 | (:method ((a (eql 'rational)) (b (eql 'rational))) 25 | 'rational)) 26 | -------------------------------------------------------------------------------- /src/declare.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/declare.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (eval-when (:compile-toplevel :load-toplevel :execute) 6 | (template:define-template instantiate-mixed-type-matrix-operations 7 | (type-a type-b) 8 | `(progn 9 | (template:instantiate-templated-function m+ ,type-a ,type-b) 10 | (template:instantiate-templated-function v+ ,type-a ,type-b) 11 | (template:instantiate-templated-function m- ,type-a ,type-b) 12 | (template:instantiate-templated-function v- ,type-a ,type-b) 13 | (template:instantiate-templated-function scale ,type-a ,type-b) 14 | (template:instantiate-templated-function m* ,type-a ,type-b) 15 | (template:instantiate-template make-solver ,type-a ,type-b) 16 | (list ',type-a ',type-b))) 17 | 18 | (template:define-template instantiate-matrix-type (type) 19 | `(progn 20 | (template:instantiate-templated-function mref ,type) 21 | (template:instantiate-templated-function set-mref ,type) 22 | (template:instantiate-templated-function vref ,type) 23 | (template:instantiate-templated-function vtref ,type) 24 | (template:instantiate-templated-function set-vref ,type) 25 | (template:instantiate-templated-function make-matrix ,type) 26 | (template:instantiate-templated-function make-matrix* ,type) 27 | (template:instantiate-templated-function make-vector ,type) 28 | (template:instantiate-templated-function make-vector* ,type) 29 | (template:instantiate-templated-function transpose ,type) 30 | (template:instantiate-template instantiate-mixed-type-matrix-operations 31 | ,type ,type) 32 | ',type)) 33 | 34 | (defmacro define-matrix-type (type) 35 | `(template:instantiate-template instantiate-matrix-type ,type)) 36 | 37 | (defmacro define-mixed-type-matrix-operations (type-a type-b) 38 | `(progn 39 | (template:instantiate-template instantiate-mixed-type-matrix-operations 40 | ,type-a ,type-b) 41 | (template:instantiate-template instantiate-mixed-type-matrix-operations 42 | ,type-b ,type-a)))) 43 | 44 | (locally (declare (optimize (speed 2) (safety 3))) 45 | (define-matrix-type rational) 46 | (define-matrix-type single-float) 47 | (define-matrix-type double-float)) 48 | -------------------------------------------------------------------------------- /src/mref.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/mref.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (declaim (inline mindex)) 6 | (defun mindex (matrix row col) 7 | (+ (* (mrf matrix) row) 8 | (* (mcf matrix) col))) 9 | 10 | (template:define-templated-function mref (type) (matrix row col) 11 | `(policy-cond:with-expectations (> speed safety) 12 | ((type unsigned-byte row) 13 | (type unsigned-byte col) 14 | (assertion (eql (mtype matrix) ',type)) 15 | (assertion (< row (mrows matrix))) 16 | (assertion (< col (mcols matrix)))) 17 | (the ,type (aref (mvals matrix) (mindex matrix row col))))) 18 | 19 | (template:define-templated-function set-mref (type) (val matrix row col) 20 | `(policy-cond:with-expectations (> speed safety) 21 | ((type unsigned-byte row) 22 | (type unsigned-byte col) 23 | (type ,type val) 24 | (assertion (eql (array-element-type (mvals matrix)) ',type)) 25 | (assertion (< row (mrows matrix))) 26 | (assertion (< col (mcols matrix)))) 27 | (setf (aref (mvals matrix) (mindex matrix row col)) val))) 28 | 29 | (template:define-templated-function vref (type) (vector row) 30 | `(policy-cond:with-expectations (> speed safety) 31 | ((type unsigned-byte row) 32 | (assertion (eql (mtype vector) ',type)) 33 | (assertion (< row (mrows vector))) 34 | (assertion (= 1 (mcols vector)))) 35 | (the ,type (aref (mvals vector) row)))) 36 | 37 | (template:define-templated-function set-vref (type) (val vector row) 38 | `(policy-cond:with-expectations (> speed safety) 39 | ((type unsigned-byte row) 40 | (type ,type val) 41 | (assertion (eql (mtype vector) ',type)) 42 | (assertion (< row (mrows vector))) 43 | (assertion (= 1 (mcols vector)))) 44 | (setf (aref (mvals vector) row) val))) 45 | 46 | (template:define-templated-function vtref (type) (vector col) 47 | `(policy-cond:with-expectations (> speed safety) 48 | ((type unsigned-byte col) 49 | (assertion (eql (mtype vector) ',type)) 50 | (assertion (< col (mcols vector))) 51 | (assertion (= 1 (mrows vector)))) 52 | (the ,type (aref (mvals vector) col)))) 53 | 54 | (defmethod print-object ((m matrix) stream) 55 | (if *print-readably* 56 | (call-next-method) 57 | (print-unreadable-object (m stream :type t) 58 | (loop :for row :below (mrows m) 59 | :do (fresh-line stream) 60 | :do (loop :with mtype := (mtype m) 61 | :for col :below (mcols m) 62 | :do (format stream " ~A" (mref (list mtype) m row col))))))) 63 | -------------------------------------------------------------------------------- /src/mul.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/mul.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (template:define-templated-function scale (type-a type-b) (a b) 6 | `(policy-cond:with-expectations (> speed safety) 7 | ((type matrix a) 8 | (type ,type-b b) 9 | (assertion (eql ',type-a (mtype a)))) 10 | (make-matrix '(,(contagion-type type-a type-b)) 11 | (mrows a) (mcols a) 12 | (loop :for row :below (mrows a) 13 | :appending (loop :for col :below (mcols a) 14 | :collect (* (mref '(,type-a) a row col) 15 | b)))))) 16 | 17 | (template:define-templated-function m* (type-a type-b) (a b) 18 | `(policy-cond:with-expectations (> speed safety) 19 | ((assertion (= (mcols a) (mrows b)))) 20 | (make-matrix '(,(contagion-type type-a type-b)) 21 | (mrows a) (mcols b) 22 | (loop :for row :below (mrows a) 23 | :appending 24 | (loop :for col :below (mcols b) 25 | :collect 26 | (loop :for k :below (mcols a) 27 | :summing 28 | (* (mref '(,type-a) a row k) 29 | (mref '(,type-b) b k col)))))))) 30 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/package.lisp 2 | 3 | (defpackage #:gauss 4 | (:use #:cl) 5 | (:export #:matrix 6 | #:make-vector 7 | #:make-vector* 8 | #:make-matrix 9 | #:make-matrix*) 10 | (:export #:mrows 11 | #:mcols 12 | #:mtype) 13 | (:export #:mref 14 | #:vref) 15 | (:export #:transpose) 16 | (:export #:square-matrix-p 17 | #:commensuratep 18 | #:column-vector-p) 19 | (:export #:m+ 20 | #:v+ 21 | #:m- 22 | #:v-) 23 | (:export #:scale 24 | #:m*) 25 | (:export #:solve) 26 | (:export #:define-matrix-type 27 | #:define-mixed-type-matrix-operations) 28 | (:export #:define-matrix-operation-shortcuts) 29 | (:export #:make-vector/q #:make-vector*/q 30 | #:make-matrix/q #:make-matrix*/q 31 | #:mref/q #:vref/q #:transpose/q 32 | #:m+/qq #:v+/qq #:m-/qq #:v-/qq 33 | #:scale/qq #:m*/qq 34 | #:solve/qq) 35 | (:export #:make-vector/s #:make-vector*/s 36 | #:make-matrix/s #:make-matrix*/s 37 | #:mref/s #:vref/s #:transpose/s 38 | #:m+/ss #:v+/ss #:m-/ss #:v-/ss 39 | #:scale/ss #:m*/ss 40 | #:solve/ss) 41 | (:export #:make-vector/d #:make-vector*/d 42 | #:make-matrix/d #:make-matrix*/d 43 | #:mref/d #:vref/d #:transpose/d 44 | #:m+/dd #:v+/dd #:m-/dd #:v-/dd 45 | #:scale/dd #:m*/dd 46 | #:solve/dd)) 47 | -------------------------------------------------------------------------------- /src/shortcuts.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/shortcuts.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (eval-when (:compile-toplevel :load-toplevel :execute) 6 | (defun just-the-arguments (lambda-list) 7 | (labels ((first-atom (atom-or-list) 8 | (cond 9 | ((null atom-or-list) nil) 10 | ((listp atom-or-list) (first-atom (first atom-or-list))) 11 | (t atom-or-list)))) 12 | (mapcar #'first-atom 13 | (set-difference lambda-list 14 | lambda-list-keywords)))) 15 | 16 | (defun make-matrix-operation-shortcuts (extension-a type-a 17 | extension-b type-b) 18 | (let ((pkg (if (symbolp extension-a) 19 | (symbol-package extension-a) 20 | *package*))) 21 | 22 | (labels ((shortcut-name (function-symbol &rest extensions) 23 | (intern (format nil 24 | "~A/~A" 25 | function-symbol 26 | (apply #'concatenate 27 | 'string 28 | (mapcar #'string extensions))) 29 | pkg)) 30 | 31 | (make-shortcut (function-symbol 32 | lambda-list 33 | shortcut-name 34 | &rest types) 35 | `((declaim (inline ,shortcut-name)) 36 | (defun ,shortcut-name (&rest args) 37 | (apply #',function-symbol '(,@types) args)) 38 | (define-compiler-macro ,shortcut-name (&whole form 39 | ,@lambda-list) 40 | (declare (ignore ,@(just-the-arguments lambda-list))) 41 | (list* ',function-symbol 42 | (list 'quote '(,@types)) 43 | (rest form))))) 44 | 45 | (make-shortcut-1 (function-symbol lambda-list) 46 | (make-shortcut function-symbol 47 | lambda-list 48 | (shortcut-name function-symbol extension-a) 49 | type-a)) 50 | (make-shortcut-2 (function-symbol lambda-list) 51 | (append (make-shortcut function-symbol 52 | lambda-list 53 | (shortcut-name function-symbol 54 | extension-a 55 | extension-b) 56 | type-a 57 | type-b) 58 | (unless (eql type-a type-b) 59 | (make-shortcut function-symbol 60 | lambda-list 61 | (shortcut-name function-symbol 62 | extension-b 63 | extension-a) 64 | type-b 65 | type-a))))) 66 | 67 | (append '(progn) 68 | (make-shortcut-1 'make-matrix '(rows cols values)) 69 | (make-shortcut-1 'make-matrix* '(rows cols &rest values)) 70 | (make-shortcut-1 'make-vector '(values)) 71 | (make-shortcut-1 'make-vector* '(&rest values)) 72 | (make-shortcut-1 'mref '(m row col)) 73 | (make-shortcut-1 'vref '(v row)) 74 | (make-shortcut-1 'transpose '(m)) 75 | (make-shortcut-2 'm+ '(a b)) 76 | (make-shortcut-2 'v+ '(a b)) 77 | (make-shortcut-2 'm- '(a b)) 78 | (make-shortcut-2 'v- '(a b)) 79 | (make-shortcut-2 'scale '(a b)) 80 | (make-shortcut-2 'm* '(a b)) 81 | (make-shortcut-2 'solve '(a b)) 82 | `(',(shortcut-name 'm+ extension-a extension-b))))))) 83 | 84 | (defmacro define-matrix-operation-shortcuts (extension-a type-a 85 | extension-b type-b) 86 | (make-matrix-operation-shortcuts extension-a type-a 87 | extension-b type-b)) 88 | 89 | (define-matrix-operation-shortcuts q rational q rational) 90 | (define-matrix-operation-shortcuts s single-float s single-float) 91 | (define-matrix-operation-shortcuts d double-float d double-float) 92 | -------------------------------------------------------------------------------- /src/solve.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/solve.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (declaim (inline square-matrix-p)) 6 | (defun square-matrix-p (m) 7 | (= (mrows m) (mcols m))) 8 | 9 | (declaim (inline commensuratep)) 10 | (defun commensuratep (a b) 11 | (= (mcols a) (mrows b))) 12 | 13 | (declaim (inline column-vector-p)) 14 | (defun column-vector-p (v) 15 | (= (mcols v) 1)) 16 | 17 | (template:define-templated-function find-pivot-row (type) (m col) 18 | `(policy-cond:with-expectations (> speed safety) 19 | ((type matrix m) 20 | (type fixnum col) 21 | (assertion (eql ',type (mtype m))) 22 | (assertion (square-matrix-p m)) 23 | (assertion (<= 0 col)) 24 | (assertion (< col (mcols m)))) 25 | (loop :with best-pivot-row fixnum := col 26 | :with best-pivot-val ,type := (mref '(,type) m col col) 27 | :for row fixnum :from (1+ best-pivot-row) :below (mrows m) 28 | :for val ,type := (mref '(,type) m row col) 29 | :when (< best-pivot-val val) 30 | :do (setf best-pivot-row row 31 | best-pivot-val val) 32 | :finally (return best-pivot-row)))) 33 | 34 | (template:define-templated-function swap-rows-of-matrix (type) (m row-a row-b) 35 | `(policy-cond:with-expectations (> speed safety) 36 | ((type matrix m) 37 | (type fixnum row-a) 38 | (type fixnum row-b) 39 | (assertion (eql ',type (mtype m))) 40 | (assertion (<= 0 row-a)) 41 | (assertion (< row-a (mrows m))) 42 | (assertion (<= 0 row-b)) 43 | (assertion (< row-b (mrows m)))) 44 | (loop :for col fixnum :below (mcols m) 45 | :for a ,type := (mref '(,type) m row-a col) 46 | :for b ,type := (mref '(,type) m row-b col) 47 | :do (set-mref '(,type) b m row-a col) 48 | :do (set-mref '(,type) a m row-b col)))) 49 | 50 | (template:define-templated-function row-operation (type) 51 | (m row row-factor other-row other-row-factor &optional start) 52 | "Reduce row ROW by taking each element in the row and replacing it 53 | with the element times ROW-FACTOR plus the corresponding element of 54 | the OTHER-ROW times the OTHER-ROW-FACTOR. Start with index START." 55 | `(policy-cond:with-expectations (> speed safety) 56 | ((type matrix m) 57 | (type fixnum row) 58 | (type ,type row-factor) 59 | (type fixnum other-row) 60 | (type ,type other-row-factor) 61 | (type (or null fixnum) start) 62 | (assertion (eql ',type (mtype m))) 63 | (assertion (<= 0 row)) 64 | (assertion (< row (mrows m))) 65 | (assertion (<= 0 other-row)) 66 | (assertion (< other-row (mrows m))) 67 | (assertion (or (null start) (<= 0 start))) 68 | (assertion (or (null start) (< start (mcols m))))) 69 | (loop :for col fixnum :from (or start 0) :below (mcols m) 70 | :for r ,type := (mref '(,type) m row col) 71 | :for o ,type := (mref '(,type) m other-row col) 72 | :for v ,type := (+ (* r row-factor) 73 | (* o other-row-factor)) 74 | :do (set-mref '(,type) v m row col)))) 75 | 76 | (template:define-templated-function eliminate-column (type) (m v col) 77 | `(policy-cond:with-expectations (> speed safety) 78 | ((type matrix m) 79 | (type matrix v) 80 | (type fixnum col) 81 | (assertion (eql ',type (mtype m))) 82 | (assertion (eql ',type (mtype v))) 83 | (assertion (square-matrix-p m)) 84 | (assertion (commensuratep m v)) 85 | (assertion (< col (mcols m)))) 86 | (loop :with pivot-row fixnum := col 87 | :with pivot-value ,type := (- (mref '(,type) m pivot-row col)) 88 | :for row fixnum :from (1+ col) :below (mcols m) 89 | :for value ,type := (mref '(,type) m row col) 90 | :do (row-operation '(,type) 91 | m row pivot-value pivot-row value col) 92 | :do (row-operation '(,type) 93 | v row pivot-value pivot-row value)))) 94 | 95 | (template:define-templated-function forward-propagation (type) (m v) 96 | `(policy-cond:with-expectations (> speed safety) 97 | ((type matrix m) 98 | (type matrix v) 99 | (assertion (eql ',type (mtype m))) 100 | (assertion (eql ',type (mtype v))) 101 | (assertion (square-matrix-p m)) 102 | (assertion (commensuratep m v))) 103 | (loop :for col :below (mcols m) 104 | :for pivot-row := (find-pivot-row '(,type) m col) 105 | :unless (= pivot-row col) 106 | :do (progn 107 | (swap-rows-of-matrix '(,type) m pivot-row col) 108 | (swap-rows-of-matrix '(,type) v pivot-row col)) 109 | :do (eliminate-column '(,type) m v col)))) 110 | 111 | (template:define-templated-function back-substitute (type) (m v) 112 | `(policy-cond:with-expectations (> speed safety) 113 | ((type matrix m) 114 | (type matrix v) 115 | (assertion (eql ',type (mtype m))) 116 | (assertion (eql ',type (mtype v))) 117 | (assertion (square-matrix-p m)) 118 | (assertion (commensuratep m v))) 119 | (loop :for col fixnum :below (mcols v) 120 | :do (loop :for row fixnum :from (1- (mrows m)) :downto 0 121 | :for pivot ,type := (mref '(,type) m row row) 122 | :for val ,type := 123 | (if (zerop pivot) 124 | pivot 125 | (/ (- (mref '(,type) v row col) 126 | (loop :for c :from (1+ row) 127 | :below (mcols m) 128 | :summing 129 | (the ,type 130 | (* (mref '(,type) m row c) 131 | (mref '(,type) v c col))))) 132 | pivot)) 133 | :do (set-mref '(,type) val v row col))))) 134 | 135 | (template:define-templated-function solve-by-forward-sub-back-prop 136 | (type) (m v) 137 | `(policy-cond:with-expectations (> speed safety) 138 | ((type matrix m) 139 | (type matrix v) 140 | (assertion (eql ',type (mtype m))) 141 | (assertion (eql ',type (mtype v))) 142 | (assertion (square-matrix-p m)) 143 | (assertion (commensuratep m v))) 144 | (forward-propagation '(,type) m v) 145 | (back-substitute '(,type) m v) 146 | v)) 147 | 148 | (template:define-templated-function solve (type-m type-v) (m v) 149 | (let ((new-type-v (contagion-type type-m type-v))) 150 | `(policy-cond:with-expectations (> speed safety) 151 | ((type matrix m) 152 | (type matrix v) 153 | (assertion (eql ',type-m (mtype m))) 154 | (assertion (eql ',type-v (mtype v))) 155 | (assertion (square-matrix-p m)) 156 | (assertion (commensuratep m v))) 157 | (let ((m (copy-matrix m ',new-type-v)) 158 | (v (copy-matrix v ',new-type-v))) 159 | (values (solve-by-forward-sub-back-prop '(,new-type-v) m v)))))) 160 | 161 | (template:define-template make-solver (type-m type-v) 162 | (let ((type (contagion-type type-m type-v))) 163 | `(progn 164 | (template:instantiate-templated-function find-pivot-row ,type) 165 | (template:instantiate-templated-function swap-rows-of-matrix ,type) 166 | (template:instantiate-templated-function row-operation ,type) 167 | (template:instantiate-templated-function eliminate-column ,type) 168 | (template:instantiate-templated-function forward-propagation ,type) 169 | (template:instantiate-templated-function back-substitute ,type) 170 | (template:instantiate-templated-function solve-by-forward-sub-back-prop 171 | ,type) 172 | (template:instantiate-templated-function solve ,type-m ,type-v)))) 173 | -------------------------------------------------------------------------------- /src/transpose.lisp: -------------------------------------------------------------------------------- 1 | ;;; src/transpose.lisp 2 | 3 | (in-package #:gauss) 4 | 5 | (template:define-templated-function transpose (type) (a) 6 | `(policy-cond:with-expectations (> speed safety) 7 | ((assertion (eql ',type (mtype a)))) 8 | (%matrix :rows (mcols a) :cols (mrows a) 9 | :cf (mrf a) :rf (mcf a) 10 | :vals (mvals a)))) 11 | -------------------------------------------------------------------------------- /test/add.lisp: -------------------------------------------------------------------------------- 1 | ;;;; test/add.lisp 2 | 3 | (in-package #:gauss-test) 4 | 5 | (nst:def-test-group add-tests () 6 | (nst:def-test simple-two-by-one (:values (:equal 3.0) 7 | (:equal 6.0)) 8 | (let* ((a (gauss:make-vector* '(single-float) 1.0 2.0)) 9 | (b (gauss:make-vector* '(single-float) 2.0 4.0)) 10 | (c (gauss:m+ '(single-float single-float) a b))) 11 | (values (gauss:vref '(single-float) c 0) 12 | (gauss:vref '(single-float) c 1))))) 13 | -------------------------------------------------------------------------------- /test/construct.lisp: -------------------------------------------------------------------------------- 1 | ;;;; test/construct.lisp 2 | 3 | (in-package #:gauss-test) 4 | 5 | (nst:def-test-group construct-tests () 6 | (nst:def-test simple-2d-vector (:values (:equal 1.0) 7 | (:equal 2.0)) 8 | (let ((v (gauss:make-vector* '(single-float) 1.0 2.0))) 9 | (values (gauss:vref '(single-float) v 0) 10 | (gauss:vref '(single-float) v 1)))) 11 | 12 | (nst:def-test simple-two-by-two (:values (:equal 1.0) (:equal 2.0) 13 | (:equal 4.0) (:equal 8.0)) 14 | (let ((m (gauss:make-matrix* '(single-float) 2 2 15 | 1.0 2.0 16 | 4.0 8.0))) 17 | (values (gauss:mref '(single-float) m 0 0) 18 | (gauss:mref '(single-float) m 0 1) 19 | (gauss:mref '(single-float) m 1 0) 20 | (gauss:mref '(single-float) m 1 1))))) 21 | -------------------------------------------------------------------------------- /test/mul.lisp: -------------------------------------------------------------------------------- 1 | ;;;; test/mul.lisp 2 | 3 | (in-package #:gauss-test) 4 | 5 | (nst:def-test-group scale-tests () 6 | (nst:def-test scale-matrix (:values (:equal 10.0) 7 | (:equal 15.0)) 8 | (let* ((a (gauss:make-vector* '(single-float) 5.0 7.5)) 9 | (b 2.0) 10 | (c (gauss:scale '(single-float single-float) a b))) 11 | (values (gauss:vref '(single-float) c 0) 12 | (gauss:vref '(single-float) c 1))))) 13 | 14 | (nst:def-test-group mul-tests () 15 | (nst:def-test simple-matrix-by-vector (:values (:equal 5.0) 16 | (:equal 11.0)) 17 | (let* ((a (gauss:make-matrix* '(single-float) 18 | 2 2 19 | 1.0 2.0 20 | 3.0 4.0)) 21 | (b (gauss:make-vector* '(single-float) 1.0 2.0)) 22 | (c (gauss:m* '(single-float single-float) a b))) 23 | (values (gauss:vref '(single-float) c 0) 24 | (gauss:vref '(single-float) c 1)))) 25 | 26 | (nst:def-test matrix-by-matrix (:values (:equal 6.0) (:equal 17.0) 27 | (:equal 15.0) (:equal 38.0)) 28 | (let* ((a (gauss:make-matrix* '(single-float) 29 | 2 3 30 | 1.0 2.0 3.0 31 | 4.0 5.0 6.0)) 32 | (b (gauss:make-matrix* '(single-float) 33 | 3 2 34 | 1.0 1.0 35 | 1.0 2.0 36 | 1.0 4.0)) 37 | (c (gauss:m* '(single-float single-float) a b))) 38 | (values (gauss:mref '(single-float) c 0 0) 39 | (gauss:mref '(single-float) c 0 1) 40 | (gauss:mref '(single-float) c 1 0) 41 | (gauss:mref '(single-float) c 1 1))))) 42 | -------------------------------------------------------------------------------- /test/package.lisp: -------------------------------------------------------------------------------- 1 | ;;; test/package.lisp 2 | 3 | (defpackage #:gauss-test 4 | (:use #:cl)) 5 | -------------------------------------------------------------------------------- /test/run.lisp: -------------------------------------------------------------------------------- 1 | ;;;; test/run.lisp 2 | 3 | (in-package #:gauss-test) 4 | 5 | (defun run-all-tests (&key (debug-on-error nst:*debug-on-error*) 6 | (debug-on-fail nst:*debug-on-fail*)) 7 | (let ((nst:*debug-on-error* debug-on-error) 8 | (nst:*debug-on-fail* debug-on-fail)) 9 | (nst:nst-cmd :run-package #.*package*))) 10 | -------------------------------------------------------------------------------- /test/solve.lisp: -------------------------------------------------------------------------------- 1 | ;;;; test/solve.lisp 2 | 3 | (in-package #:gauss-test) 4 | 5 | (nst:def-test-group solve-tests () 6 | (nst:def-test solve-identity (:values (:equal 1.0) 7 | (:equal 2.0)) 8 | (let* ((a (gauss:make-matrix* '(single-float) 9 | 2 2 10 | 1.0 0.0 11 | 0.0 1.0)) 12 | (b (gauss:make-vector* '(single-float) 1.0 2.0)) 13 | (c (gauss:solve '(single-float single-float) a b))) 14 | (values (gauss:vref '(single-float) c 0) 15 | (gauss:vref '(single-float) c 1)))) 16 | 17 | ;; [ 1 1 ] [ x ] [ 1 ] 18 | ;; [ 0 1 ] [ y ] = [ 2 ] 19 | ;; 20 | ;; y = 2 21 | ;; x + y = 1 22 | ;; x = -1 23 | (nst:def-test solve-upper-triangular (:values (:equal -1.0) 24 | (:equal 2.0)) 25 | (let* ((a (gauss:make-matrix* '(single-float) 26 | 2 2 27 | 1.0 1.0 28 | 0.0 1.0)) 29 | (b (gauss:make-vector* '(single-float) 1.0 2.0)) 30 | (c (gauss:solve '(single-float single-float) a b))) 31 | (values (gauss:vref '(single-float) c 0) 32 | (gauss:vref '(single-float) c 1)))) 33 | 34 | ;; [ 0 1 ] [ x ] = [ 1 ] 35 | ;; [ 1 1 ] [ y ] = [ 2 ] 36 | ;; x = 1 37 | ;; x + y = 2 38 | ;; y = 1 39 | (nst:def-test solve-lower-triangular (:values (:equal 1.0) 40 | (:equal 1.0)) 41 | (let* ((a (gauss:make-matrix* '(single-float) 42 | 2 2 43 | 0.0 1.0 44 | 1.0 1.0)) 45 | (b (gauss:make-vector* '(single-float) 1.0 2.0)) 46 | (c (gauss:solve '(single-float single-float) a b))) 47 | (values (gauss:vref '(single-float) c 0) 48 | (gauss:vref '(single-float) c 1)))) 49 | 50 | ;; [ 1 2 ] [ x ] [ 1 ] 51 | ;; [ 3 4 ] [ y ] = [ 2 ] 52 | ;; 53 | ;; 3x + 4y = 2 54 | ;; x + 2y = 1 55 | ;; 2y = 1 - x 56 | ;; 3x + 2(1-x) = 2 57 | ;; 3x - 2x = 0 58 | ;; x = 0 59 | ;; y = 1/2 60 | (nst:def-test solve-general (:values (:equal 0.0) 61 | (:equal 0.5)) 62 | (let* ((a (gauss:make-matrix* '(single-float) 63 | 2 2 64 | 1.0 2.0 65 | 3.0 4.0)) 66 | (b (gauss:make-vector* '(single-float) 1.0 2.0)) 67 | (c (gauss:solve '(single-float single-float) a b))) 68 | (values (gauss:vref '(single-float) c 0) 69 | (gauss:vref '(single-float) c 1)))) 70 | 71 | (nst:def-test solve-general-matrix (:values (:equal 0.0) (:equal 0.0) 72 | (:equal 0.5) (:equal 1.0)) 73 | (let* ((a (gauss:make-matrix* '(single-float) 74 | 2 2 75 | 1.0 2.0 76 | 3.0 4.0)) 77 | (b (gauss:make-matrix* '(single-float) 78 | 2 2 79 | 1.0 2.0 80 | 2.0 4.0)) 81 | (c (gauss:solve '(single-float single-float) a b))) 82 | (values (gauss:mref '(single-float) c 0 0) 83 | (gauss:mref '(single-float) c 0 1) 84 | (gauss:mref '(single-float) c 1 0) 85 | (gauss:mref '(single-float) c 1 1)))) 86 | 87 | ;; [ 1 1 1 1 ] [ 1 ] [ 10 ] 88 | ;; [ 1 1 0 1 ] [ 2 ] = [ 7 ] 89 | ;; [ 1 0 1 1 ] [ 3 ] [ 8 ] 90 | ;; [ 1 2 3 4 ] [ 4 ] [ 30 ] 91 | 92 | (nst:def-test solve-general-4-by-4 (:values (:equal 1.0) 93 | (:equal 2.0) 94 | (:equal 3.0) 95 | (:equal 4.0)) 96 | (let* ((a (gauss:make-matrix* '(single-float) 97 | 4 4 98 | 1.0 1.0 1.0 1.0 99 | 1.0 1.0 0.0 1.0 100 | 1.0 0.0 1.0 1.0 101 | 1.0 2.0 3.0 4.0)) 102 | (b (gauss:make-vector* '(single-float) 10.0 7.0 8.0 30.0)) 103 | (c (gauss:solve '(single-float single-float) a b))) 104 | (values (gauss:vref '(single-float) c 0) 105 | (gauss:vref '(single-float) c 1) 106 | (gauss:vref '(single-float) c 2) 107 | (gauss:vref '(single-float) c 3))))) 108 | -------------------------------------------------------------------------------- /test/transpose.lisp: -------------------------------------------------------------------------------- 1 | ;;;; test/transpose.lisp 2 | 3 | (in-package #:gauss-test) 4 | 5 | (nst:def-test-group transpose-tests () 6 | (nst:def-test transpose-vector (:values (:equal 1) (:equal 2)) 7 | (let* ((a (gauss:make-vector* '(single-float) 3.0 4.0)) 8 | (b (gauss:transpose '(single-float) a))) 9 | (values (gauss:mrows b) 10 | (gauss:mcols b)))) 11 | 12 | (nst:def-test transpose-two-by-two (:values (:equal 1.0) (:equal 3.0) 13 | (:equal 2.0) (:equal 4.0)) 14 | (let* ((a (gauss:make-matrix* '(single-float) 15 | 2 2 16 | 1.0 2.0 17 | 3.0 4.0)) 18 | (b (gauss:transpose '(single-float) a))) 19 | (values (gauss:mref '(single-float) b 0 0) 20 | (gauss:mref '(single-float) b 0 1) 21 | (gauss:mref '(single-float) b 1 0) 22 | (gauss:mref '(single-float) b 1 1))))) 23 | --------------------------------------------------------------------------------