基于VB的灰色模型预测和线性回归预测教学内容.doc

《基于VB的灰色模型预测和线性回归预测教学内容.doc》由会员分享，可在线阅读，更多相关《基于VB的灰色模型预测和线性回归预测教学内容.doc（29页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、Good is good, but better carries it.精益求精，善益求善。基于VB的灰色模型预测和线性回归预测-灰色模型预测GM(1,1)与线性回归预测（一元、多元）新建一个工程，添加一个模块（.bas），两个命令按钮：窗体代码：OptionExplicitPrivateSubCommand1_Click()灰色模型预测DimDataAsStringData=2.67,3.13,3.25,3.36,3.56,3.72GM1_1_PredictDataEndSubPrivateSubCommand2_Click()线性回归预测DimX1AsString,X2AsString,X

2、3AsString,X4AsString,YAsStringX1=100.38,99.7,92.3,87.6,87.17,88.3,92.75,100.6,90.05;最后要加上分号;X2=53.24,51.5,50.5,52.4,59.6,59.7,65.2,62.4,53.68;最后要加上分号;X3=226,250,281,272,194,180,105,115,250;最后要加上分号;Y=644,640,517,425,385,401,448,599,462最后不要加上分号;请注意！Linear_Regression_PredictX1&X2&X3&YEndSub模块代码：OptionE

3、xplicitPrivateSubCalculate_1_AGO(X_0()AsDouble,X_1()AsDouble)做一次累加生成1-AGODimiAsLong,TempXAsDouble,KAsLongK=UBound(X_0)ReDimX_1(K)Fori=0ToKTempX=TempX+X_0(i)X_1(i)=TempXNextiEndSubPrivateSubCalculate_Matrix_B(X_1()AsDouble,B()AsDouble)计算数据矩阵BDimiAsLong,KAsLongK=UBound(X_1)-1ReDimB(K,1)Fori=0ToKB(i,0)

