Problem: Solve a system of n independent linear equations in n variables.
It is well known that this problem is equivalent to solving the single matrix equation
where a typical value aij in the a matrix is the coefficient of xj in the ith equation, and a typical value bi in the b matrix is the number on the right-hand side of the ith equation./ a11 a12 ... a1n \ / x1 \ / b1 \ | a21 a22 ... a2n | | x2 | | b2 | | . . . . | | . | | . | | . . . . | | . | = | . | | . . . . | | . | | . | \ an1 an2 ... ann / \ xn / \ bn /
To solve this equation by Gaussian elimination, one first transforms the system of equations by performing solution-preserving transformations on the matrices, leading to a matrix equation like that shown above, except that all the values in the lower triangle of the a matrix are zero. The value of xn is then known to be bn/ann, and by backwards substitution the values of the other unknowns can be computed similarly.
Scheme does not have a matrix data type, but it is natural to implement matrices as vectors of vectors, like two-dimensional arrays in C.
To save writing out the long procedure names vector-ref
and vector-set!
repeatedly, let's define short aliases for
them:
We'll also need the operation of copying a vector, which is easily defined:(define $ vector-ref) (define $! vector-set!)
The analogous operations for matrices (as vectors of vectors) can now be defined straightforwardly:(define vector-copy (lambda (vec) (let* ((len (vector-length vec)) (result (make-vector len))) (do ((index 0 (+ index 1))) ((= index len) result) ($! result index ($ vec index))))))
Now we're ready to implement solution by Gaussian elimination. The procedure takes two arguments, the matrix of coefficients from the left-hand side of the equations and the vector of numbers from the right-hand side. It returns a vector of numbers -- the values of the unknowns in the original system of equations.(define $$ (lambda (matrix row column) ($ ($ matrix row) column))) (define $$! (lambda (matrix row column value) ($! ($ matrix row) column value))) (define matrix-copy (lambda (mat) (let* ((rows (vector-length mat)) (result (make-vector rows))) (do ((row 0 (+ row 1))) ((= row rows) result) ($! result row (vector-copy ($ mat row)))))))
Here's the plan: For each row of the matrix, swap it with any of the rows that follow it (or with itself) so as to place the entry with the largest absolute value on the diagonal of the matrix; this averts division by zero (since the matrix is non-singular) and helps avoid numerical instability when the matrix elements are inexact. Then convert all the matrix entries beneath that element on the diagonal to zero by subtracting away from each later equation an appropriate scalar multiple of the earlier one. When this has been done for all the rows, use back-substitution to recover the solution vector from the upper-triangular matrix.
Since the matrix transformations are destructive, the procedure begins by
making copies of the argument matrices and operates on those copies rather
than the originals. Omitting the copy operation would give the caller the
choice between speed -- (gaussian-elimination mat vec)
-- and
protection -- (gaussian-elimination (matrix-copy mat) (vector-copy
vec))
.
To break up the problem into simpler subproblems, it's useful to create several internally defined procedures. Each of the solution-preserving matrix transformations (namely, adding a scalar multiple of one equation to another, and exchanging the positions of two equations) deserves its own procedure, as does determining which entry in a given column has the largest absolute value. Finally, we need a back-substitution procedure that builds up the solution vector one element at a time; it has an internally defined procedure of its own that computes a single element of the solution vector.
Assembling the pieces yields this substantial structure:
(define gaussian-elimination (lambda (coefficients right-hand-sides) (let* ((n (vector-length right-hand-sides)) (lhs (matrix-copy coefficients)) (rhs (vector-copy right-hand-sides)) (scalar-multiple-add! (lambda (augend addend scalar) (do ((column 0 (+ column 1))) ((= column n)) ($$! lhs augend column (+ ($$ lhs augend column) (* scalar ($$ lhs addend column))))) ($! rhs augend (+ ($ rhs augend) (* scalar ($ rhs addend)))))) (swap-equations! (lambda (alphonse gaston) (let ((temp-lhs ($ lhs alphonse)) (temp-rhs ($ rhs alphonse))) ($! lhs alphonse ($ lhs gaston)) ($! rhs alphonse ($ rhs gaston)) ($! lhs gaston temp-lhs) ($! rhs gaston temp-rhs)))) (biggest-in-column (lambda (col start) (let loop ((row (+ start 1)) (biggest-so-far ($$ lhs start col)) (row-so-far start)) (if (= row n) (cons biggest-so-far row-so-far) (let ((current ($$ lhs row col))) (if (< (abs biggest-so-far) (abs current)) (loop (+ row 1) current row) (loop (+ row 1) biggest-so-far row-so-far))))))) (back-substitute (lambda (lhs rhs) (let* ((result (make-vector n)) (solution (lambda (index) (let loop ((number ($ rhs index)) (later-index (+ index 1))) (if (= later-index n) (/ number ($$ lhs index index)) (loop (- number (* ($$ lhs index later-index) ($ result later-index))) (+ later-index 1))))))) (do ((index (- n 1) (- index 1))) ((negative? index) result) ($! result index (solution index))))))) (do ((index 0 (+ index 1))) ((= index (- n 1))) (let* ((swapfacts (biggest-in-column index index)) (pivot (car swapfacts)) (swap-row (cdr swapfacts))) (swap-equations! index swap-row) (do ((eliminand (+ index 1) (+ eliminand 1))) ((= eliminand n)) (scalar-multiple-add! eliminand index (- (/ ($$ lhs eliminand index) pivot)))))) (back-substitute lhs rhs))))
This document is available on the World Wide Web as
http://www.math.grin.edu/~stone/events/scheme-workshop/gaussian.html