├── README.md ├── flomat-doc ├── info.rkt └── manual-flomat.scrbl ├── flomat ├── expm.rkt ├── flomat.rkt ├── info.rkt └── main.rkt └── info.rkt /README.md: -------------------------------------------------------------------------------- 1 | # sci 2 | 3 | This repository contains libraries for scientific computing. 4 | 5 | - `flomat`: floating point matrices. 6 | 7 | # Installation 8 | 9 | Use 10 | 11 | raco pkg install sci 12 | 13 | to install the Racket part of `sci`. 14 | 15 | For macOS this is enough. 16 | 17 | For Linux/Windows check details in the documentation. 18 | 19 | The library `flomat` relies on CBLAS and LAPACK, so they need to be installed 20 | in a place where they can be found by Racket. 21 | 22 | 23 | # License 24 | 25 | We follow the lead of the main Racket license: 26 | Sci is distributed under the MIT license and the Apache version 2.0 license, at your option. 27 | -------------------------------------------------------------------------------- /flomat-doc/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | ;;; Info file for sci/flomat. 3 | 4 | ;; Name 5 | ; The collection name can be different from the directory name, 6 | ; Here they are the same. 7 | (define collection "flomat-doc") 8 | 9 | ;; Version 10 | (define version "1.0") 11 | 12 | ;; Dependencies 13 | 14 | (define deps '("base" 15 | "flomat")) 16 | 17 | (define scribblings '(("manual-flomat.scrbl" () ("Math and Science")))) 18 | 19 | (define build-deps '("math-doc" 20 | "racket-doc" 21 | "scribble-lib" 22 | "scribble-math" 23 | ("linux-shared-libraries" #:platform "x86_64-linux-natipkg"))) 24 | -------------------------------------------------------------------------------- /flomat-doc/manual-flomat.scrbl: -------------------------------------------------------------------------------- 1 | #lang scribble/manual 2 | @(require (for-label racket/base ffi/vector ffi/unsafe flomat)) 3 | 4 | @; raco scribble +m --dest html --redirect-main http://docs.racket-lang.org manual-flomat.scrbl && open html/manual-flomat.html 5 | @(require scribble/example scribble-math ) 6 | @(require racket/format) 7 | 8 | @; Used to reference other manuals. 9 | @(define reference.scrbl '(lib "scribblings/reference/reference.scrbl")) 10 | @(define math.scrbl '(lib "math/scribblings/math.scrbl")) 11 | 12 | @; Convenient shortcuts for writing TeX. 13 | @(use-mathjax) 14 | @(define mxn @${m\times n}) 15 | @(define nxm @${m\times n}) 16 | @(define mxm @${m\times m}) 17 | @(define nxn @${n\times n}) 18 | @(define mx1 @${m\times 1}) 19 | @(define nx1 @${n\times 1}) 20 | @(define mxk @${m\times k}) 21 | @(define nxk @${n\times k}) 22 | @(define 1xm @${1\times m}) 23 | @(define 1xn @${1\times n}) 24 | @(define A @${A}) 25 | @(define B @${B}) 26 | @(define B. @~a{@${B}.}) 27 | @(define C @${C}) 28 | @(define L @${L}) 29 | @(define Q @${Q}) 30 | @(define R @${R}) 31 | @(define S @${S}) 32 | @(define T @${T}) 33 | @(define U @${U}) 34 | @(define V @${V}) 35 | @(define X @${X}) 36 | @(define b @${b}) 37 | @(define i @${i}) 38 | @(define j @${j}) 39 | @(define k @${k}) 40 | @(define l @${l}) 41 | @(define m @${m}) 42 | @(define n @${n}) 43 | @(define x @${x}) 44 | @(define y @${y}) 45 | 46 | @(define ith (list @${i} "'th")) 47 | @(define jth (list @${j} "'th")) 48 | @(define kth (list @${k} "'th")) 49 | @(define mth (list @${m} "'th")) 50 | @(define nth (list @${n} "'th")) 51 | @(define ijth (list @${(i,j)} "'th")) 52 | 53 | @; Long urls 54 | @(define url-apple-blas-docs "https://developer.apple.com/documentation/accelerate/blas?language=objc") 55 | @(define url-dcopy-docs "http://www.netlib.org/lapack/explore-html/de/da4/group__double__blas__level1_ga21cdaae1732dea58194c279fca30126d.html") 56 | 57 | @(define (wikipedia name . preflow) 58 | (define url (string-append "https://en.wikipedia.org/wiki/" name)) 59 | @margin-note{@hyperlink[url (list* @bold{Wikipedia: } " " preflow)]}) 60 | 61 | @(define (wikipedia/section url . preflow) 62 | @margin-note{@hyperlink[url (list* @bold{Wikipedia: } " " preflow)]}) 63 | 64 | @(define (cblas-docs name . preflow) 65 | (define url (string-append "https://en.wikipedia.org/wiki/" name)) 66 | @margin-note{@hyperlink[url (list* @bold{Wikipedia: } " " preflow)]}) 67 | 68 | 69 | 70 | @; Note: Without `with-html5` MathJax isn't loaded. 71 | @title[#:tag "flomat" #:style (with-html5 manual-doc-style)]{Flomat: Floating Point Matrices} 72 | 73 | @defmodule[flomat] 74 | 75 | This manual documents the matrix library @racketmodname[flomat]. 76 | 77 | @author[@author+email["Jens Axel Søgaard" "jensaxel@soegaard.net"]] 78 | 79 | @local-table-of-contents[] 80 | 81 | @section{Introduction} 82 | 83 | A matrix is a rectangular arrangements of numbers in rows and columns. 84 | This library provides functions to construct and compute with 85 | matrices whose elements are IEEE double precision floating point numbers. 86 | These numbers are referred to as @tech[#:doc reference.scrbl]{flonums} 87 | in the Racket manual, but the most common name for these numbers are 88 | simply @emph{doubles}. 89 | 90 | Restricting the scope of the library to dense matrices with floating numbers 91 | allow the implementation to use routines implemented in Fortran and C. 92 | The low-level routines consists of calls to functions in BLAS and LAPACK. 93 | BLAS (Basic Linear Algebra Subprograms) and LAPACK (Linear Algebra PACKage) 94 | are industry standard libraries and are available on all major platforms. 95 | 96 | If you are in need of matrix algebra over more general numbers then 97 | look at the functional matrix library in @secref["matrices" #:doc math.scrbl]. 98 | 99 | This library can be used in a functional manner, but imperative operations 100 | are available. There are at least two reasons to use the imperative approach: 101 | 1) text books often describe matrix algorithms using imperative operations, 102 | and, 2) imperative operations can reduce the amount of memory needed 103 | during a computation. 104 | 105 | The available operations can be divided into rough categories: 106 | @itemlist[ 107 | @item{Level 1: High level - do what I mean} 108 | @item{Level 2: Medium level - do what I mean this way} 109 | @item{Level 3: Low level - do it using this underlying C-function}] 110 | 111 | To use the library one can get by with level 1 operations, but if you understand 112 | the underlying representation, you can improve your algorithms using 113 | level 2 operations. For those that really want to squeeze out the last bit of 114 | performance we have made level 3 operations available as well. The Quick Tutorial 115 | only describes level 1 and level 2 operations. 116 | 117 | 118 | @section{Quick Tutorial} 119 | 120 | @(define quick-eval (let ([e (make-base-eval)]) (e '(require flomat)) e)) 121 | 122 | This section shows how to do simple matrix computations. 123 | The beginning part of the tutorial describes working with matrices simply as arrays 124 | of numbers. 125 | The end shows how to do linear algebra. 126 | 127 | @subsection{Basic Properties} 128 | 129 | An @racket[flomat] consists conceptually of a two-dimensional 130 | array of floating point numbers. An @mxn (@m by @n) matrix is 131 | divided into @m rows and @n columns. The rows are numbered @${0, \ldots, m-1} 132 | and the columns are numbered @${0, \ldots, n-1}. 133 | 134 | @(define (barrow elm) @~a{{\Rule 20pt 0.5pt 0pt} \mspace 2pt @elm \mspace 2pt {\Rule 20pt 0.5pt 0pt}}) 135 | @(define (barcol elm) @~a{\begin{matrix} {\Rule 0.5pt 20pt 0pt} \\ @elm \\ {\Rule 0.5pt 20pt 0pt} \end{matrix}}) 136 | @$${A = 137 | \begin{bmatrix} 138 | a_{0,0} & a_{0,1} & \cdots & a_{0,n-1} \\ 139 | a_{1,0} & a_{1,1} & \cdots & a_{1,n-1} \\ 140 | \vdots & \vdots & \cdots & \vdots \\ 141 | a_{m-1,0} & a_{m-1,1} & \cdots & a_{m-1,n-1} \\ 142 | \end{bmatrix} 143 | = 144 | \begin{bmatrix} @barrow{a_{0,*}} \\ @barrow{a_{1,*}} \\ \cdots \\ @barrow{a_{{m-1},*}} \end{bmatrix} 145 | = 146 | \begin{bmatrix} @barcol{A_0} & @barcol{A_1} \cdots @barcol{A_{n-1}} \end{bmatrix}} 147 | 148 | The basic properties of an @racket[flomat] can be examined using these functions: 149 | 150 | @bold[@racket[(shape A)]] 151 | return a list of with the number of rows and columns @linebreak[] 152 | @bold[@racket[(size A)]] 153 | the number of elements in the matrix @linebreak[] 154 | @bold[@racket[(nrows A)]] 155 | the number of rows @linebreak[] 156 | @bold[@racket[(ncols A)]] 157 | the number of columns 158 | 159 | @examples[#:label #f #:eval quick-eval 160 | (define A (flomat: [[1 2 3] 161 | [4 5 5]])) 162 | (shape A) ; dimensions 163 | (size A) 164 | (nrows A) 165 | (ncols A)] 166 | 167 | @subsection{Basic Indexing} 168 | 169 | Since a matrix is divided into rows and columns we can refer to an 170 | element in the matrix by row and column numbers. The element on the 171 | @ith row and @jth column is referred to as the element with index @${(i,j)}. 172 | 173 | The indices are zero-based so a matrix with @m rows and @n columns 174 | has row-indices @${0, 1, \ldots, m-1} and column-indices @${0, 1, \ldots n-1}. 175 | 176 | @$${A = 177 | \begin{bmatrix} 178 | a_{0,0} & a_{0,1} & \cdots & a_{0,n-1} \\ 179 | a_{1,0} & a_{1,1} & \cdots & a_{1,n-1} \\ 180 | \vdots & \vdots & \cdots & \vdots \\ 181 | a_{m-1,0} & a_{m-1,1} & \cdots & a_{m-1,n-1} \\ 182 | \end{bmatrix}} 183 | 184 | @bold[@racket[(ref A i j)]] 185 | the element in @A with index @${(i,j)} @linebreak[] 186 | @bold[@racket[(mset! A i j x)]] 187 | change element in @A with index @${(i,j)} to @${x} @linebreak[] 188 | 189 | @bold[@racket[(row A i)]] 190 | the @ith row of @A @linebreak[] 191 | @bold[@racket[(col A j)]] 192 | the @jth column of @A 193 | 194 | Notice that row and column vectors are simply matrices with 195 | a single row and a single column respectively 196 | 197 | @examples[#:label #f 198 | #:eval quick-eval 199 | (define A (flomat: [[1 2 3] 200 | [4 5 5]])) 201 | (ref A 0 1) 202 | (row A 0) 203 | (col A 1)] 204 | 205 | 206 | @subsection{Matrix Creation} 207 | 208 | There are several ways of creating matrices. 209 | 210 | Use @racket[matrix] to create an @racket[flomat] from existing Racket data. 211 | It can convert vector-of-vector-of and list-of-lists representation of matrices 212 | into the @racket[flomat] representation. A vector of numbers or a list 213 | of numbers will be converted into a column vector (a matrix with only one column). 214 | 215 | Any non-floating point numbers will be converted to floating point. 216 | The function @racket[matrix] also accepts @racket[f64vectors] as input. 217 | 218 | @bold[@racket[(matrix obj)]] 219 | create a matrix with values from @racket[obj] 220 | 221 | @examples[#:label #f #:eval quick-eval 222 | (matrix '[[1/2 1/3] [4 5]]) 223 | (matrix #[#[1 2 3] #[4 5 6]]) 224 | (matrix (list 1 2 3)) 225 | (matrix (vector 1 2 3)) 226 | (matrix (f64vector 1 2 3))] 227 | 228 | After conversion the created @racket[flomat] will contain a pointer to 229 | a newly allocated piece of memory containing the floating point numbers. 230 | If you happen to work with data in the form of @racket[f64vector]s, then 231 | you can avoid the allocation, if you use @racket[matrix!] instead. 232 | If the same @racket[f64vector] is used to create two matrices with @racket[matrix!] 233 | they will share the same backing array - so setting an element one matrix 234 | will affect the other. 235 | 236 | @bold[@racket[(matrix! obj)]] 237 | create a matrix with values from @racket[obj] avoid allocation of 238 | backing array if possible 239 | 240 | @examples[#:label #f #:eval quick-eval 241 | (define v (f64vector 1 2 3)) 242 | (define A (matrix! v)) 243 | (define B (matrix! v)) 244 | (list A B) 245 | (mset! A 0 0 42) 246 | (list A B)] 247 | For comparision the same example with @racket[matrix]: 248 | @examples[#:label #f #:eval quick-eval 249 | (define v (f64vector 1 2 3)) 250 | (define A (matrix v)) 251 | (define B (matrix v)) 252 | (list A B) 253 | (mset! A 0 0 42) 254 | (list A B)] 255 | 256 | In order to create a matrix of specific size with all zeros or all ones, 257 | use the functions @racket[zeros] and @racket[ones]. Use @racket[eye] 258 | to make matrix with ones on a diagonal. 259 | 260 | 261 | @bold[@racket[(zeros n)]] 262 | create a square @nxn matrix with all zeros @linebreak[] 263 | @bold[@racket[(zeros m n)]] 264 | create a @mxn matrix with all zeros @linebreak[] 265 | @bold[@racket[(ones n)]] 266 | create a square @nxn matrix with all ones @linebreak[] 267 | @bold[@racket[(ones m n)]] 268 | create a @mxn matrix with all ones @linebreak[] 269 | @bold[@racket[(eye m n k)]] 270 | create a @mxn matrix with ones on the @kth diagonal 271 | 272 | The arguments @n and @k are optional for @racket[eye] 273 | and defaults to @m and @${0} respectively. 274 | 275 | @examples[#:label #f #:eval quick-eval 276 | (zeros 2) 277 | (zeros 2 3) 278 | (ones 2) 279 | (ones 2 3) 280 | (list (eye 3) (eye 3 4) (eye 3 3 1) (eye 3 3 -1))] 281 | 282 | To create ranges of values use @racket[arange] or @racket[colarange] which both work like 283 | @racket[(matrix (range start stop step))], but avoids building an intermediary list. 284 | The functions @racket[arange] and @racket[colarange] produce row and column vectors respectively. 285 | The vector created has length 286 | @$${\huge\lceil\normalsize{ \frac{\text{stop}-\text{start}}{\text{step}}}\huge\rceil\normalsize.} 287 | 288 | @bold[@racket[(arange start stop step)]] 289 | create a row vector with values from start to stop (exclusively), 290 | here step is the gap between values @linebreak[] 291 | @bold[@racket[(arange start stop)]] 292 | like @racket[(arange start stop 1.0)] @linebreak[] 293 | @bold[@racket[(arange stop)]] 294 | like @racket[(arange 0.0 stop 1.0)] @linebreak[] 295 | 296 | @bold[@racket[(colarange start stop step)]] @linebreak[] 297 | @bold[@racket[(colarange start stop)]] @linebreak[] 298 | @bold[@racket[(colarange start)]] @linebreak[] 299 | like @racket[arange] but produces a column vector. 300 | 301 | 302 | @examples[#:label #f #:eval quick-eval 303 | (arange 5 10 2) 304 | (arange 5 10) 305 | (arange 5)] 306 | @examples[#:label #f #:eval quick-eval 307 | (colarange 5 10 2) 308 | (colarange 5 10) 309 | (colarange 5)] 310 | 311 | As an alternative to @racket[arange] consider using @racket[linspace], which 312 | allow you to provide an exact endpoint. 313 | 314 | @bold[@racket[(linspace start stop num)]] @linebreak[] 315 | return a column vector with @racket[num] numbers evenly spaced from 316 | @racket[start] to @racket[stop] @linebreak[] 317 | @bold[@racket[(linspace start stop num #f)]] @linebreak[] 318 | like @racket[(linspace start stop num)] but omit the last number 319 | 320 | @examples[#:label #f #:eval quick-eval 321 | (linspace 2 4 6) 322 | (linspace 2 4 6 #f)] 323 | 324 | Sometimes it is possible to keep the elements of matrix, but change its shape. 325 | 326 | @bold[@racket[(reshape A m n)]] @linebreak[] 327 | return a matrix with shape @mxn using the elements of @A, @linebreak[] 328 | @bold[@racket[(reshape! A m n)]] @linebreak[] 329 | return a matrix with shape @mxn using the elements of @A, share the backing area with @A 330 | 331 | @examples[#:label #f #:eval quick-eval 332 | (arange 9) 333 | (reshape (arange 9) 3 3) 334 | (transpose (reshape (arange 9) 3 3))] 335 | 336 | 337 | 338 | @subsection{Elementwise Operations} 339 | 340 | Elementwise operations (also called @emph{pointwise} operations) work on each element. 341 | The operations are named with a beginning point. 342 | Besides the elementwise versions of the standard arithmetic operations, 343 | the standard numerical functions also have elementwise counterparts. 344 | Binary operators work both on matrices (of the same side) 345 | and on a number and matrix. 346 | 347 | Formally for a function @${f} of one or two arguments, the corresponding pointwise 348 | function @${.f} satisfy: 349 | 350 | @$${.f( \begin{bmatrix} a_{ij} \end{bmatrix}) 351 | = \begin{bmatrix} f(a_{ij}) \end{bmatrix} 352 | \textrm{ or } 353 | .f( \begin{bmatrix} a_{ij} \end{bmatrix}, 354 | \begin{bmatrix} b_{ij} \end{bmatrix}) 355 | = \begin{bmatrix} f(a_{ij},b_{ij}) \end{bmatrix}} 356 | 357 | 358 | @bold[@racket[(.+ A B)]] @linebreak[] 359 | @bold[@racket[(.- A B)]] and @bold[@racket[(.- A)]] @linebreak[] 360 | @bold[@racket[(.* A B)]] @linebreak[] 361 | @bold[@racket[(./ A B)]] and @bold[@racket[(./ A)]] @linebreak[] 362 | Elementwise version of the arithmetical operations. 363 | The operations returns the result as a new matrix. 364 | 365 | Note that @racket[.*] is elementwise multiplication. Use @racket[times] 366 | to multiply two matrices in the linear algebra sense. 367 | 368 | @examples[#:label #f #:eval quick-eval 369 | (define A (matrix '((0 1) (2 3)))) 370 | (define B (matrix '((4 5) (6 7)))) 371 | (.- A) 372 | (./ A) 373 | (.+ A B) 374 | (.- A B) 375 | (.* A B) 376 | (./ A B)] 377 | One of the arguments can be a number: 378 | @examples[#:label #f #:eval quick-eval 379 | (define A (matrix '((0 1) (2 3)))) 380 | (.+ A 1) 381 | (.- A 2) 382 | (.* 3 B) 383 | (./ A 4)] 384 | 385 | The elementwise versions of the standard numerical functions are: 386 | 387 | @bold[@racket[(.sin A)]] 388 | @bold[@racket[(.cos A)]] 389 | @bold[@racket[(.tan A)]] 390 | @bold[@racket[(.exp A)]] 391 | @bold[@racket[(.log A)]] 392 | @bold[@racket[(.sqr A)]] 393 | @bold[@racket[(.sqrt A)]] 394 | @bold[@racket[(.expt A B)]] 395 | 396 | @examples[#:label #f #:eval quick-eval 397 | (define A (matrix '((0 1) (2 3)))) 398 | (.sqr A) 399 | (.expt A 2) 400 | (.expt 2 A)] 401 | 402 | 403 | The elementwise operations above all, allocate a new matrix. 404 | If instead you want to modify the elements of an existing matrix, 405 | the following functions are for you. 406 | 407 | @bold[@racket[(.-! A)]] 408 | @bold[@racket[(./! A)]] 409 | @bold[@racket[(.sin! A)]] 410 | @bold[@racket[(.cos! A)]] 411 | @bold[@racket[(.tan! A)]] 412 | @bold[@racket[(.exp! A)]] 413 | @bold[@racket[(.log! A)]] 414 | @bold[@racket[(.sqr! A)]] 415 | @bold[@racket[(.sqrt! A)]] 416 | @bold[@racket[(.expt! A B)]] 417 | @bold[@racket[(.+! A B)]] 418 | @bold[@racket[(.-! A B)]] 419 | @bold[@racket[(.*! A B)]] 420 | @bold[@racket[(./! A B)]] @linebreak[] 421 | 422 | 423 | For binary operations, the result is stored in the first argument. 424 | @examples[#:label #f #:eval quick-eval 425 | (define A (matrix '((0 1) (2 3)))) 426 | (.-! A) 427 | (.-! A) 428 | (.expt! A 2) 429 | (.expt! A 2)] 430 | 431 | Also, if you want to store the result of an elementwise in another 432 | matrix @C, you can do as follows for the unary operations: 433 | 434 | 435 | @bold[@racket[(.sin! A C)]] 436 | @bold[@racket[(.cos! A C)]] 437 | @bold[@racket[(.tan! A C)]] 438 | @bold[@racket[(.exp! A C)]] 439 | @bold[@racket[(.log! A C)]] 440 | @bold[@racket[(.sqr! A C)]] 441 | @bold[@racket[(.sqrt! A C)]] 442 | 443 | And for the binary operations: 444 | 445 | @bold[@racket[(.+! A B C)]] 446 | @bold[@racket[(.-! A B C)]] 447 | @bold[@racket[(.*! A B C)]] 448 | @bold[@racket[(./! A B C)]] @linebreak[] 449 | @examples[#:label #f #:eval quick-eval 450 | (define A (matrix '((0 1) (2 3)))) 451 | (define B (matrix '((4 5) (6 7)))) 452 | (.sqr! B A) 453 | A] 454 | 455 | Finally, for @racket[.-!] and @racket[./!] which are both unary and binary operations 456 | at once, use @racket[#f] as @B to get the unary version. 457 | 458 | @examples[#:label #f #:eval quick-eval 459 | (define A (matrix '((0 1) (2 3)))) 460 | (define B (matrix '((4 5) (6 7)))) 461 | (.-! B #f A) 462 | A] 463 | 464 | 465 | @subsection{Indexing, Submatrices and Iterating} 466 | 467 | From the section on Basic Indexing we know that the element on row @i in column @j, 468 | has index @${(i,j)} and can be extracted with the function @racket[ref]. 469 | 470 | The @ith row and the @jth column can be extraced with @racket[row] and @racket[col] 471 | respectively. 472 | 473 | To get a submatrix use @racket[sub] and @racket[sub!]. 474 | 475 | @bold[@racket[(sub A i j m n)]] @linebreak[] 476 | Make a copy of the submatrix of @A with upper left corner in @${(i,j)} and with size mxn. 477 | 478 | @bold[@racket[(sub! A i j m n)]] @linebreak[] 479 | Same as @racket[sub], but the elements are not copied - the underlying 480 | array of flonums are shared. 481 | 482 | 483 | @examples[#:label #f #:eval quick-eval 484 | (define A (transpose (reshape (arange 25) 5 5))) 485 | A 486 | (sub A 0 0 3 2) 487 | (sub A 1 1 2 2)] 488 | 489 | The function @racket[sub!] can be used to mutate part of a larger submatrix. 490 | 491 | Let's say we have a matrix, in which we want to zero out all elements except 492 | those on the edges. We can use @racket[sub!] to get a submatrix of the inner part, 493 | then use @racket[zeros!] to clear the elements. 494 | 495 | @examples[#:label #f #:eval quick-eval 496 | (define A (transpose (reshape (arange 10 35) 5 5))) 497 | A 498 | (define B (sub! A 1 1 3 3)) 499 | B 500 | (zeros! B) 501 | A] 502 | 503 | To iterate over a row or a column use @racket[in-row] and @racket[in-col]. 504 | 505 | @examples[#:label #f #:eval quick-eval 506 | (define A (matrix '((11 22) (33 44)))) 507 | (for/list ([ x (in-row A 0)]) x) 508 | (for/list ([(i x) (in-row A 0)]) (list x i)) 509 | (for/list ([ x (in-col A 0)]) x) 510 | (for/list ([(i x) (in-col A 0)]) (list x i))] 511 | 512 | @subsection{Basic Linear Algebra} 513 | 514 | The basic linear algebra are @racket[plus], @racket[minus] and @racket[times], 515 | which compute the sum, difference and product of a series of matrices. 516 | 517 | @bold[@racket[(plus A ...)]] 518 | @bold[@racket[(minus A ...)]] 519 | @bold[@racket[(times A ...)]] @linebreak[] 520 | Computes the sum, difference and product of a series of matrices and/or numbers. 521 | 522 | @examples[#:label #f #:eval quick-eval 523 | (define A (matrix '((2 0) (0 2)))) 524 | (define B (matrix '((1 2) (3 4)))) 525 | (define C (column 4 5)) 526 | (plus A B) 527 | (plus A 10) 528 | (plus A 10 B) 529 | (minus A) 530 | (minus A B) 531 | (times A B) 532 | (times A 2 B) 533 | (times A C)] 534 | 535 | As usual, there are variants that mutate the first given matrix 536 | instead of allocating a new backing array of flonums. 537 | 538 | @bold[@racket[(plus! A B ...)]] 539 | @bold[@racket[(minus! A B ...)]] @linebreak[] 540 | Like @racket[plus] and @racket[minus] but stores 541 | the result in @A, which must be a matrix. 542 | 543 | @examples[#:label #f #:eval quick-eval 544 | (define A (matrix '((2 0) (0 2)))) 545 | (define B (matrix '((0 2) (2 0)))) 546 | (plus! A B) 547 | A] 548 | 549 | @bold[@racket[(power A n)]] @linebreak[] 550 | Computes the @nth power of a matrix @A, where @n is a natural number. 551 | 552 | @examples[#:label #f #:eval quick-eval 553 | (define A (matrix '((1 1) (0 1)))) 554 | (list (power A 0) (power A 1) (power A 2) (power A 3))] 555 | 556 | @subsection{Matrix and Vector Products} 557 | 558 | The inner product (also known as the dot product) of two column vectors 559 | can be computed by @racket[dot]. 560 | 561 | @bold[@racket[(dot v w)]] @linebreak[] 562 | Computes the inner product of two column vectors (i.e. matrices with only one column). 563 | 564 | @examples[#:label #f #:eval quick-eval 565 | (define v (column -1 1)) 566 | (define w (matrix '((2) (2)))) 567 | (dot v w)] 568 | 569 | The outer product of a column vector @A with @m rows and an row @B with @n columns 570 | is an @mxn matrix @${O} with elements @${o_{i,j} = a_i\cdot b_j}. 571 | 572 | @bold[@racket[(outer A B)]] @linebreak[] 573 | Computes the outer product of the first column of @A and the first row of @${B}. 574 | 575 | @examples[#:label #f #:eval quick-eval 576 | (define A (column 2 3)) 577 | (define B (transpose (column 5 7))) 578 | (outer A B)] 579 | 580 | 581 | The Kronecker product between two matrices @racket[A] and @racket[B] replaces 582 | each element @racket[a] of @racket[A] with a copy of @racket[B] scaled with @racket[A]. 583 | The Kronecker product is a generalization of the outer product. 584 | 585 | @bold[@racket[(kron A B)]] @linebreak[] 586 | Computes the Kronecker product of the matrices @A and @${B}. 587 | 588 | @examples[#:label #f #:eval quick-eval 589 | (define A (matrix '((1 2) (3 4)))) 590 | (define B (matrix '((1 1) (1 1)))) 591 | (kron A B)] 592 | 593 | 594 | @subsection{Matrix Decompositions} 595 | 596 | @bold[@racket[(cholesky A)]] @bold[@racket[(qr A)]] @bold[@racket[(svd A)]] @linebreak[] 597 | Computes the Cholesky, QR and SVD decompositions respectively. 598 | 599 | 600 | The Singular Value Decomposition (SVD) returns three matrices: 601 | a unitary matrix @U, a column vector of singular values @S and 602 | a unitary matrix @${V^T} (@V transposed). The function @racket[diag] constructs 603 | a diagonal matrix from the singular values. 604 | 605 | @examples[#:label #f #:eval quick-eval 606 | (define A (matrix '((1 2) (3 4)))) 607 | (define-values (U S VT) (svd A)) 608 | (define Σ (diag S)) 609 | (list U Σ VT S) 610 | (times U Σ VT)] 611 | 612 | The QR Decomposition of @A consists of two matrices: an orthogonal matrix @Q 613 | and an upper triangular matrix @R such that @${A=QR}. 614 | 615 | @examples[#:label #f #:eval quick-eval 616 | (define A (matrix '((1 2) (3 4)))) 617 | (define-values (Q R) (qr A)) 618 | (list Q R) 619 | (times Q R)] 620 | 621 | If the matrix @A is symmetric and positive-definite, then 622 | the Cholesky decomposition can be computed. 623 | It comes in two forms 624 | 625 | @$${A = L L^T \textrm{ or } A = U^T U,} 626 | 627 | where @L and @U are lower and upper triangular matrices. 628 | 629 | Note: @racket[cholesky] does not check that the input matrix @A 630 | is symmetric and positive definite. 631 | 632 | @examples[#:label #f #:eval quick-eval 633 | (define A (matrix '((1 2) (2 4)))) 634 | (define L (cholesky A)) 635 | (list L (transpose L)) 636 | (times L (transpose L)) 637 | (define U (cholesky A 'upper)) 638 | (list (transpose U) U) 639 | (times (transpose U) U)] 640 | 641 | 642 | @subsection{Matrix Eigenvalues and Eigenvectors} 643 | 644 | Eigenvalues and eigenvectors of a square matrix can be computed with @racket[eig] 645 | or, if only the eigenvalues are needed, with @racket[eigvals]. 646 | Note that even if all elements of a matrix are real, the eigenvalues in some 647 | cases are complex. Therefore the eigenvalues are returned as a standard 648 | Racket vector. 649 | 650 | 651 | @bold[@racket[(eig A)]] @linebreak[] 652 | Compute eigenvalues and right eigenvectors. 653 | 654 | @bold[@racket[(eigvals A)]] @linebreak[] 655 | Compute eigenvalues. 656 | 657 | @examples[#:label #f #:eval quick-eval 658 | (eig (diag '(1 2))) 659 | (eigvals (diag '(1 2))) 660 | (eig (matrix '((1 -1) (1 1))))] 661 | 662 | 663 | 664 | @subsection{Norms and Invariants} 665 | 666 | The standard Frobenius norm @${|\cdot|} can be computed by @racket[norm]. 667 | For a column vector the norm is sometimes referred to as the length. 668 | 669 | @bold[@racket[(norm A)]] @linebreak[] 670 | Compute the square root of the sum of the square of all elements. 671 | 672 | @examples[#:label #f #:eval quick-eval 673 | (norm (matrix '((1 1)))) 674 | (norm (matrix '((1 -1) (-1 1))))] 675 | 676 | 677 | @bold[@racket[(det A)]] @linebreak[] 678 | Computes the determinant of a square matrix @${A}. 679 | 680 | @examples[#:label #f #:eval quick-eval 681 | (det (matrix '((1 2) (0 4)))) 682 | (det (matrix '((1 1) (2 2))))] 683 | 684 | @bold[@racket[(trace A)]] @linebreak[] 685 | Computes the trace, the sum along a diagonal, of a matrix. 686 | 687 | @examples[#:label #f #:eval quick-eval 688 | (trace (matrix '((1 2) (0 4))))] 689 | 690 | 691 | @bold[@racket[(rank A)]] @linebreak[] 692 | Computes the rank of a square matrix. 693 | The rank is the dimension of the column space, 694 | which is equal to the dimension of the row space, 695 | which is equal to the number of non-zero singular values 696 | in an SVD decomposition. 697 | 698 | @examples[#:label #f #:eval quick-eval 699 | (rank (matrix '((1 2) (0 4)))) 700 | (rank (matrix '((1 1) (2 2))))] 701 | 702 | 703 | @subsection{Solving Equations and Inverting Matrices} 704 | 705 | Solving linear equations are more or less the raison d'etre for matrices. 706 | The main workhorse is @racket[mldivide], which can solve for @X 707 | in the equation: 708 | 709 | @$${AX = B,} 710 | 711 | where @A is a an @mxm matrix, and both @X and @B are @${m\times n}. 712 | 713 | Note that @A needs to be of full rank for the equation 714 | to have a solution. The solver doesn't check that the input 715 | matrix has full rank, it just runs it computation as usual. 716 | To check that the output from @racket[solve] is indeed a solution, 717 | you can evaluate @racket[(times A X)] and compare with @${B}. 718 | The name @racket[mldivide] is short for "Matrix Left divide" (think @${X=A\backslash B}). 719 | Although @racket[mldivide] doesn't find @X by 720 | multiplying @B with @${A^{-1}} on the left, 721 | it is a fitting analogy. 722 | 723 | @bold[@racket[(mldivide A B)]] @linebreak[] 724 | Solve the equation @${AX = B} using @${LU}-decomposition with 725 | partial pivoting. The matrix @A must be square and of full rank, the number 726 | of rows in @A must be the same as the number columns in @${B}. 727 | 728 | @examples[#:label #f #:eval quick-eval 729 | (define A (matrix '((1 2) (3 4)))) 730 | (define B (matrix '((1) (0)))) 731 | (define X (mldivide A B)) 732 | (list X (times A X))] 733 | 734 | @bold[@racket[(mrdivide B A)]] @linebreak[] 735 | Solve the equation @${XA = B}. 736 | The name @racket[mrdivide] is short for "Matrix Right divide" (think @${X=A/B}). 737 | 738 | @examples[#:label #f #:eval quick-eval 739 | (define A (matrix '((1 2) (3 4)))) 740 | (define B (matrix '((2 4) (6 8)))) 741 | (define X (mrdivide B A)) 742 | (list X (times X A))] 743 | 744 | 745 | @bold[@racket[(inv A)]] @linebreak[] 746 | Find the multiplicative inverse of a square matrix @${A}. 747 | 748 | @examples[#:label #f #:eval quick-eval 749 | (define A (matrix '((1 2) (3 4)))) 750 | (define Ainv (inv A)) 751 | (list Ainv (times A Ainv))] 752 | An inverse of @A can be used to solve @${AX=B}, but 753 | using @racket[mldivide] directly is normally better. However, let's 754 | try to solve the equation from the previous example. 755 | 756 | @examples[#:label #f #:eval quick-eval 757 | (define B (matrix '((1) (0)))) 758 | (define X (times Ainv B)) 759 | (list X (times A X))] 760 | 761 | 762 | @bold[@racket[(pinv A)]] @linebreak[] 763 | Find the Moore-Penrose pseudo-inverse @${A^+}of the matrix @${A}. 764 | The matrix @A does not need to be square. 765 | The pseudo inverse of an @mxn matrix is of size @${n\times m}. 766 | 767 | 768 | @examples[#:label #f #:eval quick-eval 769 | (define A (matrix '((1 2) (3 4)))) 770 | (define A+ (pinv A)) 771 | (list A+ (times A+ A A+) (times A A+ A))] 772 | @examples[#:label #f #:eval quick-eval 773 | (define B (matrix '((1 2 3) (4 5 6)))) 774 | (define B+ (pinv B)) 775 | (list B+ (times B+ B B+) (times B B+ B))] 776 | 777 | 778 | @subsection{Least Squares Problems} 779 | 780 | Let @A be an @mxn matrix and let @b be an @nx1 column vector. 781 | The equation @${Ax=b} (depending on @A) may not have 782 | an unique solution - or a solution at all. 783 | 784 | As an alternative, one can look for the vector @x that minimizes: 785 | @$${|Ax-b|_2,} 786 | where @${|\cdot|_2} is the Euclidean 2-norm. 787 | 788 | The function @racket[lstsq] return the minimum norm solution @x 789 | of the above the problem. 790 | 791 | If @racket[lstsq] is given an @nxk matrix @B, then the 792 | problem will be solved for each column @b of @${B}. 793 | 794 | 795 | 796 | @bold[@racket[(lstsq A B)]] @linebreak[] 797 | Find minimum norm solution to the least squares problem: @racket["minimize |Ax-b|"] , 798 | for each column @b of a larger matrix @${B}. 799 | 800 | 801 | As an example, let's look at estimating @${b_0} and @${b_1} in the model: 802 | @$${y=b_0\cdot x+b_1} 803 | given a data set consisting of corresponding @${x}- and @${y}-values. 804 | The calculation reveals that the relation between @x and @y is @${y=2x+1}. 805 | 806 | The matrix @X is called the @emph{design matrix} of the problem. 807 | See @hyperlink["https://en.wikipedia.org/wiki/Design_matrix"]{Design Matrix} at Wikipedia. 808 | In this case the design matrix has two columns: the first has the @${x}-values, the 809 | second contains just ones. 810 | 811 | @examples[#:label #f #:eval quick-eval 812 | (define xs (column 0 1 2 3)) 813 | (define ys (column 1 3 5 7)) 814 | (define X (augment xs (flomat-ones (nrows xs) 1))) 815 | X 816 | (define B (lstsq X ys)) 817 | B] 818 | 819 | @subsection{Matrix Functions} 820 | @bold[@racket[(expm A)]] @linebreak[] 821 | Compute the matrix exponential @${\exp(A)}. 822 | 823 | @examples[#:label #f #:eval quick-eval 824 | (list (exp 1) (exp 2)) 825 | (expm (matrix '((1 0) (0 2)))) 826 | (expm (matrix '((1 2) (3 4))))] 827 | 828 | 829 | 830 | @section{Installation} 831 | 832 | The package @racket[flomat] is part of @racket[sci], so to install 833 | it, write this in a terminal: 834 | 835 | @racket[raco pkg install sci] 836 | 837 | Alternatively, use the Package Manager in DrRacket. 838 | 839 | The package relies on the shared libraries CBLAS and LAPACK. 840 | Depending on your OS, you might need to install these yourself. 841 | 842 | On macOS both CBLAS and LAPACK is part of the Accelerate Framework 843 | which is distributed by Apple. This means no extra installation is 844 | needed. 845 | 846 | On Linux you need copies of CBLAS and LAPACK. Since BLAS and LAPACK 847 | exists in multiple versions, so a little care is needed. First 848 | on most systems @racket[libblas] is used for the Fortran version, 849 | and @racket[libcblas], so get the latter. However on Debian it turns 850 | out @racket[libblas] is exporting the names used by CBLAS, so 851 | (either?) ought to be fine. 852 | 853 | On Windows: A tester is needed. Install CBLAS and LAPACK and let 854 | me know if it works. Otherwise make an Issue at Github and we 855 | will add the proper paths. 856 | 857 | 858 | @section{Reference} 859 | 860 | 861 | @subsection{Representation} 862 | 863 | 864 | @wikipedia["Row-_and_column-major_order"]{Column Major Order} 865 | An @mxn matrix is consist conceptually of @mxn floating points 866 | arranged in @m rows and @n columns. Concretely the floating point 867 | numbers are stored in an one-dimentional array in @emph{column major order}. 868 | This means that the entries in each column are stored together in the array. 869 | 870 | Given the address of an entry the 871 | @deftech["leading dimension" #:key "leading dimension"] @racket[ld] 872 | is the amount to add to get the address of the next entry in the same row. 873 | 874 | For matrices with no gaps between columns in the array, the leading dimension 875 | and the number of rows is the same @racket[ld=m]. 876 | 877 | For matrices with gaps between columns in the array, the leading dimension 878 | might be larger than the number of rows @racket[ld>m]. 879 | 880 | Allowing gaps in the array allows submatrices of a larger matrix 881 | to share the underlying array. 882 | 883 | As an example, let's look at an @${2\times 3} matrix with leading dimension 5. 884 | 885 | @$${A = 886 | \begin{bmatrix} 887 | a_{00} & a_{01} & a_{02} \\ 888 | a_{10} & a_{11} & a_{12} 889 | \end{bmatrix}} 890 | 891 | The underlying array is: 892 | 893 | @$${[\underbrace{\overbrace{a_{00},a_{10}}^{\text{first column}},?,?}_{\text{ld}=5}, 894 | \underbrace{\overbrace{a_{01},a_{11}}^{\text{second column}},?,?}_{\text{ld}=5}, 895 | \underbrace{\overbrace{a_{02},a_{12}}^{\text{third column}},?,?}_{\text{ld}=5}]} 896 | 897 | Notice that the length of the underlying array is @${m\cdot\text{ld}=2\cdot 5=15}. 898 | 899 | The main takeaway is that: 900 | 901 | @itemlist[#:style 'ordered 902 | @item{A matrix has an underlying array.} 903 | @item{The entries in a column is stored together.} 904 | @item{The underlying array can be shared between matrices.} 905 | @item{There can be gaps between columns in the array.}] 906 | 907 | The exact details of leading dimensions is mostly relevant if you need to 908 | call BLAS or LAPACK functions directly. 909 | 910 | 911 | @defthing[_flomat ctype?] 912 | Pointer to an array of flonums. 913 | 914 | @(defstruct flomat ([m natural?] [n natural?] [a _flomat] [lda natural?]) #:omit-constructor) 915 | Strucure representing an @mxn matrix with leading dimension @racket[lda] 916 | with an underlying array of floating points stored in @racket[a]. 917 | 918 | @defform*[[(define-param (m n) A) 919 | (define-param (m n a) A) 920 | (define-param (m n a lda) A)]] 921 | Equivalent to @(linebreak) 922 | @racket[(match-define (flomat m n _ _) A)] @(linebreak) 923 | @racket[(match-define (flomat m n a _) A)] @(linebreak) 924 | @racket[(match-define (flomat m n a lda) A)] @(linebreak) 925 | respectively. 926 | 927 | @defform[(index lda i j)] 928 | Expands to @racket[(+ i (* j lda))] which is the array index 929 | of the entry on row @i, column @${j}. 930 | 931 | @defproc[(ptr-elm [a _flomat] [lda natural?] [i natural?] [j natural?]) _flomat] 932 | Computes the address of the entry on row @i, column @${j}. 933 | 934 | @defproc[(ptr-row [a _flomat] [i natural?]) _flomat] 935 | Computes the adress of the beginning of row @${i}. 936 | 937 | @defproc[(ptr-col [a _flomat] [lda natural?] [j natural?]) _flomat] 938 | Computes the adress of the beginning of column @${j}. 939 | Note that the leading dimenstion @racket[lda] is needed. 940 | 941 | 942 | @defproc[(alloc-flomat [m natural?] [n natural?]) _flomat] 943 | Allocate a floating point array with @${mn} elements and 944 | return a tagged pointer to the array. 945 | 946 | @defproc[(alloc-same-size-matrix [A flomat?]) _flomat] 947 | Like @racket[alloc-flomat] but use the dimensions @mxn 948 | of @racket[A] to determine the size. 949 | 950 | @subsection{Copying} 951 | 952 | @defproc[(copy-flomat [A flomat?]) flomat?] 953 | Return a newly allocated @racket[flomat] struct with a newly 954 | allocated backing array of flonums. If racket[A] has dimensions 955 | @mxn then the newly allocated array will have length @${m\cdot n}. 956 | The backing array of the copy can therefore be shorter than the original 957 | backing array. 958 | 959 | 960 | @defproc[(unsafe-vector-copy! [s natural?] [a _flomat] [lda natural?] [b natural?]) void?] 961 | Copies @racket[s] elements from @racket[A] into @racket[B]. 962 | The elements copied has indices: @${0}, @${\text{lda}}, @${2\text{lda}} @${\ldots} . 963 | No error checking is done. 964 | 965 | Note that @racket[unsafe-vector-copy!] can be used to copy a column or a row 966 | depending on the leading dimension used. 967 | 968 | @defproc[(unsafe-matrix-copy! [m natural?] [n natural?] [a _flomat] [lda natural?] [b _flomat] [ldb natural?]) void?] 969 | Copies the @mxn matrix @racket[A] into @racket[B]. 970 | 971 | If you need to copy @racket[A] into an index other than @${(0,0)} use 972 | @racket[(ptr-elm b ldb i j)] to find the addres of the submatrix of @racket[B] 973 | which has upper left corner in @${(i,j)}. 974 | 975 | In the same manner you can use @racket[(ptr-elm a lda i j)] to find 976 | start of an submatrix in @racket[A]. 977 | 978 | 979 | @subsection{Simple Constructors} 980 | 981 | @defproc[(make-flomat [m natural?] [n natural?] [x natural? 0.0]) flomat?] 982 | Returns a flomat of dimension @mxn with an backing array of size @${mn}. 983 | All entries are initialized to contain @racket[x]. 984 | @examples[#:label #f #:eval quick-eval (make-flomat 2 3 4)] 985 | 986 | @defform[(flomat: [[x ...] ...])] 987 | This is "literal syntax" and expands into a form that constructs 988 | a @racket[flomat] containing the numbers @racket[x ... ...]. 989 | The default printer outputs small matrices as flomat literals, so 990 | results can be copy-pasted into the repl. 991 | 992 | @defproc[(list->flomat [xss list-of-list-of-number]) flomat] 993 | Given a matrix represented as list of rows (where a row is a list of numbers), 994 | return a new matrix with the same entries. 995 | Note: @racket[matrix] is usually simpler to use 996 | @examples[#:label #f #:eval quick-eval (list->flomat '((1 2) (3 4)))] 997 | 998 | @defproc[(vectors->flomat [xss vector-of-vector-of-number]) flomat] 999 | Given a matrix represented as vector of rows (where a row is a vector of numbers), 1000 | return a new matrix with the same entries. 1001 | Note: @racket[matrix] is usually simpler to use 1002 | @examples[#:label #f #:eval quick-eval (vectors->flomat '#(#(1 2) #(3 4)))] 1003 | 1004 | @defproc[(flomat->vectors [A flomat]) vector?] 1005 | Given a flomat @racket[A] return a matrix with the same entries represented 1006 | as vector of rows (where a row is a vector of numbers). 1007 | @examples[#:label #f #:eval quick-eval (flomat->vectors (matrix '[[1 2] [3 4]]))] 1008 | 1009 | @defproc[(vector->flomat [m natural?] [n natural?] [v vector?]) flomat] 1010 | Given a vector @racket[v] of length @${mn} representing a matrix with 1011 | entries in row major order, return a matrix with the same dimensions 1012 | and entries represented as a @racket[flomat]. 1013 | @examples[#:label #f #:eval quick-eval (vector->flomat 2 3 (vector 1 2 3 4 5 6))] 1014 | 1015 | @defproc[(flomat->vector [A flomat]) vector?] 1016 | Return a vector of all entries in @racket[A] in row-major order. 1017 | @examples[#:label #f #:eval quick-eval (flomat->vector (matrix '[[1 2] [3 4]]))] 1018 | 1019 | @defproc[(flomat/dim [m natural?] [n natural?] [xs list-of-numbers]) flomat?] 1020 | Construct a @racket[flomat?] matrix with entries from @racket[xs]. 1021 | The numbers in @racket[xs] are expected to be in row major order. 1022 | @examples[#:label #f #:eval quick-eval (flomat/dim 2 3 1 2 3 4 5 6)] 1023 | 1024 | 1025 | @subsection[#:tag "ref:basic-properties"]{Basic Properties} 1026 | 1027 | The basic properties of an @racket[flomat] can be examined using these functions: 1028 | 1029 | @defproc[(shape [A flomat?]) (list natural? natural?)] 1030 | Return a list with the number of rows and columns of the matrix @${A}. 1031 | 1032 | @defproc[(size [A flomat?]) natural?] 1033 | Return the size of a matrix @${A}. That is return @${mn} where 1034 | @m is the number of rows and @n is the number columns. Note that 1035 | the size of a matrix can be smaller than the length of the 1036 | backing array, if the leading dimension of the matrix is a non-unit. 1037 | 1038 | @defproc[(nrows [A flomat?]) natural?] 1039 | Return the number of rows, @m, in the matrix @${A}. 1040 | 1041 | @defproc[(ncols [A flomat?]) natural?] 1042 | Return the number of columns, @n, in the matrix @${A}. 1043 | 1044 | @examples[#:label #f #:eval quick-eval 1045 | (define A (flomat: [[1 2 3] 1046 | [4 5 5]])) 1047 | (shape A) ; dimensions 1048 | (size A) 1049 | (nrows A) 1050 | (ncols A)] 1051 | 1052 | 1053 | @subsection[#:tag "ref:basic-indexing"]{Basic Indexing} 1054 | 1055 | Since a matrix is divided into rows and columns we can refer to an 1056 | element in the matrix by row and column numbers. The element @${a_{ij}} on the 1057 | @ith row and @jth column is referred to as the element with index @${(i,j)}. 1058 | 1059 | The indices are zero-based so a matrix with @m rows and @n columns 1060 | has row-indices @${0, 1, \ldots, m-1} and column-indices @${0, 1, \ldots n-1}. 1061 | 1062 | @$${A = 1063 | \begin{bmatrix} 1064 | a_{0,0} & a_{0,1} & \cdots & a_{0,n-1} \\ 1065 | a_{1,0} & a_{1,1} & \cdots & a_{1,n-1} \\ 1066 | \vdots & \vdots & \cdots & \vdots \\ 1067 | a_{m-1,0} & a_{m-1,1} & \cdots & a_{m-1,n-1} \\ 1068 | \end{bmatrix}} 1069 | 1070 | @defproc[(ref [A flomat?] [i natural?] [j natural?]) real?] 1071 | Return @${a_{ij}} the element in @A with index @${(i,j)}. 1072 | 1073 | @defproc[(mset! [A flomat?] [i natural?] [j natural?] [x real?]) real?] 1074 | Overwrite @${a_{ij}}, the element in @A with index @${(i,j)}, with the number @${x}. 1075 | 1076 | @defproc[(row [A flomat?] [i natural?]) flomat?] 1077 | Return the @ith row of @A as a row vector i.e. as a matrix of dimension @${1\times n}. 1078 | Allocates a new backing array. 1079 | 1080 | @defproc[(col [A flomat?] [j natural?]) flomat?] 1081 | Return the @jth column of @A as a column vector i.e. as a matrix of dimension @${m\times 1}. 1082 | Allocates a new backing array. 1083 | 1084 | @defproc[(sub [A flomat?] [i natural?] [j natural?] [m natural?] [n natural?]) flomat?] 1085 | Return the @mxn submatrix of with @A upper, left corner in @${(i,j)}. 1086 | Allocates a new backing array. 1087 | 1088 | @deftogether[ [@defproc[(row! [A flomat?] [i natural?]) flomat?] 1089 | @defproc[(col! [A flomat?] [j natural?]) flomat?] 1090 | @defproc[(sub! [A flomat?] [i natural?] [j natural?] [m natural?] [n natural?]) flomat?]]] 1091 | Like @racket[row], @racket[col] and @racket[sub], but uses the same backing array as @racket[A]. 1092 | 1093 | 1094 | @subsection[#:tag "ref:matrix-creation"]{Matrix Creation} 1095 | 1096 | @defproc[(matrix [obj value]) flomat?] 1097 | Create a matrix with values from @racket[obj]. 1098 | 1099 | Use @racket[matrix] to create a @racket[flomat] from existing Racket data. 1100 | It can convert vector-of-vector-of and list-of-lists representation of matrices 1101 | into the @racket[flomat] representation. A vector of numbers or a list 1102 | of numbers will be converted into a column vector (a matrix with only one column). 1103 | 1104 | Any non-floating point numbers will be converted to floating point. 1105 | The function @racket[matrix] also accepts @racket[f64vectors] as input. 1106 | 1107 | @defproc[(matrix! [obj value]) flomat?] 1108 | Like @racket[matrix] but uses the same backing array if possible. 1109 | 1110 | @defproc[(column [x real?] ...) flomat?] 1111 | Return a column vector (a @1xn matrix) with @racket[x ...] as entries. 1112 | 1113 | @defproc[(zeros [m natural?] [n natural? m]) flomat?] 1114 | Create a an @mxn matrix with all zeros. If @racket[n] 1115 | os omitted, a square @mxm matrix is returned. 1116 | 1117 | @defproc[(ones [m natural?] [n natural? m]) flomat?] 1118 | Line @racket[zeros] but the all entries will be racket[1.0]. 1119 | 1120 | @defproc[(constant! [A flomat?] [x real?]) flomat?] 1121 | Overwrite all entries in @A with @${x}. 1122 | Return @${A}. 1123 | 1124 | @deftogether[[ 1125 | @defproc[(zeros! [A flomat?]) flomat?] 1126 | @defproc[(ones! [A flomat?]) flomat?]]] 1127 | Overwrite @A with zeros or ones. 1128 | Returns @${A}. 1129 | 1130 | 1131 | 1132 | @defproc[(diag [X (or flomat? vector?)] [m natural? #f] [n natural? #f] [reciproc? boolean? #f]) flomat?] 1133 | Construct a diagonal matrix of size @mxn with elements from a standard Racket vector or a 1134 | flomat column vector @${X}. 1135 | 1136 | If @racket[reciproc?] is true, then the diagonal will hold the reciprocal of the entries 1137 | in @${X}. 1138 | 1139 | @examples[#:label #f 1140 | #:eval quick-eval 1141 | (diag (vector 1 2 3)) 1142 | (diag (vector 1 2 3) 5 5) 1143 | (diag (vector 2 4) 2 2 #t)] 1144 | 1145 | 1146 | @defproc[(eye [m natural?] [n natural? m] [k integer? 0]) flomat?] 1147 | Create a @mxn matrix with ones on the @kth diagonal. 1148 | The main diagonal is the 0'th diagonal. 1149 | Diagonals above the main diagonal have positive indices. 1150 | Diagonals below the main diagonal have negative indices. 1151 | 1152 | Note: @racket[(eye n)] will create a square identity matrix of size @${n\times n}. 1153 | 1154 | The diagonals are indexed as follows: 1155 | @$${\begin{bmatrix} 1156 | 0 & 1 & 2 & 3 \\ 1157 | -1 & 0 & 1 & 2 \\ 1158 | -2 & -1 & 0 & 1 \\ 1159 | -3 & -2 & -1 & 0 1160 | \end{bmatrix}} 1161 | 1162 | @examples[#:label #f 1163 | #:eval quick-eval 1164 | (eye 4 4 1) 1165 | (eye 4 4 -1)] 1166 | 1167 | To create ranges of values use @racket[arange] or @racket[colarange] which both work like 1168 | @racket[(matrix (range start stop step))], but avoids building an intermediary list. 1169 | The functions @racket[arange] and @racket[colarange] produce row and column vectors respectively. 1170 | The vector created has length 1171 | @$${\huge\lceil\normalsize{ \frac{\text{stop}-\text{start}}{\text{step}}}\huge\rceil\normalsize.} 1172 | 1173 | @deftogether[[ 1174 | @defproc[(arange [start real?] [stop real?] [step real? 1.0]) flomat?] 1175 | @defproc[(arange [stop real?]) flomat?]]] 1176 | Returns a row vector with values from start to stop (exclusively), here step is the gap between values. 1177 | The call @racket[(arange stop)] is equivalent to @racket[(arange 0.0 stop 1.0)]. 1178 | 1179 | Note: If you need an exact endpoint, then use @racket[linspace] instead. 1180 | 1181 | 1182 | @deftogether[[ 1183 | @defproc[(colarange [start real?] [stop real?] [step real? 1.0]) flomat?] 1184 | @defproc[(colarange [stop real?]) flomat?]]] 1185 | Like @racket[arange] but produces a column vector. 1186 | 1187 | @examples[#:label #f #:eval quick-eval 1188 | (arange 5 10 2) 1189 | (arange 5 10) 1190 | (arange 5)] 1191 | @examples[#:label #f #:eval quick-eval 1192 | (colarange 5 10 2) 1193 | (colarange 5 10) 1194 | (colarange 5)] 1195 | 1196 | 1197 | @deftogether[[ 1198 | @defproc[(linspace [start real?] [stop real?] [num natural?]) flomat?] 1199 | @defproc[(linspace [start real?] [stop real?] [num natural?] [include-last? #f]) flomat?]]] 1200 | Return a column vector with @racket[num] numbers evenly spaced from 1201 | @racket[start] to @racket[stop]. If the fourth argument is #f, the 1202 | last number is omitted. 1203 | 1204 | @examples[#:label #f #:eval quick-eval 1205 | (linspace 2 4 6) 1206 | (linspace 2 4 6 #f)] 1207 | 1208 | @deftogether[[ 1209 | @defproc[(reshape [A flomat?] [m natural?] [n natural?]) flomat?] 1210 | @defproc[(reshape! [A flomat?] [m natural?] [n natural?]) flomat?]]] 1211 | Return a matrix with shape @mxn using the elements of @${A}. 1212 | The function @racket[reshape] creates a new backing area and @racket[reshape!] 1213 | uses the one in @${A}. 1214 | 1215 | @examples[#:label #f #:eval quick-eval 1216 | (arange 9) 1217 | (reshape (arange 9) 3 3) 1218 | (transpose (reshape (arange 9) 3 3))] 1219 | 1220 | @subsection[#:tag "ref:block-operations"]{Block Operations} 1221 | 1222 | @defproc[(augment [A flomat?] ...) flomat?] 1223 | Two matrices with the same number of rows can be @emph{augmented}: 1224 | 1225 | @$${ \text{augment}( \begin{bmatrix} @barcol{A_0} \cdots & @barcol{A_{n-1}} \end{bmatrix}, 1226 | \begin{bmatrix} @barcol{B_0} \cdots & @barcol{B_{N-1}} \end{bmatrix} ) = 1227 | \begin{bmatrix} @barcol{A_0} \cdots @barcol{A_{n-1}} & 1228 | @barcol{B_0} \cdots @barcol{B_{N-1}} 1229 | \end{bmatrix}} 1230 | 1231 | The function @racket[augment] will augment one or more matrices with the same number of rows. 1232 | 1233 | @examples[#:label #f #:eval quick-eval 1234 | (augment (matrix '[[1 2] 1235 | [3 4]]) 1236 | (matrix '[[5 6 7] 1237 | [8 9 10]]))] 1238 | 1239 | @defproc[(stack [A flomat?] ...) flomat?] 1240 | Two matrices with the same number of columns can be @emph{stacked}: 1241 | 1242 | 1243 | @$${ \text{stack}( \begin{bmatrix} @barrow{A_0} \\ \cdots \\ @barrow{A_{m-1}} \end{bmatrix}, 1244 | \begin{bmatrix} @barrow{B_0} \\ \cdots \\ @barrow{B_{M-1}} \end{bmatrix} ) = 1245 | \begin{bmatrix} @barrow{A_0} \\ \cdots \\ @barrow{A_{m-1}} \\ 1246 | @barrow{B_0} \\ \cdots \\ @barrow{B_{M-1}} 1247 | \end{bmatrix}} 1248 | 1249 | The function @racket[stack] will stack one or more matrices with the same number of columns. 1250 | 1251 | @examples[#:label #f #:eval quick-eval 1252 | (stack (matrix '[[1 2] 1253 | [3 4]]) 1254 | (matrix '[[5 6] 1255 | [7 8] 1256 | [9 10]]))] 1257 | 1258 | @defproc[(block-diagonal [A flomat?] ...+) flomat?] 1259 | Make a block diagonal matrix with the matrices @racket[A ...] on the diagonal. 1260 | 1261 | @examples[#:label #f #:eval quick-eval 1262 | (block-diagonal (matrix '[[1 2] 1263 | [3 4]]) 1264 | (matrix '[[5 6] 1265 | [7 8] 1266 | [9 10]]))] 1267 | 1268 | @defproc[(repeat [A flomat?] [m natural?] [n natural? m]) flomat?] 1269 | Make a matrix with @mxn blocks, each block is @${A}. 1270 | 1271 | @examples[#:label #f #:eval quick-eval 1272 | (define A (matrix '[[1 2] 1273 | [3 4]])) 1274 | (repeat A 3)] 1275 | 1276 | 1277 | @subsection[#:tag "ref:elementwise-operations"]{Elementwise Operations} 1278 | @wikipedia["Hadamard_product_(matrices)"]{Pointwise Multiplication (Hadamard Prodcut)} 1279 | Elementwise operations (also called @emph{pointwise} operations) work on each element. 1280 | The operations all have names that being with a point. 1281 | 1282 | If a function @${f} is unary, then the corresponding pointwise function @${.f} satisfies: 1283 | 1284 | @$${.f( \begin{bmatrix} a_{ij} \end{bmatrix}) 1285 | = \begin{bmatrix} f(a_{ij}) \end{bmatrix}} 1286 | 1287 | If a function @${f} is binary, then the corresponding pointwise function @${.f} satisfies: 1288 | 1289 | @$${.f( \begin{bmatrix} a_{ij} \end{bmatrix}, 1290 | \begin{bmatrix} b_{ij} \end{bmatrix}) 1291 | = \begin{bmatrix} f(a_{ij},b_{ij}) \end{bmatrix}} 1292 | 1293 | A few functions are such as @racket[.-] and @racket[./] can be used both 1294 | as unary and binary functions. 1295 | 1296 | @defproc*[([(.- [A flomat?]) flomat?] 1297 | [(./ [A flomat?]) flomat?] 1298 | [(.sin [A flomat?]) flomat?] 1299 | [(.cos [A flomat?]) flomat?] 1300 | [(.tan [A flomat?]) flomat?] 1301 | [(.exp [A flomat?]) flomat?] 1302 | [(.log [A flomat?]) flomat?] 1303 | [(.sqr [A flomat?]) flomat?] 1304 | [(.sqrt [A flomat?]) flomat?] 1305 | 1306 | [(.+ [A flomat?] [B flomat?]) flomat?] 1307 | [(.- [A flomat?] [B flomat?]) flomat?] 1308 | [(.* [A flomat?] [B flomat?]) flomat?] 1309 | [(./ [A flomat?] [B flomat?]) flomat?] 1310 | [(.expt [A flomat?] [B flomat?]) flomat?])] 1311 | The builtin unary and pointwise functions. They all allocate a new @racket[flomat]. 1312 | 1313 | @defproc*[([(.-! [A flomat?]) flomat?] 1314 | [(./! [A flomat?]) flomat?] 1315 | [(.sin! [A flomat?]) flomat?] 1316 | [(.cos! [A flomat?]) flomat?] 1317 | [(.tan! [A flomat?]) flomat?] 1318 | [(.exp! [A flomat?]) flomat?] 1319 | [(.log! [A flomat?]) flomat?] 1320 | [(.sqr! [A flomat?]) flomat?] 1321 | [(.sqrt! [A flomat?]) flomat?] 1322 | 1323 | [(.+! [A flomat?] [B flomat?]) flomat?] 1324 | [(.-! [A flomat?] [B flomat?]) flomat?] 1325 | [(.*! [A flomat?] [B flomat?]) flomat?] 1326 | [(./! [A flomat?] [B flomat?]) flomat?] 1327 | [(.expt! [A flomat?] [B flomat?]) flomat?])] 1328 | The function @racket[.f!] works like @racket[.f] expect no new backing array is allocated. 1329 | The underlying flonum array of @racket[A] is overwritten. 1330 | 1331 | @defform[(define-pointwise-unary f)] 1332 | Define unary pointwise functions @racket[.f] and @racket[.f!] which applies the 1333 | function bound to the identifier @racket[f]. 1334 | 1335 | @defform[(define-pointwise-binary f)] 1336 | Define binary pointwise functions @racket[.f] and @racket[.f!] which applies the 1337 | function bound to the identifier @racket[f]. 1338 | 1339 | @defform[(ddefine-pointwise-unary/binary f)] 1340 | Define unary/binary pointwise functions @racket[.f] and @racket[.f!] which applies the 1341 | function bound to the identifier @racket[f]. 1342 | 1343 | 1344 | @subsection[#:tag "ref:matrix-operations"]{Matrix Operations} 1345 | 1346 | @deftogether[[ 1347 | @defproc[(plus [A flomat] ...+) flomat?] 1348 | @defproc[(plus! [A flomat] ...+) flomat?]]] 1349 | @wikipedia["Matrix_addition"]{Matrix Addition} 1350 | Computes the matrix sum of one or more matrices. 1351 | The function @racket[plus] allocates a new backing area. 1352 | The function @racket[plus!] writes the result in the backing area of the first argument. 1353 | 1354 | @deftogether[[ 1355 | @defproc[(times [A flomat] ...+) flomat?] 1356 | @defproc[(times! [A flomat] ...+) flomat?]]] 1357 | @wikipedia["Matrix_multiplication"]{Matrix Multiplication} 1358 | Computes the matrix product of one or more matrices. 1359 | The function @racket[times] allocates a new backing area. 1360 | The function @racket[times!] writes the result in the backing area of the first argument. 1361 | 1362 | @deftogether[[ 1363 | @defproc[(minus [A flomat] [B flomat] ...) flomat?] 1364 | @defproc[(minus! [A flomat] [B flomat] ...) flomat?]]] 1365 | Subtracts the matrices @${B\ldots} from @${A}. 1366 | Given only one argument @${A}, @racket[minus] computes @${-A}. 1367 | 1368 | The function @racket[minus] allocates a new backing area. 1369 | The function @racket[minus!] writes the result in the backing area of the first argument. 1370 | 1371 | @defproc[(power [A flomat?] [n natural?]) flomat?] 1372 | @wikipedia/section["https://en.wikipedia.org/wiki/Matrix_multiplication#Powers_of_a_matrix"]{Powers of a matrix} 1373 | Computes the @nth power of a matrix @A, where @n is a natural number. 1374 | 1375 | @examples[#:label #f #:eval quick-eval 1376 | (define A (matrix '((1 1) (0 1)))) 1377 | (list (power A 0) (power A 1) (power A 2) (power A 3))] 1378 | 1379 | 1380 | @deftogether[[ 1381 | @defproc[(transpose [A flomat]) flomat?] 1382 | @defproc[(transpose! [A flomat]) flomat?]]] 1383 | @wikipedia["Transpose"]{Transpose} 1384 | Computes the transpose of a matrix @${A}. 1385 | 1386 | The transpose of @${B=A^T} of an @mxn matrix @A is an @nxm matrix @${B=A^T} where @${b_{ij}=a_{ji}}. 1387 | 1388 | The function @racket[minus] allocates a new backing area. 1389 | The function @racket[minus!] writes the result in the backing area of the first argument. 1390 | 1391 | 1392 | @subsection[#:tag "matrix-and-vector-products"]{Matrix and Vector Products} 1393 | 1394 | @defproc[(dot [v flomat?] [w flomat?]) real?] 1395 | @wikipedia["Dot_product"]{Dot Product (Inner Product)} 1396 | Computes the inner product (also known as the dot product) of two column vectors 1397 | of the same length. 1398 | 1399 | @$${a\cdot b = \sum_{i=0}^{m-1} a_{i,0} b_{i,0}} 1400 | 1401 | 1402 | @examples[#:label #f #:eval quick-eval 1403 | (define v (column -1 1)) 1404 | (define w (matrix '((2) (2)))) 1405 | (dot v w)] 1406 | 1407 | @defproc[(outer [A flomat?] [B flomat?]) flomat?] 1408 | @wikipedia["Outer_product"]{Outer Product} 1409 | Computes the outer product of the first column of @A and the first row of @${B}. 1410 | 1411 | The outer product of a column vector @A with @m rows and an row @B with @n columns 1412 | is an @mxn matrix @${O} with elements @${o_{i,j} = a_i\cdot b_j}. 1413 | 1414 | @examples[#:label #f #:eval quick-eval 1415 | (define A (column 2 3)) 1416 | (define B (transpose (column 5 7))) 1417 | (outer A B)] 1418 | 1419 | @defproc[(kron [A flomat?] [B flomat?]) flomat?] 1420 | @wikipedia["Kronecker_product"]{Kronecker Product} 1421 | Computes the Kronecker product of the matrices @A and @${B}. 1422 | 1423 | The Kronecker product between two matrices @A and @B replaces 1424 | each element @${a} of @A with a copy of @B scaled with @${A}. 1425 | The Kronecker product is a generalization of the outer product. 1426 | 1427 | @examples[#:label #f #:eval quick-eval 1428 | (define A (matrix '((1 2) (3 4)))) 1429 | (define B (matrix '((1 1) (1 1)))) 1430 | (kron A B)] 1431 | 1432 | 1433 | @subsection[#:tag "ref:norms-and-invariants"]{Norms and Invariants} 1434 | 1435 | @defproc[(norm [A flomat?] [norm-type (or 2 1 'inf 'max-abs) 2]) real?] 1436 | @wikipedia["Matrix_norm"]{Matrix Norm} 1437 | Depending on @racket[norm-type], @racket[norm] will compute 1438 | an 1-norm, a Frobenius norm, an infinity norm or the maximal absolute entry value. 1439 | 1440 | The default norm type is the Frobenius norm. 1441 | The Frobenius norm is the square root of the sum of the square of all elements. 1442 | @$${\left\lVert A \right\rVert_\textrm{Frobenius} = \sqrt{\sum a_{ij}^2}} 1443 | 1444 | The 1-norm computes the maximum absolute column sum. 1445 | @$${\left\lVert A \right\rVert_1 = \max_j \sum_{i} |a_{ij}|} 1446 | 1447 | The infinity-norm computes the maximum absolute row sum. 1448 | The 1-norm computes the maximum absolute column sum. 1449 | @$${\left\lVert A \right\rVert_\infty = \max_i \sum_{j} |a_{ij}|} 1450 | 1451 | The max-abs-normal computes the maximal absolute value. 1452 | @$${\left\lVert A \right\rVert_\text{max} = \max_i \max_j |a_{ij}|} 1453 | 1454 | @examples[#:label #f #:eval quick-eval 1455 | (define A (matrix '[[1 2] 1456 | [3 4]])) 1457 | (norm A) ; Frobenius 1458 | (norm A 1) ; max col sum 1459 | (norm A 'inf) ; max row sum 1460 | (norm A 'max) ; max abs value 1461 | 1462 | (define B (matrix '[[-1 -2] 1463 | [-3 -4]])) 1464 | (norm B) ; Frobenius 1465 | (norm B 1) ; max col sum 1466 | (norm B 'inf) ; max row sum 1467 | (norm B 'max) ; max abs value 1468 | ] 1469 | 1470 | 1471 | @defproc[(det [A flomat? ]) flomat?] 1472 | @wikipedia["Determinant"]{Determinant} 1473 | Computes the determinant of a square matrix @${A}. 1474 | 1475 | @examples[#:label #f #:eval quick-eval 1476 | (det (matrix '((1 2) (0 4)))) 1477 | (det (matrix '((1 1) (2 2))))] 1478 | 1479 | @defproc[(trace [A flomat?]) flomat?] 1480 | @wikipedia["Trace_(linear_algebra)"]{Trace} 1481 | Computes the trace: the sum along a diagonal, of a matrix. 1482 | @$${ \text{trace}(A) = \sum_k a_{kk} } 1483 | 1484 | @examples[#:label #f #:eval quick-eval 1485 | (trace (matrix '((1 2) (0 4))))] 1486 | 1487 | 1488 | @defproc[(rank [A flomat?]) flomat?] 1489 | @wikipedia["Rank_(linear_algebra)"]{Rank} 1490 | Computes the rank of a square matrix. 1491 | 1492 | The rank is the equal to: 1493 | @itemlist[ 1494 | @item{the dimension of the column space} 1495 | @item{the dimension of the row space} 1496 | @item{the number of non-zero singular values in an SVD (singular value decomposition)}] 1497 | 1498 | @examples[#:label #f #:eval quick-eval 1499 | (rank (matrix '((1 2) (0 4)))) 1500 | (rank (matrix '((1 1) (2 2))))] 1501 | 1502 | 1503 | @subsection[#:tag "ref:solving-equations-and-inverting-matrices"]{Solving Equations and Inverting Matrices} 1504 | 1505 | @defproc[(mldivide [A flomat?] [B flomat?]) flomat?] 1506 | Solves the equation 1507 | @$${AX = B} 1508 | where @A is a an @mxm matrix, and both @X and @B are @${m\times n}. 1509 | 1510 | The computation is done using @${LU}-decomposition with partial pivoting. 1511 | 1512 | The matrix @A must be square and of full rank, the number 1513 | of rows in @A must be the same as the number columns in @${B}. 1514 | 1515 | Note that @A needs to be of full rank for the equation 1516 | to have a solution. The solver doesn't check that the input 1517 | matrix has full rank, it just runs it computation as usual. 1518 | 1519 | To check that the output from @racket[solve] is indeed a solution, 1520 | you can evaluate @racket[(times A X)] and compare with @${B}. 1521 | 1522 | The name @racket[mldivide] is short for "Matrix Left divide". 1523 | Although @racket[mldivide] doesn't find @X by multiplying @B 1524 | with @${A^{-1}} on the left, it is a fitting analogy. 1525 | 1526 | @examples[#:label #f #:eval quick-eval 1527 | (define A (matrix '((1 2) (3 4)))) 1528 | (define B (matrix '((1) (0)))) 1529 | (define X (mldivide A B)) 1530 | (list X (times A X))] 1531 | 1532 | @defproc[(mrdivide [B flomat?] [A flomat?]) flomat?] 1533 | Like @racket[mldivide] but solves the equations 1534 | @$${XA = B.} 1535 | The name @racket[mrdivide] is short for "Matrix Right divide". 1536 | 1537 | @examples[#:label #f #:eval quick-eval 1538 | (define A (matrix '((1 2) (3 4)))) 1539 | (define B (matrix '((2 4) (6 8)))) 1540 | (define X (mrdivide B A)) 1541 | (list X (times X A))] 1542 | 1543 | 1544 | @defproc[(inv [A flomat?]) flomat?] 1545 | Find the multiplicative inverse of a square matrix @${A}. 1546 | The matrix needs to be of full rank. 1547 | 1548 | @examples[#:label #f #:eval quick-eval 1549 | (define A (matrix '((1 2) (3 4)))) 1550 | (define Ainv (inv A)) 1551 | (list Ainv (times A Ainv))] 1552 | 1553 | An inverse of @A can be used to solve @${AX=B}, but 1554 | using @racket[mldivide] directly is normally better. 1555 | 1556 | 1557 | @defproc[(pinv [A flomat?]) flomat?] 1558 | Finds the Moore-Penrose pseudo-inverse @${A^+}of the matrix @${A}. 1559 | The matrix @A does not need to be square. 1560 | The pseudo inverse of an @mxn matrix is of size @${n\times m}. 1561 | 1562 | @examples[#:label #f #:eval quick-eval 1563 | (define A (matrix '((1 2) (3 4)))) 1564 | (define A+ (pinv A)) 1565 | (list A+ (times A+ A A+) (times A A+ A))] 1566 | 1567 | @examples[#:label #f #:eval quick-eval 1568 | (define B (matrix '((1 2 3) (4 5 6)))) 1569 | (define B+ (pinv B)) 1570 | (list B+ (times B+ B B+) (times B B+ B))] 1571 | 1572 | 1573 | 1574 | 1575 | 1576 | 1577 | 1578 | @subsection[#:tag "ref:matrix-decompositions"]{Matrix Decompositions} 1579 | 1580 | @defproc[(cholesky [A flomat?] [triangle (or 'upper 'lower) 'lower]) flomat?] 1581 | @wikipedia["Cholesky_decomposition"]{Cholesky Decomposition} 1582 | Computes the Cholesky decomposition of a symmetric, 1583 | positive-definite matrix matrix @${A}. Beware that @racket[cholesky] does 1584 | not check that the matrix is symmetric and positive-definite. 1585 | 1586 | The Cholesky decomposition of a matrix @A has two forms: 1587 | @$${A = L L^T \textrm{ or } A = U^T U,} 1588 | where @L and @U are lower and upper triangular matrices. 1589 | 1590 | @examples[#:label #f #:eval quick-eval 1591 | (define A (matrix '((1 2) (2 4)))) 1592 | (define L (cholesky A)) 1593 | (list L (transpose L)) 1594 | (times L (transpose L)) 1595 | (define U (cholesky A 'upper)) 1596 | (list (transpose U) U) 1597 | (times (transpose U) U)] 1598 | 1599 | 1600 | @defproc[(qr [A flomat?]) flomat?] 1601 | @wikipedia["QR_decomposition"]{QR-Decomposition} 1602 | Computes the QR-decomposition for a matrix @${A}. 1603 | 1604 | The QR Decomposition of @A consists of two matrices: an orthogonal matrix @Q 1605 | and an upper triangular matrix @R such that @${A=QR}. 1606 | 1607 | @examples[#:label #f #:eval quick-eval 1608 | (define A (matrix '((1 2) (3 4)))) 1609 | (define-values (Q R) (qr A)) 1610 | (list Q R) 1611 | (times Q R)] 1612 | 1613 | 1614 | @defproc[(svd [A flomat?]) flomat?] 1615 | @wikipedia["Singular_value_decomposition"]{Singular Value Decomposition (SVD)} 1616 | Computes the Singular Value Decomposition for a matrix @${A}. 1617 | 1618 | The Singular Value Decomposition (SVD) consists of three matrices: 1619 | a unitary matrix @U, 1620 | a column vector of singular values @S and 1621 | a unitary matrix @${V^T} (@V transposed). 1622 | 1623 | Use the function @racket[diag] to construct a diagonal matrix from the singular values. 1624 | 1625 | @examples[#:label #f #:eval quick-eval 1626 | (define A (matrix '((1 2) (3 4)))) 1627 | (define-values (U S VT) (svd A)) 1628 | (define Σ (diag S)) 1629 | (list U Σ VT S) 1630 | (times U Σ VT)] 1631 | 1632 | @subsection[#:tag "ref:matrix-eigenvalues-and-eigenvectors"]{Matrix Eigenvalues and Eigenvectors} 1633 | 1634 | Eigenvalues and eigenvectors of a square matrix can be computed with @racket[eig] 1635 | or, if only the eigenvalues are needed, with @racket[eigvals]. 1636 | Note that even if all elements of a matrix are real, the eigenvalues in some 1637 | cases are complex. Therefore the eigenvalues are returned as a standard 1638 | Racket vector. 1639 | 1640 | @defproc[(eig [A flomat?]) (values vector? flomat?)] 1641 | @wikipedia["Eigenvalues_and_eigenvectors"]{Eigenvalues and eigenvectors} 1642 | Compute eigenvalues and right eigenvectors. 1643 | 1644 | @defproc[(eigvals [A flomat?]) vector?] 1645 | Compute eigenvalues. 1646 | 1647 | @examples[#:label #f #:eval quick-eval 1648 | (eig (diag '(1 2))) 1649 | (eigvals (diag '(1 2))) 1650 | (eig (matrix '((1 -1) (1 1))))] 1651 | 1652 | @subsection[#:tag "ref:least-squares-problems"]{Least Squares Problems} 1653 | 1654 | Let @A be an @mxn matrix and let @b be an @nx1 column vector. 1655 | The equation @${Ax=b} (depending on @A) may not have 1656 | an unique solution - or a solution at all. 1657 | 1658 | As an alternative, one can look for the vector @x that minimizes: 1659 | @$${|Ax-b|_2,} 1660 | where @${|\cdot|_2} is the Euclidean 2-norm. 1661 | 1662 | The function @racket[lstsq] return the minimum norm solution @x 1663 | of the above the problem. 1664 | 1665 | If @racket[lstsq] is given an @nxk matrix @B, then the 1666 | problem will be solved for each column @b of @${B}. 1667 | 1668 | 1669 | 1670 | @defproc[(lstsq [A flomat?] [B flomat?]) flomat?] 1671 | Find minimum norm solution @x to the least squares problem: 1672 | @$${\text{minimize}_x |Ax-b|_2} 1673 | for each column @b of a larger matrix @${B}. 1674 | 1675 | As an example, let's look at estimating @${b_0} and @${b_1} in the model: 1676 | @$${y=b_0\cdot x+b_1} 1677 | given a data set consisting of corresponding @${x}- and @${y}-values. 1678 | The calculation reveals that the relation between @x and @y is @${y=2x+1}. 1679 | 1680 | The matrix @X is called the @emph{design matrix} of the problem. 1681 | See @hyperlink["https://en.wikipedia.org/wiki/Design_matrix"]{Design Matrix} at Wikipedia. 1682 | In this case the design matrix has two columns: the first has the @${x}-values, the 1683 | second contains just ones. 1684 | 1685 | @examples[#:label #f #:eval quick-eval 1686 | (define xs (column 0 1 2 3)) 1687 | (define ys (column 1 3 5 7)) 1688 | (define X (augment xs (flomat-ones (nrows xs) 1))) 1689 | X 1690 | (define B (lstsq X ys)) 1691 | B] 1692 | 1693 | 1694 | @subsection[#:tag "ref:matrix-functions"]{Matrix Functions} 1695 | 1696 | @defproc[(expm [A flomat?]) flomat?] 1697 | @wikipedia["Matrix_exponential"]{Matrix Exponential} 1698 | Compute the matrix exponential @${\exp(A)}, where @A is a square matrix. 1699 | 1700 | The matrix exponential @${\exp(A)} of a square matrix @${A} is defined as: 1701 | @$${ \exp(A) = \sum_{k=0}^{\infty} \frac{1}{k!} A^k } 1702 | where @${A^0} is interpreted as the identity matrix of the same size as @${A}. 1703 | 1704 | The matrix exponential is well-defined for all square matrices @${A}. 1705 | 1706 | There is no routines in LAPACK for computing matrix exponentials. 1707 | The algorithm used in flomat is from the paper: 1708 | 1709 | @centered[@verbatim{ 1710 | "The Pade Method for computing the Matrix Exponential" 1711 | M. Arioli, B. Codenotti, C. Fassino 1712 | https://www.sciencedirect.com/science/article/pii/0024379594001901 1713 | }] 1714 | 1715 | 1716 | @examples[#:label #f #:eval quick-eval 1717 | (list (exp 1) (exp 2)) 1718 | (expm (matrix '((1 0) (0 2)))) 1719 | (expm (matrix '((1 2) (3 4))))] 1720 | 1721 | 1722 | 1723 | @subsection{Printing} 1724 | 1725 | @defproc[(flomat-print [A flomat?] [port port?] [mode boolean?]) void?] 1726 | Prints a flomat @racket[A] to the port @racket[port]. 1727 | If the mode @racket[#t] means @emph{write} and 1728 | @racket[#f] means @emph{display}. 1729 | 1730 | If the size of the matrix @racket[A] is less than the 1731 | value of the parameter @racket[current-max-flomat-print-size] the 1732 | entries are printed, otherwise an ellisis "..." is printed. 1733 | 1734 | Currently there the output of @emph{write} and @emph{display} mode is the same. 1735 | 1736 | @examples[#:label #f 1737 | #:eval quick-eval 1738 | (define A (matrix '[[1 2]])) 1739 | (flomat-print A (current-output-port) #f) 1740 | (display A) 1741 | (flomat-print A (current-output-port) #t) 1742 | (write A)] 1743 | 1744 | @defparam[current-max-flomat-print-size n natural?] 1745 | Parameter that controls printing whether the entries of the matrix 1746 | are printed. See @racket[flomat-print]. 1747 | 1748 | 1749 | @subsection{BLAS and LAPACK} 1750 | 1751 | @wikipedia["Basic_Linear_Algebra_Subprograms"]{BLAS} 1752 | BLAS (Basic Linear Algebra Subprograms) is a standard containing descriptions 1753 | of a set of commonly used low-level linear algebra routines. The idea 1754 | of having a standard set of operations originated with a Fortran library in 1977. 1755 | Over time the standard has been implemented multiple times and 1756 | there are often fast versions for particular machines available. If possible 1757 | choose an implementation tuned for you hardware. 1758 | 1759 | Where BLAS deals with low-level operations (simple vector and matrix 1760 | computations) LAPACK (Linear Algebra Package) deals with higher-level problems 1761 | such as solving linear equations, solving linear least square problems, 1762 | and finding matrix decompostions). LAPACK was originally written in Fortran 77 1763 | but current versions are written in Fortran 90. LAPACK is built on top of BLAS 1764 | in the sense that LAPACK calls BLAS to perform the low-level operations. 1765 | 1766 | The philosophy of the @racket[flomat] implementation is to use BLAS and LAPACK 1767 | to solve as many problems as possible (opposed to implement the algorithm 1768 | ourselves). The representation of a @racket[flomat] therefore matches the 1769 | expectation of the routines in BLAS and LAPACK closely. 1770 | 1771 | 1772 | @subsection{CBLAS Bindings} 1773 | 1774 | We have chosen to use CBLAS which provides a C interface (instead of a Fortran one) 1775 | to the routines in BLAS. Apple provides documentation for their implementation: 1776 | @hyperlink[url-apple-blas-docs]{CBLAS Documentation}. 1777 | 1778 | All names in CBLAS has the prefix @racket[cblas_], so if you an operation 1779 | in the Fortran documentation, simply put @racket[cblas_] in front. 1780 | 1781 | There are quite a few operations in BLAS and they all have short names, 1782 | so the names follow a pattern: the first letter describes the type 1783 | of floating point. 1784 | 1785 | @itemlist[ 1786 | @item{s - single precision} 1787 | @item{d - double precision} 1788 | @item{c - single precision complex} 1789 | @item{z - double precision complex}] 1790 | 1791 | In @racket[flomat] we have for now chosen to stick with matrices containing double 1792 | precision floating points, so we need the operations that begin with @tt{d}. 1793 | 1794 | As an example let's consider how to use @racket[dcopy], which copies 1795 | a vector @racket[X] to a vector @racket[y]. The first step is to 1796 | lookup the arguments. The header file for cblas contains 1797 | is @hyperlink["http://www.netlib.org/blas/cblas.h"]{"cblas.h"} and contains: 1798 | 1799 | @verbatim{ 1800 | void cblas_dcopy(const int N, 1801 | const double *X, const int incX, 1802 | double *Y, const int incY); } 1803 | 1804 | We can ignore @tt{const}, which simplify informs the C compiler that a 1805 | call to @tt{cblas_copy} doesn't change the argument. 1806 | 1807 | For @tt{double *} which is a pointer to an array of doubles, we use 1808 | a tagged pointer @racket[_flomat]. 1809 | 1810 | This leads to the following binding: 1811 | 1812 | @codeblock|{(define-cblas cblas_dcopy 1813 | (_fun (n : _int) 1814 | (X : _flomat) (incX : _int) 1815 | (Y : _flomat) (incY : _int) 1816 | -> _void))}| 1817 | 1818 | In order to use @racket[cblas_dcopy] we need to study the documentation, 1819 | which is found at Netlink: @hyperlink[url-dcopy-docs]{dcopy}. 1820 | 1821 | @verbatim{ 1822 | Purpose: 1823 | DCOPY copies a vector, x, to a vector, y. 1824 | uses unrolled loops for increments equal to 1. 1825 | Parameters 1826 | [in] N is INTEGER the number of elements in input vector(s) 1827 | [in] DX is DOUBLE PRECISION array dimension (1+(N-1)*abs(INCX)) 1828 | [in] INCX is INTEGER, storage spacing between elements of DX 1829 | [out] DY is DOUBLE PRECISION array dimension (1+(N-1)*abs(INCY)) 1830 | [in] INCY is INTEGER storage spacing between elements of DY} 1831 | 1832 | For vectors we see that a vector is a passed as a pair (DX, INCX) of the 1833 | start address and the stride. Since vectors in @racket[flomat] are column vectors 1834 | and matrices are stored in column major order, the elements of a column vector 1835 | are stored with an increment of 1. 1836 | 1837 | Given two matrices @A and @B we can copy the first @n 1838 | elements of the first column of @A into the first column of @B 1839 | like this: 1840 | @codeblock|{(define-param (ma na a lda) A) 1841 | (define-param (mb nb b ldb) B) 1842 | (cblas_dcopy n (ptr-elm a lda 0 j) 1 (ptr-elm b ldb 0 k) 1)}| 1843 | Here @racket[(ptr-elm a lda i j)] will compute the address of the @ijth 1844 | element of matrix @${A}. No error checking is done, so you need to 1845 | check that @n is smaller than then number of rows in @A and @B before 1846 | making the call. 1847 | 1848 | To copy into a row, use @${\text{INCY}=\text{ldb}}. 1849 | @codeblock|{(define-param (ma na a lda) A) 1850 | (define-param (mb nb b ldb) B) 1851 | (cblas_dcopy n (ptr-elm a lda 0 j) 1 (ptr-elm b ldb k 0) ldb)}| 1852 | This copies column @j of @A into row @k in @${B}. 1853 | 1854 | Note that @racket[dcopy] allows an increment @racket[INCX] of zero. 1855 | With an increment of @racket[INX=0] we can copy the same element into 1856 | all entries of the destination. 1857 | 1858 | This trick is used in the implementation of @racket[make-flomat]: 1859 | @codeblock|{ 1860 | (define (make-flomat m n [x 0.0]) 1861 | (define a (alloc-flomat m n)) 1862 | (define x* (cast (malloc 1 _double 'atomic) _pointer _flomat)) 1863 | (ptr-set! x* _double (real->double-flonum x)) 1864 | (if (= x 0.0) 1865 | (memset a 0 (* m n) _double) 1866 | (cblas_dcopy (* m n) x* 0 a 1)) 1867 | (flomat m n a m))}| 1868 | Here the case @racket[0.0] is special cased to use the faster @racket[memset]. 1869 | 1870 | @defform[(define-cblas name body ...)] 1871 | The form @racket[define-cblas] is defined via @racket[define-ffi-definer]. 1872 | See @secref["Defining_Bindings" #:doc '(lib "scribblings/foreign/foreign.scrbl")] 1873 | in the Reference manual. 1874 | 1875 | @deftogether[((defidform cblas_daxpy) 1876 | (defidform cblas_dcopy) 1877 | (defidform cblas_ddot) 1878 | (defidform cblas_dgemm) 1879 | (defidform cblas_dgemv) 1880 | (defidform cblas_dnrm2) 1881 | (defidform cblas_dscal) 1882 | (defidform cblas_dswap) 1883 | (defidform cblas_ixamax))] 1884 | The bindings used internally by @racket[flomat]. See the source of 1885 | @hyperlink["https://github.com/soegaard/sci/blob/master/flomat/flomat.rkt"]{flomat.rkt} 1886 | at Github for the exact calling conventions. 1887 | 1888 | Most users won't need to use these, but they are available if need be. 1889 | 1890 | 1891 | @subsection{LAPACK Bindings} 1892 | 1893 | LAPACK is a Fortran library, so the calling conventions are sligthly 1894 | different than usual. First of all, let's look at an example: the 1895 | function @tt{dlange} which is used to compute norms of a real matrix. 1896 | 1897 | The Fortran documentation has the following to say about the 1898 | types of the arguments: 1899 | @verbatim{ 1900 | DOUBLE PRECISION FUNCTION DLANGE( NORM, M, N, A, LDA, WORK ) 1901 | 1902 | NORM (input) CHARACTER*1 1903 | M (input) INTEGER 1904 | N (input) INTEGER 1905 | A (input) DOUBLE PRECISION array, dimension (LDA,N) 1906 | LDA (input) INTEGER 1907 | WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))} 1908 | 1909 | The corresponding binding is: 1910 | 1911 | @codeblock|{ 1912 | (define-lapack dlange_ 1913 | (_fun (norm : (_ptr i _byte)) 1914 | (m : (_ptr i _int)) 1915 | (n : (_ptr i _int)) 1916 | (a : _flomat) 1917 | (lda : (_ptr i _int)) 1918 | (work : (_ptr io _flomat)) 1919 | -> _double))}| 1920 | 1921 | Note that all arguments are passed by reference. 1922 | Use @racket[(_ptr i _)], @racket[(_ptr o _)] or @linebreak[] 1923 | @racket[(_ptr io _)] for input, output and input/output arguments. 1924 | 1925 | Note that the size of an character is the same as byte. 1926 | Use @racket[char->integer] in order to convert a Racket character 1927 | into a byte. 1928 | 1929 | The function @racket[flomat-norm] sets up the arguments before calling @racket[dlange_]: 1930 | @codeblock|{ 1931 | (define (flomat-norm A [norm-type 2]) 1932 | (define-param (m n a lda) A) 1933 | (define norm (char->integer 1934 | (match norm-type 1935 | [1 #\1] 1936 | ['inf #\I] 1937 | [2 #\F] 1938 | ['max-abs #\M] 1939 | [_ (error)]))) 1940 | (define lwork (if (equal? norm-type 'inf) (max 1 m) 1)) 1941 | (define W (make-flomat lwork 1)) 1942 | (define w (flomat-a W)) 1943 | (dlange_ norm m n a lda w))}| 1944 | Here the work array is only used when computing the infimum norm. 1945 | 1946 | 1947 | @defform[(define-lapack name body ...)] 1948 | The form @racket[define-lapack] is defined via @racket[define-ffi-definer]. 1949 | See @secref["Defining_Bindings" #:doc '(lib "scribblings/foreign/foreign.scrbl")] 1950 | in the Reference manual. LAPACK uses an underscore suffix, so remember to an 1951 | underscore to any names seen in the LAPACK documentation. 1952 | 1953 | @deftogether[((defidform dlange_) 1954 | (defidform dgeev_) 1955 | (defidform dgetrf_) 1956 | (defidform dgesvd_) 1957 | (defidform dgesdd_) 1958 | (defidform dgeqrf_) 1959 | (defidform dorgqr_) 1960 | (defidform dgetri_) 1961 | (defidform dpotrf_) 1962 | (defidform dgesv_) 1963 | (defidform dgelsd_))] 1964 | The bindings from LAPACK used internally in flomat. 1965 | See @hyperlink["http://www.netlib.org/lapack/"]{LAPACK Documentation} 1966 | at Netlib. 1967 | 1968 | Most users won't need to use these, but they are available if need be. 1969 | 1970 | See the source of 1971 | @hyperlink["https://github.com/soegaard/sci/blob/master/flomat/flomat.rkt"]{flomat.rkt} 1972 | at Github for the exact calling conventions. 1973 | 1974 | 1975 | -------------------------------------------------------------------------------- /flomat/expm.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (provide expm) 3 | 4 | ;;; 5 | ;;; Matrix Exponential 6 | ;;; 7 | 8 | ; This module implements `expm` the so-called matrix exponential. 9 | ; The standard exponential function `exp` can be written as 10 | ; an infinite sum (the Taylor series of exp). 11 | 12 | ; x x^2 x^3 13 | ; exp(x) = 1 + -- + --- + --- + ... 14 | ; 1! 2! 3! 15 | 16 | ; The matrix exponential expm(A) of a square matrix A is 17 | ; defined as the limit of: 18 | 19 | ; A A^2 A^3 20 | ; exp(A) = 1 + -- + --- + --- + ... 21 | ; 1! 2! 3! 22 | 23 | ; if the limit exist (otherwise expm(A) is undefined). 24 | 25 | ; In principle one could use this definition to calculate `expm`, 26 | ; but the convergence is slow. Instead we will use 27 | ; an approximation of `exp(x)` using a rational expression: 28 | ; a quotient of two polynomials. 29 | 30 | ; p(x) 31 | ; exp(x) ~ -------- where p and q are polynomials 32 | ; q(x) 33 | 34 | ; Henri Padé studied how to find the best rational expression 35 | ; approximating a given function. Such an approximation is 36 | ; called an "Padé approximant" today. 37 | 38 | ; The precision of the approximation depends on the number 39 | ; of terms used in the numerator and denominator. More terms 40 | ; give higher precision. 41 | 42 | ; To keep things simple, we will look at the situation where 43 | ; we use the same number of terms in both numerator and denominator. 44 | ; This is called a diagonal Padé approximation (in tables they appear 45 | ; on the diagonal. 46 | 47 | ; The first few diagonal Padé approximations are: 48 | ; 1 49 | ; exp(x) ~ --- 50 | ; 1 51 | 52 | ; 1 + 1/2 x 53 | ; exp(x) ~ ----------- 54 | ; 1 - 1/2 x 55 | 56 | ; 1 + 1/2 x + 1/12 x^2 57 | ; exp(x) ~ ----------------------- 58 | ; 1 - 1/2 x + 1/12 x^2 59 | 60 | ; 1 + 1/2 x + 1/10 x^2 + 1/120 x^3 61 | ; exp(x) ~ --------------------------------- 62 | ; 1 - 1/2 x + 1/10 x^2 - 1/120 x^3 63 | 64 | ; The explicit formula for the i'th coefficient of the p'th diagonal approximant is: 65 | 66 | ; (2p-i)! p! 67 | ; N_p = ---------------- 68 | ; (2p)! i! (p-i)! 69 | 70 | ; (2p-i)! p! 71 | ; D_p = ---------------- *(-1)^i 72 | ; (2p)! i! (p-i)! 73 | 74 | ; Given these formulas we can compute the coefficients we need, 75 | ; then we can experiment with different number of terms. 76 | 77 | ; This is fine - but what about our matrices? 78 | ; As a simple example, let's say we have chosen to use the approximation: 79 | 80 | ; 1 + 1/2 x 81 | ; exp(x) ~ ----------- 82 | ; 1 - 1/2 x 83 | 84 | ; We can rewrite this as: 85 | ; (1 - 1/2 x) exp(x) = 1 + 1/2 x 86 | 87 | ; Plugging in a matrix A, we get: 88 | ; (1 - 1/2 A) exp(A) = 1 + 1/2 A 89 | 90 | ; This can be seen as a matrix equation in which the unknown is exp(A). 91 | ; The solution can be computed by `mldivide` ("left dividing with A"). 92 | ; exp(A) = mldvide( (1 - 1/2 A), 1 + 1/2 A) 93 | 94 | ; This basic idea is the back bone of the computation. 95 | 96 | ; There is a little observation that we can use to reduce the 97 | ; amount of computation in the denominator. The terms of the 98 | ; numerator and denominator are the same - except for different 99 | ; signs in the terms with odd degree. This suggests that we 100 | ; should calculate the even and odd terms of the numerator first: 101 | 102 | ; numerator = sum_of_even + sum_of_odd 103 | 104 | ; then the denominator is a simple to compute: 105 | 106 | ; denominator = sum_of_even - sum_of_odd 107 | 108 | ; The last piece of the puzzle concerns the domain the magnitude 109 | ; of the matrix entries. The approximation works best, if 110 | ; the entries |a_ij|<=0.5. (using norms, if |A|₁ <=0.5 ). 111 | ; See [1] 112 | 113 | ; Dividing the entries of A with 2 reduces the norm 114 | ; exp(A) = exp(A/2)^2 115 | ; and if we do it s times, we get: 116 | ; exp(A) = ... = exp(A/2^s)^(2s) 117 | 118 | ; That is we use the Padé approximation on exp(A/2^s), 119 | ; then we computer the 2s'th power. 120 | 121 | 122 | ; [1] The Pade Method for computing the Matrix Exponential 123 | ; M. Arioli, B. Codenotti, C. Fassino 124 | ; https://www.sciencedirect.com/science/article/pii/0024379594001901 125 | 126 | 127 | (require racket/list) 128 | (require "flomat.rkt") 129 | 130 | ;;; 131 | ;;; Coefficients 132 | ;;; 133 | 134 | (define (fact n) (if (= n 0) 1 (* n (fact (- n 1))))) 135 | 136 | (define (ncoef p i) ; for numerator 137 | (/ (* (fact (+ p p (- i))) (fact p)) 138 | (* (fact (+ p p)) (fact i) (fact (- p i))))) 139 | 140 | 141 | (define (dcoef p i) ; for denominator 142 | (* (ncoef p i) 143 | (if (odd? i) -1 1))) 144 | 145 | ; We can compute the coefficients we need. 146 | (define n8 (let ([p 8]) (for/list ([j (+ p 1)]) (* 1.0 (ncoef p j))))) 147 | (define d8 (let ([p 8]) (for/list ([j (+ p 1)]) (* 1.0 (dcoef p j))))) 148 | 149 | (define (poly cs x) 150 | ; given (list c0 c1 c2 ... cn) compute c0 + c1*x + c2*x² + ... + cn x^n 151 | (cond 152 | [(empty? cs) 0.] 153 | [else (+ (first cs) 154 | (* x (poly (rest cs) x)))])) 155 | 156 | ; We can test the accuracy of the Pade approximation on a single number: 157 | 158 | (define (exp-pade x) 159 | (/ (poly n8 x) 160 | (poly d8 x))) 161 | 162 | ; Now: (exp 1.0) and (exp-pade 1.0) give the same result. 163 | ; Note: using n7,d7 give an error on the last decimal when using doubles. 164 | 165 | ; The matrix version of poly looks like this: 166 | 167 | (define (mpoly cs A) 168 | (define n (nrows A)) 169 | (define I (eye n)) 170 | (define Z (zeros n)) 171 | 172 | (define (loop cs) 173 | (cond 174 | [(empty? cs) Z] 175 | [else (plus (.* (first cs) I) 176 | (times A (loop (rest cs))))])) 177 | (loop cs)) 178 | 179 | ; We can directly compute expm as below, because we want to compute the 180 | ; the even and odd terms separately. 181 | 182 | (define (expm-pade0 A) 183 | (mldivide (mpoly d8 A) (mpoly n8 A))) 184 | 185 | (define (even-coefs cs) 186 | (if (empty? cs) '() (cons (first cs) (odd-coefs (rest cs))))) 187 | 188 | (define (odd-coefs cs) 189 | (if (empty? cs) '() (even-coefs (rest cs)))) 190 | 191 | ; Now without scaling, we have: 192 | 193 | (define (expm-pade/no-scaling A) 194 | (define AA (times A A)) 195 | (define even (mpoly (even-coefs n8) AA)) 196 | (define odd (times A (mpoly (odd-coefs n8) AA))) 197 | (define num (plus even odd)) 198 | (define den (minus even odd)) 199 | (mldivide den num)) 200 | 201 | ; With pre-scaling we get: 202 | 203 | (define (expm A) 204 | (define s (find-scaling-exponent A)) 205 | (define 2^s (expt 2 s)) 206 | (define A/2^s (./ A 2^s)) 207 | (repeated-squaring (expm-pade/no-scaling A/2^s) s)) 208 | 209 | (define (repeated-squaring A s) 210 | (if (<= s 0) A (repeated-squaring (times A A) (- s 1)))) 211 | 212 | (define (find-scaling-exponent A) 213 | (define N (norm A 1)) 214 | (define s (+ 1 (ceiling (log N 2)))) 215 | s) 216 | 217 | 218 | ;; (exp-pade 1.0) 219 | ;; (exp 1.0) 220 | ;; (exp-pade 2.0) 221 | ;; (exp 2.0) 222 | 223 | ;; (expm-pade0 (matrix '([1]))) 224 | ;; (expm-pade0 (matrix '([1 0] [0 2]))) 225 | 226 | ;; (expm-pade/no-scaling (matrix '([1]))) 227 | ;; (expm-pade/no-scaling (matrix '([1 0] [0 2]))) 228 | 229 | ;; (expm-pade (matrix '([1]))) 230 | ;; (expm-pade (matrix '([1 0] [0 2]))) 231 | 232 | ;; (expm-pade (matrix '([1 2] [3 4]))) 233 | 234 | 235 | ;;; Notes: 236 | ;; Found: The Scaling and Squaring Method for the Matrix Exponential Revisited, 237 | ; Nicolas J. Higham 238 | ; TODO: Read it and see if we can improve the algorithm. 239 | 240 | -------------------------------------------------------------------------------- /flomat/flomat.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (provide (all-defined-out)) 3 | 4 | ;;; TODO 5 | ;;; * Implement block. Handle mix between numbers and matrices. 6 | ;;; * Improve matrix-expt! (avoid allocation) 7 | ;;; * schur decomposition 8 | ;;; * sqrtm See Higham paper. 9 | ;;; * logm 10 | 11 | ;;; NOTES 12 | ;;; * Contracts will be added before release 13 | ;;; * See tests at bottom for examples. 14 | 15 | ;;; FEEDBACK 16 | ;;; * Where is CBLAS and LAPACK on your platform 17 | ;;; (Windows and Linux) 18 | ;;; * What are the libraries named? 19 | ;;; * Do all tests evaluate to #t on your platform? 20 | 21 | ;;; * Mail: jensaxel@soegaard.net 22 | 23 | ;;; 24 | ;;; PLATFORMS TESTED 25 | ;;; * OS X Catalina (Working) 26 | 27 | ;;; 28 | ;;; IDEAS 29 | ;;; Potential Improvements 30 | ;;; * DONE Unsafe operations 31 | ;;; * DONE add lda to the flomat structure 32 | ;;; * DONE support shared submatrix without allocation 33 | ;;; * DONE Improve equal? 34 | ;;; * Use dgeequ before dgetrf (in matrix-lu!) 35 | ;;; * Use an extra call with lwork=-1 in matrix-inverse! 36 | ;;; * support different storage schemes 37 | ;;; http://www.netlib.org/lapack/lug/node121.html 38 | 39 | ;;; Useful routines to consider: 40 | 41 | ;;; * http://www.math.utah.edu/software/lapack/lapack-d/dlazro.html 42 | ;;; * http://www.math.utah.edu/software/lapack/lapack-d/dlaset.html 43 | ;;; Constructs diagonal matrices. Use for flomat-identity 44 | ;;; * http://www.math.utah.edu/software/lapack/lapack-d/dlaswp.html 45 | ;;; Row interchanges 46 | ;;; * http://www.math.utah.edu/software/lapack/lapack-d/drscl.html 47 | ;;; Scale by 1/a with correct rounding 48 | 49 | 50 | (require ffi/vector 51 | ffi/unsafe 52 | ffi/unsafe/define 53 | racket/flonum 54 | (for-syntax 55 | racket/format 56 | racket/string 57 | ffi/unsafe 58 | racket/syntax)) 59 | 60 | 61 | ;;; 62 | ;;; LIBRARIES 63 | ;;; 64 | 65 | ; CBLAS and LAPACK are used. 66 | ; The first two are C-based whereas LAPACK is Fortran based. 67 | 68 | ; Note: Use trailing _ in names exported by LAPACK (in order to work both on macOS and Linux). 69 | 70 | 71 | ;; Find placement of libraries. 72 | 73 | (define-values (cblas-lib lapack-lib) 74 | (case (system-type) 75 | ; MACOS 76 | [(macosx) 77 | (define veclib-lib 78 | ; OS X: Contains CBLAS both CATLAS. CATLAS is not used here. 79 | ; https://developer.apple.com/library/mac/#documentation/Accelerate/ 80 | ; Reference/BLAS_Ref/Reference/reference.html 81 | (ffi-lib "/System/Library/Frameworks/vecLib.framework/Versions/Current/vecLib")) 82 | (define cblas-lib veclib-lib) 83 | (define lapack-lib 84 | (ffi-lib 85 | (string-append 86 | "/System/Library/Frameworks/Accelerate.framework/" 87 | "Versions/A/Frameworks/vecLib.framework/Versions/A/libLAPACK"))) 88 | (values cblas-lib lapack-lib)] 89 | ; UNIX 90 | [(unix) 91 | ; Note: The library names are different on Debian, Ubuntu and Arch. 92 | (define uname (string-downcase (system-type 'machine))) 93 | (define dist (cond [(regexp-match "arch" uname) 'arch] 94 | [(regexp-match "debian" uname) 'debian] 95 | [(regexp-match "ubuntu" uname) 'ubuntu] 96 | [(regexp-match #px"fc\\d\\d" uname) 'fedora] 97 | [(regexp-match #px"raspberrypi" uname) 'rp400] ; raspberry pi 98 | [(regexp-match #px"rp400" uname) 'rp400] ; raspberry pi 99 | [else 'other])) 100 | ; The lib order is important here. 101 | ; Since cblas depends on gfortran, gfortran needs to come first. 102 | (define gfortran-lib (ffi-lib "libgfortran" '("5" "3" #f))) 103 | 104 | (define quadmath-lib (case dist 105 | [(rp400) #f] 106 | [else (ffi-lib "libquadmath" '("0" #f))])) 107 | 108 | (define cblas-lib (case dist 109 | [(debian) (ffi-lib "libblas" '("3" #f))] 110 | [(arch) (ffi-lib "libcblas" '("3" #f))] 111 | [(ubuntu) (ffi-lib "libblas" '("3" #f))] 112 | [(fedora) (ffi-lib "libcblas" '("3" #f))] 113 | [(rp400) (ffi-lib "libblas" '("3" #f))] 114 | [(other) (ffi-lib "libblas" '("3" #f))])) 115 | 116 | 117 | 118 | (define lapack-lib (ffi-lib "liblapack" '("3" #f))) 119 | 120 | (values cblas-lib lapack-lib)] 121 | [(windows) ; Windows 10 122 | (define (use-openblas) 123 | (define cblas-lib (ffi-lib "libopenblas.dll")) 124 | (define lapack-lib #f) 125 | (values cblas-lib lapack-lib)) 126 | 127 | ; If RACKET_SCI_USE_OPENBLAS is set, we don't look for the standard names. 128 | (case (getenv "RACKET_SCI_USE_OPENBLAS") 129 | [(#f) (with-handlers ([exn:fail:filesystem? 130 | ; the standard names weren't found, try openblas 131 | (λ (x) (use-openblas))]) 132 | (define cblas-lib (ffi-lib "libblas.dll")) ; place them in PATH 133 | (define lapack-lib (ffi-lib "liblapack.dll")) 134 | (values cblas-lib lapack-lib))] 135 | [else (use-openblas)])])) 136 | 137 | ;;; Load libraries 138 | 139 | (define-ffi-definer define-cblas cblas-lib) 140 | (define-ffi-definer define-lapack lapack-lib) 141 | 142 | ;;; 143 | ;;; REFERENCES 144 | ;;; 145 | 146 | ; LAPACK Naming scheme: 147 | ; http://www.netlib.org/lapack/lug/node24.html 148 | 149 | ; On macOS the header files are here: 150 | 151 | ; /Library/Developer/CommandLineTools/SDKs/MacOSX10.14.sdk/System/Library/ 152 | ; Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/ 153 | ; Versions/A/Headers/clapack.h 154 | 155 | 156 | ;;; 157 | ;;; CONFIGURATION 158 | ;;; 159 | 160 | (define epsilon 1e-13) 161 | ; If two flomats have the same size and 162 | ; the differences between two entries are 163 | ; smaller than epsilon, they are considered 164 | ; equal? . Furthermore if all entries are 165 | ; smaller than epsilon flomat-zero? 166 | ; returns true. 167 | 168 | (define current-max-flomat-print-size (make-parameter 100)) 169 | ; For matrices with smaller size, all 170 | ; entries are printed. For larger matrices 171 | ; only the dimension is printed. 172 | 173 | 174 | ;;; 175 | ;;; REPRESENTATION 176 | ;;; 177 | 178 | ; BLAS/LAPACK represents matrices as one-dimensional arrays 179 | ; of numbers (S=single, D=double, X=complex or Z=double complex). 180 | ; This library uses arrays of doubles. 181 | 182 | (define _flomat (_cpointer 'flomat)) 183 | 184 | ; The array is wrapped in a struct, which besides 185 | ; a pointer to the array, holds the number of 186 | ; rows and columns. Future extension could be to 187 | ; allow different types of numbers, or perhaps 188 | ; choose specialized operations for triangular matrices. 189 | 190 | (define (flomat-print A port mode) 191 | (define print (if mode write display)) 192 | (print 193 | (if (< (flomat-size A) (current-max-flomat-print-size)) 194 | ; constructor style printing: 195 | (list 'flomat: ; (flomat-m A) (flomat-n A) 196 | (flomat->lists A)) 197 | ; omit actual elements 198 | (list 'flomat (flomat-m A) (flomat-n A) 199 | "...")) 200 | port)) 201 | 202 | 203 | 204 | (define (flomat= A B [eps #f]) 205 | ; TODO: Use (< (norm1 (.- A B)) eps) 206 | (define-param (m n a lda) A) 207 | (define-param (r c b ldb) B) 208 | (and (= m r) (= n c) 209 | (for*/and ([j (in-range n)] 210 | [i (in-range m)]) 211 | (define aij (unsafe-ref a lda i j)) 212 | (define bij (unsafe-ref b ldb i j)) 213 | (if eps 214 | (fl<= (flabs (fl- aij bij)) eps) 215 | (fl= aij bij))))) 216 | 217 | ; m = rows, n = cols, a = mxn array of doubles 218 | ; lda = leading dimension of a (see below) 219 | (struct flomat (m n a lda) 220 | #:methods gen:custom-write 221 | [(define write-proc flomat-print)] 222 | #:methods gen:equal+hash 223 | [(define equal-proc 224 | (λ (A B rec) 225 | (and (= (flomat-m A) (flomat-m B)) 226 | (= (flomat-n A) (flomat-n B)) 227 | (or (equal? (flomat-a A) (flomat-a B)) 228 | (flomat= A B epsilon))))) 229 | (define hash-proc 230 | ; TODO: Avoid allocation in hash-proc. 231 | (λ (A rec) 232 | (define-param (m n) A) 233 | (rec (cons m (cons n (flomat->vector A)))))) 234 | (define hash2-proc 235 | (λ (A rec) 236 | (define-param (m n) A) 237 | (rec (cons n (cons m (flomat->vector A))))))]) 238 | 239 | ; convenient destructuring 240 | (define-syntax (define-param stx) 241 | (syntax-case stx () 242 | [(_ (m n) A) 243 | #'(begin 244 | (define A1 A) 245 | (define m (flomat-m A1)) 246 | (define n (flomat-n A1)))] 247 | [(_ (m n a) A) 248 | #'(begin 249 | (define A1 A) 250 | (define m (flomat-m A1)) 251 | (define n (flomat-n A1)) 252 | (define a (flomat-a A1)))] 253 | [(_ (m n a lda) A) 254 | #'(begin 255 | (define A1 A) 256 | (define m (flomat-m A1)) 257 | (define n (flomat-n A1)) 258 | (define a (flomat-a A1)) 259 | (define lda (flomat-lda A1)))] 260 | [_ 261 | (syntax/loc stx (error "Wrong number of arguments"))])) 262 | 263 | ;;; 264 | ;;; MEMORY LAYOUT 265 | ;;; 266 | 267 | ; The entries are layed out in column major order. 268 | ; This means that the entries in a column are 269 | ; contigious. LAPACK needs this order. 270 | 271 | ; a[0] a[0 +lda] a[0 + 2*lda] ... a[0+(n-1)*lda] 272 | ; a[1] a[1 +lda] 273 | ; a[2] 274 | ; ... ... 275 | ; a[m-1] a[m-1 +lda] a[m01 + 2*lda] ... a[m-1+(n-1)*lda] 276 | 277 | ; For most matrices lda=m. 278 | 279 | ; For a submatrix it is possible that lda is larger than m. 280 | ; See http://stackoverflow.com/q/5009513/23567 281 | ; Example: 282 | ; If ma=10, na=12, a=, lda=10, 283 | ; then mb=7, nb=2, b=a+3+4*lda, ldb=10 (=lda) 284 | ; represent a 7x2 submatrix whose upper, lefter 285 | ; corner in A is (3,4) (indices are 0-based). 286 | 287 | ; The array index of the (i,j)th entry is: 288 | (define-syntax-rule (index lda i j) 289 | (+ i (* j lda))) 290 | 291 | (define (ptr-elm a lda i j) 292 | ; address of (i,j)th element 293 | (ptr-add a (index lda i j) _double)) 294 | 295 | (define (shared-submatrix! A i j r s) 296 | ; return rxs matrix with upper left corner (i,j) 297 | ; entries are shared with A 298 | ; TODO: consider garbage collection 299 | (define-param (m n a lda) A) 300 | (flomat r s (ptr-elm a lda i j) lda)) 301 | 302 | (define (flsubmatrix A m n i j) 303 | ; TODO: argument order not consistent with shared-submatrix! 304 | ; return a the mxn submatrix of with upper 305 | ; left corner in (i,j) 306 | (copy-flomat (shared-submatrix! A i j m n))) 307 | 308 | 309 | (define (ptr-row a i) 310 | ; pointer to beginning of row a 311 | (ptr-add a i _double)) 312 | 313 | (define (ptr-col a lda j) 314 | ; address of column j 315 | (ptr-add a (* j lda) _double)) 316 | 317 | 318 | ;;; 319 | ;;; CHECKS 320 | ;;; 321 | 322 | (define (check-flomat who A) 323 | (unless (flomat? A) 324 | (raise-type-error who "expected flomat" A))) 325 | 326 | (define (check-same-dimensions A B who) 327 | (unless (flomat-same-dimensions? A B) 328 | (raise-argument-error who "expected two matrices of the same size" A B))) 329 | 330 | (define (check-all-matrices-same-size who AS) 331 | (set! AS (filter flomat? AS)) 332 | (when (not( empty? AS)) 333 | (unless (and (apply = (map flomat-m AS)) 334 | (apply = (map flomat-n AS))) 335 | (raise-argument-error 336 | who 337 | "All input matrices are expected to have the same dimensions." 338 | AS)))) 339 | 340 | (define (check-product-dimensions who A B [C #f] [transA #f] [transB #f]) 341 | (define-values (ma na) (flomat-dimensions A)) 342 | (define-values (mb nb) (flomat-dimensions B)) 343 | (when transA (set!-values (ma na) (values na ma))) 344 | (when transB (set!-values (mb nb) (values nb mb))) 345 | (unless (if (not C) 346 | (= na mb) 347 | (and (= na mb) 348 | (= ma (flomat-m C)) 349 | (= nb (flomat-n C)))) 350 | (raise-argument-error 351 | who 352 | (if C 353 | "expected three matrices with compatible dimensions" 354 | "expected two matrices with compatible dimensions") 355 | (list (map (λ (A) (flomat-dimensions A #t)) (list A B C)) (list A B C))))) 356 | 357 | (define (check-matrix-vector-product-dimensions who A X Y transpose-A) 358 | ; ma x na * mx x nx = ma x nx 359 | (define-param (ma na) A) 360 | (define-param (mx nx) X) 361 | (define-param (my ny) Y) 362 | (when transpose-A (set!-values (ma na) (values na ma))) 363 | (unless (= ny nx 1) 364 | (raise-argument-error 365 | who "expected two column vectors, got: " 366 | (list (list mx nx) (list my ny)))) 367 | (unless (= na mx) 368 | (raise-argument-error 369 | who "expected same number of columns in matrix as there are columns in X" 370 | (list (list ma na) (list mx nx) (list 'transpose-A transpose-A))))) 371 | 372 | (define (check-legal-column who j A) 373 | (unless (< j (flomat-n A)) 374 | (raise-argument-error 375 | who "column index too large" j)) 376 | (unless (<= 0 j) 377 | (raise-argument-error 378 | who "column index must be non-negative"))) 379 | 380 | (define (check-legal-row who i A) 381 | (unless (< i (flomat-m A)) 382 | (raise-argument-error 383 | who "row index too large" i)) 384 | (unless (<= 0 i) 385 | (raise-argument-error 386 | who "row index must be non-negative"))) 387 | 388 | (define (check-square who A) 389 | (define-param (m n) A) 390 | (unless (= m n) 391 | (raise-argument-error 392 | who "square matrix expected" A))) 393 | 394 | (define (check-vector who v) 395 | (unless (vector? v) (raise-argument-error who "vector expected" v))) 396 | 397 | (define (check-integer who x) 398 | (unless (integer? x) (raise-argument-error who "integer expected" x))) 399 | 400 | (define (check-positive-integer who x) 401 | (unless (and (integer? x) (>= x 0)) 402 | (raise-argument-error who "positive integer epected" x))) 403 | 404 | 405 | 406 | ;;; 407 | ;;; SIZE and DIMENSION 408 | ;;; 409 | 410 | (define (flomat-size A) 411 | (check-flomat 'flomat-size A ) 412 | (define-param (m n) A) 413 | (* m n)) 414 | 415 | (define (flomat-dimensions A [as-list? #f]) 416 | (check-flomat 'flomat-dimensions A) 417 | (define-param (m n) A) 418 | (if as-list? 419 | (list m n) 420 | (values m n))) 421 | 422 | (define (flomat-same-dimensions? A B) 423 | (define-param (ma na) A) 424 | (define-param (mb nb) B) 425 | (and (= ma mb) (= na nb))) 426 | 427 | (define (flomat-row-vector? A) 428 | (= 1 (flomat-m A))) 429 | 430 | (define (flomat-column-vector? A) 431 | (= 1 (flomat-n A))) 432 | 433 | ;;; 434 | ;;; ALLOCATIONS and CONSTRUCTORS 435 | ;;; 436 | 437 | (define (alloc-flomat m n) 438 | (if (or (= m 0) (= n 0)) 439 | #f ; ~ NULL 440 | (cast (malloc (* m n) _double 'atomic) 441 | _pointer _flomat))) 442 | 443 | ; Note: Even though we use ptr-add we do not need to use 'atomic-interior 444 | ; since the result of ptr-add contains both the base pointer and an offset. 445 | 446 | (define (alloc-same-size-matrix A) 447 | (define-param (m n) A) 448 | (alloc-flomat m n)) 449 | 450 | 451 | (define-syntax (define-cblas* stx) 452 | (syntax-case stx () 453 | [(def xname _x (c ...) body ...) 454 | (let () 455 | (define ((xname->name ctx xname) c) 456 | (datum->syntax 457 | ctx 458 | (string->symbol 459 | (string-replace (~a xname) "x" (~a c) #:all? #f)))) 460 | (define (c->_c c) 461 | (unless (symbol? c) 462 | (error (format "expected symbol, got: ~a" c))) 463 | (case c 464 | [(c) #'_double] ; TODO missing from ffi? 465 | [(z) #'_double] ; TODO 466 | [(d) #'_double] 467 | [(s) #'_float] 468 | [else (error "expected one of c, z, d, s")])) 469 | (with-syntax ([(name ...) 470 | (map (xname->name stx (syntax->datum #'xname)) 471 | (syntax->datum #'(c ...)))] 472 | [(_c ...) (map c->_c (syntax->datum #'(c ...)))]) 473 | #'(begin 474 | (define-cblas name 475 | (let ([_x _c]) body ...)) 476 | ...)))])) 477 | 478 | ;; Note: BLAS expects complex numbers to be passed as two doubles, 479 | ; so _complex aren't per se missing from the FFI. 480 | ; https://stackoverflow.com/questions/34103818/swift-blas-cblas-cgemv-complex-numbers 481 | ; For now this library sticks with doubles. 482 | 483 | (define-cblas* cblas_xcopy _x (s d c z) ; dcopy 484 | ; copy n elements from vector X to vector Y 485 | (_fun (n : _int) 486 | (X : _flomat) (incX : _int) 487 | (Y : _flomat) (incY : _int) 488 | -> _void)) 489 | 490 | #;(define-cblas cblas_dcopy 491 | ; copy n elements from vector X to vector Y 492 | (_fun (n : _int) 493 | (X : _flomat) (incX : _int) 494 | (Y : _flomat) (incY : _int) 495 | -> _void)) 496 | 497 | (define (unsafe-vector-copy! s a lda b) 498 | ; copy s elements from A into B 499 | ; element 0, lda, 2*lda, ... is copied 500 | (cblas_dcopy s a lda b 1)) 501 | 502 | (define (unsafe-matrix-copy! m n a lda b ldb) 503 | ; Todo: The for loop currently copies each column. 504 | ; If the rows are longer than columns then it would be 505 | ; faster to copy each row. 506 | 507 | ; copy the mxn matrix A into B 508 | ; copy has upper left corner in (i,j) 509 | ; Note: use (ptr-elm b ldb i j) to 510 | ; copy into a submatrix of b. 511 | (for ([j (in-range n)]) 512 | (unsafe-vector-copy! 513 | m (ptr-elm a lda 0 j) 1 514 | (ptr-add b (* j ldb) _double)))) 515 | 516 | (define (copy-flomat A) 517 | (define-param (m n a lda) A) 518 | (define size (* m n)) 519 | (define b (cast (malloc size _double 'atomic) 520 | _pointer _flomat)) 521 | (define ldb m) 522 | (cond 523 | [(= lda m) ; elements in a are contigious 524 | (unsafe-vector-copy! size a 1 b)] 525 | [else ; copy each column separately 526 | (unsafe-matrix-copy! m n a lda b ldb)]) 527 | (flomat m n b ldb)) 528 | 529 | 530 | ;; (define (make-flomat m n [x 0.0]) 531 | ;; (define a (alloc-flomat m n)) 532 | ;; (define x* (real->double-flonum x)) 533 | ;; (if (= x 0.0) 534 | ;; (memset a 0 (* m n) _double) 535 | ;; (for ([i (* m n)]) (ptr-set! a _double i x*))) 536 | ;; (flomat m n a m)) 537 | 538 | (define (make-flomat m n [x 0.0]) 539 | (define a (alloc-flomat m n)) 540 | (define x* (cast (malloc 1 _double 'atomic) _pointer _flomat)) 541 | (ptr-set! x* _double (real->double-flonum x)) 542 | (if (= x 0.0) 543 | (memset a 0 (* m n) _double) 544 | (cblas_dcopy (* m n) x* 0 a 1)) 545 | (flomat m n a m)) 546 | 547 | 548 | (define (flomat-zeros m n) 549 | (make-flomat m n 0.0)) 550 | 551 | (define (flomat-ones m n) 552 | (make-flomat m n 1.0)) 553 | 554 | 555 | (define (list->flomat xss) 556 | (define m (length xss)) 557 | (define n (apply max (map length xss))) 558 | (for*/flomat m n 559 | ([xs (in-list xss)] 560 | [x (in-list xs)]) 561 | x)) 562 | 563 | (define (vectors->flomat xss) 564 | (define m (vector-length xss)) 565 | (define n (vector-length (vector-ref xss 0))) 566 | (for*/flomat m n 567 | ([xs (in-vector xss)] 568 | [x (in-vector xs)]) 569 | x)) 570 | 571 | (define (flomat-identity m) 572 | (define A (make-flomat m m 0.0)) 573 | (for ([i (in-range m)]) 574 | (flomat-set! A i i 1.0)) 575 | A) 576 | 577 | (define (flomat-column A j) 578 | ; copy column j 579 | (check-legal-column 'flomat-column j A) 580 | (define-param (m n) A) 581 | (copy-flomat (shared-submatrix! A 0 j m 1))) 582 | 583 | (define (flomat-row A i) 584 | ; copy row i 585 | (define-param (m n) A) 586 | (check-legal-row 'flomat-row i A) 587 | (copy-flomat (shared-submatrix! A i 0 1 n))) 588 | 589 | ;;; 590 | ;;; CONVERSIONS MATRIX <-> VECTOR 591 | ;;; 592 | 593 | (define (flomat->vector A) 594 | ; the result vector uses row-major order 595 | (define-param (m n a lda) A) 596 | (for*/vector #:length (* m n) 597 | ([i (in-range 0 m)] 598 | [j (in-range 0 n)]) 599 | (unsafe-ref a lda i j))) 600 | 601 | (define (flomat->vectors A) 602 | ; the result is a vector of rows 603 | (define-param (m n a lda) A) 604 | (for/vector #:length m 605 | ([i (in-range 0 m)]) 606 | (for/vector #:length n 607 | ([j (in-range 0 n)]) 608 | (ptr-ref a _double (+ i (* j lda))) 609 | #;(ptr-ref (ptr-elm a lda i j) _double)))) 610 | 611 | (define (vector->flomat m n v) 612 | (unless (= (* m n) (vector-length v)) 613 | (raise-argument-error 614 | 'vector->flomat 615 | "expected m*n to be the same as the length of the vector")) 616 | (define a (alloc-flomat m n)) 617 | (define k 0) 618 | (for* ([j (in-range n)] 619 | [i (in-range m)]) 620 | (ptr-set! a _double* k ; (index m i j) 621 | (vector-ref v (+ (* i n) j))) 622 | (set! k (+ k 1))) 623 | (flomat m n a m)) 624 | 625 | ; (: matrix/dim : Integer Integer Number * -> (Matrix Number)) 626 | ; construct a mxn flomat with elements from the values xs 627 | ; the length of xs must be m*n 628 | (define (flomat/dim m n . xs) 629 | (vector->flomat m n (list->vector xs))) 630 | 631 | 632 | ;;; 633 | ;;; COMPREHENSIONS 634 | ;;; 635 | 636 | ; (for/flomat m n (clause ...) . defs+exprs) 637 | ; (for/matrix (i in m) (j in n) (clauses ...) . body) 638 | ; Return an m x n flomat with elements from the last expr. 639 | ; The first n values produced becomes the first row. 640 | ; The next n values becomes the second row and so on. 641 | ; The bindings in clauses run in parallel. 642 | (define-syntax (for/flomat stx) 643 | (syntax-case stx (in) 644 | [(_for/matrix (i in m-expr) (j in n-expr) #:column (clause ...) . defs+exprs) 645 | (syntax/loc stx 646 | (let ([m m-expr] [n n-expr]) 647 | (define a (alloc-flomat m n)) 648 | (define idx 0) 649 | (for* ([j (in-range n)] 650 | [i (in-range m)] 651 | clause ...) 652 | (define x (let () . defs+exprs)) 653 | (ptr-set! a _double* idx x) 654 | (set! idx (+ idx 1))) 655 | (flomat m n a m)))] 656 | ; elements in column 0 are generated first, then column 1, ... 657 | [(_ m-expr n-expr #:column (clause ...) . defs+exprs) 658 | (syntax/loc stx 659 | (let ([m m-expr] [n n-expr]) 660 | (define a (alloc-flomat m n)) 661 | (define size (* m n)) 662 | (for ([idx (in-range size)] clause ...) 663 | (define x (let () . defs+exprs)) 664 | (ptr-set! a _double* idx x)) 665 | (flomat m n a m)))] 666 | [(_for/matrix (i in m-expr) (j in n-expr) (clause ...) . defs+exprs) 667 | (syntax/loc stx 668 | (let ([m m-expr] [n n-expr]) 669 | (define size (* m n)) 670 | (define a (alloc-flomat m n)) 671 | (define idx 0) 672 | (for* ([i (in-range m)] 673 | [j (in-range n)] 674 | clause ...) 675 | (define x (let () . defs+exprs)) 676 | (ptr-set! a _double* idx x) 677 | (set! idx (+ idx m)) 678 | (when (>= idx size) 679 | (set! idx (+ idx 1 (- size))))) 680 | (flomat m n a m)))] 681 | ; elements in row 0 are generated first, then row 1, ... 682 | [(_ m-expr n-expr (clause ...) . defs+exprs) 683 | (syntax/loc stx 684 | (let* ([m m-expr] [n n-expr]) 685 | (define a (alloc-flomat m n)) 686 | (define idx 0) 687 | (define size (* m n)) 688 | (for ([k (in-range size)] clause ...) 689 | (define x (let () . defs+exprs)) 690 | (ptr-set! a _double* idx x) 691 | (set! idx (+ idx m)) 692 | (when (>= idx size) 693 | (set! idx (+ idx 1 (- size))))) 694 | (flomat m n a m)))])) 695 | 696 | ; (for*/flomat m n (clause ...) . defs+exprs) 697 | ; Return an m x n flomat with elements from the last expr. 698 | ; The first n values produced becomes the first row. 699 | ; The next n values becomes the second row and so on. 700 | ; The bindings in clauses run nested. 701 | ; (for*/flomat m n #:column (clause ...) . defs+exprs) 702 | ; Return an m x n flomat with elements from the last expr. 703 | ; The first m values produced becomes the first column. 704 | ; The next m values becomes the second column and so on. 705 | ; The bindings in clauses run nested. 706 | 707 | (define-syntax (for*/flomat stx) 708 | (syntax-case stx () 709 | [(_ m-expr n-expr #:column (clause ...) . defs+exprs) 710 | (syntax/loc stx 711 | (let* ([m m-expr] [n n-expr]) 712 | (define a (alloc-flomat m n)) 713 | (define idx 0) 714 | (define size (* m n)) 715 | (for* (clause ... #:break (= idx size)) 716 | (define x (let () . defs+exprs)) 717 | (ptr-set! a _double* idx x) 718 | (set! idx (+ idx 1))) 719 | (flomat m n a m)))] 720 | [(_ m-expr n-expr (clause ...) . defs+exprs) 721 | (syntax/loc stx 722 | (let ([m m-expr] [n n-expr]) 723 | (define a (alloc-flomat m n)) 724 | (define idx 0) 725 | (define size (* m n)) 726 | (for* (clause ... #:final (= idx (- size 1))) 727 | (define x (let () . defs+exprs)) 728 | (ptr-set! a _double* idx x) 729 | (set! idx (+ idx m)) 730 | (when (>= idx size) 731 | (set! idx (+ idx 1 (- size))))) 732 | (flomat m n a m)))])) 733 | 734 | (define-syntax (for/flomat-sum stx) 735 | (syntax-case stx () 736 | [(_ (for:-clause ...) . defs+exprs) 737 | (syntax/loc stx 738 | (let () 739 | (define sum #f) 740 | (for (for:-clause ...) 741 | (define a (let () . defs+exprs)) 742 | (set! sum (if sum (flomat+ sum a) a))) 743 | sum))])) 744 | 745 | ;;; 746 | ;;; BINARY MATRIX OPERATIONS 747 | ;;; 748 | 749 | ;;; MATRIX SUM AND DIFFERENCE 750 | 751 | (define-cblas* cblas_xaxpy _x (s d #;c #;z) 752 | ; Y := αX+Y ; X and Y are vectors 753 | ; If incX=3 then every 3rd element of X is used. 754 | (_fun (n : _int) (alpha : _x) 755 | (X : _flomat) (incX : _int) 756 | (Y : _flomat) (incY : _int) 757 | -> _void)) 758 | 759 | #;(define-cblas cblas_daxpy 760 | ; Y := αX+Y ; X and Y are vectors 761 | ; If incX=3 then every 3rd element of X is used. 762 | (_fun (n : _int) (alpha : _double) 763 | (X : _flomat) (incX : _int) 764 | (Y : _flomat) (incY : _int) 765 | -> _void)) 766 | 767 | ;; This does not work if there are NaN entries. 768 | ;; Use memset with 0 instead. See block-diagonal as an example. 769 | ;; (define (unsafe-vector-clear n a [lda 1]) 770 | ;; (cblas_daxpy n -1.0 a lda a lda)) 771 | 772 | ; TODO: Allow adding row to different matrix! 773 | 774 | (define (flomat-add-scaled-row! A i1 s i2) 775 | ; scale row i2 and add to row i1 776 | (check-legal-row 'matrix-add-scaled-row! i1 A) 777 | (check-legal-row 'matrix-add-scaled-row! i2 A) 778 | (define-param (m n a lda) A) 779 | (define rowi1 (ptr-row a i1)) 780 | (define rowi2 (ptr-row a i2)) 781 | (define s* (real->double-flonum s)) 782 | (cblas_daxpy n s* rowi2 lda rowi1 lda) 783 | A) 784 | 785 | (define (flomat-add-scaled-row A i1 s i2) 786 | (define B (copy-flomat A)) 787 | (flomat-add-scaled-row! B i1 s i2) 788 | B) 789 | 790 | (define (flomat-add-scaled-column! A j1 s j2) 791 | (check-legal-row 'flomat-add-scaled-column! j1 A) 792 | (check-legal-row 'flomat-add-scaled-column! j2 A) 793 | (define-param (m n a lda) A) 794 | (define colj1 (ptr-col a lda j1)) 795 | (define colj2 (ptr-col a lda j2)) 796 | (define s* (real->double-flonum s)) 797 | (cblas_daxpy m s* colj1 1 colj2 1) 798 | A) 799 | 800 | (define (flomat-add-scaled-column A i1 s i2) 801 | (define B (copy-flomat A)) 802 | (flomat-add-scaled-column! B i1 s i2) 803 | B) 804 | 805 | (define (constant*flomat+flomat! alpha A B) 806 | ; B := αA+B 807 | (define-param (m n a lda) A) 808 | (define-param (r s b ldb) B) 809 | (for ([j (in-range n)]) 810 | (cblas_daxpy m alpha 811 | (ptr-col a lda j) 1 812 | (ptr-col b ldb j) 1)) 813 | B) 814 | 815 | (define (constant*flomat+flomat alpha A B) 816 | ; αA+B 817 | (define αA+B (copy-flomat B)) 818 | (constant*flomat+flomat! alpha A αA+B) 819 | αA+B) 820 | 821 | (define (flomat+! A B) 822 | ; B := A + B 823 | (check-same-dimensions A B 'flomat+!) 824 | (constant*flomat+flomat! 1.0 A B)) 825 | 826 | (define (flomat+ A B) 827 | ; A + B 828 | (check-same-dimensions A B 'flomat+) 829 | (constant*flomat+flomat 1.0 A B)) 830 | 831 | (define (flomat-! A B) 832 | ; A := A - B 833 | (check-same-dimensions A B 'flomat-!) 834 | (constant*flomat+flomat! -1.0 B A)) 835 | 836 | (define (flomat- A [B #f]) 837 | (cond 838 | [B 839 | (check-same-dimensions A B 'flomat-) 840 | (constant*flomat+flomat -1.0 B A)] 841 | [else 842 | (flomat-scale -1.0 A)])) 843 | 844 | ;;; Matrix x Matrix Multiplication 845 | 846 | (define _CBLAS_ORDER _int) 847 | (define CblasRowMajor 101) 848 | (define CblasColMajor 102) 849 | 850 | (define _CBLAS_TRANSPOSE _int) 851 | (define CblasNoTrans 111) 852 | (define CblasTrans 112) 853 | (define CblasConjTrans 113) 854 | 855 | (define-cblas* cblas_xgemm _x (s d z c) 856 | ; C := α(A*B)+βC 857 | ; 1. Multiplies A and B. 858 | ; 2. Scales result with alpha 859 | ; 3. Scales C with beta. 860 | ; 4. Stores sum in in C. 861 | (_fun (order : _CBLAS_ORDER) 862 | (transa : _CBLAS_TRANSPOSE) ; transpose A? 863 | (transb : _CBLAS_TRANSPOSE) ; transpose B? 864 | (m : _int) ; rows in A and C 865 | (n : _int) ; cols in B and C 866 | (k : _int) ; cols in A = rows in B 867 | (alpha : _x) ; scaling factor for A and B 868 | (A : _flomat) 869 | (lda : _int) ; size of first dim of A 870 | (B : _flomat) 871 | (ldb : _int) ; size of first dim of B 872 | (beta : _double) ; scaling for C 873 | (C : _flomat) 874 | (ldc : _int) ; size of first dim of C 875 | -> _void)) 876 | 877 | (define (constant*matrix*matrix+constant*matrix! alpha A B beta C transA transB) 878 | ; C := α(A*B)+βC, maybe transpose A and/or B first 879 | ; Note: the check fails when the matrices are transposed. 880 | ; todo: pass transA and transB to the checker. 881 | (check-product-dimensions 'constant*matrix*matrix+constant*matrix! 882 | A B C transA transB) 883 | (define-param (m n a lda) A) 884 | (define-param (r s b ldb) B) 885 | (define-param (x y c ldc) C) 886 | (define alpha* (real->double-flonum alpha)) 887 | (define beta* (real->double-flonum beta)) 888 | (cblas_dgemm CblasColMajor 889 | (if transA CblasTrans CblasNoTrans) 890 | (if transB CblasTrans CblasNoTrans) 891 | (if transA n m) ; rows in A 892 | (if transB r s) ; cols in B 893 | (if transA m n) ; cols in A 894 | alpha* 895 | a lda b ldb beta* c ldc) 896 | C) 897 | 898 | (define (flomat*! A B C 899 | [alpha 1.0] [beta 1.0] 900 | [transpose-A #f] [transpose-B #f]) 901 | ; C := α(A*B)+βC, maybe transpose A and/or B first 902 | (constant*matrix*matrix+constant*matrix! 903 | alpha A B beta C transpose-A transpose-B)) 904 | 905 | (define (flomat* A B [C #f] 906 | [alpha 1.0] [beta 1.0] 907 | [transpose-A #f] [transpose-B #f]) 908 | ; C := α(A*B)+βC, maybe transpose A and/or B first 909 | (define-values (ma na) (flomat-dimensions A)) 910 | (define-values (mb nb) (flomat-dimensions B)) 911 | (when transpose-A (set!-values (ma na) (values na ma))) 912 | (when transpose-B (set!-values (mb nb) (values nb mb))) 913 | (define C1 (or C (make-flomat ma nb))) 914 | (flomat*! A B C1 alpha beta transpose-A transpose-B)) 915 | 916 | ;;; Matrix Power 917 | 918 | (define (flomat-expt a n) 919 | (check-flomat 'flomat-expt a) 920 | (check-square 'matrix-expt a) 921 | (cond 922 | [(= n 0) (flomat-identity (flomat-m a))] 923 | [(= n 1) (copy-flomat a)] 924 | [(= n 2) (flomat* a a)] 925 | [(even? n) (let ([a^n/2 (flomat-expt a (quotient n 2))]) 926 | (flomat* a^n/2 a^n/2))] 927 | [else (flomat* a (flomat-expt a (sub1 n)))])) 928 | 929 | ;;; Matrix x Vector Multiplication 930 | 931 | ; NOTE: Functions accepting column vectors automatically 932 | ; convert (standard) vectors into mx1 matrices. 933 | 934 | (define-cblas* cblas_xgemv _x (s d c z) ; Double GEneral Matrix Vector multiplication 935 | ; Y := α(AX) +(βY) 936 | (_fun (order : _CBLAS_ORDER) 937 | (transa : _CBLAS_TRANSPOSE) ; transpose A? 938 | (m : _int) ; rows in A 939 | (n : _int) ; cols in A 940 | (alpha : _x) ; scaling factor for A 941 | (A : _flomat) 942 | (lda : _int) 943 | (X : _flomat) ; vector 944 | (ldx : _int) 945 | (beta : _x) ; scaling for Y 946 | (Y : _flomat) ; vector 947 | (ldy : _int) 948 | -> _void)) 949 | 950 | (define (constant*matrix*vector+constant*vector! alpha A X beta Y transA) 951 | ; unsafe: Y := α(AX) +(βY), maybe transpose A first 952 | (define-param (m n a lda) A) 953 | (cblas_dgemv CblasColMajor 954 | (if transA CblasTrans CblasNoTrans) 955 | m n 956 | (real->double-flonum alpha) 957 | a lda 958 | (flomat-a X) 1 959 | (real->double-flonum beta) 960 | (flomat-a Y) 1) 961 | Y) 962 | 963 | 964 | (define (flomat*vector! A X Y [alpha 1.0] [beta 1.0] 965 | [transpose-A #f]) 966 | (define X1 (result-flcolumn X)) 967 | (define Y1 (result-flcolumn Y)) 968 | (check-matrix-vector-product-dimensions 969 | 'constant*matrix*vector+constant*vector! A X1 Y1 transpose-A) 970 | ; Y := α(AX) +(βY), maybe transpose A first 971 | (constant*matrix*vector+constant*vector! 972 | alpha A X1 beta Y1 transpose-A)) 973 | 974 | (define (flomat*vector A X [Y #f] [alpha 1.0] [beta 1.0] 975 | [transpose-A #f] ) 976 | ; Y := α(AX) +(βY), maybe transpose A first 977 | (define Y1 (or Y (make-flomat (if transpose-A (flomat-n A) (flomat-m A)) 1 0.0))) 978 | (flomat*vector! A X Y1 alpha 1.0 transpose-A)) 979 | 980 | ;;; 981 | ;;; ELEMENT WISE OPERATIONS 982 | ;;; 983 | 984 | ;;; Ref 985 | 986 | (define (unsafe-ref a lda i j) 987 | (ptr-ref (ptr-elm a lda i j) _double)) 988 | 989 | (define (flomat-ref A i j) 990 | (define-param (m n a lda) A) 991 | (unless (< -1 i m) 992 | (raise-arguments-error 993 | 'matrix-ref (format "expected row index between 0 and ~a, got ~a" m i))) 994 | (unless (< -1 j n) 995 | (error 'matrix-ref 996 | (format "expected column index between 0 and ~a, got ~a" n j))) 997 | (unsafe-ref a lda i j)) 998 | 999 | ;;; Set! 1000 | 1001 | (define (unsafe-set! a lda i j x) 1002 | (ptr-set! (ptr-elm a lda i j) _double x)) 1003 | 1004 | (define (flomat-set! A i j x) 1005 | (check-legal-row 'flomat-set! i A) 1006 | (check-legal-column 'flomat-set! j A) 1007 | (define-param (m n a lda) A) 1008 | (define x* (real->double-flonum x)) 1009 | (unsafe-set! a lda i j x*) 1010 | A) 1011 | 1012 | ;;; Scaling 1013 | 1014 | (define-cblas* cblas_xscal _x (s d c z) 1015 | ; X := αX vector 1016 | (_fun (n : _int) (alpha : _x) 1017 | (X : _flomat) (incX : _int) 1018 | -> _void)) 1019 | 1020 | (define (constant*matrix! s A) 1021 | ; A := s*A 1022 | (define-param (m n a lda) A) 1023 | (define s* (real->double-flonum s)) 1024 | (cond 1025 | [(= lda m) 1026 | (cblas_dscal (* m n) s* a 1)] 1027 | [else 1028 | (for ([j (in-range n)]) 1029 | (cblas_dscal m s* (ptr-col a lda j) 1))]) 1030 | A) 1031 | 1032 | (define (flomat-scale! s A) 1033 | ; A := s*A 1034 | (constant*matrix! s A)) 1035 | 1036 | (define (flomat-scale s A) 1037 | ; s*A 1038 | (define sA (copy-flomat A)) 1039 | (flomat-scale! s sA)) 1040 | 1041 | (define (shared-column-flomat A j) 1042 | (check-legal-column 'shared-column-flomat j A) 1043 | (define-param (m n) A) 1044 | (shared-submatrix! A 0 j m 1)) 1045 | 1046 | (define (shared-row-flomat A i) 1047 | (check-legal-row 'shared-row-flomat i A) 1048 | (shared-submatrix! A i 0 1 (flomat-n A))) 1049 | 1050 | (define (flomat-scale-column! A j s) 1051 | ; col_j := s * col_j 1052 | (constant*matrix! s (shared-column-flomat A j)) 1053 | A) 1054 | 1055 | (define (flomat-scale-column A j s) 1056 | (define B (copy-flomat A)) 1057 | (flomat-scale-column! B j s) 1058 | B) 1059 | 1060 | (define (flomat-scale-row! A i s) 1061 | ; row_i := s * rwo_i 1062 | (check-legal-row 'flomat-scale-row! i A) 1063 | (define-values (m n) (flomat-dimensions A)) 1064 | (constant*matrix! s (shared-row-flomat A i)) 1065 | A) 1066 | 1067 | (define (flomat-scale-row A i s) 1068 | (define B (copy-flomat A)) 1069 | (flomat-scale-row! B i s) 1070 | B) 1071 | 1072 | ;;; Swapping 1073 | 1074 | (define-cblas* cblas_xswap _x (s d c z) 1075 | ; Swaps elements in the vectors x and y 1076 | (_fun (n : _int) ; length of vector 1077 | (X : _flomat) (incX : _int) 1078 | (Y : _flomat) (incY : _int) 1079 | -> _void)) 1080 | 1081 | (define (flomat-swap-rows! A i1 i2) 1082 | (check-legal-row 'flomat-swap-rows! i1 A) 1083 | (check-legal-row 'flomat-swap-rows! i2 A) 1084 | (unless (= i1 i2) 1085 | (define-param (m n a lda) A) 1086 | (define rowi1 (ptr-row a i1)) 1087 | (define rowi2 (ptr-row a i2)) 1088 | (cblas_dswap n rowi1 lda rowi2 lda)) 1089 | A) 1090 | 1091 | (define (flomat-swap-rows A i1 i2) 1092 | (define B (copy-flomat A)) 1093 | (flomat-swap-rows! B i1 i2) 1094 | B) 1095 | 1096 | (define (flomat-swap-columns! A j1 j2) 1097 | (check-legal-row 'flomat-swap-columns! j1 A) 1098 | (check-legal-row 'flomat-swap-columns! j2 A) 1099 | (unless (= j1 j2) 1100 | (define-param (m n a lda) A) 1101 | (define colj1 (ptr-col a lda j1)) 1102 | (define colj2 (ptr-col a lda j2)) 1103 | (cblas_dswap m colj1 1 colj2 1)) 1104 | A) 1105 | 1106 | (define (flomat-swap-columns A j1 j2) 1107 | (define B (copy-flomat A)) 1108 | (flomat-swap-columns! B j1 j2) 1109 | B) 1110 | 1111 | (define (flomat-flip-left-to-right! A) 1112 | (check-flomat 'flomat-flip-left-to-right! A) 1113 | (define-param (m n a lda) A) 1114 | (unless (= n 1) 1115 | (for ([j (in-range (quotient n 2))]) 1116 | (flomat-swap-columns! A j (- n j 1)))) 1117 | A) 1118 | 1119 | (define (flomat-flip-left-to-right A) 1120 | (check-flomat 'flomat-flip-left-to-right A) 1121 | (define B (copy-flomat A)) 1122 | (flomat-flip-left-to-right! B) 1123 | B) 1124 | 1125 | (define (flomat-flip-up-to-down! A) 1126 | (check-flomat 'flomat-flip-up-to-down! A) 1127 | (define-param (m n a lda) A) 1128 | (unless (= m 1) 1129 | (for ([i (in-range (quotient m 2))]) 1130 | (flomat-swap-rows! A i (- m i 1)))) 1131 | A) 1132 | 1133 | (define (flomat-flip-up-to-down A) 1134 | (check-flomat 'flomat-flip-up-to-down A) 1135 | (define B (copy-flomat A)) 1136 | (flomat-flip-up-to-down! B) 1137 | B) 1138 | 1139 | (define (flomat-rotate90 A) 1140 | ; 1 2 3 3 6 9 1141 | ; 4 5 6 becomes 2 5 8 1142 | ; 7 8 9 1 4 7 1143 | (check-flomat 'flomat-rotate90 A) 1144 | (check-square 'flomat-rotate90 A) 1145 | (define-param (m n a lda) A) 1146 | (for*/flomat n m 1147 | ([i (in-range (- n 1) -1 -1)] 1148 | [j (in-range (- m 1) -1 -1)]) 1149 | (flomat-ref A (- n j 1) i))) 1150 | 1151 | 1152 | 1153 | 1154 | ;;; Max Absolute Value 1155 | 1156 | (define-cblas* cblas_ixamax _x (s d c z) 1157 | ; Returns the index of the element with the largest 1158 | ; absolute value in a vector. 1159 | (_fun (n : _int) (X : _flomat) (incX : _int) 1160 | -> _int)) 1161 | 1162 | 1163 | (define (flomat-max-abs-index A) 1164 | (define-param (m n a lda) A) 1165 | (cond 1166 | [(= m lda) 1167 | (define idx (cblas_idamax (* m n) a lda)) 1168 | (values (remainder idx m) (quotient idx m))] 1169 | [(= n 1) 1170 | (define idx (cblas_idamax m a 1)) 1171 | (values (- idx 1) 0)] 1172 | [else 1173 | (define idx (make-vector n)) 1174 | (for ([j (in-range n)]) 1175 | (define i (cblas_idamax m (ptr-col a lda j) 1)) 1176 | (vector-set! idx j (cons (cons i j) (unsafe-ref a lda i j)))) 1177 | (define ij (car (vector-argmax cdr idx))) 1178 | (values (car ij) (cdr ij))])) 1179 | 1180 | (define (flomat-max-abs-value A) 1181 | (define-values (i j) (flomat-max-abs-index A)) 1182 | (flomat-ref A i j)) 1183 | 1184 | (define (flomat-zero? A [eps epsilon]) 1185 | ; set eps=#f to use normal equal? 1186 | (define val (flomat-max-abs-value A)) 1187 | (if eps (< (abs val) eps) (zero? val))) 1188 | 1189 | (define (flomat-ones? A [eps #f]) 1190 | ; is A a square matrix with ones on the main diaginal and zero elsewhere? 1191 | (define-param (m n a lda) A) 1192 | (and (= m n) 1193 | (for*/and ([j (in-range n)] 1194 | [i (in-range m)]) 1195 | (define aij (unsafe-ref a lda i j)) 1196 | (if (= i j) 1197 | (if eps 1198 | (fl<= (flabs (fl- aij 1.0)) eps) 1199 | (fl= aij 1.0)) 1200 | (if eps 1201 | (fl<= (flabs aij) eps) 1202 | (fl= aij 0.0)))))) 1203 | 1204 | 1205 | 1206 | ;;; 1207 | ;;; BLOCK LEVEL OPERATIONS 1208 | ;;; 1209 | 1210 | 1211 | 1212 | (define (calculate-row-height Xs) 1213 | ; Given a list of matrix-or-integer, calculate the row height. 1214 | ; #f means no common height 1215 | (define Ms (for/list ([X Xs] #:when (flomat? X)) X)) 1216 | (cond [(empty? Ms) 1] ; no matrices in Xs => no height => default is 1 1217 | [else (define hs (map flomat-m Ms)) 1218 | (if (apply = hs) (first hs) #f)])) 1219 | 1220 | 1221 | 1222 | 1223 | (define (flomat-augment C . Cs) 1224 | ; 1. Check that all have same number of rows. 1225 | (define-param (mc nc c ldc) C) 1226 | (define rows (map flomat-m (cons C Cs))) 1227 | (unless (andmap (λ (r) (= mc r)) rows) 1228 | (raise-arguments-error 1229 | 'flomat-augment 1230 | "all arguments must have same number of rows")) 1231 | ; 2. Find size for result matrix and allocate 1232 | (define m mc) 1233 | (define n (apply + (map flomat-n (cons C Cs)))) 1234 | (define a (alloc-flomat m n)) 1235 | (define lda m) 1236 | ; 3. Fill in blocks 1237 | (define j 0) 1238 | (for ([B (in-list (cons C Cs))]) 1239 | (define-param (mb nb b ldb) B) 1240 | (define aj (ptr-col a lda j)) 1241 | (unsafe-matrix-copy! mb nb b ldb aj lda) 1242 | (set! j (+ j nb))) 1243 | (flomat m n a lda)) 1244 | 1245 | (define (flomat-stack C . Cs) 1246 | ; 1. Check that all have same number of columns 1247 | (define-param (mc nc c ldc) C) 1248 | (define cols (map flomat-n (cons C Cs))) 1249 | (unless (andmap (λ (x) (= x nc)) cols) 1250 | (raise-arguments-error 1251 | 'flomat-stack 1252 | "all arguments must have same number of columns")) 1253 | ; 2. Find size for result matrix and allocate 1254 | (define rows (map flomat-m (cons C Cs))) 1255 | (define m (apply + rows)) 1256 | (define n nc) 1257 | (define a (alloc-flomat m n)) 1258 | (define lda m) 1259 | ; 3. Fill in blocks 1260 | (define i 0) 1261 | (for ([B (in-list (cons C Cs))]) 1262 | (define-param (mb nb b ldb) B) 1263 | (define ai (ptr-row a i)) 1264 | (unsafe-matrix-copy! mb nb b ldb ai lda) 1265 | (set! i (+ i mb))) 1266 | (flomat m n a lda)) 1267 | 1268 | (define (flomat-block-diagonal C . Cs) 1269 | (define rows (map flomat-m (cons C Cs))) 1270 | (define cols (map flomat-n (cons C Cs))) 1271 | ; 2. Find size for result matrix and allocate 1272 | (define m (apply + rows)) 1273 | (define n (apply + cols)) 1274 | (define a (alloc-flomat m n)) 1275 | (define lda m) 1276 | (memset a 0 0 (* m n) _double) 1277 | ; 3. Fill in blocks 1278 | (define i 0) 1279 | (define j 0) 1280 | (for ([B (in-list (cons C Cs))]) 1281 | (define-param (mb nb b ldb) B) 1282 | (define aij (ptr-elm a lda i j)) 1283 | (unsafe-matrix-copy! mb nb b ldb aij lda) 1284 | (set! i (+ i mb)) 1285 | (set! j (+ j nb))) 1286 | (flomat m n a lda)) 1287 | 1288 | (define (flomat-repeat A m [n m]) 1289 | ; Make a matrix with mxn blocks, each block is A. 1290 | (define row (apply flomat-augment (for/list ([i m]) A))) 1291 | (apply flomat-stack (for/list ([j n]) row))) 1292 | 1293 | 1294 | 1295 | ;;; 1296 | ;;; NORMS 1297 | ;;; 1298 | 1299 | (define-cblas* cblas_xnrm2 _x (s d) 1300 | ; L2-norm = (sqrt (sum (sqr X_i))), vector 1301 | (_fun (n : _int) (X : _flomat) (incX : _int) 1302 | -> _x)) 1303 | 1304 | #;(define (flomat-norm A) 1305 | ; (sqrt (sum (sqr A_ij))) 1306 | (define-param (m n a lda) A) 1307 | (cond 1308 | [(= lda m) 1309 | (cblas_dnrm2 (* m n) a 1)] 1310 | [(= n 1) 1311 | (cblas_dnrm2 m a 1)] 1312 | [else 1313 | (sqrt 1314 | (for/sum ([j (in-range n)]) 1315 | (expt (cblas_dnrm2 m (ptr-col a lda j) 1) 2)))])) 1316 | 1317 | (define-lapack dlange_ 1318 | (_fun (norm : (_ptr i _byte)) ; char M, 1, I, F 1319 | (m : (_ptr i _int)) 1320 | (n : (_ptr i _int)) 1321 | (a : _flomat) 1322 | (lda : (_ptr i _int)) 1323 | (work : _flomat) ; used only if norm is #\M 1324 | -> _double)) 1325 | 1326 | 1327 | 1328 | (define (flomat-norm A [norm-type 'frob]) 1329 | (define-param (m n a lda) A) 1330 | (define norm (char->integer 1331 | (match norm-type 1332 | [1 #\1] 1333 | ['inf #\I] 1334 | ['frob #\F] 1335 | ['max #\M] 1336 | [_ (error)]))) 1337 | (define lwork (if (equal? norm-type 'inf) (max 1 m) 1)) 1338 | (define W (make-flomat lwork 1)) 1339 | (define w (flomat-a W)) 1340 | (dlange_ norm m n a lda w)) 1341 | 1342 | 1343 | (define (flomat-norm1 A) ; maximum column sum (absolute values) 1344 | (flomat-norm A 1)) 1345 | 1346 | (define (flomat-norm-inf A) ; maximum row sum (absolute values) 1347 | (flomat-norm A 'inf)) 1348 | 1349 | (define (flomat-norm-frob A) ; Frobenius (sqrt of sum of squares) 1350 | (flomat-norm A 'frob)) 1351 | 1352 | (define (flomat-norm-max A) ; not real norm 1353 | (flomat-norm A 'max)) 1354 | 1355 | 1356 | ;;; 1357 | ;;; UNARY MATRIX OPERATIONS 1358 | ;;; 1359 | 1360 | (define (flomat-transpose A) 1361 | ; TODO: Measure: Is it faster to use 1362 | ; a loop with unsafe-vector-copy ? 1363 | (define-param (m n a lda) A) 1364 | (define AT (make-flomat n m)) 1365 | (define at (flomat-a AT)) 1366 | (for* ([j (in-range n)] 1367 | [i (in-range m)]) 1368 | (unsafe-set! at n j i (unsafe-ref a lda i j))) 1369 | AT) 1370 | 1371 | ;;; 1372 | ;;; Eigenvalues and Eigenvectors 1373 | ;;; 1374 | 1375 | (define-lapack dgeev_ 1376 | ; http://www.netlib.org/lapack/lapack-3.1.1/html/dgeev.f.html 1377 | ; DGEEV computes for an N-by-N real nonsymmetric matrix A, the 1378 | ; eigenvalues and, optionally, the left and/or right eigenvectors. 1379 | ; 1380 | ; The right eigenvector v(j) of A satisfies 1381 | ; A * v(j) = lambda(j) * v(j) 1382 | ; where lambda(j) is its eigenvalue. 1383 | ; The left eigenvector u(j) of A satisfies 1384 | ; u(j)**H * A = lambda(j) * u(j)**H 1385 | ; where u(j)**H denotes the conjugate transpose of u(j). 1386 | ; 1387 | ; The computed eigenvectors are normalized to have Euclidean norm 1388 | ; equal to 1 and largest component real. 1389 | 1390 | (_fun (jobvl : (_ptr i _byte)) ; char 'N' or 'V' 1391 | (jobvr : (_ptr i _byte)) ; char 'N' or 'V' 1392 | (n : (_ptr i _int)) ; order of a 1393 | (a : _flomat) ; io: the matrix 1394 | (lda : (_ptr i _int)) 1395 | (wr : _flomat) ; out: real part of eigenvalues 1396 | (wi : _flomat) ; out: imag part of eigenvalues 1397 | (vl : _flomat) ; left eigenvectors 1398 | (ldvl : (_ptr i _int)) 1399 | (vr : _flomat) ; right eigenvectors 1400 | (ldvr : (_ptr i _int)) 1401 | (work : _flomat) ; dim max(1,lwork) 1402 | (lwork : (_ptr i _int)) ; dim >= 4n 1403 | (info : (_ptr o _int)) 1404 | -> _void 1405 | -> info)) 1406 | 1407 | (define (flomat-eigenvalues-and-vectors! 1408 | A #:left [left? #f] #:right [right? #f] #:overwrite [overwrite? #f]) 1409 | (define A0 A) 1410 | (set! A (if overwrite? A (copy-flomat A))) 1411 | (define jobvl (char->integer (if left? #\V #\N))) 1412 | (define jobvr (char->integer (if right? #\V #\N))) 1413 | (define-param (m n a lda) A) 1414 | (define WR (make-flomat n 1)) 1415 | (define WI (make-flomat n 1)) 1416 | (define wr (flomat-a WR)) 1417 | (define wi (flomat-a WI)) 1418 | (define VL (if left? (make-flomat n n) (make-flomat 1 1))) 1419 | (define VR (if right? (make-flomat n n) (make-flomat 1 1))) 1420 | (define-param (mvl nvl vl ldvl) VL) 1421 | (define-param (mvr nvr vr ldvr) VR) 1422 | (define lwork (max 1 (* 4 n))) 1423 | (define WORK (make-flomat lwork 1)) 1424 | (define work (flomat-a WORK)) 1425 | (define info (dgeev_ jobvl jobvr n a lda wr wi vl ldvl vr ldvr work lwork)) 1426 | ; (when (> info 0) (displayln "Warning: no convergence")) 1427 | (values A0 WR WI VL VR info)) 1428 | 1429 | (define (real+imaginary->vector X Y) 1430 | ; Convert two vectors of same length with real and imaginary 1431 | ; part to a Racket vector of imaginary numbers. 1432 | (define who 'real+imaginary->vector) 1433 | (set! X (result-flcolumn X)) 1434 | (set! Y (result-flcolumn Y)) 1435 | (define-param (mx nx x ldx) X) 1436 | (define-param (my ny y ldy) Y) 1437 | (unless (and (= mx my) (= nx ny 1)) 1438 | (raise-argument-error 1439 | who "The two inputs must be vectors of the same length" (list X Y))) 1440 | (for/vector #:length mx 1441 | ([xi (in-col X)] 1442 | [yi (in-col Y)]) 1443 | (if (zero? yi) 1444 | xi 1445 | (make-rectangular xi yi)))) 1446 | 1447 | 1448 | 1449 | 1450 | 1451 | ;;; 1452 | ;;; MATRIX DECOMPOSITIONS 1453 | ;;; 1454 | 1455 | ;;; Pivots 1456 | 1457 | (struct pivots (ps)) ; ps is a u32vector 1458 | ; ps[i]=j <=> row i and row j-1 is swapped 1459 | ; Note: Fortran counts from 1 ! 1460 | 1461 | (define (unsafe-pivot-ref ps i) 1462 | ; Fortran indices are 1-based. 1463 | (- (u32vector-ref ps i) 1)) 1464 | 1465 | (define (pivots-ref Ps i) 1466 | (unsafe-pivot-ref (pivots-ps Ps) i)) 1467 | 1468 | (define (pivots-length Ps) 1469 | (u32vector-length (pivots-ps Ps))) 1470 | 1471 | (define (pivots->flomat Ps) 1472 | ; return the permuation matrix 1473 | (define ps (pivots-ps Ps)) 1474 | (define k (u32vector-length ps)) 1475 | (define A (make-flomat k k 0.0)) 1476 | (define-param (m n a lda) A) 1477 | ; introduce ones on diagonal 1478 | (for ([i (in-range m)]) 1479 | (unsafe-set! a lda i i 1.0)) 1480 | ; perform row permutations 1481 | (for ([i (in-range (- m 1) -1 -1)]) 1482 | (define i* (unsafe-pivot-ref ps i)) 1483 | (unless (= i i*) 1484 | (flomat-swap-rows! A i i*))) 1485 | A) 1486 | 1487 | (define (pivots-sign Ps) 1488 | ; return the sign of the corresponding permuation 1489 | (define ps (pivots-ps Ps)) 1490 | (define n (u32vector-length ps)) 1491 | (for/product ([i (in-range n)]) 1492 | (define i* (unsafe-pivot-ref ps i)) 1493 | (if (= i i*) 1 -1))) 1494 | 1495 | ;;; 1496 | ;;; PLU Factorization 1497 | ;;; 1498 | 1499 | ; A = P L U 1500 | ; where P is a permutation matrix, 1501 | ; L is lower triangular 1502 | ; U is upper triangular. 1503 | ; Note: U is the result of Gauss elimation. 1504 | 1505 | (define-lapack dgetrf_ 1506 | ; http://www.netlib.org/lapack/double/dgetrf.f 1507 | ; DGETRF computes an LU factorization of a general M-by-N matrix A 1508 | ; using partial pivoting with row interchanges. 1509 | ; The factorization has the form 1510 | ; A = P * L * U 1511 | ; where P is a permutation matrix, L is lower triangular with unit 1512 | ; diagonal elements (lower trapezoidal if m > n), and U is upper 1513 | ; triangular (upper trapezoidal if m < n). 1514 | 1515 | ; Algorithm: Gaussian elimination with partial pivoting 1516 | (_fun (m : (_ptr i _int)) 1517 | (n : (_ptr i _int)) 1518 | (a : _flomat) 1519 | (lda : (_ptr i _int)) 1520 | (ipiv : (_u32vector o (ptr-ref m _int))) 1521 | (info : (_ptr o _int)) 1522 | -> _void 1523 | -> (values (pivots ipiv) info))) 1524 | 1525 | (define (flomat-lu! A) 1526 | (define-param (m n a lda) A) 1527 | (dgetrf_ m n a lda)) 1528 | 1529 | (define (flomat-plu A) 1530 | (define B (copy-flomat A)) 1531 | (define-values (ps info) (flomat-lu! B)) 1532 | (define P (pivots->flomat ps)) 1533 | (define L (flomat-extract-lower/ones B)) 1534 | (define U (flomat-extract-upper B)) 1535 | ; TODO: What to do with info? 1536 | (values P L U)) 1537 | 1538 | (define (flomat-extract-upper A) 1539 | ; extract the upper matrix, 1540 | ; including the diagonal 1541 | ; discard below diagonal 1542 | (define-param (m n) A) 1543 | (define k (min m n)) 1544 | (define U (make-flomat k k)) 1545 | ; TODO: use unsafe-ref or unsafe-vector-copy 1546 | (for* ([j (in-range 0 k)] 1547 | [i (in-range (min (+ 1 j) k))]) 1548 | (flomat-set! U i j (flomat-ref A i j))) 1549 | U) 1550 | 1551 | (define (flomat-extract-lower/ones A) 1552 | ; extract the lower matrix, 1553 | ; and insert ones on diagonal 1554 | (define L (copy-flomat A)) 1555 | (define-param (m n) A) 1556 | ; TODO: use unsafe-ref or unsafe-vector-copy 1557 | (for* ([j (in-range n)] 1558 | [i (in-range 0 j)]) 1559 | (flomat-set! L i j 0)) 1560 | (for* ([j (in-range (min m n))]) 1561 | (flomat-set! L j j 1.0)) 1562 | L) 1563 | 1564 | (define (flomat-extract-lower A) 1565 | ; extract the lower matrix including the diagonal 1566 | (define L (copy-flomat A)) 1567 | (define-param (m n) A) 1568 | ; TODO: use unsafe-ref or unsafe-vector-copy 1569 | (for* ([j (in-range 1 n)] 1570 | [i (in-range 0 j)]) 1571 | (flomat-set! L i j 0)) 1572 | L) 1573 | 1574 | ;;; SVD - Singular Value Decomposition 1575 | 1576 | (define-lapack dgesvd_ 1577 | ; compute SVD 1578 | ; A = U * SIGMA * transpose(V) 1579 | ; SIGMA is an mxn matrix, 1580 | ; Algorith: QR used 1581 | (_fun (jobu : (_ptr i _byte)) ; char: a, s, o or n 1582 | (jobvt : (_ptr i _byte)) ; char 1583 | (m : (_ptr i _int)) ; rows in A 1584 | (n : (_ptr i _int)) ; cols in A 1585 | (a : _flomat) ; io 1586 | (lda : (_ptr i _int)) 1587 | (s : _flomat) ; min(m,n) x 1 1588 | (u : _flomat) ; mxm if jobu = a 1589 | (ldu : (_ptr i _int)) 1590 | (vt : _flomat) ; nxn if jobvt = a 1591 | (ldvt : (_ptr i _int)) ; 1592 | (work : _flomat) ; dim max(1,lwork) 1593 | (lwork : (_ptr i _int)) ; 1594 | (info : (_ptr o _int)) 1595 | -> _void 1596 | -> info)) 1597 | 1598 | (define-lapack dgesdd_ 1599 | ; compute SVD 1600 | ; A = U * SIGMA * transpose(V) 1601 | ; SIGMA is an mxm matrix, 1602 | ; Algorithm: Divide and conquer with QR used for small 1603 | ; This is the recommended algorithm, but uses 1604 | ; more work space. 1605 | (_fun (jobu : (_ptr i _byte)) ; char: a, s, o or n 1606 | (jobvt : (_ptr i _byte)) 1607 | (m : (_ptr i _int)) ; rows in A 1608 | (n : (_ptr i _int)) ; cols in A 1609 | (a : _flomat) ; io 1610 | (lda : (_ptr i _int)) 1611 | (s : _flomat) ; min(m,n) x 1 1612 | (u : _flomat) ; mxm if jobu = a 1613 | (ldu : (_ptr i _int)) 1614 | (vt : _flomat) ; nxn if jobvt = a 1615 | (ldvt : (_ptr i _int)) ; 1616 | (work : _flomat) ; dim max(1,lwork) 1617 | (lwork : (_ptr i _int)) 1618 | (info : (_ptr o _int)) 1619 | -> _void 1620 | -> info)) 1621 | 1622 | (define (flomat-svd! A) 1623 | ; TODO: Use lwork=-1 to get size of work 1624 | (define-param (m n a lda) A) 1625 | (define superb (- (min m n) 1)) 1626 | (define U (make-flomat m m)) 1627 | (define S (make-flomat (min m n) 1)) 1628 | (define VT (make-flomat n n)) 1629 | (define u (flomat-a U)) 1630 | (define s (flomat-a S)) 1631 | (define vt (flomat-a VT)) 1632 | (define lwork (* 10 (max m n))) ; conservative estimate 1633 | (define W (make-flomat lwork lwork)) 1634 | (define w (flomat-a W)) 1635 | (define ca (char->integer #\A)) 1636 | (define info (dgesvd_ ca ca m n a lda s u m vt n w lwork)) 1637 | ; ? TODO: Best way to return error ? 1638 | ; (displayln (list 'info-from-svd info)) 1639 | ; (when (> info 0) (displayln "Warning: no convergence")) 1640 | ; S is column vector of singular values 1641 | ; Turn S into SIGMA (mxn) by placing the values of S on the diagonal. 1642 | (values U S VT)) 1643 | 1644 | (define (flomat-svd A) 1645 | (flomat-svd! (copy-flomat A))) 1646 | 1647 | (define (flomat-singular-values A) 1648 | (define B (copy-flomat A)) 1649 | (define-values (S V D) (flomat-svd! B)) 1650 | (flomat->vector V)) 1651 | 1652 | (define (flomat-diagonal-from-singular-values m n S [reciproc? #f]) 1653 | (define A (flomat-zeros m n)) 1654 | (for ([i (in-range m)] 1655 | [s (in-col S)]) 1656 | (flomat-set! A i i (if reciproc? (/ 1 s) s))) 1657 | A) 1658 | 1659 | (define (flomat-pseudo-inverse A) 1660 | (define-param (m n) A) 1661 | (define-values (U S VT) (flomat-svd A)) 1662 | (define Σ (flomat-diagonal-from-singular-values m n S #t)) 1663 | (define A+ (flomat* (flomat-transpose VT) (flomat* (transpose Σ) (flomat-transpose U)))) 1664 | A+) 1665 | 1666 | 1667 | ;;; QR Factorization 1668 | ; dgeqrfp returns positive entries on the diagonal 1669 | ; for some reason this is missing on macOS, so now dgeqrf is used instead 1670 | #;(define-lapack dgeqrfp_ 1671 | ; Compute A = Q*R 1672 | ; Use dorgqr to generate matrix from output 1673 | (_fun (m : (_ptr i _int)) ; rows in A 1674 | (n : (_ptr i _int)) ; cols in A 1675 | (a : _flomat) ; io 1676 | (lda : (_ptr i _int)) 1677 | (tau : _flomat) ; min(m,n)x1 1678 | (work : _flomat) ; dim max(1,lwork) (x1) 1679 | (lwork : (_ptr i _int)) ; >=max(1,n) best with >=n * blocksize 1680 | (info : (_ptr o _int)) ; 1681 | -> _void 1682 | -> info)) 1683 | 1684 | (define-lapack dgeqrf_ 1685 | ; Compute A = Q*R 1686 | ; Use dorgqr to generate matrix from output 1687 | (_fun (m : (_ptr i _int)) ; rows in A 1688 | (n : (_ptr i _int)) ; cols in A 1689 | (a : _flomat) ; io 1690 | (lda : (_ptr i _int)) 1691 | (tau : _flomat) ; min(m,n)x1 1692 | (work : _flomat) ; dim max(1,lwork) (x1) 1693 | (lwork : (_ptr i _int)) ; >=max(1,n) best with >=n * blocksize 1694 | (info : (_ptr o _int)) 1695 | -> _void 1696 | -> info)) 1697 | 1698 | 1699 | (define-lapack dorgqr_ 1700 | ; generate matrix from output of dgeqrf 1701 | (_fun (m : (_ptr i _int)) ; rows in Q 1702 | (n : (_ptr i _int)) ; cols in Q m>=n>=0 1703 | (k : (_ptr i _int)) ; number of reflectors 1704 | (a : _flomat) ; io 1705 | (lda : (_ptr i _int)) 1706 | (tau : _flomat) ; min(m,n)x1 1707 | (work : _flomat) ; dim max(1,lwork) (x1) 1708 | (lwork : (_ptr i _int)) ; >=max(1,n) best with >=n * blocksize 1709 | (info : (_ptr o _int)) ; 1710 | -> _void 1711 | -> info)) 1712 | 1713 | 1714 | (define (flomat-qr B) 1715 | (define A (copy-flomat B)) 1716 | (define-param (m n a lda) A) 1717 | (define k (min m n)) 1718 | (define tau (make-flomat k 1)) 1719 | (define atau (flomat-a tau)) 1720 | ; first call dgeqrf_ to get a working size 1721 | (define work0 (make-flomat 1 1)) 1722 | (define info0 (dgeqrf_ m n a lda atau (flomat-a work0) -1)) 1723 | (define lwork (inexact->exact (flomat-ref work0 0 0))) ; 64 is a typical value 1724 | ; now make the real call 1725 | (define work (make-flomat lwork 1)) 1726 | (define awork (flomat-a work)) 1727 | (define info (dgeqrf_ m n a lda atau awork lwork)) 1728 | (define R (flomat-extract-upper A)) 1729 | (define info1 (dorgqr_ m n k a lda atau awork lwork)) 1730 | ; ? TODO: what to do with info 1731 | (values A R)) 1732 | 1733 | ; old version used dgeqrfp 1734 | #;(define (flomat-qr B) 1735 | (define A (copy-flomat B)) 1736 | (define-param (m n a lda) A) 1737 | (define k (min m n)) 1738 | (define tau (make-flomat k k)) 1739 | (define atau (flomat-a tau)) 1740 | (define lwork (* 64 n)) ; 64 block size guess 1741 | (define work (make-flomat lwork 1)) 1742 | (define awork (flomat-a work)) 1743 | ; TODO: Use lwork=-1 to get optimal lwork size 1744 | (define info (dgeqrf_ m n a lda atau awork lwork)) 1745 | (define R (flomat-extract-upper A)) 1746 | (define info1 (dorgqr_ m n k a lda atau awork lwork)) 1747 | ; ? TODO: what to do with info 1748 | (values A R)) 1749 | 1750 | ;;; 1751 | ;;; INVERSE 1752 | ;;; 1753 | 1754 | (define-lapack dgetri_ 1755 | ; http://www.netlib.org/lapack/double/dgetri.f 1756 | ; DGETRI computes the inverse of a matrix using the LU factorization 1757 | ; computed by DGETRF. 1758 | ; This method inverts U and then computes inv(A) by solving the system 1759 | ; inv(A)*L = inv(U) for inv(A). 1760 | (_fun (n : (_ptr i _int)) 1761 | (a : _flomat) 1762 | (lda : (_ptr i _int)) 1763 | (ipiv : _u32vector) 1764 | (work : (_or-null _flomat)) ; output 1765 | (lwork : (_ptr i _int)) 1766 | (info : (_ptr o _int)) 1767 | -> _void 1768 | -> (values info work))) 1769 | 1770 | (define (flomat-inverse! A) 1771 | (check-square 'flomat-inverse! A) 1772 | ; TODO: this works, but call dgetri with lwork=-1 1773 | ; to get optimal size of workspace in first 1774 | ; entry of the work array. 1775 | (define-param (m n a lda) A) 1776 | (define work (copy-flomat A)) 1777 | (define-values (ipiv info) (flomat-lu! A)) 1778 | (dgetri_ m a lda (pivots-ps ipiv) (flomat-a work) (* m m)) 1779 | A) 1780 | 1781 | (define (flomat-inverse A) 1782 | (flomat-inverse! (copy-flomat A))) 1783 | 1784 | 1785 | ;;; 1786 | ;;; Cholesky Factorization 1787 | ;;; 1788 | 1789 | ; A = U^T U or A = L L^T 1790 | ; where L is lower triangular 1791 | ; U is upper triangular. 1792 | ; and A is a square, real symmetric, positive definite matrix A. 1793 | 1794 | (define-lapack dpotrf_ 1795 | ; http://www.netlib.org/lapack/double/dpotrf.f 1796 | ; DPOTRF computes the Cholesky factorization of a real symmetric 1797 | ; positive definite matrix A. 1798 | ; 1799 | ; The factorization has the form 1800 | ; A = U^T * U if UPLO = 'U', or 1801 | ; A = L * L^T if UPLO = 'L', 1802 | ; where U is an upper triangular matrix and L is lower triangular. 1803 | (_fun (uplo : (_ptr i _byte)) ; 'U' or 'L' 1804 | (n : (_ptr i _int)) 1805 | (a : _flomat) 1806 | (lda : (_ptr i _int)) 1807 | (info : (_ptr o _int)) 1808 | -> _void 1809 | -> info)) 1810 | 1811 | (define ascii-U (char->integer #\U)) 1812 | (define ascii-L (char->integer #\L)) 1813 | 1814 | (define (flomat-cholesky! A [upper? #f]) 1815 | (check-square flomat-cholesky! A) 1816 | (define-param (m n a lda) A) 1817 | (define uplo (if upper? ascii-U ascii-L)) 1818 | (define info (dpotrf_ uplo m a lda)) 1819 | info) 1820 | 1821 | (define (flomat-cholesky A [upper? #f]) 1822 | (define B (copy-flomat A)) 1823 | (define info (flomat-cholesky! B upper?)) 1824 | (if upper? 1825 | (flomat-extract-upper B) 1826 | (flomat-extract-lower B))) 1827 | 1828 | ;;; 1829 | ;;; INVARIANTS 1830 | ;;; 1831 | 1832 | (define (flomat-trace A) 1833 | (check-square 'matrix-trace A) 1834 | (for/sum ([i (in-range (flomat-m A))]) 1835 | (flomat-ref A i i))) 1836 | 1837 | (define (flomat-determinant-from-plu LU pivots) 1838 | ; compute determinant using output from PLU 1839 | ; factorization 1840 | (* (pivots-sign pivots) 1841 | (for/product ([i (in-range (flomat-m LU))]) 1842 | (flomat-ref LU i i)))) 1843 | 1844 | (define (flomat-determinant A) 1845 | (check-square 'matrix-determinant A) 1846 | (define LU (copy-flomat A)) 1847 | (define-values (pivots info) (flomat-lu! LU)) 1848 | (flomat-determinant-from-plu LU pivots)) 1849 | 1850 | (define (count-columns-without-pivot pivots) 1851 | ; TODO: Does this strategy work? 1852 | (define ps (pivots-ps pivots)) 1853 | (define m (u32vector-length ps)) 1854 | (define with 1855 | (for/sum ([i (in-range m)]) 1856 | (define i* (- (u32vector-ref ps i) 1)) 1857 | (if (= i i*) 0 1))) 1858 | (- m with)) 1859 | 1860 | (define (flomat-rank A) 1861 | ; See answer: http://scicomp.stackexchange.com/questions/1861/understanding-how-numpy-does-svd 1862 | ; rank = dimension of column space = dimension of row space 1863 | ; = number of non-zero singular values 1864 | (define-values (U Σ VT) (flomat-svd A)) 1865 | ; ? TODO: check info from -svd... 1866 | (for/sum ([i (in-range (flomat-m Σ))] 1867 | ; TODO: Which value for epsilon is correct? 1868 | #:unless (< (abs (flomat-ref Σ i 0)) epsilon)) 1869 | 1)) 1870 | 1871 | (define (flomat-nullity A) 1872 | ; nullity = dimension of null space 1873 | (define-param (m n) A) 1874 | (- n (flomat-rank A))) 1875 | 1876 | ;;; 1877 | ;;; VECTOR OPERATIONS 1878 | ;;; 1879 | 1880 | ; Column vectors are represented as mx1 matrices. 1881 | ; All operations working on column vectors accept 1882 | ; standard vectors as input. Outputs are always 1883 | ; in the form of a mx1 matrix. 1884 | 1885 | (define (vector->flcolumn v) 1886 | (define m (vector-length v)) 1887 | (vector->flomat m 1 v)) 1888 | 1889 | (define (vector->flrow v) 1890 | (define n (vector-length v)) 1891 | (vector->flomat 1 n v)) 1892 | 1893 | (define (list->flcolumn xs) 1894 | (vector->flcolumn (list->vector xs))) 1895 | 1896 | (define (result-flcolumn c) 1897 | ; convert output to mx1 matrix 1898 | (if (vector? c) 1899 | (vector->flcolumn c) 1900 | (if (list? c) 1901 | (list->flcolumn c) 1902 | c))) 1903 | 1904 | (define (flcolumn . xs) 1905 | ; TODO: skip intermediary vector 1906 | (vector->flcolumn 1907 | (list->vector xs))) 1908 | 1909 | (define (flcolumn-size v) 1910 | (if (vector? v) 1911 | (vector-length v) 1912 | (flomat-m v))) 1913 | 1914 | ;;; Dot Product 1915 | 1916 | (define-cblas* cblas_xdot _x (s d) 1917 | ; dot product, vectors 1918 | (_fun (n : _int) 1919 | (X : _flomat) (incX : _int) 1920 | (Y : _flomat) (incY : _int) 1921 | -> _x)) 1922 | 1923 | (define (unsafe-vector-product n x y) 1924 | (cblas_ddot n x 1 y 1)) 1925 | 1926 | (define (flcolumn-dot X Y) 1927 | (set! X (result-flcolumn X)) 1928 | (set! Y (result-flcolumn Y)) 1929 | (define-param (m _ x ldx) X) 1930 | (define-param (s __ y ldy) Y) 1931 | (unless (= m s) 1932 | (error 1933 | 'column-dot 1934 | "expected two mx1 matrices with same number of rows, got ~a and ~a" 1935 | X Y)) 1936 | (unsafe-vector-product m x y)) 1937 | 1938 | (define fldot flcolumn-dot) 1939 | 1940 | (define (flcolumn-norm v) 1941 | (define-param (m _ a lda) (result-flcolumn v)) 1942 | (cblas_dnrm2 m a 1)) 1943 | 1944 | (define (flcolumn-unit m i) 1945 | ; return i'th unit vector 1946 | (define U (make-flomat m 1 0.0)) 1947 | (flomat-set! U i 0 1.0) 1948 | U) 1949 | 1950 | (define (flscale-column s A) 1951 | (define s* (real->double-flonum s)) 1952 | (cond 1953 | [(vector? A) 1954 | (define m (vector-length A)) 1955 | (vector->flcolumn 1956 | (for/vector #:length m 1957 | ([i (in-range m)]) 1958 | (* s* (vector-ref A i))))] 1959 | [else 1960 | (flomat-scale s A)])) 1961 | 1962 | (define (flcolumn+ v w) 1963 | (define m (flcolumn-size v)) 1964 | (define n (flcolumn-size w)) 1965 | (unless (= m n) 1966 | (error 1967 | 'flcolumn+ 1968 | "expected two column vectors of the same length, got ~a and ~a" v w)) 1969 | (cond 1970 | [(and (vector? v) (vector? w)) 1971 | (vector->flcolumn 1972 | (for/vector #:length (+ m n) 1973 | ([i (in-range 0 m)] 1974 | [x (in-vector v)] 1975 | [y (in-vector w)]) 1976 | (+ x y)))] 1977 | [else 1978 | (flomat+ (result-flcolumn v) (result-flcolumn w))])) 1979 | 1980 | (define (flcolumn-projection v w) 1981 | ; Return the projection og vector v on vector w. 1982 | (let ([w.w (fldot w w)]) 1983 | (if (zero? w.w) 1984 | (error 'flcolumn-projection "projection on the zero vector not defined") 1985 | (flscale-column (/ (fldot v w) w.w) w)))) 1986 | 1987 | (define (flcolumn-projection-on-unit v w) 1988 | ; Return the projection of vector v on a unit vector w. 1989 | (flscale-column (flcolumn-dot v w) w)) 1990 | 1991 | (define (flcolumn-normalize w) 1992 | ; Return unit vector with same direction as v. 1993 | ; If v is the zero vector, the zero vector is returned. 1994 | (define norm (flcolumn-norm w)) 1995 | (cond [(zero? norm) w] 1996 | [else (flscale-column (/ norm) w)])) 1997 | 1998 | (define (flzero-column-vector? v [eps #f]) 1999 | (define val (flomat-max-abs-value (result-flcolumn v))) 2000 | (if eps (< (abs val) eps) (zero? val))) 2001 | 2002 | ; (flprojection-on-orthogonal-basis v bs) 2003 | ; Project the vector v on the orthogonal basis vectors in bs. 2004 | ; The basis bs must be either the column vectors of a matrix 2005 | ; or a sequence of column-vectors. 2006 | (define (flprojection-on-orthogonal-basis v bs) 2007 | (if (empty? bs) 2008 | (error 'flprojection-on-orthogonal-basis 2009 | "received empty list of basis vectors") 2010 | (for/flomat-sum([b (in-list bs)]) 2011 | (flcolumn-projection v (result-flcolumn b))))) 2012 | 2013 | ; Project the vector v on the orthonormal basis vectors in bs. 2014 | ; The basis bs must be either the column vectors of a matrix 2015 | ; or a sequence of column-vectors. 2016 | (define (flprojection-on-orthonormal-basis v bs) 2017 | (for/flomat-sum 2018 | ([b bs]) 2019 | (flomat-scale (flcolumn-dot v b) b))) 2020 | 2021 | 2022 | ; (flgram-schmidt-orthogonal ws) 2023 | ; Given a list ws of flcolumn vectors, produce 2024 | ; an orthogonal basis for the span of the 2025 | ; vectors in ws. 2026 | (define (flgram-schmidt-orthogonal ws1) 2027 | (define ws (map result-flcolumn ws1)) 2028 | (cond 2029 | [(null? ws) '()] 2030 | [(null? (cdr ws)) (list (car ws))] 2031 | [else 2032 | (define (loop vs ws) 2033 | (cond [(null? ws) vs] 2034 | [else 2035 | (define w (car ws)) 2036 | (let ([w-proj (flprojection-on-orthogonal-basis w vs)]) 2037 | ; Note: We project onto vs (not on the original ws) 2038 | ; in order to get numerical stability. 2039 | (let ([w-minus-proj (flomat- w w-proj)]) 2040 | (if (flzero-column-vector? w-minus-proj) 2041 | (loop vs (cdr ws)) ; w in span{vs} => omit it 2042 | (loop (cons (flomat- w w-proj) vs) (cdr ws)))))])) 2043 | (reverse (loop (list (car ws)) (cdr ws)))])) 2044 | 2045 | ; (flgram-schmidt-orthonormal ws) 2046 | ; Given a list ws of flcolumn vectors, produce 2047 | ; an orthonormal basis for the span of the 2048 | ; vectors in ws. 2049 | (define (flgram-schmidt-orthonormal ws) 2050 | (map flcolumn-normalize 2051 | (flgram-schmidt-orthogonal ws))) 2052 | 2053 | ; (flprojection-on-subspace v ws) 2054 | ; Returns the projection of v on span{w_i}, w_i in ws. 2055 | (define (flprojection-on-subspace v ws) 2056 | (flprojection-on-orthogonal-basis 2057 | v (flgram-schmidt-orthogonal ws))) 2058 | 2059 | ;;; 2060 | ;;; SUMS 2061 | ;;; 2062 | 2063 | 2064 | (define unsafe-sum 2065 | ;; (unsafe-sum n a lda) 2066 | ; Beginning from addrees a, sum every lda element in double array. 2067 | ; 2068 | ; There is no `sum` operation in BLAS or LAPCK, so we compute the dot product 2069 | ; between the vector and a vector consisting only of ones. 2070 | ; Also we don't need to allocate a vector with only ones, we simply use ld=0. 2071 | (let () 2072 | (define one (cast (f64vector->cpointer (f64vector 1.0)) _pointer _flomat)) 2073 | (λ (n a lda) 2074 | (cblas_ddot n a lda one 0)))) 2075 | 2076 | (define (flomat-column-sum A j) 2077 | ; sum of all entries in column j 2078 | (define who 'flomat-column-sum) 2079 | (check-flomat who A) 2080 | (check-legal-column who j A) 2081 | (define-param (m n a lda) A) 2082 | (define aj (ptr-elm a lda 0 j)) ; address of j'th column 2083 | (unsafe-sum m aj 1)) 2084 | 2085 | (define (flomat-row-sum A i) 2086 | ; sum of all entries in row i 2087 | (define who 'flomat-row-sum) 2088 | (check-flomat who A) 2089 | (check-legal-row who i A) 2090 | (define-param (m n a lda) A) 2091 | (define ai (ptr-elm a lda i 0)) 2092 | (unsafe-sum n ai lda)) 2093 | 2094 | (define (flomat-column-sums A) 2095 | ; row vector of all column sums 2096 | (check-flomat 'flomat-column-sums A) 2097 | (define n (ncols A)) 2098 | (for/flomat 1 n ([j (in-range n)]) 2099 | (flomat-column-sum A j))) 2100 | 2101 | (define (flomat-row-sums A) 2102 | ; column vector of all row sums 2103 | (check-flomat 'flomat-row-sums A) 2104 | (define m (nrows A)) 2105 | (for/flomat m 1 ([i (in-range m)]) 2106 | (flomat-row-sum A i))) 2107 | 2108 | ;;; 2109 | ;;; EQUATION SOLVING 2110 | ;;; 2111 | 2112 | (define-lapack dgesv_ ; Double, GEneral, Solve ... 2113 | ; Compute solution to AX=B, where 2114 | ; A is nxn and X and B are n x nrhs 2115 | (_fun (n : (_ptr i _int)) 2116 | (nrhs : (_ptr i _int)) 2117 | (a : _flomat) ; io 2118 | (lda : (_ptr i _int)) 2119 | (ipiv : (_u32vector o (ptr-ref n _int))) 2120 | (b : _flomat) ; io 2121 | (ldb : (_ptr i _int)) 2122 | (info : (_ptr o _int)) 2123 | -> _void 2124 | -> info)) 2125 | 2126 | (define (flomat-solve A b) 2127 | ; A matrix, b flcolumn 2128 | ; called mldivide aka matrix left divide in Matlab 2129 | (define-param (m n a lda) (copy-flomat A)) 2130 | (define bout (copy-flomat (result-flcolumn b))) 2131 | (define info (dgesv_ n 1 a lda (flomat-a bout) m)) 2132 | ; ? TODO Handle info 2133 | bout) 2134 | 2135 | (define (flomat-solve-many! A B) 2136 | ; A matrix, b flcolumn 2137 | ; A and B are overwritten 2138 | (define-param (m n a lda) A) 2139 | (define-param (_ nrhs b ldb) B) 2140 | (define info (dgesv_ n nrhs a lda b ldb)) 2141 | ; (displayln (list 'flomat-solve-many! info)) 2142 | ; ? TODO: handle info 2143 | (values B)) 2144 | 2145 | (define (flomat-solve-many A bs-or-B) 2146 | ; A matrix, b flcolumn 2147 | (define-param (m n) A) 2148 | (define B (if (list? bs-or-B) 2149 | (apply flomat-augment 2150 | (map result-flcolumn bs-or-B)) 2151 | (copy-flomat bs-or-B))) 2152 | (flomat-solve-many! (copy-flomat A) B)) 2153 | 2154 | (define (flomat->columns A) 2155 | (define-param (m n) A) 2156 | (for/list ([j (in-range n)]) 2157 | (flomat-column A j))) 2158 | 2159 | (define flomat-left-divide flomat-solve-many) 2160 | 2161 | 2162 | ;;; 2163 | ;;; LINEAR LEAST SQUARES PROBLEM 2164 | ;;; 2165 | 2166 | (define-lapack dgelsd_ ; Double, GEneral, Least Square 2167 | ; minimize 2-norm(| b - A*x |) where b and x are columns in B and X 2168 | ; See http://www.netlib.org/lapack/lapack-3.1.1/html/dgelsd.f.html 2169 | ; B is overwritten with the result. 2170 | (_fun (m : (_ptr i _int)) ; m>=0 rows of A 2171 | (n : (_ptr i _int)) ; n>=0 cols of A 2172 | (nrhs : (_ptr i _int)) ; number of rhs (number of cols in B and X) 2173 | (a : _flomat) ; io ; is overwritten 2174 | (lda : (_ptr i _int)) ; lda >= max(1,m) 2175 | (b : _flomat) ; io ; mxnrhs 2176 | (ldb : (_ptr i _int)) ; ldb >= max(1,max(m,n)) 2177 | (s : _flomat) ; min(m,n) x 1 singular values of A in decreasing order 2178 | ; ; the condition number of A is 2-norm of S(1)/S(min(m,n) 2179 | (rcond : (_ptr i _double)) ; singular values S(i)<=rcond*S(1) is treated as 0. 2180 | ; ; if rcond<0 then machine precision is used instead 2181 | (rank : (_ptr o _int)) ; effective rank of A (number of non-zero singular values 2182 | ; ; greater than rcond*s(1) 2183 | (work : _flomat) ; dim max(1,lwork) x1 2184 | (lwork : (_ptr i _int)) ; dimension of work - use work query to find proper size 2185 | (iwork : _pointer) ; array of int dim max(1,liwork)x1 2186 | ; ; LIWORK >= 3 * MINMN * NLVL + 11 * MINMN, 2187 | ; ; where MINMN = MIN( M,N ). 2188 | (info : (_ptr o _int)) ; =0 succes exit, >0 svd failed to converge 2189 | -> _void 2190 | -> (values info rank))) 2191 | 2192 | (define (lstsq A B) 2193 | (define-param (mb nb aB ldB ) B) ; nb = nrhs 2194 | ; Least squares solution to |Ax-b| minimizing |x| for each column in B. 2195 | ; The common case is m>=n and rank(A)=n in which we get a solution to an overdetermined system. 2196 | ; If mm) then we need 2204 | ; insert some zeros below B. 2205 | 2206 | ; In the text the case n>m one sees the driver dgelsd expects B 2207 | ; to have ldb>=max(1,m,n) normally ldb>=rows in B = m , 2208 | ; so if n= nb m) (copy-flomat B)] 2215 | [else (make-flomat m nb)])) 2216 | (define-param (_ nrhs b ldb) X) 2217 | (when (< nb m) 2218 | ; The result vectors are stored in B (or the copy of B). 2219 | ; If the result vectors are B was enlarged, so we need to copy B into X 2220 | (unsafe-matrix-copy! mb nb aB ldB b ldb)) 2221 | ; (displayln (list ldb (max m n) (= ldb (max m n)))) 2222 | ; 3. Allocate array for the singular values 2223 | (define S (make-flomat (min m n) 1)) 2224 | (define s (flomat-a S)) 2225 | ; 4. The condition number -1.0 indicates machine precision. 2226 | ; Note: Numpy uses machine precision times mxn. 2227 | (define rcond -1.0) 2228 | ; 5. The size of the working are is determined by calling the driver dgelsd with lwork=-1. 2229 | (define work0 (make-flomat 1 1)) ; first entry will contain optimal length of work 2230 | (define awork0 (flomat-a work0)) 2231 | (define lwork0 -1) 2232 | (define iwork0 (malloc 1 _int 'atomic)) 2233 | ; (displayln (list m n nrhs a lda b ldb s rcond awork0 lwork0 iwork0)) 2234 | (define-values (__ ___) ; 2235 | (dgelsd_ m n nrhs a lda b ldb s rcond awork0 lwork0 iwork0)) 2236 | (define lwork (inexact->exact (flomat-ref work0 0 0))) 2237 | ; (displayln (list 'lwork lwork)) 2238 | ; 6. Prepare the actual call 2239 | ;(define nlvl (max 0 (+ 1 (ceiling (log2 (/ (min m n) (+ SMLSIZ 1))))))) 2240 | (define nlvl 32) ; 2241 | (define liwork (max 1 (+ (* 3 (min m n) nlvl) (* 11 (min m n))))) 2242 | (define iwork (malloc liwork _int 'atomic)) ; integer array 2243 | (define WORK (make-flomat (max 1 lwork) 1)) 2244 | (define work (flomat-a WORK)) 2245 | ;(displayln (list m n nrhs a lda b ldb s rcond work lwork iwork)) 2246 | (define-values (info rank) 2247 | (dgelsd_ m n nrhs a lda b ldb s rcond work lwork iwork)) 2248 | (shared-submatrix! X 0 0 n nrhs)) 2249 | 2250 | 2251 | 2252 | (define (linear-fit/plain xs ys) 2253 | (set! xs (result-flcolumn xs)) 2254 | (set! ys (result-flcolumn ys)) 2255 | ; (check-same-length 'linear-fit xs ys) 2256 | ; Here xs and ys are column vectors. 2257 | 2258 | ; Find a and b such that y=ax+b is a good fit to the input data. 2259 | ; Minimize S = sum( (y - (ax+b))² ) 2260 | 2261 | ; In vector form, the models is: 2262 | ; Y = X β + ε ; where β₁= a and β₂=b 2263 | ; X is an mx2 matrix where each is on the form [x_i 1] (X is the design matrix) 2264 | ; Multiply with X^T 2265 | ; X^T Y = X^T X β + X^T ε 2266 | ; Now left divide with X^T X which is a square matrix 2267 | 2268 | (define-param (mx nx) xs) 2269 | (define-param (my ny) ys) 2270 | (define X (flomat-augment xs (flomat-ones mx 1))) 2271 | (define XT (flomat-transpose X)) 2272 | (define XTX (flomat* XT X)) 2273 | (define XTy (flomat* XT ys)) 2274 | (define β (flomat-left-divide XTX XTy)) 2275 | ; (define resids (flomat- ys (flomat* X β))) 2276 | β) 2277 | 2278 | (define (linear-fit/qr xs ys) 2279 | (set! xs (result-flcolumn xs)) 2280 | (set! ys (result-flcolumn ys)) 2281 | ; (check-same-length 'linear-fit xs ys) 2282 | ; Here xs and ys are column vectors. 2283 | 2284 | ; Find a and b such that y=ax+b is a good fit to the input data. 2285 | ; Minimize S = sum( (y - (ax+b))² ) 2286 | 2287 | ; In vector form, the models is: 2288 | ; Y = X β + ε ; where β₁= a and β₂=b 2289 | ; X is an mx2 matrix where each is on the form [x_i 1] (X is the design matrix) 2290 | 2291 | ; With X = QR: 2292 | ; Q^T Y = Q^T X β + Q^T ε ~ Q^T X β = Q^T Q R β = R β 2293 | ; Now solve for β. 2294 | 2295 | (define-param (mx nx) xs) 2296 | (define-param (my ny) ys) 2297 | (define X (flomat-augment xs (flomat-ones mx 1))) 2298 | ; 1. Compute X = QR 2299 | (define-values (Q R) (flomat-qr X)) 2300 | ; 2. Compute the vector Q^T Y 2301 | (define QTY (flomat* Q ys #f 1.0 1.0 #t)) 2302 | ; 3. Solve upper triangular Rβ = Q^T Y for β. 2303 | (define β (flomat-left-divide R QTY)) 2304 | ; (define resids (flomat- ys (flomat* X β))) 2305 | β) 2306 | 2307 | (define (linear-fit-residuals xs ys β) 2308 | (set! xs (result-flcolumn xs)) 2309 | (set! ys (result-flcolumn ys)) 2310 | (define-param (mx nx) xs) 2311 | (define X (flomat-augment xs (flomat-ones mx 1))) 2312 | (flomat- ys (flomat* X β))) 2313 | 2314 | (define (values->list f) 2315 | (call-with-values f list)) 2316 | 2317 | (define (linear-fit xs ys [method 'qr]) 2318 | (match method 2319 | ['qr (linear-fit/qr xs ys)] 2320 | ['plain (linear-fit/plain xs ys)] 2321 | [_ (error linear-fit (~a "unknown method, given: " method))])) 2322 | 2323 | 2324 | 2325 | ;;; 2326 | ;;; SEQUENCES 2327 | ;;; 2328 | 2329 | (define (in-row/proc A r) 2330 | (define-param (m n a lda) A) 2331 | (make-do-sequence 2332 | (λ () 2333 | (define (pos->elm j) (unsafe-ref a lda r j)) 2334 | (define next-pos add1) 2335 | (define initial-pos 0) 2336 | (define (continue? j) (< j n)) 2337 | (values pos->elm initial-pos continue? #f #f)))) 2338 | 2339 | ; (in-row M i] 2340 | ; Returns a sequence of all elements of row i, 2341 | ; that is xi0, xi1, xi2, ... 2342 | (define-sequence-syntax in-row 2343 | (λ () #'in-row/proc) 2344 | (λ (stx) 2345 | (syntax-case stx () 2346 | [[(x) (_ M-expr r-expr)] 2347 | #'((x) 2348 | (:do-in 2349 | ([(M r m n a lda) 2350 | (let ([M1 M-expr]) 2351 | (define-param (rd cd a lda) M1) 2352 | (values M1 r-expr rd cd a lda))]) 2353 | (begin 2354 | (unless (flomat? M) 2355 | (raise-type-error 'in-row "expected flomat, got ~a" M)) 2356 | (unless (and (integer? r) (and (<= 0 r ) (< r m))) 2357 | (raise-type-error 'in-row "expected row number" r))) 2358 | ([j 0]) 2359 | (< j n) 2360 | ([(x) (unsafe-ref a lda r j)]) 2361 | #true 2362 | #true 2363 | [(+ j 1)]))] 2364 | [[(i x) (_ M-expr r-expr)] 2365 | #'((i x) 2366 | (:do-in 2367 | ([(M r m n a lda) 2368 | (let ([M1 M-expr]) 2369 | (define-param (rd cd a lda) M1) 2370 | (values M1 r-expr rd cd a lda))]) 2371 | (begin 2372 | (unless (flomat? M) 2373 | (raise-type-error 'in-row "expected flomat, got ~a" M)) 2374 | (unless (and (integer? r) (and (<= 0 r ) (< r m))) 2375 | (raise-type-error 'in-row "expected row number" r))) 2376 | ([j 0]) 2377 | (< j n) 2378 | ([(x) (unsafe-ref a lda r j)] 2379 | [(i) j]) 2380 | #true 2381 | #true 2382 | [(+ j 1)]))] 2383 | [[_ clause] (raise-syntax-error 2384 | 'in-row "expected (in-row )" #'clause #'clause)]))) 2385 | 2386 | ; (in-flcol M j] 2387 | ; Returns a sequence of all elements of column j, 2388 | ; that is x0j, x1j, x2j, ... 2389 | 2390 | (define (in-col/proc A s) 2391 | (define-param (m n a lda) A) 2392 | (make-do-sequence 2393 | (λ () 2394 | (define (pos->elm i) (unsafe-ref a lda i s)) 2395 | (define next-pos add1) 2396 | (define initial-pos 0) 2397 | (define (continue? i) (< i m)) 2398 | (values pos->elm next-pos initial-pos #f #f)))) 2399 | 2400 | (define-sequence-syntax in-col 2401 | (λ () #'in-col/proc) 2402 | (λ (stx) 2403 | (syntax-case stx () 2404 | ; M-expr evaluates to column 2405 | [[(x) (_ M-expr)] 2406 | #'((x) 2407 | (:do-in 2408 | ([(M n m a) 2409 | (let ([M1 (result-flcolumn M-expr)]) 2410 | (define-param (rd cd a) M1) 2411 | (values M1 rd cd a))]) 2412 | (unless (flomat? M) 2413 | (raise-type-error 'in-column "expected matrix, got ~a" M)) 2414 | ([j 0]) 2415 | (< j n) 2416 | ([(x) (ptr-ref a _double j)]) 2417 | #true 2418 | #true 2419 | [(+ j 1)]))] 2420 | ; M-expr evaluates to matrix, s-expr to column index 2421 | [[(x) (_ M-expr s-expr)] 2422 | #'((x) 2423 | (:do-in 2424 | ([(M s m n a lda) 2425 | (let ([M1 M-expr]) 2426 | (define-param (rd cd a lda) M1) 2427 | (values M1 s-expr rd cd a lda))]) 2428 | (begin 2429 | (unless (flomat? M) 2430 | (raise-type-error 'in-col "expected matrix, got ~a" M)) 2431 | (unless (integer? s) 2432 | (raise-type-error 'in-col "expected column number, got ~a" s)) 2433 | (unless (and (integer? s) (and (<= 0 s ) (< s n))) 2434 | (raise-type-error 'in-col "expected column number, got ~a" s))) 2435 | ([j 0]) 2436 | (< j m) 2437 | ([(x) (unsafe-ref a lda j s)]) 2438 | #true 2439 | #true 2440 | [(+ j 1)]))] 2441 | [[(i x) (_ M-expr s-expr)] 2442 | #'((x) 2443 | (:do-in 2444 | ([(M s m n a lda) 2445 | (let ([M1 M-expr]) 2446 | (define-param (rd cd a lda) M1) 2447 | (values M1 s-expr rd cd a lda))]) 2448 | (begin 2449 | (unless (flomat? M) 2450 | (raise-type-error 'in-column "expected matrix, got ~a" M)) 2451 | (unless (integer? s) 2452 | (raise-type-error 'in-column "expected col number, got ~a" s)) 2453 | (unless (and (integer? s) (and (<= 0 s ) (< s n))) 2454 | (raise-type-error 'in-column "expected col number, got ~a" s))) 2455 | ([j 0]) 2456 | (< j m) 2457 | ([(x) (unsafe-ref a lda j s)] 2458 | [(i) j]) 2459 | #true 2460 | #true 2461 | [(+ j 1)]))] 2462 | [[_ clause] (raise-syntax-error 2463 | 'in-col "expected (in-col )" #'clause #'clause)]))) 2464 | 2465 | 2466 | ;;; 2467 | ;;; Special Matrices 2468 | ;;; 2469 | 2470 | ; Note: See Matlab gallery for ideas. 2471 | 2472 | (define (flomat-vandermonde xs n) 2473 | ; One row for each element of xs. 2474 | ; Each row consist of the first 0..n-1 powers of x. 2475 | (define m (length xs)) 2476 | (define αs (list->vector xs)) 2477 | (define α^j (make-vector m 1.0)) 2478 | (for*/flomat m n #:column 2479 | ([j (in-range 0 n)] 2480 | [i (in-range 0 m)]) 2481 | (define αi^j (vector-ref α^j i)) 2482 | (define αi (vector-ref αs i )) 2483 | (vector-set! α^j i (* αi^j αi)) 2484 | αi^j)) 2485 | 2486 | 2487 | ;;; 2488 | ;;; SYNTAX 2489 | ;;; 2490 | 2491 | (require 2492 | (for-syntax racket/base 2493 | syntax/parse)) 2494 | 2495 | (define-syntax (flomat: stx) 2496 | (syntax-parse stx 2497 | [(_ [[x0 xs0 ...] [x xs ...] ...]) 2498 | (syntax/loc stx (vectors->flomat (vector (vector x0 xs0 ...) (vector x xs ...) ...)))] 2499 | [(_ [xs ... (~and [] r) ys ...]) 2500 | (raise-syntax-error 'flomat: "given empty row" stx #'r)] 2501 | [(_ (~and [] c)) 2502 | (raise-syntax-error 'flomat: "given empty matrix" stx #'c)] 2503 | [(_ x) 2504 | (raise-syntax-error 'flomat: "expected two-dimensional data" stx)])) 2505 | 2506 | (define-syntax (flrow-matrix stx) 2507 | (syntax-parse stx 2508 | [(_ [x xs ...]) (syntax/loc stx (flomat: [[x xs ...]]))] 2509 | [(_ (~and [] r)) 2510 | (raise-syntax-error 'flrow-matrix "given empty row" stx #'r)])) 2511 | 2512 | (define-syntax (flcol-matrix stx) 2513 | (syntax-parse stx 2514 | [(_ [x xs ...]) (syntax/loc stx (flomat: [[x] [xs] ...]))] 2515 | [(_ (~and [] c)) 2516 | (raise-syntax-error 'flrow-matrix "given empty column" stx #'c)])) 2517 | 2518 | 2519 | ; TODO: 2520 | #;(provide 2521 | ; DONE matrix* 2522 | ; DONE matrix-expt 2523 | ; DONE matrix-ref 2524 | ; DONE matrix-scale 2525 | ; DONE matrix-row-vector? 2526 | ; DONE matrix-column-vector? 2527 | ; DONE matrix/dim ; construct 2528 | ; DONE matrix-augment ; horizontally 2529 | ; DONE matrix-stack ; vertically 2530 | ; DONE matrix-block-diagonal 2531 | ; norms 2532 | ; DONE matrix-norm 2533 | ; operators 2534 | ; DONE matrix-transpose 2535 | ; NO-COMPLEX matrix-conjugate 2536 | ; NO-COMPLEX matrix-hermitian 2537 | ; DONE matrix-inverse 2538 | ; row and column 2539 | ; DONE matrix-scale-row 2540 | ; DONE matrix-scale-column 2541 | ; DONE matrix-swap-rows 2542 | ; DONE matrix-swap-columns 2543 | ; DONE matrix-add-scaled-row 2544 | ; DONE ADDED matrix-add-scaled-column 2545 | ; reduction 2546 | ; (DONE) matrix-gauss-eliminate ; ? use upper in LU ? 2547 | ; DONE matrix-gauss-jordan-eliminate ; ? LU ? Use matrix-gauss-eliminate 2548 | ; (DONE) matrix-row-echelon-form ; ? LU ? 2549 | ; DONE matrix-reduced-row-echelon-form ; ? LU ? Use matrix-gauss-eliminate 2550 | 2551 | ; invariant 2552 | ; DONE matrix-rank (uses SVD!) 2553 | ; DONE matrix-nullity 2554 | ; DONE matrix-determinant 2555 | ; DONE matrix-trace 2556 | ; spaces 2557 | ;matrix-column+null-space 2558 | ; solvers 2559 | ; DONE matrix-solve 2560 | ; DONE matrix-solve-many 2561 | ; spaces 2562 | matrix-column-space ; use SVD somehow 2563 | ; column vectors 2564 | ; DONE column ; construct 2565 | ; DONE unit-column 2566 | ; DONE result-column ; convert to lazy 2567 | ; DONE column-dimension 2568 | ; DONE column-dot 2569 | ; DONE column-norm 2570 | ; DONE column-projection 2571 | ; DONE column-normalize 2572 | ; DONE scale-column 2573 | ; DONE column+ 2574 | ; projection 2575 | ; DONE projection-on-orthogonal-basis 2576 | ; DONE projection-on-orthonormal-basis 2577 | ; DONE projection-on-subspace 2578 | ; DONE gram-schmidt-orthogonal 2579 | ; DONE gram-schmidt-orthonormal 2580 | ; factorization 2581 | ; DONE matrix-lu (renamed to matrix-plu) 2582 | ; DONE matrix-qr 2583 | ; comprehensions 2584 | ; DONE for/matrix: 2585 | ; DONE for*/matrix: 2586 | ; DONE for/matrix-sum: 2587 | ; sequences 2588 | ; DONE in-row 2589 | ; DONE in-column 2590 | ; special matrices 2591 | ; DONE vandermonde-matrix 2592 | ) 2593 | 2594 | 2595 | (define (flomat->lists A) 2596 | (map vector->list 2597 | (vector->list 2598 | (flomat->vectors A)))) 2599 | 2600 | (define (lists->flomat xss) 2601 | (vectors->flomat 2602 | (list->vector (map list->vector xss)))) 2603 | 2604 | 2605 | (define (flomat-map! A f) 2606 | (define-param (m n a lda) A) 2607 | (for* ([i (in-range m)] 2608 | [j (in-range n)]) 2609 | (define aij (unsafe-ref a lda i j)) 2610 | (define x (f aij)) 2611 | (define x* (real->double-flonum x)) 2612 | (unsafe-set! a lda i j x*)) 2613 | A) 2614 | 2615 | 2616 | (define (flomat-map A f) 2617 | (flomat-map! (copy-flomat A) f)) 2618 | 2619 | (define (flomat-make-diagonal v [k 0]) 2620 | ; create a square matrix A with diagonal elements from v 2621 | ; if k is given, place the elements on the kth digonal, 2622 | ; k=0 is the main diagonal 2623 | ; k>0 above the main diagonal 2624 | ; k<0 below the main diagonal 2625 | (check-vector 'flomat-make-diagonal v) 2626 | (check-integer 'flomat-make-diagonal k) 2627 | (define s (+ (vector-length v) (abs k))) 2628 | (define A (make-flomat s s)) 2629 | (define-param (m n a lda) A) 2630 | (cond 2631 | [(= k 0) (for ([i (in-naturals)] [x (in-vector v)]) 2632 | (define x* (real->double-flonum x)) 2633 | (unsafe-set! a lda i i x*))] 2634 | [(> k 0) (for ([i (in-naturals)] [x (in-vector v)]) 2635 | (define x* (real->double-flonum x)) 2636 | (unsafe-set! a lda i (+ i k) x*))] 2637 | [(< k 0) (for ([i (in-naturals)] [x (in-vector v)]) 2638 | (define x* (real->double-flonum x)) 2639 | (unsafe-set! a lda (- i k) i x*))]) 2640 | A) 2641 | 2642 | (define (flomat-eye m0 [n0 m0] [k 0]) 2643 | (check-integer 'flomat-eye k) 2644 | ; create an mxn matrix with 1 on the k'th diagonal 2645 | (define A (make-flomat m0 n0 0.0)) 2646 | (define-param (m n a lda) A) 2647 | (cond 2648 | [(= k 0) (for ([i (in-range m)]) 2649 | (unsafe-set! a lda i i 1.0))] 2650 | [(> k 0) (for ([i (in-range (- m k))]) 2651 | (unsafe-set! a lda i (+ i k) 1.0))] 2652 | [(< k 0) (for ([i (in-range (+ m k))]) 2653 | (unsafe-set! a lda (- i k) i 1.0))]) 2654 | A) 2655 | 2656 | (define (flomat-diagonal A [k 0]) 2657 | ; extract the k'th diagonal of the matrix A 2658 | (check-flomat 'flomat-diagonal A) 2659 | (check-integer 'flomat-diagonal k) 2660 | (define-param (m n a lda) A) 2661 | (define s (min m n)) 2662 | (cond 2663 | [(= k 0) (for/vector ([i (in-range s)]) 2664 | (unsafe-ref a lda i i))] 2665 | [(> k 0) (for/vector ([i (in-range (- s k))]) 2666 | (unsafe-ref a lda i (+ i k)))] 2667 | [(< k 0) (for/vector ([i (in-range (+ s k))]) 2668 | (unsafe-ref a lda i (- i k)))])) 2669 | 2670 | (define (flomat-lower-triangle A [k 0]) 2671 | ; return triangle with elements on or below the k'th diagonal 2672 | (check-flomat 'flomat-lower-triangle A) 2673 | (check-integer 'flomat-lower-triangle k) 2674 | (define B (copy-flomat A)) 2675 | (define-param (m n a lda) A) 2676 | (cond 2677 | [(= k 0) (for* ([i (in-range m)] 2678 | [j (in-range (+ i 1) n)]) 2679 | (flomat-set! B i j 0.0))] 2680 | [(> k 0) (for* ([i (in-range m)] 2681 | [j (in-range (+ i 1 k) n)]) 2682 | (flomat-set! B i j 0.0))] 2683 | [(< k 0) (for* ([i (in-range m)] 2684 | [j (in-range (max 0 (+ i 1 k)) n)]) 2685 | (flomat-set! B i j 0.0))]) 2686 | B) 2687 | 2688 | (define (flomat-circulant-matrix v) 2689 | ; A circulant matrix is a matrix in which each row 2690 | ; is the previous row shifted one to the right. 2691 | (define n (vector-length v)) 2692 | (for*/flomat n n 2693 | ([i (in-range n)] 2694 | [j (in-range n)]) 2695 | (vector-ref v (remainder (+ i j) n)))) 2696 | 2697 | 2698 | (define (flomat-outer-product A B) 2699 | ; accept standard vectors as input 2700 | (define A1 (if (vector? A) (vector->flcolumn A) A)) 2701 | (define B1 (if (vector? B) (vector->flrow B) B)) 2702 | ; compute outer product between first column of A and first row of B 2703 | (define-values (am an) (flomat-dimensions A1)) 2704 | (define-values (bm bn) (flomat-dimensions B1)) 2705 | (for*/flomat am bn ([a (in-col A1 0)] 2706 | [b (in-row B1 0)]) 2707 | (* a b))) 2708 | 2709 | 2710 | ; Since the matrix entries of a column are stored contigious, 2711 | ; we can use cblas_ixamax with incX=1 to find pivots. 2712 | (define (flomat-find-partial-pivot A i j) 2713 | ; Find the index k of the element a_kj with k>=i 2714 | ; that has the largest absolute value. 2715 | ; I.e. a partial pivot in row j. 2716 | (define-param (m n a lda) A) 2717 | (define ptr (ptr-elm a lda i j)) ; address of the (i,j)th element. 2718 | (define idx (cblas_idamax (- m i) ptr 1)) 2719 | (+ i idx)) 2720 | 2721 | 2722 | (define (flomat-gauss-elim! A [jordan? #f] [unitize-pivot? #f] [pivoting 'partial]) 2723 | (define A-original A) 2724 | 2725 | (let loop ([A A] [i 0] [j 0] [without-pivot '()]) 2726 | (define-param (m n a lda) A) 2727 | 2728 | (define (eliminate-row! i pivot l) 2729 | ; eliminate row l using row i which has pivot 2730 | (define x (unsafe-ref a lda l 0)) ; first element in row l 2731 | (flomat-add-scaled-row! A l (* -1 (/ x pivot)) i) ; scale and subtract 2732 | (unsafe-set! a lda l 0 0.0)) ; exact 0.0 2733 | 2734 | (define (eliminate-rows-below! i pivot) (for ([l (in-range (+ i 1) m)]) (eliminate-row! i pivot l))) 2735 | (define (eliminate-rows-above! i pivot) (for ([l (in-range 0 i)]) (eliminate-row! i pivot l))) 2736 | 2737 | (define (A-without-first-column) (shared-submatrix! A 0 1 m (- n 1))) 2738 | 2739 | (cond 2740 | [(= n 0) (values A-original (reverse without-pivot))] 2741 | ;; None of the rest of the columns can have pivots 2742 | [(= i m) (values A-original (append (reverse without-pivot) (range j (+ j n))))] 2743 | [else (define p (case pivoting 2744 | [(partial) (flomat-find-partial-pivot A i 0)] 2745 | #;[(first) (flomat-find-first-pivot A 0 0)] 2746 | [else (error 'flomat-gauss-elim! "unknown pivoting type")])) 2747 | (define pivot (flomat-ref A p 0)) 2748 | (cond 2749 | [(<= pivot epsilon) ;; no pivot 2750 | (loop (A-without-first-column) i (+ j 1) (cons j without-pivot))] 2751 | [else ;; pivot found 2752 | (flomat-swap-rows! A i p) 2753 | (eliminate-rows-below! i pivot) 2754 | (when jordan? (eliminate-rows-above! i pivot)) 2755 | (when unitize-pivot? (flomat-scale-row! A i (/ 1. pivot))) 2756 | (loop (A-without-first-column) (+ i 1) (+ j 1) without-pivot)])]))) 2757 | 2758 | (define (flomat-gauss-elim A [jordan? #f] [unitize-pivot? #f] [pivoting 'partial]) 2759 | (flomat-gauss-elim! (copy-flomat A) jordan? unitize-pivot? pivoting)) 2760 | 2761 | (define (matrix-row-echelon! A [jordan? #f] [unitize-pivot? #f] [pivoting 'partial]) 2762 | (flomat-gauss-elim! A jordan? unitize-pivot? pivoting) 2763 | A) 2764 | 2765 | (define (matrix-row-echelon A [jordan? #f] [unitize-pivot? #f] [pivoting 'partial]) 2766 | (matrix-row-echelon! (copy-flomat A) jordan? unitize-pivot? pivoting)) 2767 | 2768 | ;;; 2769 | ;;; RANDOM NUMBERS 2770 | ;;; 2771 | 2772 | ; A seed is an integer array of dimension 4. 2773 | ; On entry the elements must be between 0 and 4095, 2774 | ; and the last element must be odd. 2775 | ; The routines update the seed automatically. 2776 | 2777 | (define _iseed (_cpointer 'flomat-iseed)) 2778 | 2779 | (define (generate-iseed) 2780 | (define i* (cast (malloc 4 _int 'atomic)_pointer _iseed)) 2781 | (define r0 (random 4096)) 2782 | (define r1 (random 4096)) 2783 | (define r2 (random 4096)) 2784 | (define r3 (random 4096)) 2785 | (let loop () 2786 | (unless (odd? r3) 2787 | (set! r3 (random 4096)) 2788 | (loop))) 2789 | (ptr-set! i* _int 0 r0) 2790 | (ptr-set! i* _int 1 r1) 2791 | (ptr-set! i* _int 2 r2) 2792 | (ptr-set! i* _int 3 r3) 2793 | i*) 2794 | 2795 | (define the-iseed (generate-iseed)) 2796 | 2797 | ; DLARNV returns a vector of n random real numbers from a uniform or normal distribution. 2798 | (define-lapack dlarnv_ 2799 | (_fun (idist : (_ptr i _int)) ; i 1: uniform (0,1), 2: uniform (-1,1), 3: normal(0,1) 2800 | (iseed : _iseed) ; io 2801 | (n : (_ptr i _int)) 2802 | (x : _flomat) 2803 | -> _void)) 2804 | 2805 | ; DLARND returns a random real number from a uniform or normal distribution. 2806 | ; Not available on macOS (using the default lapack) 2807 | #;(define-lapack dlarnd_ 2808 | (_fun (idist : (_ptr i _int)) ; i 1: uniform (0,1), 2: uniform (-1,1), 3: normal(0,1) 2809 | (iseed : _iseed) ; io 2810 | -> _double)) 2811 | 2812 | 2813 | ; uniform numbers: (0,1) 2814 | (define rand 2815 | ; 1: uniform (0,1) 2816 | (case-lambda 2817 | [() 2818 | (define a (alloc-flomat 1 1)) 2819 | (dlarnv_ 1 the-iseed 1 a) 2820 | (ptr-ref a _double 0)] 2821 | [(n) 2822 | (check-positive-integer 'rand n) 2823 | (define a (alloc-flomat n n)) 2824 | (dlarnv_ 1 the-iseed (* n n) a) 2825 | (flomat n n a n)] 2826 | [(m n) 2827 | (check-positive-integer 'rand m) 2828 | (check-positive-integer 'rand n) 2829 | (define a (alloc-flomat m n)) 2830 | (dlarnv_ 1 the-iseed (* m n) a) 2831 | (flomat m n a m)])) 2832 | 2833 | 2834 | ; standard normal distribution (0,1) 2835 | (define randn 2836 | ; 1: normal distribution (0,1) 2837 | (case-lambda 2838 | [() 2839 | (define a (alloc-flomat 1 1)) 2840 | (dlarnv_ 3 the-iseed 1 a) 2841 | (ptr-ref a _double 0)] 2842 | [(n) 2843 | (check-positive-integer 'randn n) 2844 | (define a (alloc-flomat n n)) 2845 | (dlarnv_ 3 the-iseed (* n n) a) 2846 | (flomat n n a n)] 2847 | [(m n) 2848 | (check-positive-integer 'randn m) 2849 | (check-positive-integer 'randn n) 2850 | (define a (alloc-flomat m n)) 2851 | (dlarnv_ 3 the-iseed (* m n) a) 2852 | (flomat m n a m)])) 2853 | 2854 | 2855 | ;;; 2856 | ;;; HIGH LEVEL 2857 | ;;; 2858 | 2859 | (define (mat? A) (flomat? A)) 2860 | (define (row? A) (and (flomat? A) (flomat-row-vector? A))) 2861 | (define (col? A) (and (flomat? A) (flomat-column-vector? A))) 2862 | 2863 | (define (row A i) (flomat-row A i)) 2864 | (define (col A i) (flomat-column A i)) 2865 | (define (ref A i j) (flomat-ref A i j)) 2866 | 2867 | (define (shape A) (list (flomat-m A) (flomat-n A))) 2868 | (define (size A) (flomat-size A)) 2869 | (define (nrows A) (flomat-m A)) 2870 | (define (ncols A) (flomat-n A)) 2871 | 2872 | (define augment flomat-augment) 2873 | (define stack flomat-stack) 2874 | (define repeat flomat-repeat) 2875 | (define block-diagonal flomat-block-diagonal) 2876 | 2877 | (define (f64vector->flomat v [transpose? #f]) 2878 | (define m (f64vector-length v)) 2879 | (define n 1) 2880 | (define lda 1) 2881 | (define a (cast (f64vector->cpointer v) _pointer _flomat)) 2882 | (if transpose? 2883 | (flomat n m a lda) 2884 | (flomat m n a lda))) 2885 | 2886 | (define (column . xs) 2887 | (matrix (map list xs))) 2888 | 2889 | (define (matrix x) 2890 | (cond 2891 | [(vector? x) (cond 2892 | ; vector of vector 2893 | [(vector? (vector-ref x 0)) (vectors->flomat x)] 2894 | ; a single vector represents a column vector 2895 | [else (vector->flcolumn x)])] 2896 | [(list? x) (cond 2897 | ; list of lists 2898 | [(list? (first x)) (list->flomat x)] 2899 | [else (apply flcolumn x)])] 2900 | [(f64vector? x) (copy-flomat (matrix! x))] 2901 | [else (error)])) 2902 | 2903 | (define (matrix! x) 2904 | (cond 2905 | [(f64vector? x) (f64vector->flomat x)] 2906 | [else 2907 | (error 'matrix! "expected an f64vector as input")])) 2908 | 2909 | (provide f64vector) 2910 | 2911 | (define (mset! A i j x) (flomat-set! A i j x)) 2912 | 2913 | (define (zeros m [n m]) (flomat-zeros m n)) 2914 | (define (ones m [n m]) (flomat-ones m n)) 2915 | (define (make m n [x 0.0]) (make-flomat m n [x 0.0])) 2916 | (define (constant! A x) 2917 | (define x* (real->double-flonum x)) 2918 | (define-param (m n a lda) A) 2919 | (for* ([i (in-range m)] [j (in-range n)]) 2920 | (unsafe-set! a lda i j x*))) 2921 | (define (zeros! A) (constant! A 0.0)) 2922 | (define (ones! A) (constant! A 1.0)) 2923 | 2924 | 2925 | (define (do-arange start stop step transpose?) 2926 | (define len (inexact->exact (ceiling (/ (- stop start) step)))) 2927 | (define v (make-f64vector len)) 2928 | (for ([x (in-range (* 1.0 start) (* 1.0 stop) (* 1. step))] 2929 | [k (in-naturals)]) 2930 | (f64vector-set! v k x)) 2931 | (f64vector->flomat v transpose?)) 2932 | 2933 | (define (colarange start [stop #f] [step 1.0]) 2934 | (cond [stop (do-arange start stop step #f)] 2935 | [else (colarange 0. start step)])) 2936 | 2937 | (define (arange start [stop #f] [step 1.0]) 2938 | (cond [stop (do-arange start stop step #t)] 2939 | [else (arange 0. start step)])) 2940 | 2941 | 2942 | (define (reshape A m n) 2943 | (reshape! (copy-flomat A) m n)) 2944 | 2945 | (define (reshape! A m n) 2946 | (define-param (M N a lda) A) 2947 | (unless (<= (* m n) (* M N)) 2948 | (error 'reshape! 2949 | "the size of the new shape is larger than the original matrix")) 2950 | (cond 2951 | [(= lda 1) ; A is a row vector => no gaps 2952 | (flomat m n a m)] 2953 | [(= lda M) ; no gap between each column 2954 | (flomat m n a m)] 2955 | ; [if ... M N m n ... has a nice relationship then ...] 2956 | [else 2957 | (error 'reshape! "not able to reshape")])) 2958 | 2959 | (define (transpose A) (flomat-transpose A)) 2960 | 2961 | (define (linspace start stop [num 50] [endpoint #t]) 2962 | (define step (/ (- stop start) (* 1.0 (- num 1)))) 2963 | (define len (if endpoint num (- num 1))) 2964 | (define v (make-f64vector len)) 2965 | (for/list ([k (in-range len)]) 2966 | (define x (+ start (* k step))) 2967 | (f64vector-set! v k x)) 2968 | (f64vector->flomat v)) 2969 | 2970 | (define (sub! A i j r s) (shared-submatrix! A i j r s)) 2971 | ; return rxs matrix with upper left corner (i,j) 2972 | ; entries are shared with A 2973 | (define (sub A i j m n) (flsubmatrix A m n i j)) 2974 | ; return a the mxn submatrix of with upper left corner in (i,j) 2975 | 2976 | (define (col! A j) 2977 | (check-legal-column 'col j A) 2978 | (define m (flomat-m A)) ; nrows 2979 | (sub! A 0 j m 1)) 2980 | 2981 | (define (row! A i) 2982 | (check-legal-row 'row i A) 2983 | (define n (flomat-n A)) ; ncols 2984 | (sub! A i 0 1 n)) 2985 | 2986 | 2987 | ;;; 2988 | ;;; Pointwise Operations 2989 | ;;; 2990 | 2991 | (define-syntax (define-pointwise-unary stx) 2992 | (syntax-parse stx 2993 | [(_define-pointwise f:id) 2994 | (with-syntax ([.f! (format-id #'f ".~a!" (syntax-e #'f))] 2995 | [.f (format-id #'f ".~a" (syntax-e #'f))]) 2996 | (syntax/loc stx 2997 | (begin 2998 | (define (.f! A [C #f]) 2999 | (when (flomat? C) (check-same-dimensions A C '.f)) 3000 | (unless C (set! C A)) 3001 | (define-param (m n a lda) A) 3002 | (define-param (_ __ c ldc) C) 3003 | (for* ([i (in-range m)] 3004 | [j (in-range n)]) 3005 | (define aij (unsafe-ref a lda i j)) 3006 | (define x (f aij)) 3007 | (unsafe-set! c ldc i j x)) 3008 | C) 3009 | (define (.f A) 3010 | (.f! (copy-flomat A))))))])) 3011 | 3012 | (define-syntax (define-pointwise-unaries stx) 3013 | (syntax-parse stx 3014 | [(_ f:id ...) 3015 | (syntax/loc stx 3016 | (begin 3017 | (define-pointwise-unary f) ...))])) 3018 | 3019 | (define-pointwise-unaries sin cos tan sqr sqrt log exp) 3020 | 3021 | (define-syntax (define-pointwise-binary stx) 3022 | (syntax-parse stx 3023 | [(_define-pointwise f:id) 3024 | (with-syntax ([.f! (format-id #'f ".~a!" (syntax-e #'f))] 3025 | [.f (format-id #'f ".~a" (syntax-e #'f))]) 3026 | (syntax/loc stx 3027 | (begin 3028 | (define (.f! A B [C #f]) 3029 | (cond 3030 | [(and (flomat? A) (flomat? B)) 3031 | (check-same-dimensions A B '.f!) 3032 | (when (flomat? C) (check-same-dimensions A C '.f!)) 3033 | (unless C (set! C A)) 3034 | (define-param (m n a lda) A) 3035 | (define-param (M N b ldb) B) 3036 | (define-param (_ __ c ldc) C) 3037 | (for* ([i (in-range m)] 3038 | [j (in-range n)]) 3039 | (define aij (unsafe-ref a lda i j)) 3040 | (define bij (unsafe-ref b ldb i j)) 3041 | (define x (f aij bij)) 3042 | (unsafe-set! c ldc i j x)) 3043 | C] 3044 | [(number? A) ; now C needs to be an flomat 3045 | (unless (flomat? C) 3046 | (error (error '.! "if A is a constant, C must be a flomat"))) 3047 | (cond [(flomat? B) (define-param (m n b ldb) B) 3048 | (.f! (make-flomat m n A) B C)] 3049 | [else (error '.! "wrong input types")])] 3050 | [(number? B) 3051 | (cond [(flomat? A) 3052 | (when (flomat? C) (check-same-dimensions A C '.f!)) 3053 | (unless C (set! C A)) 3054 | (define-param (m n a lda) A) 3055 | (define-param (_ __ c ldc) C) 3056 | (for* ([i (in-range m)] 3057 | [j (in-range n)]) 3058 | (define aij (unsafe-ref a lda i j)) 3059 | (define x (f aij B)) 3060 | (unsafe-set! c ldc i j x)) 3061 | C] 3062 | [else (error '.! "wrong input types")])])) 3063 | (define (.f A B) 3064 | (cond 3065 | [(flomat? A) (.f! A B (copy-flomat A))] 3066 | [(flomat? B) (.f! A B (copy-flomat B))] 3067 | [else (flomat 1 1 (f A B))])))))])) 3068 | 3069 | (define-syntax (define-pointwise-binaries stx) 3070 | (syntax-parse stx 3071 | [(_ f:id ...) 3072 | (syntax/loc stx 3073 | (begin 3074 | (define-pointwise-binary f) ...))])) 3075 | 3076 | (define-pointwise-binaries + * expt) 3077 | 3078 | (define-syntax (define-pointwise-unary/binary stx) 3079 | (syntax-parse stx 3080 | [(_define-pointwise f:id) 3081 | (with-syntax ([.f! (format-id #'f ".~a!" (syntax-e #'f))] 3082 | [.f (format-id #'f ".~a" (syntax-e #'f))]) 3083 | (syntax/loc stx 3084 | (begin 3085 | (define (.f! A [B #f] [C #f]) 3086 | (cond 3087 | [B ; binary 3088 | (cond 3089 | [(and (flomat? A) (flomat? B)) 3090 | (check-same-dimensions A B '.f!) 3091 | (when (flomat? C) (check-same-dimensions A C '.f!)) 3092 | (unless C (set! C A)) 3093 | (define-param (m n a lda) A) 3094 | (define-param (M N b ldb) B) 3095 | (define-param (_ __ c ldc) C) 3096 | (for* ([i (in-range m)] 3097 | [j (in-range n)]) 3098 | (define aij (unsafe-ref a lda i j)) 3099 | (define bij (unsafe-ref b ldb i j)) 3100 | (define x (f aij bij)) 3101 | (unsafe-set! c ldc i j x)) 3102 | C] 3103 | [(number? A) ; now C needs to be an flomat 3104 | (unless (flomat? C) 3105 | (error (error '.! "if A is a constant, C must be a flomat"))) 3106 | (cond [(flomat? B) (define-param (m n b ldb) B) 3107 | (.f! (make-flomat m n A) B C)] 3108 | [else (error '.! "wrong input types")])] 3109 | [(number? B) 3110 | (cond [(flomat? A) 3111 | (when (flomat? C) (check-same-dimensions A C '.f!)) 3112 | (unless C (set! C A)) 3113 | (define-param (m n a lda) A) 3114 | (define-param (_ __ c ldc) C) 3115 | (for* ([i (in-range m)] 3116 | [j (in-range n)]) 3117 | (define aij (unsafe-ref a lda i j)) 3118 | (define x (f aij B)) 3119 | (unsafe-set! c ldc i j x)) 3120 | C] 3121 | [else (error '.! "wrong input types")])])] 3122 | ; B is #f 3123 | [else ; unary with result to A or C 3124 | (unless C (set! C A)) 3125 | (check-same-dimensions A C '.f!) 3126 | (define-param (m n a lda) A) 3127 | (define-param (_ __ c ldc) C) 3128 | (for* ([i (in-range m)] 3129 | [j (in-range n)]) 3130 | (define aij (unsafe-ref a lda i j)) 3131 | (define x (f aij)) 3132 | (unsafe-set! c ldc i j x)) 3133 | C])) 3134 | (define (.f A [B #f]) 3135 | (if B 3136 | (.f! A B (copy-flomat A)) 3137 | (.f! (copy-flomat A) B))))))])) 3138 | 3139 | (define-syntax (define-pointwise-unary/binaries stx) 3140 | (syntax-parse stx 3141 | [(_ f:id ...) 3142 | (syntax/loc stx 3143 | (begin 3144 | (define-pointwise-unary/binary f) ...))])) 3145 | 3146 | (define-pointwise-unary/binaries - /) 3147 | 3148 | (define (plus! A . BS) 3149 | (check-flomat 'plus! A) 3150 | (check-all-matrices-same-size 'plus! (cons A BS)) 3151 | (let loop ([BS BS]) 3152 | (cond 3153 | [(empty? BS) A] 3154 | [(flomat? (first BS)) (flomat+! (first BS) A) (loop (rest BS))] 3155 | [(number? (first BS)) (.+! A (first BS)) (loop (rest BS))])) 3156 | A) 3157 | 3158 | (define (plus A . BS) 3159 | (check-all-matrices-same-size 'plus (cons A BS)) 3160 | (let loop ([A A] [BS BS]) 3161 | (cond 3162 | [(empty? BS) A] 3163 | [(flomat? (first BS)) (if (number? A) 3164 | (loop (.+ A (first BS)) (rest BS)) 3165 | (loop (flomat+ A (first BS)) (rest BS)))] 3166 | [(number? (first BS)) (loop (.+ A (first BS)) (rest BS))]))) 3167 | 3168 | (define (minus! A . BS) 3169 | (check-flomat 'minus! A) 3170 | (check-all-matrices-same-size 'minus! (cons A BS)) 3171 | (cond 3172 | [(empty? BS) (.-! A)] 3173 | [else (let loop ([BS BS]) 3174 | (cond 3175 | [(empty? BS) A] 3176 | [(flomat? (first BS)) (flomat-! (first BS) A) (loop (rest BS))] 3177 | [(number? (first BS)) (.-! A (first BS)) (loop (rest BS))])) 3178 | A])) 3179 | 3180 | (define (minus A . BS) 3181 | (check-all-matrices-same-size 'minus (cons A BS)) 3182 | (cond 3183 | [(empty? BS) (.- A)] 3184 | [else (let loop ([A A] [BS BS]) 3185 | (cond 3186 | [(empty? BS) A] 3187 | [(flomat? (first BS)) (if (number? A) 3188 | (loop (.- A (first BS)) (rest BS)) 3189 | (loop (flomat- A (first BS)) (rest BS)))] 3190 | [(number? (first BS)) (loop (.- A (first BS)) (rest BS))]))])) 3191 | 3192 | (define (times! A . BS) 3193 | (check-flomat 'times! A) 3194 | ; todo: check sizes 3195 | (let loop ([BS BS]) 3196 | (cond 3197 | [(empty? BS) A] 3198 | [(flomat? (first BS)) (flomat*! A (first BS) A) (loop (rest BS))] 3199 | [(number? (first BS)) (.*! A (first BS)) (loop (rest BS))])) 3200 | A) 3201 | 3202 | (define (times A . BS) 3203 | ; todo: check sizes 3204 | (let loop ([A A] [BS BS]) 3205 | (cond 3206 | [(empty? BS) A] 3207 | [(flomat? (first BS)) (if (number? A) 3208 | (loop (.* A (first BS)) (rest BS)) 3209 | (loop (flomat* A (first BS)) (rest BS)))] 3210 | [(number? (first BS)) (if (number? A) 3211 | (loop (* A (first BS)) (rest BS)) 3212 | (loop (.* A (first BS)) (rest BS)))]))) 3213 | 3214 | (define × times) 3215 | 3216 | (define (dot A B) 3217 | (flcolumn-dot A B)) 3218 | 3219 | (define (outer A B) 3220 | ; compute outer product between first column of A and first row of B 3221 | (flomat-outer-product A B)) 3222 | 3223 | (define (power A n) 3224 | ; n natural 3225 | (flomat-expt A n)) 3226 | 3227 | (define (kron A B) 3228 | (define-param (m n a lda) A) 3229 | (define-param (mb nb b ldb) B) 3230 | (define C (make-flomat (* m mb) (* n nb))) 3231 | (define-param (mc nc c ldc) C) 3232 | 3233 | (for* ([i (in-range m)] 3234 | [j (in-range n)]) 3235 | (define k (* i mb)) 3236 | (define l (* j nb)) 3237 | (define c_kl (ptr-elm c ldc k l)) 3238 | (unsafe-matrix-copy! mb nb b lda c_kl ldc) 3239 | (define aij (unsafe-ref a lda i j)) 3240 | (flomat-scale! aij (sub! C k l mb nb))) 3241 | C) 3242 | 3243 | 3244 | (define (diag X [m? #f] [n? #f] [reciproc? #f]) 3245 | (set! X (result-flcolumn X)) 3246 | ; todo: use optional arguments to denote diagonal like matlab? 3247 | (define-param (m n) X) 3248 | (flomat-diagonal-from-singular-values (or m? m) (or n? m) X reciproc?)) 3249 | 3250 | 3251 | (define (cholesky A [triangle 'lower]) 3252 | ; triangle is 'lower or 'upper 3253 | (define lower? (member triangle '(lower low l))) 3254 | (flomat-cholesky A (not lower?))) 3255 | 3256 | (define (svd A) (flomat-svd A)) 3257 | (define (qr A) (flomat-qr A)) 3258 | 3259 | (define (eig A) 3260 | (define who 'eig) 3261 | (check-square who A) 3262 | (define-values (A0 WR WI VL VR info) 3263 | (flomat-eigenvalues-and-vectors! A #:right #t #:overwrite #f)) 3264 | (values (real+imaginary->vector WR WI) VR)) 3265 | 3266 | (define (eigvals A) 3267 | (define who 'eigvals) 3268 | (check-square who A) 3269 | (define-values (A0 WR WI VL VR info) 3270 | (flomat-eigenvalues-and-vectors! A #:right #f #:overwrite #f)) 3271 | (real+imaginary->vector WR WI)) 3272 | 3273 | (define (norm A [type 'frob]) 3274 | (flomat-norm A type)) 3275 | 3276 | (define (det A) 3277 | (flomat-determinant A)) 3278 | 3279 | (define (trace A) 3280 | (flomat-trace A)) 3281 | 3282 | (define (rank A) 3283 | ; rank = dimension of column space = dimension of row space 3284 | ; = number of non-zero singular values 3285 | (flomat-rank A)) 3286 | 3287 | ; todo: condition number 3288 | 3289 | (define (mldivide A B) 3290 | ; todo: also handle non-square A 3291 | (flomat-solve-many A B)) 3292 | 3293 | (define (mrdivide B A) 3294 | ; B/A = (A'\B')' 3295 | (transpose (mldivide (transpose A) (transpose B)))) 3296 | 3297 | (define (inv A) 3298 | (flomat-inverse A)) 3299 | 3300 | (define (pinv A) 3301 | (flomat-pseudo-inverse A)) 3302 | 3303 | (define (eye m [n m] [k 0]) 3304 | (flomat-eye m n k)) 3305 | 3306 | (define rowsum flomat-row-sum) 3307 | (define rowsums flomat-row-sums) 3308 | (define colsum flomat-column-sum) 3309 | (define colsums flomat-column-sums) 3310 | (define (summ A) (rowsum (colsums A) 0)) 3311 | 3312 | ;;; 3313 | ;;; TEST 3314 | ;;; 3315 | 3316 | 3317 | (module+ test 3318 | (require rackunit) 3319 | 3320 | (define (flcheck-equal? a b) 3321 | (< (abs (- b a)) 0.00001)) 3322 | 3323 | 3324 | (with-check-info 3325 | (['test-case "flomat/dim"]) 3326 | (check-equal? (flomat->vector (flomat/dim 2 2 1 2 3 4)) 3327 | #(1. 2. 3. 4.)) 3328 | (check-equal? (flomat->vector (vector->flomat 2 2 #(1 2 3 4))) 3329 | #(1. 2. 3. 4.)) 3330 | (check-equal? (flomat->vector (flomat/dim 2 2 1 2 3 4)) 3331 | #(1. 2. 3. 4.)) 3332 | (check-equal? (flomat->vectors (flomat/dim 2 2 1 2 3 4)) 3333 | #(#[1. 2.] #[3. 4.])) 3334 | 3335 | (let () 3336 | (define A (flomat/dim 2 2 1 2 3 4)) 3337 | (define B (flomat/dim 2 2 5 6 7 8)) 3338 | (define AB (flomat/dim 2 2 19 22 43 50)) 3339 | (check-equal? (flomat->vectors (flomat* A B)) 3340 | (flomat->vectors AB))) 3341 | 3342 | (let () 3343 | (define C (flomat/dim 2 2 1 2 3 4)) 3344 | (define D (flomat/dim 2 3 5 6 7 8 9 10)) 3345 | (define CD (flomat/dim 2 3 21 24 27 47 54 61)) 3346 | (check-equal? (flomat->vectors (flomat* C D)) 3347 | (flomat->vectors CD))) 3348 | 3349 | (check-equal? (flomat->vectors 3350 | (flomat* (flomat/dim 2 3 0 0 1 0 0 0) 3351 | (flomat/dim 3 2 1 2 3 4 5 6))) 3352 | (flomat->vectors 3353 | (flomat/dim 2 2 5 6 0 0)))) 3354 | 3355 | 3356 | (with-check-info 3357 | (['test-group "matrix-constructors.rkt"]) 3358 | (with-check-info 3359 | (['test-case 'flomat-identity]) 3360 | 3361 | (check-equal? (flomat->lists (flomat-identity 1)) '[[1.]]) 3362 | (check-equal? (flomat->lists (flomat-identity 2)) '[[1. 0.] [0. 1.]]) 3363 | (check-equal? (flomat->lists (flomat-identity 3)) '[[1. 0. 0.] [0. 1. 0.] [0. 0. 1.]]) 3364 | (check-equal? (flomat->lists (flomat-identity 1)) '[[1.]]) 3365 | (check-equal? (flomat->lists (flomat-identity 2)) '[[1. 0.] [0. 1.]]) 3366 | (check-equal? (flomat->lists (flomat-identity 3)) '[[1. 0. 0.] [0. 1. 0.] [0. 0. 1.]])) 3367 | (with-check-info 3368 | (['test-case 'const-matrix]) 3369 | (check-equal? (flomat->lists (make-flomat 2 3 0.)) '((0. 0. 0.) (0. 0. 0.)))) 3370 | (with-check-info 3371 | (['test-case 'matrix->list]) 3372 | (check-equal? (flomat->lists (lists->flomat '((1. 2.) (3. 4.)))) '((1. 2.) (3. 4.)))) 3373 | (with-check-info 3374 | (['test-case 'matrix->vectors]) 3375 | (check-equal? (flomat->vectors (vectors->flomat '#(#(1. 2.) #(3. 4.)))) '#(#(1. 2.) #(3. 4.)))) 3376 | (with-check-info 3377 | (['test-case 'matrix-row]) 3378 | (check-equal? (flomat-row (flomat-identity 3) 0) (list->flomat '[[1 0 0]])) 3379 | (check-equal? (flomat-row (flomat-identity 3) 1) (list->flomat '[[0 1 0]])) 3380 | (check-equal? (flomat-row (flomat-identity 3) 2) (list->flomat '[[0 0 1]]))) 3381 | (with-check-info 3382 | (['test-case 'matrix-col]) 3383 | (check-equal? (flomat-column (flomat-identity 3) 0) (list->flomat '[[1] [0] [0]])) 3384 | (check-equal? (flomat-column (flomat-identity 3) 1) (list->flomat '[[0] [1] [0]])) 3385 | (check-equal? (flomat-column (flomat-identity 3) 2) (list->flomat '[[0] [0] [1]]))) 3386 | (with-check-info 3387 | (['test-case 'flsubmatrix]) 3388 | (check-equal? (flsubmatrix (flomat-identity 3) 1 2 0 0) 3389 | (list->flomat '[[1 0]])) 3390 | (check-equal? (flsubmatrix (flomat-identity 3) 2 3 0 0) 3391 | (list->flomat '[[1 0 0] [0 1 0]])))) 3392 | 3393 | (with-check-info 3394 | (['test-group "product"]) 3395 | (check-equal? 3396 | (flomat*vector (list->flomat '[[1 2 3] [4 5 6]]) 3397 | (list->flomat '[[10] [11] [12]])) 3398 | (list->flomat '[[68] [167]])) 3399 | (check-equal? 3400 | (flomat*vector (list->flomat '[[1 4] [2 5] [3 6]]) 3401 | (list->flomat '[[10] [11] [12]]) 3402 | #f 1. 1. #t) 3403 | (list->flomat '[[68] [167]]))) 3404 | 3405 | (with-check-info 3406 | (['test-group "flomat-pointwise.rkt"]) 3407 | (let () 3408 | (define A (list->flomat '[[1 2] [3 4]])) 3409 | (define ~A (list->flomat '[[-1 -2] [-3 -4]])) 3410 | (define B (list->flomat '[[5 6] [7 8]])) 3411 | (define A+B (list->flomat '[[6 8] [10 12]])) 3412 | (define A-B (list->flomat '[[-4 -4] [-4 -4]])) 3413 | (with-check-info 3414 | (['test-case 'flomat+]) 3415 | (check-equal? (flomat+ A B) A+B)) 3416 | (with-check-info 3417 | (['test-case 'flomat-]) 3418 | (check-equal? (flomat- A B) A-B) 3419 | (check-equal? (flomat- A) ~A)))) 3420 | 3421 | (with-check-info 3422 | (['test-group "flomat-expt.rkt"]) 3423 | (define A (list->flomat '[[1 2] [3 4]])) 3424 | (with-check-info 3425 | (['test-case 'flomat-expt]) 3426 | (check-equal? (flomat-expt A 0) (flomat-identity 2)) 3427 | (check-equal? (flomat-expt A 1) A) 3428 | (check-equal? (flomat-expt A 2) (list->flomat '[[7 10] [15 22]])) 3429 | (check-equal? (flomat-expt A 3) (list->flomat '[[37 54] [81 118]])) 3430 | (check-equal? (flomat-expt A 8) (list->flomat '[[165751 241570] [362355 528106]])))) 3431 | 3432 | (with-check-info 3433 | (['test-group "flomat-operations.rkt"]) 3434 | (with-check-info 3435 | (['test-case 'vandermonde-flomat]) 3436 | (check-equal? (flomat-vandermonde '(1 2 3) 5) 3437 | (list->flomat '[[1 1 1 1 1] [1 2 4 8 16] [1 3 9 27 81]]))) 3438 | (with-check-info 3439 | (['test-case 'in-column]) 3440 | (check-equal? (for/list ([x (in-col (flomat/dim 2 2 1 2 3 4) 0)]) x) 3441 | '(1. 3.)) 3442 | (check-equal? (for/list ([x (in-col (flomat/dim 2 2 1 2 3 4) 1)]) x) 3443 | '(2. 4.)) 3444 | (check-equal? (for/list ([x (in-col (flcolumn 5 2 3))]) x) 3445 | '(5. 2. 3.))) 3446 | (with-check-info 3447 | (['test-case 'in-row]) 3448 | (check-equal? (for/list ([x (in-row (flomat/dim 2 2 1 2 3 4) 0)]) x) 3449 | '(1. 2.)) 3450 | (check-equal? (for/list ([x (in-row (flomat/dim 2 2 1 2 3 4) 1)]) x) 3451 | '(3. 4.))) 3452 | (with-check-info 3453 | (['test-case 'for/flomat:]) 3454 | (check-equal? (for/flomat 2 4 ([i (in-naturals)]) i) 3455 | (flomat/dim 2 4 3456 | 0 1 2 3 3457 | 4 5 6 7)) 3458 | (check-equal? (for/flomat 2 4 #:column ([i (in-naturals)]) i) 3459 | (flomat/dim 2 4 3460 | 0 2 4 6 3461 | 1 3 5 7)) 3462 | (check-equal? (for/flomat 3 3 ([i (in-range 10 100)]) i) 3463 | (flomat/dim 3 3 10 11 12 13 14 15 16 17 18))) 3464 | (with-check-info 3465 | (['test-case 'for*/flomat:]) 3466 | (check-equal? (for*/flomat 3 3 ([i (in-range 3)] [j (in-range 3)]) (+ (* i 10) j)) 3467 | (flomat/dim 3 3 0 1 2 10 11 12 20 21 22))) 3468 | (with-check-info 3469 | (['test-case 'flomat-block-diagonal]) 3470 | (check-equal? (flomat-block-diagonal (flomat/dim 2 2 1 2 3 4) (flomat/dim 1 3 5 6 7)) 3471 | (list->flomat '[[1 2 0 0 0] [3 4 0 0 0] [0 0 5 6 7]]))) 3472 | (with-check-info 3473 | (['test-case 'flomat-augment]) 3474 | (check-equal? (flomat-augment (flcolumn 1 2 3) (flcolumn 4 5 6) (flcolumn 7 8 9)) 3475 | (flomat/dim 3 3 1 4 7 2 5 8 3 6 9))) 3476 | (with-check-info 3477 | (['test-case 'flomat-stack]) 3478 | (check-equal? (flomat-stack (flcolumn 1 2 3) (flcolumn 4 5 6) (flcolumn 7 8 9)) 3479 | (flcolumn 1 2 3 4 5 6 7 8 9))) 3480 | (with-check-info 3481 | (['test-case 'column-dimension]) 3482 | (= (flcolumn-size #(1 2 3)) 3) 3483 | (= (flcolumn-size (vector->flomat 1 2 #(1 2))) 1)) 3484 | (let ([flomat: vector->flomat]) 3485 | (with-check-info 3486 | (['test-case 'column-dot]) 3487 | (= (flcolumn-dot (flcolumn 1 2) (flcolumn 1 2)) 5) 3488 | (= (flcolumn-dot (flcolumn 1 2) (flcolumn 3 4)) 11) 3489 | (= (flcolumn-dot (flcolumn 3 4) (flcolumn 3 4)) 25) 3490 | (= (flcolumn-dot (flcolumn 1 2 3) (flcolumn 4 5 6)) 3491 | (+ (* 1 4) (* 2 5) (* 3 6))))) 3492 | (with-check-info 3493 | (['test-case 'flomat-trace]) 3494 | (check-equal? (flomat-trace (vector->flomat 2 2 #(1 2 3 4))) 5.)) 3495 | (let ([flomat: vector->flomat]) 3496 | (with-check-info 3497 | (['test-case 'column-norm]) 3498 | (= (flcolumn-norm (flcolumn 2 4)) (sqrt 20)))) 3499 | (with-check-info 3500 | (['test-case 'column-projection]) 3501 | (check-equal? (flcolumn-projection #(1 2 3) #(4 5 6)) (flcolumn 128/77 160/77 192/77)) 3502 | (check-equal? (flcolumn-projection (flcolumn 1 2 3) (flcolumn 2 4 3)) 3503 | (flomat-scale 19/29 (flcolumn 2 4 3)))) 3504 | (with-check-info 3505 | (['test-case 'projection-on-orthogonal-basis]) 3506 | (check-equal? (flprojection-on-orthogonal-basis #(3 -2 2) (list #(-1 0 2) #( 2 5 1))) 3507 | (flcolumn -1/3 -1/3 1/3)) 3508 | (check-equal? (flprojection-on-orthogonal-basis 3509 | (flcolumn 3 -2 2) (list #(-1 0 2) (flcolumn 2 5 1))) 3510 | (flcolumn -1/3 -1/3 1/3))) 3511 | (with-check-info 3512 | (['test-case 'projection-on-orthonormal-basis]) 3513 | (check-equal? (flprojection-on-orthonormal-basis 3514 | #(1 2 3 4) 3515 | (list (flomat-scale 1/2 (flcolumn 1 1 1 1)) 3516 | (flomat-scale 1/2 (flcolumn -1 1 -1 1)) 3517 | (flomat-scale 1/2 (flcolumn 1 -1 -1 1)))) 3518 | (flcolumn 2 3 2 3))) 3519 | (with-check-info 3520 | (['test-case 'flgram-schmidt-orthogonal]) 3521 | (check-equal? (flgram-schmidt-orthogonal (list #(3 1) #(2 2))) 3522 | (list (flcolumn 3 1) (flcolumn -2/5 6/5)))) 3523 | (with-check-info 3524 | (['test-case 'flvector-normalize]) 3525 | (check-equal? (flcolumn-normalize #(3 4)) 3526 | (flcolumn 3/5 4/5))) 3527 | (with-check-info 3528 | (['test-case 'flgram-schmidt-orthonormal]) 3529 | (check-equal? (flgram-schmidt-orthonormal '(#(3 1) #(2 2))) 3530 | (list (flcolumn-normalize #(3 1)) 3531 | (flcolumn-normalize #(-2/5 6/5))))) 3532 | 3533 | (with-check-info 3534 | (['test-case 'projection-on-subspace]) 3535 | (check-equal? (flprojection-on-subspace #(1 2 3) '(#(2 4 3))) 3536 | (flomat-scale 19/29 (flcolumn 2 4 3)))) 3537 | (with-check-info 3538 | (['test-case 'unit-vector]) 3539 | (check-equal? (flcolumn-unit 4 1) (flcolumn 0 1 0 0))) 3540 | (with-check-info (['test-case 'flomat-qr]) 3541 | (let*-values ([(A) (flomat/dim 3 2 1 1 0 1 1 1)] 3542 | [(Q R) (flomat-qr A)]) 3543 | (check-true 3544 | (flomat= (flomat* Q R) 3545 | A 3546 | epsilon)))) 3547 | (with-check-info 3548 | (['test-case 'flomat-solve]) 3549 | (let* ([M (list->flomat '[[1 5] [2 3]])] 3550 | [b (list->flomat '[[5] [5]])]) 3551 | (check-equal? (flomat* M (flomat-solve M b)) b))) 3552 | (with-check-info 3553 | (['test-case 'flomat-inverse]) 3554 | (check-equal? (let ([M (list->flomat '[[1 2] [3 4]])]) (flomat* M (flomat-inverse M))) 3555 | (flomat-identity 2)) 3556 | (check-equal? (let ([M (list->flomat '[[1 2] [3 4]])]) (flomat* (flomat-inverse M) M)) 3557 | (flomat-identity 2))) 3558 | (with-check-info 3559 | (['test-case 'flomat-determinant]) 3560 | (check-equal? (flomat-determinant (list->flomat '[[3]])) 3.) 3561 | (check-equal? (flomat-determinant (list->flomat '[[1 2] [3 4]])) (- (* 1. 4.) (* 2. 3.))) 3562 | (flcheck-equal? (flomat-determinant (list->flomat '[[1 2 3] [4 5 6] [7 8 9]])) 0.) 3563 | (flcheck-equal? (flomat-determinant (list->flomat '[[1 2 3] [4 -5 6] [7 8 9]])) 120.) 3564 | (flcheck-equal? (flomat-determinant 3565 | (list->flomat '[[1 2 3 4] [-5 6 7 8] [9 10 -11 12] [13 14 15 16]])) 5280.)) 3566 | (with-check-info 3567 | (['test-case 'flomat-scale]) 3568 | (check-equal? (flomat-scale 2 (list->flomat '[[1 2] [3 4]])) 3569 | (list->flomat '[[2 4] [6 8]]))) 3570 | (with-check-info 3571 | (['test-case 'flomat-transpose]) 3572 | (check-equal? (flomat-transpose (list->flomat '[[1 2] [3 4]])) 3573 | (list->flomat '[[1 3] [2 4]]))) 3574 | ; TODO: Just use U from LU factorization 3575 | #;(let () 3576 | (: gauss-eliminate : (flomat Number) Boolean Boolean -> (flomat Number)) 3577 | (define (gauss-eliminate M u? p?) 3578 | (let-values ([(M wp) (flomat-gauss-eliminate M u? p?)]) 3579 | M)) 3580 | (with-check-info 3581 | (['test-case 'flomat-gauss-eliminate]) 3582 | (check-equal? (let ([M (list->flomat '[[1 2] [3 4]])]) 3583 | (gauss-eliminate M #f #f)) 3584 | (list->flomat '[[1 2] [0 -2]])) 3585 | (check-equal? (let ([M (list->flomatixix '[[2 4] [3 4]])]) 3586 | (gauss-eliminate M #t #f)) 3587 | (list->flomatixixix '[[1 2] [0 1]])) 3588 | (check-equal? (let ([M (list->flomatix '[[2. 4.] [3. 4.]])]) 3589 | (gauss-eliminate M #t #t)) 3590 | (list->flomatix '[[1. 1.3333333333333333] [0. 1.]])) 3591 | (check-equal? (let ([M (list->flomat '[[1 4] [2 4]])]) 3592 | (gauss-eliminate M #t #t)) 3593 | (list->flomat '[[1 2] [0 1]])) 3594 | (check-equal? (let ([M (list->flomat '[[1 2] [2 4]])]) 3595 | (gauss-eliminate M #f #t)) 3596 | (list->flomat '[[2 4] [0 0]])))) 3597 | (with-check-info 3598 | (['test-case 'flomat-scale-row]) 3599 | (check-equal? (flomat-scale-row (flomat-identity 3) 0 2) 3600 | (lists->flomat '[[2 0 0] [0 1 0] [0 0 1]]))) 3601 | (with-check-info 3602 | (['test-case 'flomat-swap-rows]) 3603 | (check-equal? (flomat-swap-rows (lists->flomat '[[1 2 3] [4 5 6] [7 8 9]]) 0 1) 3604 | (lists->flomat '[[4 5 6] [1 2 3] [7 8 9]]))) 3605 | (with-check-info 3606 | (['test-case 'flomat-add-scaled-row]) 3607 | (check-equal? (flomat-add-scaled-row (lists->flomat '[[1 2 3] [4 5 6] [7 8 9]]) 0 2 1) 3608 | (lists->flomat '[[9 12 15] [4 5 6] [7 8 9]]))) 3609 | (let () 3610 | (define M (lists->flomat '[[1 1 0 3] 3611 | [2 1 -1 1] 3612 | [3 -1 -1 2] 3613 | [-1 2 3 -1]])) 3614 | (define-values (P L U) (flomat-plu M)) 3615 | (with-check-info 3616 | (['test-case 'flomat-plu]) 3617 | (check-equal? (flomat* P (flomat* L U)) M))) 3618 | (with-check-info 3619 | (['test-case 'flomat-rank]) 3620 | (check-equal? (flomat-rank (list->flomat '[[0 0] [0 0]])) 0) 3621 | (check-equal? (flomat-rank (list->flomat '[[1 0] [0 0]])) 1) 3622 | (check-equal? (flomat-rank (list->flomat '[[1 0] [0 3]])) 2) 3623 | (check-equal? (flomat-rank (list->flomat '[[1 2] [2 4]])) 1) 3624 | (check-equal? (flomat-rank (list->flomat '[[1 2] [3 4]])) 2)) 3625 | (with-check-info 3626 | (['test-case 'flomat-nullity]) 3627 | (check-equal? (flomat-nullity (list->flomat '[[0 0] [0 0]])) 2) 3628 | (check-equal? (flomat-nullity (list->flomat '[[1 0] [0 0]])) 1) 3629 | (check-equal? (flomat-nullity (list->flomat '[[1 0] [0 3]])) 0) 3630 | (check-equal? (flomat-nullity (list->flomat '[[1 2] [2 4]])) 1) 3631 | (check-equal? (flomat-nullity (list->flomat '[[1 2] [3 4]])) 0)) 3632 | ; Not implemented yet... 3633 | #;(let () 3634 | (define-values (c1 n1) 3635 | (flomat-column+null-space (list->flomat '[[0 0] [0 0]]))) 3636 | (define-values (c2 n2) 3637 | (flomat-column+null-space (list->flomat '[[1 2] [2 4]]))) 3638 | (define-values (c3 n3) 3639 | (flomat-column+null-space (list->flomat '[[1 2] [2 5]]))) 3640 | (with-check-info 3641 | (['test-case 'flomat-column+null-space]) 3642 | (check-equal? c1 '()) 3643 | (check-equal? n1 (list (list->flomat '[[0] [0]]) 3644 | (list->flomat '[[0] [0]]))) 3645 | (check-equal? c2 (list (list->flomat '[[1] [2]]))) 3646 | ;(check-equal? n2 '([0 0])) 3647 | (check-equal? c3 (list (list->flomat '[[1] [2]]) 3648 | (list->flomat '[[2] [5]]))) 3649 | (check-equal? n3 '())))) 3650 | 3651 | (with-check-info 3652 | (['test-group "matrix-multiply.rkt"]) 3653 | (with-check-info 3654 | (['test-case 'flomat*]) 3655 | (let () 3656 | (define-values (A B AB) (values '[[1 2] [3 4]] '[[5 6] [7 8]] '[[19 22] [43 50]])) 3657 | (check-equal? (flomat* (list->flomat A) (list->flomat B)) (list->flomat AB))) 3658 | (let () 3659 | (define-values (A B AB) (values '[[1 2] [3 4]] '[[5 6 7] [8 9 10]] '[[21 24 27] [47 54 61]])) 3660 | (check-equal? (flomat* (list->flomat A) (list->flomat B)) (list->flomat AB)))))) 3661 | 3662 | (define (build-flomat m n f) 3663 | (for*/flomat m n 3664 | ([i (in-range m)] 3665 | [j (in-range n)]) 3666 | (f i j))) 3667 | 3668 | -------------------------------------------------------------------------------- /flomat/info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | ;;; Info file for sci/flomat. 3 | 4 | ;; Name 5 | ; The collection name can be different from the directory name, 6 | ; Here they are the same. 7 | (define collection "flomat") 8 | 9 | ;; Version 10 | (define version "1.0") 11 | 12 | ;; Dependencies 13 | 14 | (define deps '("base" 15 | ; The shared libraries 16 | ("linux-shared-libraries" #:platform "x86_64-linux-natipkg"))) 17 | 18 | (define build-deps '("rackunit-lib")) 19 | -------------------------------------------------------------------------------- /flomat/main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | (require "flomat.rkt" "expm.rkt") 3 | (provide (all-from-out "flomat.rkt" "expm.rkt")) 4 | -------------------------------------------------------------------------------- /info.rkt: -------------------------------------------------------------------------------- 1 | #lang info 2 | ;;; Info file for sci which contains multiple collections 3 | 4 | ;; Name 5 | ; No name since `sci` consists of multiple collections. 6 | (define collection 'multi) 7 | 8 | ;; Version 9 | (define version "1.0") 10 | 11 | ;; Dependencies 12 | (define deps '("base" 13 | )) 14 | 15 | ;; 16 | (define implies '()) 17 | 18 | ;; Package Description 19 | (define pkg-desc "Scientific libraries: flomat (floating point matrices)") 20 | 21 | (define pkg-authors '(soegaard)) 22 | (define build-deps '("rackunit-lib" 23 | "scribble-lib" 24 | "scribble-math" 25 | "math-doc" 26 | "racket-doc" 27 | ("linux-shared-libraries" #:platform "x86_64-linux-natipkg"))) 28 | --------------------------------------------------------------------------------