高等测量平差实验回归分析.docx
《高等测量平差实验回归分析.docx》由会员分享，可在线阅读，更多相关《高等测量平差实验回归分析.docx（24页珍藏版）》请在冰豆网上搜索。
高等测量平差实验回归分析
实验一回归分析
班级：
测绘0911学号：
0920115114姓名：
叶林日期：
16-11-2011
一、实验分析
1、实验的目的。
（1）理解各种显著性检验的原理及应用。
（2）如何用vb来实现例题的过程
（3）用Excel直接制作了一个简单的回归分析和显著性检验的模板，只要在相应的单元格输入统计数据就能自动显示检验的结果：
2、实验要求
在excel中利用宏进行vb编程，求解线性回归方程以及用不同的方法进行各种显著分析，按照要求在excel中输出步骤和结果
3、实验过程的剖析
例3-1：
该实验是展示一元线性回归参数的计算过程：
先计算法方程，从而可得参数的最小二乘估值，最后可以得到一元线性回归方程。
再计算相应的残差，然后计算观测值的方差估值。
例3-2：
该实验是求出表示大坝库水位和坝基沉陷量之间的一元线性回归方程。
计算过程为：
先计算参数估值β0，β1，即可以得到回归方程。
再根据公式评定参数估值的精度。
例3-3：
该实验是用相关系数检验直线回归方程的显著性。
先进行原假设和备选假设，然后计算相关系数ρ=σxy/σxσy，在一定的显著水平和自由度下查得相应的ρ值，从而判断y与x统计量是否相关。
例3-4：
该实验是应用方差分析法和t检验法检验回归效果的显著性。
方差分析法：
根据相应的公式计算回归平方和S回、残差平方S残和以及F统计量，在一定的显著水平和自由度下查得相应的F值，从而对原假设或备选假设作出判断。
t检验：
计算统计量t，在一定的显著水平和自由度下查得相应的t值，从而对回归效果显著性作出判断。
例3-5：
该实验的目的是确定回归方程。
其解题步骤为：
（1）、求回归方程；
（2）、计算方差的估值σ2及βi的方差；（3）回归方程的显著性检验（F检验）；（4）、回归参数的显著性检验（t检验）。
例3-6：
（1）、求回归方程：
列法方程然后解法方程，最后得到回归方程。
、求方差的估值σ2=VTV/（n-2）；（3）t检验法检验回归方程的显著性；（4）、温度在15℃时的预报值，以及在一定的置信度下预报值的区间估计。
例3-7：
该实验为自回归模型阶数的确定，
（1）、确定模型阶数p：
从p=1开始计算直到统计量F满足小于在一定的显著水平α下的Fα值即接受原假设为止。
（2）、模型参数估计：
根据求得的阶数计算参数的估值从而可以得到自回归模型。
例3-8：
该实验是根据例3-7中计算得出的自回归模型预报第37次和第38次的高程值。
例3-9：
该实验为二阶多项式拟合模型：
先根据相应的公式列出误差方程和法方程，然后解法方程，从而得到拟合方程。
再计算方差的估值，对精度进行评定。
二、实验的步骤
1．例题3-1至3-4
2．例题3-5
3．例题3-6
t/摄氏度
△l/mm
12.1
1.6
15.2
1.9
14.8
1.7
13.9
1.8
15.9
2.1
16.4
2
18.5
2.3
17.3
2
19.6
2.2
4．例题3-7，3-8
序数
高程x/mm
13
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
三、实验的结论分析
一般来说，用程序编写的代码，并运行实现得到的结果与书上的结果有所差距，这种现象是必然的。
因为过程中由于各种原因造成的误差经过每一个步骤的累计，误差难免会有，造成这种现象的原因有以下几种
1，定义的精度不同，定义单精度和双精度，最终得到的结果不同，一般来说，用双精度得到的结果更精确
2，程序本身的缺陷，由于我们并不是经验丰富的专业技术人员，眼界狭隘，难以编写更好的程序。
3，误差是哪一别免得，我们只能降低误差，不能消除它
进行各种显著分析时，运用到for语句，这在vb中经常出现和使用，同时也有逆矩阵，矩阵相乘等运算，需要我们调用函数，注意函数调用有专用的语句
四、实验心得体会
我理解各种显著性检验的原理及应用。
同时理论联系实际，更好的理解课上的知识，开阔了眼界，我还学会了如何用vb来实现他们，并用Excel直接制作了一个简单的回归分析和显著性检验的模板，只要在相应的单元格输入统计数据就能自动显示检验的结果，这种实习过程让我更加的熟练vb的操作，能将我的编写程序的能力升华。
五、源程序（主体部分）（带注释）（如果使用了程序）
1．例题1-4
Sub按钮1_单击（）
DimTitleRowAsExcel.Range
DimwsAsExcel.Worksheet
DimstrTitleAsString
Setws=ThisWorkbook.Sheets（5）
SetTitleRow=ws.Range（ws.Cells（1,10）,ws.Cells（3,17））
strTitle="例3-1回归分析EXCELVBA演示"
SetTitleRow=ws.Range（ws.Cells（4,10）,ws.Cells（6,17））
strTitle="2、计算平均值"
DimX_pjAsSingle
DimY_pjAsSingle
DimiAsInteger,sumAsSingle
sum=0
Fori=2To13
sum=sum+ws.Cells（i,2）
Next
X_pj=sum/12
sum=0
Fori=2To13
sum=sum+ws.Cells（i,3）
Next
Y_pj=sum/12
SetTitleRow=ws.Range（ws.Cells（7,10）,ws.Cells（9,17））
strTitle="X平均="+CStr（Round（X_pj,4））+"Y平均="+CStr（Round（Y_pj,4））
SetTitleRow=ws.Range（ws.Cells（10,10）,ws.Cells（12,17））
strTitle="3、计算S（xx）,S（xy）,B0,B1"
DimS1AsSingle
DimS2AsSingle
DimB0AsDouble,B1AsDouble
sum=0
Fori=2To13
sum=sum+ws.Cells（i,2）*ws.Cells（i,2）
Next
S1=sum-12*X_pj*X_pj
sum=0
Fori=2To13
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
SetTitleRow=ws.Range（ws.Cells（13,10）,ws.Cells（15,17））
strTitle="B0="+CStr（Round（B0,4））+"B1="+CStr（Round（B1,4））+"S（xx）="+CStr（Round（S1,4））+"S（xy）="+CStr（Round（S2,4））
WithTitleRow
.Merge
.ColumnWidth=11'设置列宽，11个字符宽
.Cells（1,1）=strTitle
.Font.Name="宋体"
.Font.Size=12'去
.Font.Bold=True
.HorizontalAlignment=xlVAlignCenter
.VerticalAlignment=xlVAlignCenter
.Borders.LineStyle=xlContinuous
.Borders.Weight=xlThick
EndWith
SetTitleRow=ws.Range（ws.Cells（16,10）,ws.Cells（18,17））
strTitle="4.评定参数估值的精度"
Dimm0AsDouble
Dimm1AsDouble
Dimm2AsDouble
DimV（13）AsDouble
Fori=1To12
V（i）=B0+B1*ws.Cells（i+1,2）-ws.Cells（i+1,3）
Next
sum=0
Fori=1To12
sum=sum+V（i）*V（i）
Next
m0=sum/10
m1=m0*（1/12+X_pj*X_pj/S1）
m2=m0/S1
SetTitleRow=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））
SetTitleRow=ws.Range（ws.Cells（22,10）,ws.Cells（24,17））
strTitle="例3-3.检验回归方程显著"
DimpAsDouble
DimS3AsDouble
sum=0
Fori=2To13
sum=sum+ws.Cells（i,3）*ws.Cells（i,3）
Next
S3=sum-12*Y_pj*Y_pj
p=S2/Sqr（S1*S3）
IfAbs（p）>0.578Then
SetTitleRow=ws.Range（ws.Cells（25,10）,ws.Cells（26,17））
strTitle="p="+CStr（Round（p,4））+"y与x有关,直线回归模型有效"
EndIf
SetTitleRow=ws.Range（ws.Cells（27,10）,ws.Cells（29,17））
strTitle="例3-4.方差分析法和t检验法检验回归方程显著"
DimS回AsDouble
DimS残AsDouble
DimFAsDouble
DimtAsDouble
S回=B1*B1*S1
S残=10*m0
F=S回/（S残/（12-2））
t=-Sqr（S1）*B1/0.8626
IfF>10.04Andt>2.23Then
SetTitleRow=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"
EndIf
EndSub
2．例题3-5
Sub按钮4_单击（）
'设置第一行的标题格式
DimTitleRowAsExcel.Range
DimwsAsExcel.Worksheet
DimstrTitleAsString
Setws=ThisWorkbook.Sheets
（1）
SetTitleRow=ws.Range（ws.Cells（1,10）,ws.Cells（3,17））
strTitle="例3-5回归分析EXCELVBA演示"
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'计算过程
'1、求回归方程
'2、计算方差的估值
'3、回归方程显著性检验（F检验）
'4、回归参数显著性检验（t检验）
'-----------第一步求回归方程----------
'1、求回归方程步骤
'a、组成法方程
'b、得到系数
'c、写出回归方程
'步骤提示信息
SetTitleRow=ws.Range（ws.Cells（4,10）,ws.Cells（5,17））
strTitle="1、求回归方程"
'计算法方程系数项和常数项
'方法1：
引入数组，采用矩阵计算的方式完成
'方法2：
添加辅助系数项通过excel提供的数学公式完成，为节省时间演示功能中采用
DimResultCofRangeAsExcel.Range'回归方程系数
DimEquConstRangeAsExcel.Range'法方程常数项
DimEquCofRangeAsExcel.Range'法方程系数阵
DimCoeffRangeAsExcel.Range'误差方程系数区域
DimConstRangeAsExcel.Range'误差常数区域
DimInvEquCofRangeAsExcel.Range'法方程逆阵
SetCoeffRange=ws.Range（ws.Cells（2,1）,ws.Cells（23,3））
SetConstRange=ws.Range（ws.Cells（2,4）,ws.Cells（23,4））
SetTitleRow=ws.Range（ws.Cells（7,10）,ws.Cells（8,17））
strTitle="N*X-W=0"
SetEquCofRange=ws.Range（ws.Cells（9,10）,ws.Cells（11,12））
SetEquConstRange=ws.Range（ws.Cells（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.WorksheetFunction.Transpose（CoeffRange）,ConstRange）
'计算系数
SetTitleRow=ws.Range（ws.Cells（12,10）,ws.Cells（13,17））
strTitle="X=N-1W"
'
SetResultCofRange=ws.Range（ws.Cells（14,17）,ws.Cells（16,17））
SetInvEquCofRange=ws.Range（ws.Cells（14,12）,ws.Cells（16,14））
ResultCofRange.NumberFormat="0.0000"
InvEquCofRange.NumberFormat="0.0000"
InvEquCofRange=Application.WorksheetFunction.MInverse（EquCofRange）
ResultCofRange=Application.WorksheetFunction.MMult（InvEquCofRange,EquConstRange）
'得到法方程表达式
SetTitleRow=ws.Range（ws.Cells（17,10）,ws.Cells（18,17））
strTitle="Y=B0+B1*X1+B2*X2"
SetTitleRow=ws.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"
'-----------结束第一步--------------------
'-----------第二步计算方差估值-------
步骤提示信息
SetTitleRow=ws.Range（ws.Cells（21,10）,ws.Cells（22,17））
strTitle="2、计算方差估值"
DimdSAsDouble'残差=v'v
DimdQAsDouble'方差估值
DimdD1AsDouble'b1系数方差
DimdD2AsDouble'b2系数方差
Dimy1RangeAsExcel.Range'估值区域
Sety1Range=ws.Range（ws.Cells（2,5）,ws.Cells（23,5））
y1Range=Application.WorksheetFunction.MMult（CoeffRange,ResultCofRange）
'y1Range.Formula="=y1Range-ConstRange"
dS=CDbl（Application.WorksheetFunction.SumX2MY2（ConstRange,y1Range））
dQ=dS/19
dD1=dQ*InvEquCofRange.Cells（2,2）
dD2=dQ*InvEquCofRange.Cells（3,3）
SetTitleRow=ws.Range（ws.Cells（23,10）,ws.Cells（24,17））
strTitle="S残="+CStr（Round（dS,4））+"σ2="+CStr（Round（dQ,4））+"Dβ1="+CStr（Round（dD1,4））+"Dβ2="+CStr（Round（dD2,4））
SetTitleRow=ws.Range（ws.Cells（25,10）,ws.Cells（26,17））
strTitle="3、回归方程显著性检验"
Dimaverage_yAsDouble
DimS_yAsDouble
DimFAsDouble
DimiAsInteger
S_y=0
average_y=Application.WorksheetFunction.Average（Worksheets
（1）.Range（Cells（2,4）,Cells（23,4）））
Fori=2To23
S_y=S_y+（ws.Cells（i,5）-average_y）*（ws.Cells（i,5）-average_y）
Next
F=（S_y/2）/（88.1209/19）
SetTitleRow=ws.Range（ws.Cells（27,10）,ws.Cells（28,17））
IfF>3.44Then
strTitle="ayerage_y="+CStr（Round（average_y,4））+""+"S_y="+CStr（Round（S_y,4））+""+"F="+CStr（Round（F,4））+""+"拒绝原假设（β1=β2=0）,回归方程效果显著"+"F>3.44"
Else
strTitle="ayerage_y="+CStr（Round（average_y,4））+"S_y="+CStr（Round（S_y,4））+"F="+CStr（Round（F,4））+"不拒绝原假设β1=β2=0"
EndIf
'
SetTitleRow=ws.Range（ws.Cells（29,10）,ws.Cells（30,17））
strTitle="4、回归参数显著性检验"
Dimt1AsDouble,t2AsDouble
Dimq1AsDouble,q2AsDouble
q1=dD1/dQ
q2=dD2/dQ
t1=Abs（0.2711/（Sqr（dQ）*Sqr（q1）））
t2=Abs（0.0085/（Sqr（dQ）*Sqr（q2）））
SetTitleRow=ws.Range（ws.Cells（31,10）,ws.Cells（32,17））
Ift1>2.09Andt2<2.09Then
strTitle="t1="+CStr（Round（t1,4））+""+"t2="+CStr（Round（t2,4））+""+"拒绝H0,β1回归参数效果显著β2回归参数效果不显著"
EndIf
EndSub
3．例题3-6
Sub按钮6_单击（）
DimTitleRowAsExcel.Ran
升级会员 