最小二乘法.txt

用VB编写的最小二乘法。在GPS差分、或是测量平差中经常用到。

Option Explicit
Option Base 1
Dim tem(9) As Double, delv(9) As Double 'tem(9)存放温度，delv(9)存放的率
Dim a As Double, b As Double 'a、b是回归方程系数



Private Sub cmdcalnc_Click() '内插过程
tem(1) = Val(txtx1.Text): delv(1) = Val(txty1.Text)
tem(2) = Val(txtx2.Text): delv(2) = Val(txty2.Text)
tem(3) = Val(txtx3.Text): delv(3) = Val(txty3.Text)
tem(4) = Val(txtx4.Text): delv(4) = Val(txty4.Text)
tem(5) = Val(txtx5.Text): delv(5) = Val(txty5.Text)
tem(6) = Val(txtx6.Text): delv(6) = Val(txty6.Text)
tem(7) = Val(txtx7.Text): delv(7) = Val(txty7.Text)
tem(8) = Val(txtx8.Text): delv(8) = Val(txty8.Text)
tem(9) = Val(txtx9.Text): delv(9) = Val(txty9.Text)

Dim ncx As Double, ncy As Double 'ncx为内插x，ncy为内插y
ncx = Val(txtncx.Text)
Call huigui_equation
ncy = a * ncx + b
txtncy.Text = Str(ncy)
End Sub

Private Sub huigui_equation() '求回归方程的系数
tem(1) = Val(txtx1.Text): delv(1) = Val(txty1.Text)
tem(2) = Val(txtx2.Text): delv(2) = Val(txty2.Text)
tem(3) = Val(txtx3.Text): delv(3) = Val(txty3.Text)
tem(4) = Val(txtx4.Text): delv(4) = Val(txty4.Text)
tem(5) = Val(txtx5.Text): delv(5) = Val(txty5.Text)
tem(6) = Val(txtx6.Text): delv(6) = Val(txty6.Text)
tem(7) = Val(txtx7.Text): delv(7) = Val(txty7.Text)
tem(8) = Val(txtx8.Text): delv(8) = Val(txty8.Text)
tem(9) = Val(txtx9.Text): delv(9) = Val(txty9.Text)

Dim i As Integer
Dim sumx As Double, sumx2 As Double, sumy As Double, sumxy As Double
sumx = 0: sumx2 = 0: sumy = 0: sumxy = 0
For i = 1 To 9
    sumx = sumx + tem(i)
    sumx2 = sumx2 + tem(i) ^ 2
    sumy = sumy + delv(i)
    sumxy = sumxy + tem(i) * delv(i)
Next i
a = (9 * sumxy - sumx * sumy) / (9 * sumx2 - sumx * sumx)
b = sumy / 9 - a * sumx / 9
End Sub

Private Sub cmdcalwt_Click() '外推过程
tem(1) = Val(txtx1.Text): delv(1) = Val(txty1.Text)
tem(2) = Val(txtx2.Text): delv(2) = Val(txty2.Text)
tem(3) = Val(txtx3.Text): delv(3) = Val(txty3.Text)
tem(4) = Val(txtx4.Text): delv(4) = Val(txty4.Text)
tem(5) = Val(txtx5.Text): delv(5) = Val(txty5.Text)
tem(6) = Val(txtx6.Text): delv(6) = Val(txty6.Text)
tem(7) = Val(txtx7.Text): delv(7) = Val(txty7.Text)
tem(8) = Val(txtx8.Text): delv(8) = Val(txty8.Text)
tem(9) = Val(txtx9.Text): delv(9) = Val(txty9.Text)

Dim wtx As Double, wty As Double 'wtx为外推x，wty为外推y
wtx = Val(txtwtx.Text)
Call huigui_equation
wty = a * wtx + b
txtwty.Text = Str(wty)
End Sub

Private Sub cmddatamodify_Click() '修改数据
txtx1.Text = "": txtx2.Text = "": txtx3.Text = "": txtx4.Text = "": txtx5.Text = "": txtx6.Text = "": txtx7.Text = "": txtx8.Text = "": txtx9.Text = ""
txty1.Text = "": txty2.Text = "": txty3.Text = "": txty4.Text = "": txty5.Text = "": txty6.Text = "": txty7.Text = "": txty8.Text = "": txty9.Text = ""
txtncx.Text = "": txtncy.Text = ""
txtwtx.Text = "": txtwty.Text = ""
End Sub

Private Sub cmddraw_Click() '画图
tem(1) = Val(txtx1.Text): delv(1) = Val(txty1.Text)
tem(2) = Val(txtx2.Text): delv(2) = Val(txty2.Text)
tem(3) = Val(txtx3.Text): delv(3) = Val(txty3.Text)
tem(4) = Val(txtx4.Text): delv(4) = Val(txty4.Text)
tem(5) = Val(txtx5.Text): delv(5) = Val(txty5.Text)
tem(6) = Val(txtx6.Text): delv(6) = Val(txty6.Text)
tem(7) = Val(txtx7.Text): delv(7) = Val(txty7.Text)
tem(8) = Val(txtx8.Text): delv(8) = Val(txty8.Text)
tem(9) = Val(txtx9.Text): delv(9) = Val(txty9.Text)
pic1.Scale (-30, 120)-(250, -20)
'画坐标格网
pic1.Line (0, 0)-(230, 0)
pic1.Line (230, 0)-(222, 4)
pic1.Line (230, 0)-(222, -4)
pic1.CurrentX = 230
pic1.CurrentY = -1
pic1.Print "x"
pic1.Line (0, 0)-(0, 115)
pic1.Line (0, 115)-(-5, 110)
pic1.Line (0, 115)-(5, 110)
pic1.CurrentX = 5
pic1.CurrentY = 115
pic1.Print "y"
'画散点图
Dim i As Integer
For i = 1 To 9
    pic1.CurrentX = tem(i)
    pic1.CurrentY = -5
    pic1.Print tem(i)
    pic1.CurrentX = -23
    pic1.CurrentY = delv(i)
    pic1.Print delv(i)
    pic1.PSet (tem(i), delv(i))
    pic1.Circle (tem(i), delv(i)), 2
Next i
'画直线
Call huigui_equation
pic1.Line (-10, -10 * a + b)-(200, a * 200 + b)
End Sub

Private Sub cmdexit_Click() '退出
End
End Sub

Private Sub cmdpicclear_Click() '刷新画布
pic1.Cls
End Sub