4、=-0.5*(X_1(i)+X_1(i+1)B(i,1)=1NextiEndSubPrivateSubCalculate_Matrix_YN(X_0()AsDouble,YN()AsDouble)计算数据矩阵YNDimiAsLong,KAsLongK=UBound(X_0)-1ReDimYN(K,0)Fori=0ToKYN(i,0)=X_0(i+1)NextiEndSub函数名：Matrix_Transpotation功能：计算矩阵的转置transpotation参数：m-Integer型变量，矩阵的行数n-Integer型变量，矩阵的列数mtxA-Double型mxn二维数组，存放原矩阵mt

5、xAT-Double型nxm二维数组，返回转置矩阵PrivateSubMatrix_Transpotation(mtxA()AsDouble,mtxAT()AsDouble)DimiAsInteger,jAsIntegerDimMAsInteger,NAsIntegerM=UBound(mtxA,2)N=UBound(mtxA,1)ReDimmtxAT(M,N)Fori=0ToMForj=0ToNmtxAT(i,j)=mtxA(j,i)NextjNextiEndSub函数名：Matrix_Multiplication功能：计算矩阵的乘法multiplication参数：m-Integer型变量

6、，相乘的左边矩阵的行数n-Integer型变量，相乘的左边矩阵的列数和右边矩阵的行数l-Integer型变量，相乘的右边矩阵的列数mtxA-Double型mxn二维数组，存放相乘的左边矩阵mtxB-Double型nxl二维数组，存放相乘的右边矩阵mtxC-Double型mxl二维数组，返回矩阵乘积矩阵PrivateSubMatrix_Multiplication(mtxA()AsDouble,mtxB()AsDouble,mtxC()AsDouble)DimiAsInteger,jAsInteger,KAsIntegerDimMAsInteger,NAsInteger,LAsIntegerM=

7、UBound(mtxA,1):N=UBound(mtxB,1):L=UBound(mtxB,2)ReDimmtxC(M,L)Fori=0ToMForj=0ToLmtxC(i,j)=0#ForK=0ToNmtxC(i,j)=mtxC(i,j)+mtxA(i,K)*mtxB(K,j)NextKNextjNextiEndSub函数名：Matrix_Inversion功能：矩阵求逆参数：n-Integer型变量，矩阵的阶数mtxA-Double型二维数组，体积为nxn。存放原矩阵A；返回时存放其逆矩阵A-1。返回值：Boolean型，失败为False，成功为TruePrivateFunctionMat

8、rix_Inversion(mtxA()AsDouble)AsBoolean局部变量DimNAsIntegerN=UBound(mtxA)ReDimnIs(N)AsInteger,nJs(N)AsIntegerDimiAsInteger,jAsInteger,KAsIntegerDimdAsDouble,PAsDouble全选主元，消元ForK=0ToNd=0#Fori=KToNForj=KToNP=Abs(mtxA(i,j)If(Pd)Thend=PnIs(K)=inJs(K)=jEndIfNextjNexti求解失败If(d+1#=1#)ThenMatrix_Inversion=False

9、ExitFunctionEndIfIf(nIs(K)K)ThenForj=0ToNP=mtxA(K,j)mtxA(K,j)=mtxA(nIs(K),j)mtxA(nIs(K),j)=PNextjEndIfIf(nJs(K)K)ThenFori=0ToNP=mtxA(i,K)mtxA(i,K)=mtxA(i,nJs(K)mtxA(i,nJs(K)=PNextiEndIfmtxA(K,K)=1#/mtxA(K,K)Forj=0ToNIf(jK)ThenmtxA(K,j)=mtxA(K,j)*mtxA(K,K)NextjFori=0ToNIf(iK)ThenForj=0ToNIf(jK)Thenmt

10、xA(i,j)=mtxA(i,j)-mtxA(i,K)*mtxA(K,j)NextjEndIfNextiFori=0ToNIf(iK)ThenmtxA(i,K)=-mtxA(i,K)*mtxA(K,K)NextiNextK调整恢复行列次序ForK=NTo0Step-1If(nJs(K)K)ThenForj=0ToNP=mtxA(K,j)mtxA(K,j)=mtxA(nJs(K),j)mtxA(nJs(K),j)=PNextjEndIfIf(nIs(K)K)ThenFori=0ToNP=mtxA(i,K)mtxA(i,K)=mtxA(i,nIs(K)mtxA(i,nIs(K)=PNextiEnd

11、IfNextK求解成功Matrix_Inversion=TrueEndFunctionPrivateSubPredicted_Value(ByValX_1_0AsDouble,ByValu_valueAsDouble,ByVala_valueAsDouble,KAsLong,PV()AsDouble)DimiAsLongReDimPV(K)Fori=1ToK+1PV(i-1)=(X_1_0-u_value/a_value)*Exp(-a_value*(i-1)*(1-Exp(a_value)NextiPV(0)=X_1_0EndSubPrivateSubString_to_Array(Data

12、AsString,X_0()AsDouble)Data字符串转为X_0数组,X_0是原始序列DimPredict_Data()AsString,KAsLong,iAsLongPredict_Data=Split(Data,)K=UBound(Predict_Data)ReDimX_0(K)Fori=0ToKX_0(i)=Predict_Data(i)NextiEndSubPrivateSubPrint_Array(Arrays()AsDouble,TitleAsString)打印数组DimiAsLongForm1.PrintvbCrLf&String(25,-)&Title&String(25

13、,-)&vbCrLfFori=0ToUBound(Arrays)Form1.PrintFormat(Arrays(i),0.0000)&;NextiForm1.PrintEndSubPrivateSubPrint_String(Arrays()AsString,TitleAsString)打印字符-Relative_Residual_Error-RREDimiAsLongForm1.PrintvbCrLf&String(25,-)&Title&String(25,-)&vbCrLfFori=0ToUBound(Arrays)Form1.PrintArrays(i)&;NextiForm1.Pr

14、intEndSubPrivateSubPrint_One_String(SAsDouble,TitleAsString)Form1.PrintvbCrLf&String(25,-)&Title&String(25,-)&vbCrLfForm1.PrintSpace(25)&Format(S,0.#)EndSubPrivateSubAbsolute_Residual_Error(Array1()AsDouble,Array2()AsDouble,ARE()AsDouble)绝对残差DimKAsLong,iAsLongK=UBound(Array1)ReDimARE(K)Fori=0ToKARE(

15、i)=Format(Abs(Array2(i)-Array1(i),0.0000)NextiEndSubPrivateSubRelative_Residual_Error(Array1()AsDouble,ARE()AsDouble,RRE()AsString)相对残差DimKAsLong,iAsLongK=UBound(Array1)ReDimRRE(K)Fori=0ToKRRE(i)=Format(ARE(i)/Array1(i),0.000%)NextiEndSubPrivateSubRelatedness_Test(ARE()AsDouble,PAsDouble,RAsDouble)计

16、算相关度DimiAsLong,KAsLong,MinAsDouble,MaxAsDouble,SumRAsDoubleDimRi()AsDoubleK=UBound(ARE)ReDimRi(K)Min=ARE(0):Max=ARE(0)Fori=0ToKIfARE(i)MaxThenMax=ARE(i)NextiFori=0ToKRi(i)=(Min+P*Max)/(ARE(i)+P*Max)SumR=SumR+Ri(i)NextiR=Format(SumR/(K+1),0.0000)EndSubPrivateFunctionArray_Mean(Array1()AsDouble)AsDoub

17、le计算平均数DimiAsLong,KAsLongK=UBound(Array1)Fori=0ToKArray_Mean=Array_Mean+Array1(i)NextiArray_Mean=Array_Mean/(K+1)EndFunctionPrivateFunctionMean_Square_Error(Array1()AsDouble)AsDouble计算均方差DimAverageAsDouble,iAsLong,KAsLong,TempAsDoubleK=UBound(Array1)Average=Array_Mean(Array1()Fori=0ToKTemp=Temp+(Arr

18、ay1(i)-Average)2NextiMean_Square_Error=Format(Sqr(Temp/(K+1),0.0000)EndFunctionPublicSubGM1_1_Predict(DataAsString)Data是原始序列字符,以逗号,分开DimX_0()AsDouble,X_1()AsDouble,B()AsDouble,YN()AsDouble,PV()AsDoubleDimBT()AsDouble,BTB()AsDouble,BTBBT()AsDouble,A()AsDouble,ARE()AsDoubleDimRRE()AsString,RAsDoubleSt

19、ring_to_ArrayData,X_0Data字符串转为X_0数组,X_0是原始序列Print_ArrayX_0,原始数据Calculate_1_AGOX_0,X_1做一次累加生成X_1Calculate_Matrix_YNX_0,YN计算矩阵YNCalculate_Matrix_BX_1,B计算矩阵BMatrix_TranspotationB,BT计算矩阵B的转置BTMatrix_MultiplicationBT,B,BTB矩阵BTB=BTBIfNotMatrix_Inversion(BTB)Then矩阵BTB求逆,求逆后也是BTBMsgBox求解失败,vbCritical,提示Exit

20、SubEndIfMatrix_MultiplicationBTB,BT,BTBBT矩阵BTBBT=BTBBTMatrix_MultiplicationBTBBT,YN,A矩阵BTBBTYN=A,A(1,0)=u,A(0,0)=aDebug.Printu=&A(1,0)&,&a=&A(0,0)Predicted_ValueX_1(0),A(1,0),A(0,0),UBound(X_1),PV预测Print_ArrayPV,预测数据Absolute_Residual_ErrorX_0,PV,AREPrint_ArrayARE,绝对残差Relative_Residual_ErrorX_0,ARE,R

21、REPrint_StringRRE,相对残差Relatedness_TestARE,0.5,RPrint_One_StringR,关联度Print_One_StringFormat(Array_Mean(X_0),0.0000),原始数据平均数Print_One_StringFormat(Array_Mean(ARE),0.0000),残差平均数Print_One_StringMean_Square_Error(X_0),原始数据均方差S1Print_One_StringMean_Square_Error(ARE),残差均方差S2EndSub以下是线性回归预测PrivateSubLRP_Ori

22、ginalDate_To_Array(OriginalDateAsString,X()AsDouble,Y()AsDouble)DimODS()AsString,iAsLong,jAsLong,ODS_NAsLong,X_RowAsLong,X_ColumnAsLongODS=Split(OriginalDate,;)ODS_N=UBound(ODS)-1ReDimXn(ODS_N)AsStringFori=0ToODS_NXn(i)=ODS(i)X1,X2,XnNextiDimTempY()AsStringTempY=Split(ODS(ODS_N+1),)DimTYAsLongTY=UBo

23、und(TempY)ReDimY(TY,0)Forj=0ToTYY(j,0)=TempY(j)Form1.PrintY(j,0)NextjX_Row=TYX_Column=UBound(ODS)ReDimX(X_Row,X_Column)DimTempX()AsStringFori=0To(X_Column-1)TempX=Split(Xn(i),)Forj=0ToX_Row9X(j,i+1)=TempX(j)X(j,0)=1NextjNextiTest_Print_ArrayX()EndSubPublicSubLinear_Regression_Predict(OriginalDateAsS

24、tring)DimX()AsDouble,Y()AsDouble,B()AsDouble,iAsLongDimXT()AsDouble,XTX()AsDouble,XTXXT()AsDoubleLRP_OriginalDate_To_ArrayOriginalDate,X,YMatrix_TranspotationX,XT计算矩阵X的转置XTMatrix_MultiplicationXT,X,XTX矩阵XTX=XTXIfNotMatrix_Inversion(XTX)Then矩阵BTB求逆,求逆后也是BTBMsgBox求解失败,vbCritical,提示ExitSubEndIfMatrix_M

25、ultiplicationXTX,XT,XTXXT矩阵XTXXT=XTXXTMatrix_MultiplicationXTXXT,Y,B矩阵XTXXTY=B,A(1,0)=u,A(0,0)=aFori=0ToUBound(B)Print_One_StringB(i,0),回归系数b&iNextiEndSubPrivateSubTest_Print_Array(X()AsDouble)显示二维数组Dimi%,j%Fori=0ToUBound(X(),1)Forj=0ToUBound(X(),2)Form1.PrintFormat(X(i,j),000.0000)&;NextjForm1.PrintNextiEndSub灰色预测线性回归预测-