|
|
本人在编程序过程中遇到困难,急求 Wenjian_Cao老师给以帮助,十分感激!
多面函数拟合:ε=∑KQ(x,y,Xj,Yj)
其中Q(x,y,Xj,Yj)= Sqr[(Xi - Xj) ^ 2 + (Yi - Yj) ^ 2]
思路:先输入数组S(X,Y) {已知的水准高程},求出Qnn
再输入待求高程的X,Y坐标 ,求出Qk(Xk,Yk)=Sqr((Xk - Xj) ^ 2 + (Yk - Yj) ^ 2)
调用求逆阵程序求Qnn的逆
调矩阵相乘过程求Qk*Qnn^(-1)
计算 εk= Qk*Qnn^(-1)ε
得到正常高h=H-εk (H为大地高)
程序初稿:Dim Qk() As Integer
Dim B() As Integer
Rect() as integer
' n =Val(InputBox("请输入数组维数n"))
Call sub1
Xk = Val(InputBox("请输入待求参数的X坐标"))
Yk = Val(InputBox("请输入待求参数的Y坐标"))
For j = 0 To k
' Qk() = Sqr((Xi - Xj) ^ 2 + (Yi - Yj) ^ 2)
m = Sqr((Xi - Xj) ^ 2 + (Yi - Yj) ^ 2)
Next j
Print m
' Call Rect_yu
'Call rect_multip
'Call rect_multip
End Sub
Function Rect_yu(a() As Double, L As Long, C() As Double) As Double '矩阵求逆
Dim T0 As Double
Dim t1 As Double
Dim t2 As Double
Dim t3 As Double
Dim B() As Double
Dim Num As Double
Dim Chay As Long
Dim Chax As Long
Chay = 0
Chax = 0
ReDim B(L - 1, L - 1)
Num = 0
Dim add As Double
add = 1 / Rect(a(), L)
For T0 = 0 To L
For t3 = 0 To L
For t1 = 0 To L - 1
If t1 < T0 Then
Chax = 0
Else
Chax = 1
End If
For t2 = 0 To L - 1
If t2 < t3 Then
Chay = 0
Else
Chay = 1
End If
B(t1, t2) = a(t1 + Chax, t2 + Chay)
Next t2
Next t1
C(t3, T0) = Rect(B(), L - 1) * add * ((-1) ^ (T0 + t3))
Next t3
Next T0
End Function
Private Function rect_multip(a() As Double, B() As Double, n As Long, n1 As Long, n2 As Long, C() As Double) As Double '矩阵相乘
Dim t1 As Long
Dim t2 As Long
Dim t3 As Long
For t1 = 0 To n1
For t2 = 0 To n2
C(t1, t2) = 0
For t3 = 0 To n
C(t1, t2) = C(t1, t2) + a(t1, t3) * B(t3, t2)
Next t3
Next t2
Next t1
End Function
Private Sub sub1()
Dim Qnn() As Integer
Const k = 1
Dim a(k, k) As Integer
For i = 0 To k
For j = 0 To k
a(i, j) = Val(InputBox("请输入数组"))
Next j
Next i
For i = 0 To k
For j = 0 To k
' Qnn() = Sqr((Xi - Xj) ^ 2 + (Yi - Yj) ^ 2)
d = Sqr((Xi - Xj) ^ 2 + (Yi - Yj) ^ 2)
Print d
Next j
Print
Next i
' Print Qnn(d, d)
End Sub
|
|