高等测量平差实验回归分析.docx

1、高等测量平差实验回归分析实 验 一回归分析班级：测绘0911 学号：0920115114 姓名：叶林 日期：16-11-2011一、 实验分析1、 实验的目的。（1） 理解各种显著性检验的原理及应用。（2） 如何用vb来实现例题的过程（3） 用Excel直接制作了一个简单的回归分析和显著性检验的模板，只要在相应的单元格输入统计数据就能自动显示检验的结果：2、 实验要求在excel中利用宏进行vb编程，求解线性回归方程以及用不同的方法进行各种显著分析，按照要求在excel中输出步骤和结果3、 实验过程的剖析例3-1：该实验是展示一元线性回归参数的计算过程：先计算法方程，从而可得参数的最小二乘估值

2、，最后可以得到一元线性回归方程。再计算相应的残差，然后计算观测值的方差估值。 例3-2：该实验是求出表示大坝库水位和坝基沉陷量之间的一元线性回归方程。计算过程为：先计算参数估值0 ，1 ，即可以得到回归方程。再根据公式评定参数估值的精度。 例3-3：该实验是用相关系数检验直线回归方程的显著性。先进行原假设和备选假设，然后计算相关系数=xy/xy ，在一定的显著水平和自由度下查得相应的值，从而判断y与x统计量是否相关。 例3-4：该实验是应用方差分析法和t检验法检验回归效果的显著性。方差分析法：根据相应的公式计算回归平方和S回、残差平方S残和以及F统计量，在一定的显著水平和自由度下查得相应的F值

3、，从而对原假设或备选假设作出判断。t检验：计算统计量t，在一定的显著水平和自由度下查得相应的t值，从而对回归效果显著性作出判断。 例3-5：该实验的目的是确定回归方程。其解题步骤为：（1）、求回归方程；（2）、计算方差的估值2 及i 的方差；（3）回归方程的显著性检验（F检验）；（4）、回归参数的显著性检验（t检验）。 例3-6：（1）、求回归方程：列法方程然后解法方程，最后得到回归方程。、求方差的估值2 =VT V/(n-2)；（3）t检验法检验回归方程的显著性；（4）、温度在15 时的预报值，以及在一定的置信度下预报值的区间估计。 例3-7：该实验为自回归模型阶数的确定，（1）、确定模型阶

4、数p：从p=1开始计算直到统计量F满足小于在一定的显著水平下的F值即接受原假设为止。（2）、模型参数估计：根据求得的阶数计算参数的估值从而可以得到自回归模型。 例3-8：该实验是根据例3-7中计算得出的自回归模型预报第37次和第38次的高程值。 例3-9：该实验为二阶多项式拟合模型：先根据相应的公式列出误差方程和法方程，然后解法方程，从而得到拟合方程。再计算方差的估值，对精度进行评定。二、 实验的步骤1例题3-1至3-42例题3-53例题3-6t/摄氏度l/mm12.11.615.21.914.81.713.91.815.92.116.4218.52.317.3219.62.24例题3-7，3

5、-8序数高程 x/mm13 26.67 1 26.33 14 27.95 2 26.27 15 26.74 3 26.43 16 27.53 4 25.56 17 25.31 5 26.82 18 26.90 6 26.56 19 28.09 7 25.93 20 26.78 8 26.43 21 28.66 9 26.52 22 26.75 10 25.46 23 27.24 11 26.12 24 28.02 12 27.28 25 26.81 5例题3-9三、 实验的结论分析一般来说，用程序编写的代码，并运行实现得到的结果与书上的结果有所差距，这种现象是必然的。因为过程中由于各种原因造成

6、的误差经过每一个步骤的累计，误差难免会有，造成这种现象的原因有以下几种1， 定义的精度不同，定义单精度和双精度，最终得到的结果不同，一般来说 ，用双精度得到的结果更精确2， 程序本身的缺陷，由于我们并不是经验丰富的专业技术人员，眼界狭隘，难以编写更好的程序。3， 误差是哪一别免得，我们只能降低误差，不能消除它进行各种显著分析时，运用到for语句，这在vb中经常出现和使用，同时也有逆矩阵，矩阵相乘等运算，需要我们调用函数，注意函数调用有专用的语句四、 实验心得体会 我理解各种显著性检验的原理及应用。同时理论联系实际，更好的理解课上的知识，开阔了眼界，我还学会了如何用vb来实现他们，并用Excel

