連立一次方程式

ガウスの消去法

目次へ

　連立一次方程式を解く問題はこの世の中に沢山存在する。そのために代数学が発展した史実を

観れば納得する。我国でも「鶴亀算」と愛称される連立一次方程式の問題を江戸時代あたりで

多用されている。簡単に説明すれば、以下のとおりである。

　「鶴は脚を２本、亀は脚を４本もつ。ここに、脚の総数が２４本、鶴と亀の総数が１０匹であ

る。さて、鶴と亀はそれぞれ何匹ずついるか？」という問題である。

　現代では以下のように連立方程式を立てることで、未知数をもとめることは朝飯前である。

　　　・・・・・・・・・・・・・・・・・・・・・（５．１）

答はここでは書かないが、式（５．１）を解くには一方の変数の消去を行って、その解を求め、

それを元の方程式に代入して他方の未知数を求める処理を行えば良いことは誰でも知っている。

さて、この問題は極めて簡単で小規模な未知数をもつ問題であるから、筆算や暗算で解を得る

ことは容易である。ところが、大規模な未知数をもつ問題を目の前にしたら、凡人には解く意

欲がなくなるのが普通であろう。実際、建築学の分野でも構造力学や建築計画学において数式

を扱う問題は沢山あり、そこでは連立方程式を多用する。このように多数の未知数を扱う問題

に対して、規則的な算法が用意できれば、計算機プログラムで問題を数値解としてえることが

できる。

　以下に示すのは、代数学で有名なガウス（ Gauss, Carl Friedrich, 1777-1855）による

算法である。「ガウスの消去法」と呼ばれるもので、式（５．１）の解き方の説明そのもので

ある。式（５．２）で示される n 個の未知数をもつ連立一次方程式が与えられたときの算法を

説明しよう。

　　　　・・・・・・・・（５．２）

式（５．２）は行列で書き改めると次式で表せる。

　　・・・・・・・・・・・・・・・・・・・・・・・・（５．３）

ただし、

式（５．２）中の第２式のを消去するために、第１式の辺々にを乗じて第

２式から引くと、式（５．４）が得られる。

　・・（５．４）

同様に第３の式のを消去するために、第１式の辺々にを乗じて第３式から

引くと、式（５．５）が得られる。

　・・（５．５）

この処理を一般化して、 i 番目の式のを消去する式は式（５．６）で与えられる。

　　・・・・・・・・・・・・・・・・（５．６）

ただし、ﾊ。

いま、式（５．２）におけるをとおいて、係数マトリクスを式（５．７）で

表現することにする。

　・・・・・・・・・・・・・・・・・・・（５．７）

式（５．６）を用いて、未知数を減らしていくと、式（５．８）のようなマトリクスが得られる。

　・・・・・・・・・・・・・・・（５．８）

これを用いて元の連立一次方程式の形に戻すと、式（５．９）となる。

　・・・・・・・・・・・・・・・・（５．９）

同式の n 番目の式から、

　・・・・・・・・・・・・・・・・・・・・・・・・・・・・・（５．10）

が得られ、更にこれを n-1 番目の式に代入してを得る。以下順次同様の代入を繰返して

すべての解を得ることができる。k 番目の解は式（５．11）で求められる。

　・・・・・・・・・・・・・・・・・・・・・（５．11）

コード　



Private Sub CommandButton1_Click()

'


'  Gaussian Method

      Dim a(10, 11), p(10, 11), x(10)

' 　解のセルをクリア

    Range("B21:E30").Select
    Selection.ClearContents
    Range("B4").Select

'　　セルの基準位置

      ii = 6: jj = 1: kk = 14: mm = 20
     
'　　未知数の数をワークシートから読み取る。

      With Worksheets("Sheet1")
        n = .Cells(4, 2)
      End With
      
      If n = 0 Then
        With Worksheets("Sheet1")
          .Cells(4, 4) = "１以上の未知数の数を入力してください。"
          .Cells(4, 4).Font.Color = RGB(255, 0, 0)
        End With
        GoTo EndJob
      End If
      
      With Worksheets("Sheet1")
        .Cells(4, 4) = ""
        .Cells(4, 4).Font.Color = RGB(0, 0, 0)
      End With
      
      m = n + 1

'　　マトリクスＡとベクトルｂをワークシートから読み取る。

      With Worksheets("Sheet1")
        For i = 1 To n
          For j = 1 To n
            a(i, j) = .Cells(ii + i, jj + j)
          Next j
        Next i
        
        For i = 1 To n
            a(i, m) = .Cells(ii + i, kk)
        Next i
      End With

'　　サブルーチン GAUSS を呼び出して方程式を解く。

      GoSub GAUSS

'　　解をワークシートに書き出す。

      With Worksheets("Sheet1")
        For i = 1 To n
          .Cells(mm + i, 2) = x(i)
        Next i
      End With
      End

'------------------ サブルーチン------------------


'　　サブルーチン　ガウスの掃き出し法

GAUSS:

      For j = 1 To n - 1
      For i = j + 1 To n

Pos1:
        If a(j, j) <> 0# Then GoTo Pos2
        
'　　サブルーチン PIV を呼び出す。

        GoSub PIV
      
        GoTo Pos1

Pos2:
        w = a(i, j) / a(j, j)
        a(i, j) = 0#
      
        For k = j + 1 To m
          a(i, k) = a(i, k) - w * a(j, k)
        Next k
      
      Next i
      Next j
      
      If a(n, n) = 0# Then
      With Worksheets("Sheet1")
        .Cells(18, 7) = "この方程式は解けません。"
        .Cells(18, 7).Font.Color = RGB(255, 0, 0)
      End With
      GoTo EndJob
      
      Else
      With Worksheets("Sheet1")
        .Cells(18, 7) = ""
        .Cells(18, 7).Font.Color = RGB(0, 0, 0)
      End With
      
      End If
      
      x(n) = a(n, m) / a(n, n)
      
      For kk = 1 To n - 1
        k = n - kk
        s = a(k, m)
        For j = k + 1 To n
          s = s - a(k, j) * x(j)
        Next j
        x(k) = s / a(k, k)
      Next kk
      Return

'　　サブルーチン　ピボット
PIV:

      k1 = j + 1
      
Pos3:
      If k1 > n Then
      With Worksheets("Sheet1")
        .Cells(18, 7) = "この方程式は解けません。"
        .Cells(18, 7).Font.Color = RGB(255, 0, 0)
      End With
      
      GoTo EndJob
      
      Else
      With Worksheets("Sheet1")
        .Cells(18, 7) = ""
        .Cells(18, 7).Font.Color = RGB(0, 0, 0)
      End With
      
      End If
      
Pos4:
      
      For l = 1 To m
        w = a(j, l)
        a(j, l) = a(k1, l)
        a(k1, l) = w
      Next l

      If a(j, j) <> 0# Then Return
      k1 = k1 + 1
      GoTo Pos3

EndJob:

End Sub

サンプル