Commit 60c1fae1 authored by Liam M. Healy's avatar Liam M. Healy

Add matrix.lisp, root-mean-square

New file matrix.lisp consolidates matrix functions and adds a few
more.
parent bb6c5242
;; Make arrays from other arrays
;; Liam Healy 2009-11-11 11:33:22EST compose-array.lisp
;; Time-stamp: <2013-11-11 11:41:28EST compose.lisp>
;; Time-stamp: <2018-11-03 11:36:45EDT compose.lisp>
;;
;; Copyright 2009, 2010, 2011 Liam M. Healy
;; Copyright 2009, 2010, 2011, 2018 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -20,7 +20,7 @@
(in-package :grid)
(export '(drop subgrid codimension-one-subspace row column transpose
(export '(drop subgrid codimension-one-subspace transpose
make-grid-with-diagonal diagonal identity-matrix
set-diagonal concatenate-grids stride))
......@@ -91,24 +91,6 @@ is an optional pre-existing grid in which to write the result."
(remove-position (sequential-list (rank grid)) position))
subgrid))
(defun row (grid index &optional destination)
"The subgrid with the first index set to the specified value."
(codimension-one-subspace grid 0 index destination))
(defun (setf row) (subgrid grid index)
"Set the subgrid with the first index set to the specified value."
(setf (codimension-one-subspace grid 0 index)
subgrid))
(defun column (grid index &optional destination)
"The subgrid with the second index set to the specified value."
(codimension-one-subspace grid 1 index destination))
(defun (setf column) (subgrid grid index)
"Set the subgrid with the second index set to the specified value."
(setf (codimension-one-subspace grid 1 index)
subgrid))
;;;;****************************************************************************
;;;; Transpose
;;;;****************************************************************************
......
;; Functions on two-dimensional grids
;; Liam Healy 2018-11-03 11:31:58EDT matrix.lisp
;; Time-stamp: <2018-11-03 11:36:45EDT matrix.lisp>
;; Copyright 2009, 2010, 2012, 2016, 2018 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :grid)
(export '(row rows column columns matrix-from-columns map-columns
matrix-from-rows map-rows))
;;;;****************************************************************************
;;;; Rows and columns of a matrix
;;;;****************************************************************************
(defun row (grid index &optional destination)
"The subgrid with the first index set to the specified value."
(codimension-one-subspace grid 0 index destination))
(defun rows (grid)
"A list of all the rows."
(loop for index from 0 below (dim0 grid)
collect (row grid index)))
(defun (setf row) (subgrid grid index)
"Set the subgrid with the first index set to the specified value."
(setf (codimension-one-subspace grid 0 index)
subgrid))
(defun column (grid index &optional destination)
"The subgrid with the second index set to the specified value."
(codimension-one-subspace grid 1 index destination))
(defun columns (grid)
"A list of all the columns."
(loop for index from 0 below (dim1 grid)
collect (column grid index)))
(defun (setf column) (subgrid grid index)
"Set the subgrid with the second index set to the specified value."
(setf (codimension-one-subspace grid 1 index)
subgrid))
;;;;****************************************************************************
;;;; Make/map matrix from row or column vectors
;;;;****************************************************************************
(defun matrix-from-columns (&rest columns)
"Make the matrix out of the equal-length vectors.
If *default-grid-type* is non-nil, resultant grid
will be of the specified type; otherwise, it will
be the same as the first column."
(assert
(apply '=
(mapcar
(lambda (c) (when (= 1 (length (dimensions c))) (dim0 c)))
columns))
(columns)
"Columns must be vectors of equal length.")
(let ((ans (make-grid
(make-specification
(or (gridp (first columns)) *default-grid-type*)
(list (dim0 (first columns)) (length columns))
(element-type (first columns))))))
(loop for j from 0
for col in columns
do (setf (column ans j) col))
ans))
(defun map-columns (function matrix)
"Apply a function that returns a column for each of the columns of the matrix"
(apply #'matrix-from-rows (mapcar function (rows matrix))))
(defun matrix-from-rows (&rest rows)
"Make a matrix from the specified rows"
(transpose (apply #'matrix-from-columns rows)))
(defun map-rows (function matrix)
"Apply a function that returns a row for each of the rows of the matrix"
(apply #'matrix-from-rows (mapcar function (rows matrix))))
;; Inner product, norms
;; Liam Healy 2009-12-13 12:23:01EST inner.lisp
;; Time-stamp: <2016-01-06 17:45:51EST norm-vector-product.lisp>
;; Time-stamp: <2018-11-03 16:45:27EDT norm-vector-product.lisp>
;;
;; Copyright 2009, 2010, 2012, 2016 Liam M. Healy
;; Copyright 2009, 2010, 2012, 2016, 2018 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -24,7 +24,7 @@
;;;; Vector products
;;;;****************************************************************************
(export '(cross inner euclidean norm normalize outer))
(export '(cross inner euclidean root-mean-square norm normalize outer))
(defun cross (grid0 grid1)
"The cross product of two vectors, using the first three components of each."
......@@ -51,18 +51,21 @@
do (antik:incf sum (antik:* (aref* grid0 e0) (aref* grid1 e1)))
finally (return sum)))))
(defun euclidean (grid &optional (kind :euclidean))
"The norm of the grid. Kind can be :euclidean, for the
euclidean, or 2-norm."
(declare (ignorable kind))
(defun euclidean (grid)
"The Euclidean, or 2-norm of the grid."
(antik:sqrt (inner grid grid)))
(defun root-mean-square (grid)
"The root mean square of the vector."
(/ (euclidean grid) (sqrt (total-size grid))))
(defun norm (grid &optional (kind :euclidean))
"The norm of the grid. Kind can be :euclidean, for the
euclidean norm."
(declare (ignorable kind))
(euclidean grid))
;;; Rename this to #'direction
(defun normalize (grid &optional threshold)
"Find the normalized grid, i.e., each element is divided by grid
norm, and the normalization factor. If the norm is less than the
......@@ -95,30 +98,3 @@
do (setf (aref product e0 e1)
(antik:* (aref* grid0 e0) (aref* grid1 e1))))))
product)))
;;;;****************************************************************************
;;;; Make a matrix out of column vectors
;;;;****************************************************************************
(export 'matrix-from-columns)
(defun matrix-from-columns (&rest columns)
"Make the matrix out of the equal-length vectors.
If *default-grid-type* is non-nil, resultant grid
will be of the specified type; otherwise, it will
be the same as the first column."
(assert
(apply '=
(mapcar
(lambda (c) (when (= 1 (length (dimensions c))) (dim0 c)))
columns))
(columns)
"Columns must be vectors of equal length.")
(let ((ans (make-grid
(make-specification
(or (gridp (first columns)) *default-grid-type*)
(list (dim0 (first columns)) (length columns))
(element-type (first columns))))))
(loop for j from 0
for col in columns
do (setf (column ans j) col))
ans))
;; Minimize or maximize the function in one variable.
;; Liam Healy 2011-01-14 12:18:15EST minimize.lisp
;; Time-stamp: <2017-12-16 16:09:19EST one-dim.lisp>
;; Time-stamp: <2018-11-03 11:59:53EDT one-dim.lisp>
;; Copyright 2011, 2014, 2015, 2017 Liam M. Healy
;; Copyright 2011, 2014, 2015, 2017, 2018 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -24,6 +24,8 @@
(export '(root-1d minimize-1d maximize-1d))
(defvar *maximum-iterations* 15)
(defgeneric root-1d (function initial derivative &optional absolute-error relative-error method)
(:documentation
"Find the root of a real function of a real variable. Returns the argument value of the root and the computed value of the function at that value. The argument and return values may be physical quantities. If derivative is nil, the function should return value and derivative as multiple values.")
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment