先說一下，如果是陶老師的學生，建議不要抄！
1.視窗
依然是見仁見智，打碼的部分是我的名字學号。
2.Form代碼
Imports System.IO
Public Class Form1
'//***********************************檔案夾讀取**************************************************//
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
OpenFileDialog1.InitialDirectory = "C:\"
OpenFileDialog1.Filter = "文本檔案(*.txt)|*.txt|所有檔案(*.*)|*.*"
OpenFileDialog1.FilterIndex = 1
OpenFileDialog1.RestoreDirectory = True
If OpenFileDialog1.ShowDialog = DialogResult.OK Then
TextFileName.Text = OpenFileDialog1.FileName
End If
If TextFileName.Text <> "" Then
Dim fs As FileStream
fs = New FileStream(TextFileName.Text, FileMode.OpenOrCreate, FileAccess.Read)
Dim sr As StreamReader
sr = New StreamReader(fs)
Text1.Text = sr.ReadToEnd
sr.Close()
fs.Close()
End If
End Sub
'//************************************條件平差*******************************************//
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
str1 = Text1.Text
M1 = Split(Trim(str1), vbCrLf)
'/******************************************/
M2 = M1(0).Trim().Split(New Char() {" ", ",", "，"}) '結果為（n=4,t=2,y=2）
M3 = M2(0).Split("=") '結果為（n,4）
n = CInt(M3(1)) '讀取觀測個數n
M3 = M2(1).Split("=")
t = CInt(M3(1)) '讀取必要觀測個數t，即待定點個數
r = n - t '計算多餘觀測量=n-t
M3 = M2(2).Split("=")
y = CInt(M3(1)) '讀取已知點個數y
Dim H1(y - 1), S(n - 1), X(t - 1), h(n - 1), L(n - 1) As Double
Dim A(t - 1, n - 1) As Double 'A矩陣t行n列
Dim A_1(n - 1, t - 1) As Double 'A的逆矩陣
Dim Q(n - 1, n - 1), P(n - 1, n - 1), VP(0, n - 1), V(n - 1, 0), V_1(n - 1, t - 1), V_Z(0, n - 1) As Double
Dim NAA(t - 1, t - 1), NAA_1(t - 1, n - 1), NAA_n(t - 1, t - 1), K1(t - 1, 0), W(t - 1, 0) As Double
For i = 0 To y - 1
M2 = Split(Trim(M1(i + 2)), "=") '取已知點資料,即H1數組中的數值
H1(i) = CDbl(M2(1))
Next
'系數矩陣A的讀取
For i = 0 To t - 1
For j = 0 To n - 1
M4 = M1(y + 3 + i).Trim().Split(New Char() {" ", ",", "，"})
A(i, j) = CDbl(M4(j))
Next
Next
A_1 = ZZ(A, A_1) '轉置
For i = 0 To n - 1
M5 = M1(y + t + 5 + i).Trim().Split(New Char() {" ", ",", "，"})
h(i) = CDbl(M5(1))
S(i) = CDbl(M5(2)) 'S，用于定權
Next
For k = 0 To n - 1
For j = 0 To n - 1
If k = j Then
Q(j, k) = S(k)
Else Q(j, k) = 0
End If
Next
Next 'Q矩陣
P = QN(Q)
'W矩陣的讀取
For i = 0 To t - 1
M6 = M1(y + t + 3).Trim().Split(New Char() {" ", ",", "，"})
W(i, 0) = CDbl(M6(i))
Next
NAA_1 = Mmul(A, Q, NAA_1)
NAA = Mmul(NAA_1, A_1, NAA)
NAA_n = QN(NAA) 'NAA的逆矩陣
For i = 0 To t - 1
For j = 0 To t - 1
NAA_n(i, j) = -NAA_n(i, j) '負的NAA
Next
Next
K1 = Mmul(NAA_n, W, K1) '計算K矩陣
V_1 = Mmul(Q, A_1, V_1)
V = Mmul(V_1, K1, V) '計算V矩陣
For i = 0 To n - 1
L(i) = h(i) + V(i, 0) / 1000
Next '計算觀測量的平內插補點L
M2 = Split(Trim(M1(2)), "=")
For k = 0 To t - 1
M7 = M1(y + t + 6 + n + k).Trim().Split(New Char() {" ", ",", "，"})
X(k) = M2(1)
For i = 0 To n - 1
xx = M7(i + 1) * L(i) '這一步是将與未知點計算有關的平內插補點帶入，有關為0，無關為1
X(k) = X(k) + xx
Next
Next
'計算機關權中誤差
V_Z = ZZ(V, V_Z)
VP = Mmul(V_Z, P, VP)
sgm = Mmul(VP, V, sgm)
sigm = Math.Sqrt(sgm(0, 0) / r)
Text2.Text = "" + "未知點平差後高程值：（機關，米）" + vbCrLf
For j = 0 To t - 1
M7 = M1(y + t + 6 + n + j).Trim().Split(New Char() {" ", ",", "，"})
Text2.Text = Text2.Text + M7(0) + "：" + CStr(X(j)) + vbCrLf
Next
Text2.Text = Text2.Text + "機關權中誤差為：（機關：毫米）" + vbCrLf
Text2.Text = Text2.Text + CStr（sigm） + vbCrLf
End Sub
Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
Dim sf As New SaveFileDialog
sf.Filter = "文本檔案(*.txt)|*.txt|所有檔案(*.*)|*.*"
sf.ShowDialog()
My.Computer.FileSystem.WriteAllText（sf.FileName， Text2.Text， False）
MsgBox("已儲存檔案到:" & sf.FileName)
End Sub
Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
Dim sf As New SaveFileDialog
sf.Filter = "文本檔案(*.txt)|*.txt|所有檔案(*.*)|*.*"
sf.ShowDialog()
My.Computer.FileSystem.WriteAllText（sf.FileName， Text1.Text， False）
MsgBox("已儲存檔案到:" & sf.FileName)
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
str2 = Text1.Text
M1 = Split(Trim(str2), vbCrLf)
M2 = M1(0).Trim().Split(New Char() {" ", ",", "，"}) '結果為（n=4,t=1,y=4）
M3 = M2(0).Split("=") '結果為（n,4）
n = CInt(M3(1)) '讀取觀測個數n,即方程數
M3 = M2(1).Split("=")
t = CInt(M3(1)) '讀取必要觀測個數t，即參數個數
r = n - t '計算多餘觀測量=n-t
Dim B(n - 1, t - 1), B_Z(t - 1, n - 1), BZP(t - 1, n - 1), V(n - 1, 0), VZ(0, n - 1), xx(t - 1, 0), BX(n - 1, 0) As Double
Dim P(n - 1, n - 1), NBB(t - 1, t - 1), NBB_N(t - 1, t - 1), W(t - 1, 0), L(n - 1, 0), VZP(0, n - 1) As Double
Dim h(n - 1), S(n - 1), X(t - 1)， L_1(n - 1) As Double
'矩陣L的讀取
M4 = Split(M1(n + 3), ";")
For j = 0 To n - 1
L(j, 0) = CDbl(M4(j))
Next
'系數矩陣B的讀取
For i = 0 To n - 1
For j = 0 To t - 1
M5 = M1(n + 5 + i).Trim().Split(New Char() {" ", ",", "，"})
B(i, j) = CDbl(M5(j))
Next
Next
B_Z = ZZ(B, B_Z) 'B的轉置
For i = 0 To n - 1
M6 = M1(2 + i).Trim().Split(New Char() {" ", ",", "，"})
h(i) = CDbl(M6(1))
S(i) = CDbl(M6(2)) 'S，用于定權
Next
'P矩陣的讀取
For k = 0 To n - 1
For j = 0 To n - 1
If k = j Then
P(j, k) = 10 / S(k)
Else P(j, k) = 0
End If
Next
Next
BZP = Mmul(B_Z, P, BZP)
NBB = Mmul(BZP, B, NBB)
W = Mmul(BZP, L, W)
NBB_N = QN(NBB)
xx = Mmul(NBB_N, W, xx)
BX = Mmul(B, xx, BX)
For k = 0 To n - 1
V(k, 0) = BX(k, 0) - L(k, 0)
Next
For i = 0 To t - 1
M7 = M1(2 * n + i + 6).Trim().Split("=")
X(i) = CDbl(M7(1)) + xx(i, 0) / 1000
Next
For j = 0 To n - 1
L_1(j) = h(j) + V(j, 0) / 1000
Next
VZ = ZZ(V, VZ)
VZP = Mmul(VZ, P, VZP)
sgm = Mmul(VZP, V, sgm)
sigm = Math.Sqrt(sgm(0, 0) / r)
Text2.Text = "" + "未知點平差後高程值：（機關，米）" + vbCrLf
For j = 0 To t - 1
M8 = M1(2 * n + 6 + j).Trim().Split("=")
Text2.Text = Text2.Text + M8(0) + "：" + CStr(X(j)) + vbCrLf
Next
Text2.Text = Text2.Text + "觀測值的平內插補點：（機關，米）" + vbCrLf
For k = 0 To n - 1
M9 = M1(2 + k).Trim().Split(New Char() {" ", ",", "，"})
Text2.Text = Text2.Text + M9(0) + "：" + CStr(L_1(k)) + vbCrLf
Next
Text2.Text = Text2.Text + "機關權中誤差為：（機關：毫米）" + vbCrLf
Text2.Text = Text2.Text + CStr（sigm） + vbCrLf
End Sub
End Class
3.Module代碼
Module Module1
Public str1, str2 As String
Public y, n, t, i, j, k, r As Integer
Public xx, sgm(0, 0), sigm As Double
Public M1(), M2(), M3(), M4(), M5(), M6(), M7(), M8(), M9() As String
'//********************************下面是函數部分*********************************//
'矩陣相乘函數
Function Mmul(mtxA(,) As Double, mtxB(,) As Double, ByRef mtxC(,) As Double)
Dim m As Integer
Dim n As Integer
Dim l As Integer
Dim i As Integer, j As Integer, K As Integer
m = UBound(mtxA, 1) - LBound(mtxA, 1)
n = UBound(mtxA, 2) - LBound(mtxA, 2)
l = UBound(mtxB, 2) - LBound(mtxB, 2)
For i = 0 To m
For j = 0 To l
mtxC(i, j) = 0#
For K = 0 To n
mtxC(i, j) = mtxC(i, j) + mtxA(i, K) * mtxB(K, j)
Next K
Next j
Next i
Return mtxC
End Function
'矩陣轉置函數
Function ZZ(mtxA(,) As Double, mtxB(,) As Double)
Dim m As Integer
Dim n As Integer
Dim i As Integer, j As Integer
m = UBound(mtxA, 1) - LBound(mtxA, 1) '原來的行數
n = UBound(mtxA, 2) - LBound(mtxA, 2) '原來的列數
For i = 0 To m
For j = 0 To n
mtxB(j, i) = mtxA(i, j)
Next j
Next i
Return mtxB
End Function
'矩陣求逆函數
Function QN(Mtx(,) As Double)
Dim N As Double
N = UBound(Mtx, 1) - LBound(Mtx, 1) '矩陣的行數/列數
Dim row(0 To N) As Integer, col(0 To N) As Integer
Dim d As Double, p As Double
For k = 0 To N
d = 0.0#
For i = k To N
For j = k To N
p = Math.Abs(Mtx(i, j))
If (p > d) Then
d = p
row(k) = i
col(k) = j '記錄變換的位置
End If
Next j
Next i
If (d + 1.0# = 1.0#) Then '找到主元，并存儲到行列号
End If
If (row(k) <> k) Then
For j = 0 To N
p = Mtx(k, j)
Mtx(k, j) = Mtx(row(k), j)
Mtx(row(k), j) = p '行變換
Next j
End If
If (col(k) <> k) Then
For i = 0 To N
p = Mtx(i, k)
Mtx(i, k) = Mtx(i, col(k))
Mtx(i, col(k)) = p '列變換
Next i
End If
Mtx(k, k) = 1.0# / Mtx(k, k)
For j = 0 To N
If (j <> k) Then
Mtx(k, j) = Mtx(k, j) * Mtx(k, k)
End If
Next j
For i = 0 To N
If (i <> k) Then
For j = 0 To N
If (j <> k) Then
Mtx(i, j) = Mtx(i, j) - Mtx(i, k) * Mtx(k, j)
End If
Next j
End If
Next i
For i = 0 To N
If (i <> k) Then
Mtx(i, k) = -Mtx(i, k) * Mtx(k, k)
End If
Next i
Next k
For k = N To 0 Step -1
If (col(k) <> k) Then
For j = 0 To N
p = Mtx(k, j)
Mtx(k, j) = Mtx(col(k), j)
Mtx(col(k), j) = p
Next j
End If
If (row(k) <> k) Then
For i = 0 To N
p = Mtx(i, k)
Mtx(i, k) = Mtx(i, row(k))
Mtx(i, row(k)) = p
Next i
End If
Next k
Return Mtx
End Function
End Module
當時費勁切片分資料的做法真的笨的可以ε＝ε＝ε＝(#>д<)ﾉ
![MCDM方法及matlab應用五：ＭＡＢＡＣ方法及matlab應用[圖]](data:image/gif;base64,R0lGODlhAQABAIAAAP///wAAACwAAAAAAQABAAACAkQBADs=)