GAUSSIAN ELIMINATION

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

/ a11  a12  ... a1n \  / x1 \     / b1 \
| a21  a22  ... a2n |  | x2 |     | b2 |
|  .    .    .   .  |  | .  |     | .  |
|  .    .    .   .  |  | .  |  =  | .  |
|  .    .    .   .  |  | .  |     | .  |
\ an1  an2  ... ann /  \ xn /     \ bn /
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.

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:

(define $ vector-ref)
(define $! vector-set!)
We'll also need the operation of copying a vector, which is easily defined:
(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))))))
The analogous operations for matrices (as vectors of vectors) can now be defined straightforwardly:
(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)))))))
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.

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


created July 14, 1995
last revised June 24, 1996

John David Stone (stone@math.grin.edu)