Common Lisp Написал первую осмысленную программу на Common Lisp.
Ниже -- фрагмент: функция
hyperplane для вычисления коэффициентов уравнения гиперплоскости, проходящей через заданный набор точек, количество которых совпадает с размерностью пространства, и вспомогательные к ней функции.
Комментарии от знатоков приветствуются.
(asdf:operate 'asdf:load-op 'cl-utilities)
(defpackage algebra
(:use :common-lisp :cl-utilities))
(in-package algebra)
(defun submatrix (matrix row-to-delete)
(let* ((n (car (array-dimensions matrix)))
(result (make-array (list (1- n) (1- n)))))
(flet ((fill-row (matrix-row result-row)
(loop for index from 1 below n do
(setf (aref result result-row (1- index))
(aref matrix matrix-row index)))))
(when (/= row-to-delete 0)
(loop for row from 1 below row-to-delete do
(fill-row row (1- row)))
(fill-row 0 (1- row-to-delete)))
(loop for row from (1+ row-to-delete) below n do
(fill-row row (1- row)))
result)))
(defun determinant-sub (matrix)
(let ((n (car (array-dimensions matrix))))
(if (= 1 n)
(aref matrix 0 0)
(let ((rows ()) (prod 1) (selected-row nil) (multiplier nil)
(numerator 1) (denominator 1))
(loop for index from 0 below n do
(when (/= 0 (aref matrix index 0))
(setq rows (append rows (list index)))
(setq prod (* prod (aref matrix index 0)))
))
(if (= (length rows) 0)
0
(progn
(setq selected-row (car rows))
(setq multiplier (/ prod (aref matrix selected-row 0)))
(loop for index from 1 below n do
(setf
(aref matrix selected-row index)
(* (aref matrix selected-row index) multiplier)))
(dolist (row (cdr rows))
(setq multiplier (/ prod (aref matrix row 0)))
(loop for index from 1 below n do
(setf
(aref matrix row index)
(- (* (aref matrix row index) multiplier)
(aref matrix selected-row index)))))
(if (/= 0 selected-row)
(setq numerator -1))
(if (= 1 (length rows))
(setq numerator (* numerator (aref matrix (car rows) 0))))
(if (> (length rows) 2)
(setq denominator (expt prod (- (length rows) 2))))
(/ (* (determinant-sub (submatrix matrix selected-row))
numerator
) denominator)))))))
(defun determinant (matrix)
(determinant-sub (copy-array matrix)))
(defun submatrix2 (matrix row-to-delete)
(let* ((n (car (array-dimensions matrix)))
(result (make-array (list (1- n) (1- n)))))
(flet ((fill-row (matrix-row result-row)
(loop for index from 1 below n do
(setf (aref result result-row (1- index))
(aref matrix matrix-row index)))))
(when (/= row-to-delete 0)
(loop for row from 0 below row-to-delete do
(fill-row row row)))
(loop for row from (1+ row-to-delete) below n do
(fill-row row (1- row)))
result)))
(defun hyperplane (points)
(let* ((first-point (car points))
(n (length first-point))
(matrix (make-array (list n n)))
(row 0) (col 1)
(multiplier 1) (free-term 0)
(result ()))
(dolist (point (cdr points))
(setf row 0)
(mapcar #'(lambda (a b)
(setf (aref matrix row col) (- a b))
(setf row (1+ row)))
point first-point)
(setf col (1+ col)))
(loop for row from 0 below n do
(setq result
(append result
(list (* multiplier
(determinant
(submatrix2 matrix row))))))
(setq multiplier (- multiplier)))
(mapcar #'(lambda (a b) (setf free-term (- free-term (* a b))))
result first-point)
(append result (list free-term))))