7、直接制作了一个简单的回归分析和显著性检验的模板，只要在相应的单元格输入统计数据就能自动显示检验的结果，这种实习过程让我更加的熟练vb的操作，能将我的编写程序的能力升华。五、 源程序（主体部分）（带注释）（如果使用了程序）1例题1-4 Sub 按钮1_单击()Dim TitleRow As Excel.Range Dim ws As Excel.Worksheet Dim strTitle As String Set ws = ThisWorkbook.Sheets(5) Set TitleRow = ws.Range(ws.Cells(1, 10), ws.Cells(3, 17) strTi

8、tle = 例3-1 回归分析EXCEL VBA演示 Set TitleRow = ws.Range(ws.Cells(4, 10), ws.Cells(6, 17)strTitle = 2、计算平均值 Dim X_pj As Single Dim Y_pj As Single Dim i As Integer, sum As Single sum = 0 For i = 2 To 13 sum = sum + ws.Cells(i, 2) Next X_pj = sum / 12 sum = 0 For i = 2 To 13 sum = sum + ws.Cells(i, 3) Next

9、Y_pj = sum / 12 Set TitleRow = ws.Range(ws.Cells(7, 10), ws.Cells(9, 17) strTitle = X平均= + CStr(Round(X_pj, 4) + Y平均= + CStr(Round(Y_pj, 4) Set TitleRow = ws.Range(ws.Cells(10, 10), ws.Cells(12, 17)strTitle = 3、计算S(xx),S(xy),B0,B1 Dim S1 As Single Dim S2 As Single Dim B0 As Double, B1 As Double sum

10、= 0 For i = 2 To 13 sum = sum + ws.Cells(i, 2) * ws.Cells(i, 2) Next S1 = sum - 12 * X_pj * X_pj sum = 0 For i = 2 To 13 sum = sum + ws.Cells(i, 3) * ws.Cells(i, 2) Next S2 = sum - Y_pj * X_pj * 12 B1 = S2 / S1 B0 = Y_pj - X_pj * B1 Set TitleRow = ws.Range(ws.Cells(13, 10), ws.Cells(15, 17) strTitle

11、 = B0= + CStr(Round(B0, 4) + B1= + CStr(Round(B1, 4) + S(xx)= + CStr(Round(S1, 4) + S(xy)= + CStr(Round(S2, 4) With TitleRow .Merge .ColumnWidth = 11 设置列宽，11个字符宽 .Cells(1, 1) = strTitle .Font.Name = 宋体 .Font.Size = 12 去 .Font.Bold = True .HorizontalAlignment = xlVAlignCenter .VerticalAlignment = xlV

12、AlignCenter .Borders.LineStyle = xlContinuous .Borders.Weight = xlThick End With Set TitleRow = ws.Range(ws.Cells(16, 10), ws.Cells(18, 17)strTitle = 4.评定参数估值的精度 Dim m0 As Double Dim m1 As Double Dim m2 As Double Dim V(13) As Double For i = 1 To 12 V(i) = B0 + B1 * ws.Cells(i + 1, 2) - ws.Cells(i +

13、1, 3) Next sum = 0 For i = 1 To 12 sum = sum + V(i) * V(i) Next m0 = sum / 10 m1 = m0 * (1 / 12 + X_pj * X_pj / S1) m2 = m0 / S1 Set TitleRow = ws.Range(ws.Cells(19, 10), ws.Cells(21, 17) strTitle = m0= + CStr(Round(m0, 4) + m1= + CStr(Round(m1, 4) + m2= + CStr(Round(m2, 4) Set TitleRow = ws.Range(w

14、s.Cells(22, 10), ws.Cells(24, 17)strTitle = 例3-3.检验回归方程显著 Dim p As Double Dim S3 As Double sum = 0 For i = 2 To 13 sum = sum + ws.Cells(i, 3) * ws.Cells(i, 3) Next S3 = sum - 12 * Y_pj * Y_pjp = S2 / Sqr(S1 * S3)If Abs(p) 0.578 ThenSet TitleRow = ws.Range(ws.Cells(25, 10), ws.Cells(26, 17) strTitle

15、= p= + CStr(Round(p, 4) + y与x有关,直线回归模型有效 End If Set TitleRow = ws.Range(ws.Cells(27, 10), ws.Cells(29, 17)strTitle = 例3-4.方差分析法和t检验法检验回归方程显著 Dim S回 As Double Dim S残 As Double Dim F As Double Dim t As Double S回 = B1 * B1 * S1 S残 = 10 * m0 F = S回 / (S残 / (12 - 2) t = -Sqr(S1) * B1 / 0.8626 If F 10.04

16、And t 2.23 Then Set TitleRow = ws.Range(ws.Cells(30, 10), ws.Cells(32, 17) strTitle = H0:B1=0,H1:B1!=0 + + F= + CStr(Round(F, 4) + 拒绝H0 + + t= + CStr(Round(t, 4) + 拒绝H0 End If End Sub2例题3-5Sub 按钮4_单击() 设置第一行的标题格式 Dim TitleRow As Excel.Range Dim ws As Excel.Worksheet Dim strTitle As String Set ws = T

17、hisWorkbook.Sheets(1) Set TitleRow = ws.Range(ws.Cells(1, 10), ws.Cells(3, 17) strTitle = 例3-5 回归分析EXCEL VBA演示 + 计算过程 1、求回归方程 2、计算方差的估值 3、回归方程显著性检验（F检验） 4、回归参数显著性检验（t检验） -第一步 求回归方程- 1、求回归方程步骤 a、组成法方程 b、得到系数 c、写出回归方程 步骤提示信息 Set TitleRow = ws.Range(ws.Cells(4, 10), ws.Cells(5, 17) strTitle = 1、求回归方程 计

18、算法方程系数项 和 常数项 方法1：引入数组，采用矩阵计算的方式完成 方法2：添加辅助系数项通过excel提供的数学公式完成，为节省时间演示功能中采用 Dim ResultCofRange As Excel.Range 回归方程系数 Dim EquConstRange As Excel.Range 法方程常数项 Dim EquCofRange As Excel.Range 法方程系数阵 Dim CoeffRange As Excel.Range 误差方程系数区域 Dim ConstRange As Excel.Range 误差常数区域 Dim InvEquCofRange As Excel.R

19、ange 法方程逆阵 Set CoeffRange = ws.Range(ws.Cells(2, 1), ws.Cells(23, 3) Set ConstRange = ws.Range(ws.Cells(2, 4), ws.Cells(23, 4) Set TitleRow = ws.Range(ws.Cells(7, 10), ws.Cells(8, 17) strTitle = N*X-W=0 Set EquCofRange = ws.Range(ws.Cells(9, 10), ws.Cells(11, 12) Set EquConstRange = ws.Range(ws.Cell

20、s(9, 15), ws.Cells(11, 15) 设置单元格式 - 将数字设置为两位小数 EquCofRange.NumberFormat = 0.00 EquConstRange.NumberFormat = 0.00 EquCofRange = Application.WorksheetFunction.MMult(Application.WorksheetFunction.Transpose(CoeffRange), CoeffRange) EquConstRange = Application.WorksheetFunction.MMult(Application.Workshee

21、tFunction.Transpose(CoeffRange), ConstRange) 计算系数 Set TitleRow = ws.Range(ws.Cells(12, 10), ws.Cells(13, 17) strTitle = X = N-1W Set ResultCofRange = ws.Range(ws.Cells(14, 17), ws.Cells(16, 17) Set InvEquCofRange = ws.Range(ws.Cells(14, 12), ws.Cells(16, 14) ResultCofRange.NumberFormat = 0.0000 InvE

22、quCofRange.NumberFormat = 0.0000 InvEquCofRange = Application.WorksheetFunction.MInverse(EquCofRange) ResultCofRange = Application.WorksheetFunction.MMult(InvEquCofRange, EquConstRange) 得到法方程表达式 Set TitleRow = ws.Range(ws.Cells(17, 10), ws.Cells(18, 17) strTitle = Y= B0+B1*X1+B2*X2 Set TitleRow = ws

23、.Range(ws.Cells(19, 10), ws.Cells(20, 17) 不严谨，需要判断系数的正负号 strTitle = Y= + CStr(Round(ResultCofRange.Cells(1, 1), 4) + CStr(Round(ResultCofRange.Cells(2, 1), 4) + *X1 + + + CStr(Round(ResultCofRange.Cells(3, 1), 4) + *X2 -结束第一步- -第二步 计算方差估值- 步骤提示信息 Set TitleRow = ws.Range(ws.Cells(21, 10), ws.Cells(22

24、, 17) strTitle = 2、计算方差估值 Dim dS As Double 残差 = vv Dim dQ As Double 方差估值 Dim dD1 As Double b1系数方差 Dim dD2 As Double b2系数方差 Dim y1Range As Excel.Range 估值区域 Set y1Range = ws.Range(ws.Cells(2, 5), ws.Cells(23, 5) y1Range = Application.WorksheetFunction.MMult(CoeffRange, ResultCofRange) y1Range.Formula

25、= =y1Range-ConstRange dS = CDbl(Application.WorksheetFunction.SumX2MY2(ConstRange, y1Range) dQ = dS / 19 dD1 = dQ * InvEquCofRange.Cells(2, 2) dD2 = dQ * InvEquCofRange.Cells(3, 3) Set TitleRow = ws.Range(ws.Cells(23, 10), ws.Cells(24, 17) strTitle = S残= + CStr(Round(dS, 4) + 2= + CStr(Round(dQ, 4)

26、+ D1= + CStr(Round(dD1, 4) + D2= + CStr(Round(dD2, 4) Set TitleRow = ws.Range(ws.Cells(25, 10), ws.Cells(26, 17) strTitle = 3、回归方程显著性检验 Dim average_y As Double Dim S_y As Double Dim F As Double Dim i As Integer S_y = 0 average_y = Application.WorksheetFunction.Average(Worksheets(1).Range(Cells(2, 4)

27、, Cells(23, 4) For i = 2 To 23 S_y = S_y + (ws.Cells(i, 5) - average_y) * (ws.Cells(i, 5) - average_y) Next F = (S_y / 2) / (88.1209 / 19) Set TitleRow = ws.Range(ws.Cells(27, 10), ws.Cells(28, 17) If F 3.44 Then strTitle = ayerage_y= + CStr(Round(average_y, 4) + + S_y= + CStr(Round(S_y, 4) + + F= +

28、 CStr(Round(F, 4) + + 拒绝原假设(1=2=0),回归方程效果显著 + F3.44 Else strTitle = ayerage_y= + CStr(Round(average_y, 4) + S_y= + CStr(Round(S_y, 4) + F= + CStr(Round(F, 4) + 不拒绝原假设1=2=0End If Set TitleRow = ws.Range(ws.Cells(29, 10), ws.Cells(30, 17) strTitle = 4、回归参数显著性检验 Dim t1 As Double, t2 As Double Dim q1 As

29、 Double, q2 As Double q1 = dD1 / dQ q2 = dD2 / dQ t1 = Abs(0.2711 / (Sqr(dQ) * Sqr(q1) t2 = Abs(0.0085 / (Sqr(dQ) * Sqr(q2) Set TitleRow = ws.Range(ws.Cells(31, 10), ws.Cells(32, 17)If t1 2.09 And t2 2.09 Then strTitle = t1= + CStr(Round(t1, 4) + + t2= + CStr(Round(t2, 4) + + 拒绝H0,1回归参数效果显著2回归参数效果不显著End IfEnd Sub3例题3-6Sub 按钮6_单击()Dim TitleRow As Excel.Ran