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

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.72"GM1_1_PredictDataEndSubPrivateSubCommand2_Click()'线性回归预测DimX1AsString,X2AsString,X3AsString,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模块代码：OptionExplicitPrivateSubCalculate_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)=-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二维数组，存放原矩阵'mtxAT-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型变量，相乘的左边矩阵的行数'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=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，成功为True''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''PrivateFunctionMatrix_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(P>d)Thend=PnIs(K)=inJs(K)=jEndIfNextjNexti'求解失败If(d+1#=1#)ThenMatrix_Inversion=FalseExitFunctionEndIfIf(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(j<>K)ThenmtxA(K,j)=mtxA(K,j)*mtxA(K,K)NextjFori=0ToNIf(i<>K)ThenForj=0ToNIf(j<>K)ThenmtxA(i,j)=mtxA(i,j)-mtxA(i,K)*mtxA(K,j)NextjEndIfNextiFori=0ToNIf(i<>K)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)=PNextiEndIfNextK'求解成功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(DataAsString,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,"-")&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.PrintEndSubPrivateSubPrint_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(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)'计算相关度DimiAsLong,KAsLong,MinAsDouble,MaxAsDouble,SumRAsDoubleDimRi()AsDoubleK=UBound(ARE)ReDimRi(K)Min=ARE(0):Max=ARE(0)Fori=0ToKIfARE(i)<MinThenMin=ARE(i)IfARE(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)AsDouble'计算平均数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+(Array1(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,RAsDoubleString_to_ArrayData,X_0'Data字符串转为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'矩阵BT×B=BTBIfNotMatrix_Inversion(BTB)Then'矩阵BTB求逆,求逆后也是BTBMsgBox"求解失败",vbCritical,"提示"ExitSubEndIfMatrix_MultiplicationBTB,BT,BTBBT'矩阵BTB×BT=BTBBTMatrix_MultiplicationBTBBT,YN,A'矩阵BTBBT×YN=A,A(1,0)=u,A(0,0)=aDebug.Print"u="&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,RREPrint_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),"原始数据均方差S1"Print_One_StringMean_Square_Error(ARE),"残差均方差S2"EndSub'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''以下是线性回归预测''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''PrivateSubLRP_OriginalDate_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=UBound(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_Row'9X(j,i+1)=TempX(j)X(j,0)=1NextjNextiTest_Print_ArrayX()EndSubPublicSubLinear_Regression_Predict(OriginalDateAsString)DimX()AsDouble,Y()AsDouble,B()AsDouble,iAsLongDimXT()AsDouble,XTX()AsDouble,XTXXT()AsDoubleLRP_OriginalDate_To_ArrayOriginalDate,X,YMatrix_TranspotationX,XT'计算矩阵X的转置XTMatrix_MultiplicationXT,X,XTX'矩阵XT×X=XTXIfNotMatrix_Inversion(XTX)Then'矩阵BTB求逆,求逆后也是BTBMsgBox"求解失败",vbCritical,"提示"ExitSubEndIfMatrix_MultiplicationXTX,XT,XTXXT'矩阵XTX×XT=XTXXTMatrix_MultiplicationXTXXT,Y,B'矩阵XTXXT×Y=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灰色预测线性回归预测-