似水无痕一、二次曲面移动拟合法内插DEM的原理DEM内插就是根据参考点上的高程求出其他待定点上的高程,在数学上属于插值问题。

任意一种内插方法都是基于邻近数据点之间存在很大的相关性,从而由邻近点的数据内插出待定点上的数据。

移动曲面拟合法内插,是以每一待定点为中心,定义一个局部函数去拟合周围的数据点。

该方法十分灵活,一般情况精度较高,计算相对简单,不需很大计算机内存,其过程如下:(1)根据实际内插要求,解算待定点P的平面坐标( xP , yp )。

(2)为了选取邻近的数据点,以待定点P为圆心,以R为半径作圆(如图1所示) ,凡落在圆内的数据点即被选用。

在二次曲面内插时,考虑到计算方便,将坐标原点移至该DEM格网点P ( xP , yp )由于二次曲面系数个数为6,要求选用的数据点个数n > 6。

当数据点i ( xi , yi )到待定点P ( xP , yp )的距离di = sqr(x i2 - .y i2 ) i < R时,该点即被选用。

若选择的点数不够时,则应增大R的数值,直至数据点的个数n满足要求。

(3)选择二次曲面Z =Ax2 +B xy +Cy2 +Dx + Ey +F作为拟合面,则对应点的误差方程为vi = Ax2 +B xy +Cy2 +Dx + Ey +F - Z i由n个数据点列出的误差方程为v = MX - ZX = (M T PM) -1M T PZ由于坐标原点移至该DEM格网点P ( xP , yp ) ,所以系数F就是待定点的内插高程值ZP二、程序采用平台：,access数据库（存储已知点）数据：10个点程序代码：Imports System.MathPublic Class Form1Dim conn As OleDb.OleDbConnection = New OleDb.OleDbConnectionDim cmd As OleDb.OleDbCommand = New OleDb.OleDbCommandDim adapter As OleDb.OleDbDataAdapter = New OleDb.OleDbDataAdapterDim datareader As OleDb.OleDbDataReader'数据库连接Dim xe As Double, ye As Double, d(9) As Double, X(9) As Double, Y(9) As Double, Z(9, 0) As DoubleDim M(9, 5) As Double, P(9, 9) As DoubleDim Xz(5, 0) As DoublePrivate Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.ClickDim i As Integerxe = 110ye = 110 '待定点坐标DataSet1.Tables.Clear()DataGridView1.Columns.Clear()conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Application.StartupPath & "\DEM.mdb"mandText = "select 点号,X,Y,Z from DEM "cmd.Connection = connconn.Open()OleDbDataAdapter1.SelectCommand = cmdOleDbDataAdapter1.Fill(DataSet1, "DEM")DataGridView1.DataSource = DataSet1.Tables.Item("DEM")conn.Close()'连接数据库，把数据读到DatagridviewFor i = 0 To 9X(i) = DataGridView1.Rows.Item(i).Cells.Item("X").ValueY(i) = DataGridView1.Rows.Item(i).Cells.Item("Y").ValueZ(i, 0) = DataGridView1.Rows.Item(i).Cells.Item("Z").ValueM(i, 0) = (X(i) - xe) * (X(i) - xe)M(i, 1) = (X(i) - xe) * (Y(i) - ye)M(i, 2) = (Y(i) - ye) * (Y(i) - ye)M(i, 3) = X(i) - xeM(i, 4) = Y(i) - xeM(i, 5) = 1P(i, i) = 1 / Sqrt(Abs((X(i) - xe) * (X(i) - xe) + (Y(i) - ye) * (Y(i) - ye)))Next'对矩阵赋初值End SubPrivate Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.ClickTextBox1.Text = ""Dim i As IntegerXz = JZCF(JZCF(JZCF(NJZ(JZCF(JZCF(DZ(M), P), M)), DZ(M)), P), Z)TextBox1.Text = TextBox1.Text & "待定点的坐标：X=110,Y=110" & vbCrLf & vbCrLfTextBox1.Text = TextBox1.Text & "误差方程为：V=AXi^2+BXiYi+CYi^2+DXi+EYi+F-Zi" & vbCrLf & vbCrLfTextBox1.Text = TextBox1.Text & "由X=(M(T)PM)'M(T)PZ" & vbCrLfTextBox1.Text = TextBox1.Text & "其中X=(A B C D E F )(T) Z=(Z1 Z2 Z3 ```Zn)(T)" & vbCrLfTextBox1.Text = TextBox1.Text & " M=(Xi^2 XiYi Yi^2 Xi Yi 1)" & vbCrLf & vbCrLfTextBox1.Text = TextBox1.Text & "求得X=（"For i = 0 To 5TextBox1.Text = TextBox1.Text & Format(Xz(i, 0), "0.000") & " "NextTextBox1.Text = TextBox1.Text & ")" & vbCrLf & vbCrLfTextBox1.Text = TextBox1.Text & "由于坐标原点移至待定点上，因此待定点的高程Z=F" & vbCrLfTextBox1.Text = TextBox1.Text & "待定点高程Z=" & Format(Xz(5, 0), "0.000")End Sub'~~~~~~~~~~~~~~~~~求解矩阵的逆矩阵~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~Public Function NJZ(ByVal q(,) As Double) As Double(,)Dim BS(,) As Double, NJ(,) As Double, Qz As Double, h As Integer, l As Integer, n As Integern = q.GetUpperBound(0)ReDim BS(n, n)ReDim NJ(n, n)BS = BSJZ(q) '伴随矩阵Qz = HLei(q)If Qz <> 0 ThenFor h = 0 To nFor l = 0 To nNJ(h, l) = (1 / Qz) * BS(h, l) '求解矩阵的逆矩阵NextNextNJZ = NJElseMessageBox.Show("矩阵不可逆")NJZ = NothingEnd IfEnd Function'~~~~~~~~~~~~~~~~~求解矩阵的伴随矩阵~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~Public Function BSJZ(ByVal q(,) As Double) As Double(,) '求解矩阵的伴随矩阵Dim i As Integer, j As Integer, k As Integer, n As Integer, BS(,) As Doublei = 0j = 0k = 0n = q.GetUpperBound(0)ReDim BS(n, n)For i = 0 To nFor j = 0 To nBS(j, i) = YZS(q, i, j)NextBSJZ = BSEnd Function'~~~~~~~~~~~~~~~~~'求解矩阵的余子式的值~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~Public Function YZS(ByVal q(,) As Double, ByVal h As Integer, ByVal l As Integer) As Double '求解矩阵的余子式的值Dim i As Integer, j As Integer, x As Integer, y As Integer, n As Integer, YZ(,) As Doublei = 0j = 0n = q.GetUpperBound(0)ReDim YZ(n - 1, n - 1)For i = 0 To nIf i <> h ThenFor j = 0 To nIf j <> l Then '求得h,l位置的余子式YZ(x, y) = q(i, j)y += 1End IfNextx += 1End IfNextYZS = (-1) ^ (h + l + 2) * HLei(YZ) '余子式的值End Function'~~~~~~~~~~~~~~~~~''求解n阶行列式的值~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~Public Function HLei(ByVal q(,) As Double) As Double '求解n阶行列式的值Dim i As Integer, j As Integer, k As Integer, n As Integeri = 0j = 0k = 0If q.GetUpperBound(0) > 1 Then '判断是否为2*2矩阵，若不是则继续求其余子式n = q.GetUpperBound(0)Dim p(n - 1, n - 1) As Double '余子式方阵For k = 0 To nDim h As IntegerDim l As Integer '余子式的行列号h = 0For i = 1 To nl = 0For j = 0 To nIf j <> k Then '按第一列展开求余子式p(h, l) = q(i, j)l += 1End IfNexth += 1NextHLei = HLei + (-1) ^ (k + 2) * q(0, k) * HLei(p) '递归方法求行列式的值NextElseHLei = q(0, 0) * q(1, 1) - q(0, 1) * q(1, 0) ' 二阶行列式求值End IfEnd Function'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~求解矩阵的转置~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~Public Function DZ(ByVal q(,) As Double) As Double(,) '求解矩阵的转置Dim i As Integer, j As Integer, n As Integer, m As Integer, DZJZ(,) As Doublei = 0j = 0n = q.GetUpperBound(0)ReDim DZJZ(m, n)For i = 0 To nFor j = 0 To mDZJZ(j, i) = q(i, j)NextNextDZ = DZJZEnd Function'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~矩阵乘法~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~Public Function JZCF(ByVal a(,) As Double, ByVal b(,) As Double) As Double(,) '矩阵乘法Dim ha As Integer, la As Integer, hb As Integer, lb As Integer, c(,) As DoubleDim i As Integer, j As Integer, k As Integerha = a.GetUpperBound(0)la = a.GetUpperBound(1)lb = b.GetUpperBound(1)If la = hb ThenReDim c(ha, lb)For i = 0 To haFor j = 0 To lbFor k = 0 To lac(i, j) = c(i, j) + a(i, k) * b(k, j)NextNextNextJZCF = cElseMessageBox.Show("这两个矩阵不能相乘！")JZCF = NothingEnd IfEnd FunctionEnd Class。