連立一次方程式
連立一次方程式を解く問題はこの世の中に沢山存在する。そのために代数学が発展した史実を
観れば納得する。我国でも「鶴亀算」と愛称される連立一次方程式の問題を江戸時代あたりで
多用されている。簡単に説明すれば、以下のとおりである。
「鶴は脚を2本、亀は脚を4本もつ。ここに、脚の総数が24本、鶴と亀の総数が10匹であ
る。さて、鶴と亀はそれぞれ何匹ずついるか?」という問題である。
現代では以下のように連立方程式を立てることで、未知数をもとめることは朝飯前である。
・・・・・・・・・・・・・・・・・・・・・(5.1)
答はここでは書かないが、式(5.1)を解くには一方の変数の消去を行って、その解を求め、
それを元の方程式に代入して他方の未知数を求める処理を行えば良いことは誰でも知っている。
さて、この問題は極めて簡単で小規模な未知数をもつ問題であるから、筆算や暗算で解を得る
ことは容易である。ところが、大規模な未知数をもつ問題を目の前にしたら、凡人には解く意
欲がなくなるのが普通であろう。実際、建築学の分野でも構造力学や建築計画学において数式
を扱う問題は沢山あり、そこでは連立方程式を多用する。このように多数の未知数を扱う問題
に対して、規則的な算法が用意できれば、計算機プログラムで問題を数値解としてえることが
できる。
以下に示すのは、代数学で有名なガウス( Gauss, Carl Friedrich, 1777-1855) による
算法である。「ガウスの消去法」と呼ばれるもので、式(5.1)の解き方の説明そのもので
ある。式(5.2)で示される n 個の未知数をもつ連立一次方程式が与えられたときの算法を
説明しよう。
・・・・・・・・(5.2)
式(5.2)は行列で書き改めると次式で表せる。
・・・・・・・・・・・・・・・・・・・・・・・・(5.3)
ただし、
式(5.2)中の第2式の を消去するために、第1式の辺々に
を乗じて第
2式から引くと、式(5.4)が得られる。
・・(5.4)
同様に第3の式のを消去するために、第1式の辺々に
を乗じて第3式から
引くと、式(5.5)が得られる。
・・(5.5)
この処理を一般化して、 i 番目の式のを消去する式は式(5.6)で与えられる。
・・・・・・・・・・・・・・・・(5.6)
ただし、ハ。
いま、式(5.2)におけるを
とおいて、係数マトリクスを式(5.7)で
表現することにする。
・・・・・・・・・・・・・・・・・・・(5.7)
式(5.6)を用いて、未知数を減らしていくと、式(5.8)のようなマトリクスが得られる。
・・・・・・・・・・・・・・・(5.8)
これを用いて元の連立一次方程式の形に戻すと、式(5.9)となる。
・・・・・・・・・・・・・・・・(5.9)
同式の n 番目の式から、
・・・・・・・・・・・・・・・・・・・・・・・・・・・・・(5.10)
が得られ、更にこれを n-1 番目の式に代入してを得る。以下順次同様の代入を繰返して
すべての解を得ることができる。k 番目の解は式(5.11)で求められる。
・・・・・・・・・・・・・・・・・・・・・(5.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) = "1以上の未知数の数を入力してください。"
.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
' マトリクスAとベクトルbをワークシートから読み取る。
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