灰色预测GM(1,1)模型实现IML & R

虽然相关文章都会提及GM(1,1)模型，但是感觉都没有刘思峰的《灰色系统》书中第六章讲的详细。下面利用矩阵语言算法实现，代码经校对后衔接了中国卫生统计中的两篇文章。

/*颜 杰 2006 中国卫生统计*/
data a1;
INPUT t year xt@@;/*读入原始数据序列*/
   yt+xt;/*生成一阶累加序列*/
   index=1;
   zt=-(yt+LAG(yt))/2;/*为数据矩阵B准备数据*/
DATAlINES;
1 1990 24395 2 1991 25286
3 1992 26901 4 1993 27339
5 1994 27871 6 1995 28721
7 1996 29728 8 1997 30067
9 1998 30791 10 1999 31284
11 2000 33716 12 2001 34558
;
PROC IML;/*调用IML模块*/
   USE a1;/*打开已有的SAS数据集a1*/
   READ ALL VAR{zt index}INTO B WHERE(zt ^= .);/*将a1中变量zt和index值(不含第读入矩阵B*/
   READ ALL VAR{xt}INTO Yn WHERE(zt ^= .);/*将a1中变量xt矩阵Yn*/
   ahat=INV(B`*B)*B`*Yn;/*计算参数矩阵*/
   ahatt=ahat`; /*将参数矩阵转置*/
   na={a u};
   CREATE a2 FROM ahatt[COLNAME=na];/*用转置后的参数矩阵数据建立SAS数据集a2*/
   APPEND FROM ahatt;/*将数据读入到数据集*/
   print b yn ahat ahatt;
QUIT;/*退出IML模块*/
DATA a3;
   SET a2;
   index=1;
RUN;
DATA a4;
   SET a1;
   IF _N_ =1; 
   xt0=xt;
   KEEP xt0 index;
RUN;
DATA a5;
   MERGE a1 a3 a4;
   BY index;
   IF _N_ =1 THEN xp=xt;
     ELSE DO
     yt1=(xt0-u/a)*EXP(-a*(t-1))+u/a;/*计算*/
     yt0=(xt0-u/a)*EXP(-a*(t-2))+u/a;/*计算*/
     xp=yt1-yt0;/*计算*/
     END;
   error=xp-xt;/*计算绝对误差*/
   rerror=error/xt*100;/*计算相对误差*/
  /* DROP yt index zt yt1 yt0 xt0;*/
PROC PRINT DATA=a5;/*输出计算结果*/
RUN;/*运行上述程序*/


/* 孔超 2008.12 中国卫生统计               */
/*改进之一：在原程序的data al中加上jbi=lag (x0)／x0一行命令；
在data al后建立data pan以实现 灰色模型的事前检验 */
data a1;
INPUT t year xt@@;/*读入原始数据序列*/
   yt+xt;/*生成一阶累加序列*/
   index=1;
   jbi=lag(xt)/xt;
   zt=-(yt+LAG(yt))/2;/*为数据矩阵B准备数据*/
DATAlINES;
1 1990 24395 2 1991 25286
3 1992 26901 4 1993 27339
5 1994 27871 6 1995 28721
7 1996 29728 8 1997 30067
9 1998 30791 10 1999 31284
11 2000 33716 12 2001 34558
;
data pan;/*事前检验*/
   set a1;
   if 0.1353< =jbi< =7.389 then good=1;
   else good=.;  /*实施判断标准进行判断*/
title 'panduanmoxing';
proc print data=pan;/*输出事前检验的结果*/

/*改进之二：设计如下程序实现灰色模型的后验比检验，评价灰色模型的拟合质量*/
proc means data=a5 std mean noprint;/*计算后验比中的标准差*/
   var xt error;
   output out=a5_2 std=sl s2 mean=x_e_;
data a5_3;/*计算后验比值C并评价模型拟合的质量*/
   set a5_2;
   c=s2/sl;
   if 0.65 < c then jdu=0;
     else if 0.5<c< =0.65 then jdu=3;
       else if 0.35<c<0.5 then jdu=2;
       else jdu=1;
/*drop sl s2 _type_ _freq_;*/
title 'houyanchabi';
proc print data=a5_3;run;/*输出后验比值C和模型拟合评价的结果*/

/*改进之三：结合循环语句，定义一个数组，实现灰色模型对未来年份的门诊量的预测*/
data a6;/*输入要预测的未来年份数据*/
   input t year @@;
datalines;
14 2006 15 2007 16 2008 17 2009 18 2010
;
data a7;/*应用模型对未来年份的预测*/
   merge a3 a4;
   array t(6)(12 13 14 15 16 17);/*定义一个数组来实现循环计算*/
   do i=2 to 6;
     x1k1=(xt0-u/a)* exp(-a*t(i))+u/a;
     x1k0=(xt0-u/a)* exp(-a*t(i-1))+u/a;
     xp=x1k1-x1k0;
     output;
   end;
   /*drop tl t2 t3 t4 t5 t6 a b x01 i x1k1 x1k0 index;*/
data a8;
   merge a6 a7;
title 'yuce';
proc print data=a8;/*输出未来年份预测的结果*/
run;/*运行上述程序*/

#编写应用于R软件的GM(1,1)模型
gm11<-function(x0,t){ #x0为输入学列，t为预测个数
x1<-cumsum(x0) #一次累加生成序列1-AG0序列
b<-numeric(length(x0)-1)
n<-length(x0)-1
for(i in 1:n){ #生成x1的紧邻均值生成序列
b[i]<--(x1[i]+x1[i+1])/2 
b} #得序列b，即为x1的紧邻均值生成序列
D<-numeric(length(x0)-1)
D[]<-1
B<-cbind(b,D)
BT<-t(B)#做逆矩阵
M<-solve(BT%*%B)
YN<-numeric(length(x0)-1)
YN<-x0[2:length(x0)]
alpha<-M%*%BT%*%YN  #模型的最小二乘估计参数列满足alpha尖
alpha2<-matrix(alpha,ncol=1)
a<-alpha2[1]
u<-alpha2[2]
cat("GM(1,1)参数估计值：",'\n',"发展系数-a=",-a,"  ","灰色作用量u=",u,'\n','\n') #利用最小二乘法求得参数估计值a,u
y<-numeric(length(c(1:t)))
y[1]<-x1[1]
for(w in 1:(t-1)){  #将a,u的估计值代入时间响应序列函数计算x1拟合序列y
y[w+1]<-(x1[1]-u/a)*exp(-a*w)+u/a 
}
cat("x(1)的模拟值：",'\n',y,'\n')
xy<-numeric(length(y))
xy[1]<-y[1]
for(o in 2:t){ #运用后减运算还原得模型输入序列x0预测序列
xy[o]<-y[o]-y[o-1] 
} 
cat("x(0)的模拟值：",'\n',xy,'\n','\n')                       

#计算残差e
e<-numeric(length(x0))
for(l in 1:length(x0)){
e[l]<-x0[l]-xy[l] #得残差
}
cat("残差：",'\n',e,'\n')
#计算相对误差
e2<-numeric(length(x0))
for(s in 1:length(x0)){
e2[s]<-(abs(e[s])/x0[s]) #得相对误差
}
cat("相对残差：",'\n',e2,'\n','\n')
cat("残差平方和=",sum(e^2),'\n')
cat("平均相对误差=",sum(e2)/(length(e2)-1)*100,"%",'\n')
cat("相对精度=",(1-(sum(e2)/(length(e2)-1)))*100,"%",'\n','\n')

#后验差比值检验
avge<-mean(abs(e));esum<-sum((abs(e)-avge)^2);evar=esum/(length(e)-1);se=sqrt(evar)  #计算残差的方差se
avgx0<-mean(x0);x0sum<-sum((x0-avgx0)^2);x0var=x0sum/(length(x0));sx=sqrt(x0var)  #计算原序列x0的方差sx
cv<-se/sx  #得验差比值
cat("后验差比值检验:",'\n',"C值=",cv,'\n')#对后验差比值进行检验，与一般标准进行比较判断预测结果好坏。
if(cv < 0.35){     
cat("C值<0.35, GM(1,1)预测精度等级为：好",'\n','\n')
}else{
if(cv<0.5){
cat("C值属于[0.35,0.5), GM(1,1)模型预测精度等级为：合格",'\n','\n')
}else{
if(cv<0.65){
cat("C值属于[0.5,0.65), GM(1,1)模型预测精度等级为：勉强合格",'\n','\n')
}else{
cat("C值>=0.65, GM(1,1)模型预测精度等级为：不合格",'\n','\n')
}
}
}
#画出输入序列x0的预测序列及x0的比较图像
plot(xy,col='blue',type='b',pch=16,xlab='时间序列',ylab='值')
points(x0,col='red',type='b',pch=4)
legend('topleft',c('预测价格','原始价格'),pch=c(16,4),lty=l,col=c('blue','red'))
}

a<-c(1.95,2.23,2.4,2.15,1.8,1.95)

gm11(a,length(a)+6)