?? lemodule.bas
字號(hào):
Attribute VB_Name = "LEModule"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 模塊名：LEModule.bas
' 功能： 求解線性方程組
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 模塊名：LEModule.bas
' 函數(shù)名：LEGauss
' 功能： 使用全選主元高斯消去法求解線性方程組
' 參數(shù) n - Integer型變量，線性方程組的階數(shù)
' dblA - Double型 n x n 二維數(shù)組，線性方程組的系數(shù)矩陣
' dblB - Double型長(zhǎng)度為 n 的一維數(shù)組，線性方程組的常數(shù)向量，返回方程組的解向量
' 返回值：Boolean型，求解成功為True，無解或求解失敗為False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function LEGauss(n As Integer, dblA() As Double, dblB() As Double) As Boolean
' 局部變量
Dim i As Integer, j As Integer, k As Integer
Dim nIs As Integer
ReDim nJs(n) As Integer
Dim d As Double, t As Double
' 開始求解
For k = 1 To n - 1
d = 0#
' 歸一
For i = k To n
For j = k To n
t = Abs(dblA(i, j))
If t > d Then
d = t
nJs(k) = j
nIs = i
End If
Next j
Next i
' 無解，返回
If d + 1# = 1# Then
LEGauss = False
Exit Function
End If
' 消元
If nJs(k) <> k Then
For i = 1 To n
t = dblA(i, k)
dblA(i, k) = dblA(i, nJs(k))
dblA(i, nJs(k)) = t
Next i
End If
If nIs <> k Then
For j = k To n
t = dblA(k, j)
dblA(k, j) = dblA(nIs, j)
dblA(nIs, j) = t
Next j
t = dblB(k)
dblB(k) = dblB(nIs)
dblB(nIs) = t
End If
d = dblA(k, k)
For j = k + 1 To n
dblA(k, j) = dblA(k, j) / d
Next j
dblB(k) = dblB(k) / d
For i = k + 1 To n
For j = k + 1 To n
dblA(i, j) = dblA(i, j) - dblA(i, k) * dblA(k, j)
Next j
dblB(i) = dblB(i) - dblA(i, k) * dblB(k)
Next i
Next k
d = dblA(n, n)
' 無解，返回
If Abs(d) + 1# = 1# Then
LEGauss = False
Exit Function
End If
' 回代
dblB(n) = dblB(n) / d
For i = n - 1 To 1 Step -1
t = 0#
For j = i + 1 To n
t = t + dblA(i, j) * dblB(j)
Next j
dblB(i) = dblB(i) - t
Next i
' 調(diào)整解的次序
nJs(n) = n
For k = n To 1 Step -1
If nJs(k) <> k Then
t = dblB(k)
dblB(k) = dblB(nJs(k))
dblB(nJs(k)) = t
End If
Next k
' 求解成功
LEGauss = True
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 模塊名：LEModule.bas
' 函數(shù)名：LEGaussJordan
' 功能： 使用全選主元高斯－約當(dāng)消去法求解線性方程組
' 參數(shù) n - Integer型變量，線性方程組的階數(shù)
' m - Integer型變量，線性方程組的個(gè)數(shù)，即右端常數(shù)矩陣列向量的個(gè)數(shù)
' dblA - Double型 n x n 二維數(shù)組，線性方程組的系數(shù)矩陣
' dblB - Double型n x m二維數(shù)組，線性方程組的常數(shù)矩陣，返回方程組的解矩陣
' 返回值：Boolean型，求解成功為True，無解或求解失敗為False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function LEGaussJordan(n As Integer, m As Integer, dblA() As Double, dblB() As Double) As Boolean
' 局部變量
Dim i As Integer, j As Integer, k As Integer
Dim nIs As Integer
ReDim nJs(n) As Integer
Dim d As Double, q As Double
' 開始求解
For k = 1 To n
q = 0#
' 歸一
For i = k To n
For j = k To n
If Abs(dblA(i, j)) > q Then
q = Abs(dblA(i, j))
nJs(k) = j
nIs = i
End If
Next j
Next i
' 無解，返回
If q + 1# = 1# Then
LEGaussJordan = False
Exit Function
End If
' 消元
' A->
For j = k To n
d = dblA(k, j)
dblA(k, j) = dblA(nIs, j)
dblA(nIs, j) = d
Next j
' B->
For j = 1 To m
d = dblB(k, j)
dblB(k, j) = dblB(nIs, j)
dblB(nIs, j) = d
Next j
'A->
For i = 1 To n
d = dblA(i, k)
dblA(i, k) = dblA(i, nJs(k))
dblA(i, nJs(k)) = d
Next i
For j = k + 1 To n
dblA(k, j) = dblA(k, j) / dblA(k, k)
Next j
For j = 1 To m
dblB(k, j) = dblB(k, j) / dblA(k, k)
Next j
' 回代
For j = k + 1 To n
For i = 1 To n
If i <> k Then
dblA(i, j) = dblA(i, j) - dblA(i, k) * dblA(k, j)
End If
Next i
Next j
For j = 1 To m
For i = 1 To n
If i <> k Then
dblB(i, j) = dblB(i, j) - dblA(i, k) * dblB(k, j)
End If
Next i
Next j
Next k
' 調(diào)整解的次序
For k = n To 1 Step -1
For j = 1 To m
d = dblB(k, j)
dblB(k, j) = dblB(nJs(k), j)
dblB(nJs(k), j) = d
Next j
Next k
' 求解成功
LEGaussJordan = True
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 模塊名：LEModule.bas
' 函數(shù)名：LECpxGauss
' 功能： 使用全選主元高斯消去法求解復(fù)系數(shù)線性代數(shù)方程組
' 參數(shù) n - Integer型變量，線性代數(shù)方程組的階數(shù)
' dblAR - Double型 n x n 二維數(shù)組，線性代數(shù)方程組的系數(shù)矩陣的實(shí)部
' dblAI - Double型 n x n 二維數(shù)組，線性代數(shù)方程組的系數(shù)矩陣的虛部
' dblBR - Double型長(zhǎng)度為 n 的一維數(shù)組，線性代數(shù)方程組的常數(shù)向量的實(shí)部，返回方程組的解向量的實(shí)部
' dblBI - Double型長(zhǎng)度為 n 的一維數(shù)組，線性代數(shù)方程組的常數(shù)向量的虛部，返回方程組的解向量的虛部
' 返回值：Boolean型，求解成功為True，無解或求解失敗為False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function LECpxGauss(n As Integer, dblAR() As Double, dblAI() As Double, dblBR() As Double, dblBI() As Double) As Boolean
' 局部變量
Dim i As Integer, j As Integer, k As Integer
Dim nIs As Integer
ReDim nJs(n) As Integer
Dim d As Double, p As Double, q As Double, s As Double
' 開始求解
For k = 1 To n - 1
d = 0#
' 歸一
For i = k To n
For j = k To n
p = dblAR(i, j) * dblAR(i, j) + dblAI(i, j) * dblAI(i, j)
If p > d Then
d = p
nJs(k) = j
nIs = i
End If
Next j
Next i
' 無解，返回
If d + 1# = 1# Then
LECpxGauss = False
Exit Function
End If
' 消元
For j = k To n
p = dblAR(k, j)
dblAR(k, j) = dblAR(nIs, j)
dblAR(nIs, j) = p
p = dblAI(k, j)
dblAI(k, j) = dblAI(nIs, j)
dblAI(nIs, j) = p
Next j
p = dblBR(k)
dblBR(k) = dblBR(nIs)
dblBR(nIs) = p
p = dblBI(k)
dblBI(k) = dblBI(nIs)
dblBI(nIs) = p
For i = 1 To n
p = dblAR(i, k)
dblAR(i, k) = dblAR(i, nJs(k))
dblAR(i, nJs(k)) = p
p = dblAI(i, k)
dblAI(i, k) = dblAI(i, nJs(k))
dblAI(i, nJs(k)) = p
Next i
' 復(fù)數(shù)運(yùn)算
For j = k + 1 To n
p = dblAR(k, j) * dblAR(k, k)
q = -dblAI(k, j) * dblAI(k, k)
s = (dblAR(k, k) - dblAI(k, k)) * (dblAR(k, j) + dblAI(k, j))
dblAR(k, j) = (p - q) / d
dblAI(k, j) = (s - p - q) / d
Next j
p = dblBR(k) * dblAR(k, k)
q = -dblBI(k) * dblAI(k, k)
s = (dblAR(k, k) - dblAI(k, k)) * (dblBR(k) + dblBI(k))
dblBR(k) = (p - q) / d
dblBI(k) = (s - p - q) / d
For i = k + 1 To n
For j = k + 1 To n
p = dblAR(i, k) * dblAR(k, j)
q = dblAI(i, k) * dblAI(k, j)
s = (dblAR(i, k) + dblAI(i, k)) * (dblAR(k, j) + dblAI(k, j))
dblAR(i, j) = dblAR(i, j) - p + q
dblAI(i, j) = dblAI(i, j) - s + p + q
Next j
p = dblAR(i, k) * dblBR(k)
q = dblAI(i, k) * dblBI(k)
s = (dblAR(i, k) + dblAI(i, k)) * (dblBR(k) + dblBI(k))
dblBR(i) = dblBR(i) - p + q
dblBI(i) = dblBI(i) - s + p + q
Next i
Next k
d = dblAR(n, n) * dblAR(n, n) + dblAI(n, n) * dblAI(n, n)
' 無解，返回
If d + 1# = 1# Then
LECpxGauss = False
Exit Function
End If
p = dblAR(n, n) * dblBR(n)
q = -dblAI(n, n) * dblBI(n)
s = (dblAR(n, n) - dblAI(n, n)) * (dblBR(n) + dblBI(n))
dblBR(n) = (p - q) / d
dblBI(n) = (s - p - q) / d
' 回代
For i = n - 1 To 1 Step -1
For j = i + 1 To n
p = dblAR(i, j) * dblBR(j)
q = dblAI(i, j) * dblBI(j)
s = (dblAR(i, j) + dblAI(i, j)) * (dblBR(j) + dblBI(j))
dblBR(i) = dblBR(i) - p + q
dblBI(i) = dblBI(i) - s + p + q
Next j
Next i
' 調(diào)整解的次序
nJs(n) = n
For k = n To 1 Step -1
p = dblBR(k)
dblBR(k) = dblBR(nJs(k))
dblBR(nJs(k)) = p
p = dblBI(k)
dblBI(k) = dblBI(nJs(k))
dblBI(nJs(k)) = p
Next k
' 求解成功
LECpxGauss = True
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 模塊名：LEModule.bas
' 函數(shù)名：LECpxGaussJordan
' 功能： 使用全選主元高斯－約當(dāng)消去法求解復(fù)系數(shù)線性代數(shù)方程組
' 參數(shù) n - Integer型變量，線性代數(shù)方程組的階數(shù)
' m - Integer型變量，方程組右端復(fù)常數(shù)向量的個(gè)數(shù)
' dblAR - Double型 n x n 二維數(shù)組，線性代數(shù)方程組的系數(shù)矩陣的實(shí)部
' dblAI - Double型 n x n 二維數(shù)組，線性代數(shù)方程組的系數(shù)矩陣的虛部
' dblBR - Double型長(zhǎng)度為 n X m 的二維數(shù)組，存放方程組右端的m組常數(shù)向量的實(shí)部，
' 返回時(shí)存放m組解向量的實(shí)部
' dblBI - Double型長(zhǎng)度為 n x m 的二維數(shù)組，存放方程組右端的m組常數(shù)向量的虛部，
' 返回時(shí)存放m組解向量的虛部
' 返回值：Boolean型，求解成功為True，無解或求解失敗為False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function LECpxGaussJordan(n As Integer, m As Integer, dblAR() As Double, dblAI() As Double, dblBR() As Double, dblBI() As Double) As Boolean
' 局部變量
Dim i As Integer, j As Integer, k As Integer
Dim nIs As Integer
ReDim nJs(n) As Integer
Dim d As Double, p As Double, q As Double, s As Double
' 開始求解
For k = 1 To n
d = 0#
' 歸一
For i = k To n
For j = k To n
p = dblAR(i, j) * dblAR(i, j) + dblAI(i, j) * dblAI(i, j)
If p > d Then
d = p
nJs(k) = j
nIs = i
End If
Next j
Next i
' 無解，返回
If d + 1# = 1# Then
LECpxGaussJordan = False
Exit Function
End If
' 消元
If nIs <> k Then
' A->
For j = k To n
p = dblAR(k, j)
dblAR(k, j) = dblAR(nIs, j)
dblAR(nIs, j) = p
p = dblAI(k, j)
dblAI(k, j) = dblAI(nIs, j)
dblAI(nIs, j) = p
Next j
' B ->
For j = 1 To m
p = dblBR(k, j)
dblBR(k, j) = dblBR(nIs, j)
dblBR(nIs, j) = p
p = dblBI(k, j)
dblBI(k, j) = dblBI(nIs, j)
dblBI(nIs, j) = p
Next j
End If
If nJs(k) <> k Then
' A->
For i = 1 To n
p = dblAR(i, k)
dblAR(i, k) = dblAR(i, nJs(k))
dblAR(i, nJs(k)) = p
p = dblAI(i, k)
dblAI(i, k) = dblAI(i, nJs(k))
dblAI(i, nJs(k)) = p
Next i
End If
' 復(fù)數(shù)運(yùn)算
For j = k + 1 To n
p = dblAR(k, j) * dblAR(k, k)
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -