*本程序提供SAS爱好者交流学习,禁止商业用途;
*算法参考冯定<神经网络专家系统>;
*案例DeepLearning http://blog.sina.com.cn/s/blog_593af2a70101endk.html;
*作者:keming;
*开发于2008年7月.;


读者可先阅读http://blog.sina.com.cn/s/blog_593af2a70101endk.html，再理解程序。


/*************************************/
*本程序提供SAS爱好者交流学习,禁止商业用途;
*算法参考冯定<神经网络专家系统>;
*案例DeepLearning http://blog.sina.com.cn/s/blog_593af2a70101endk.html;
*作者:keming;
*开发于2008年7月.;
/*************************************/



X CD ".";

OPTIONS MPRINTCENTER ERRORS=0LS=255 COMPRESS=YES;

DATA RAWDATA;
LENGTH EVENT_ID 8;
EVENT_ID=_N_;
INPUT TMPV1 TMPV2 TMPV3 TMPV4;
CARDS;
1 0 0 0
0 1 0 0
0 0 1 0
0 0 0 1
;
RUN;


%MACRO TMPTARGET;

PROC CONTENTS DATA=RAWDATA(DROP=EVENT_ID ) OUT=INPUTVARLST NOPRINT;
RUN;

DATA _NULL_;
SET INPUTVARLST END=LAST;
CALL SYMPUT(CATS("VAR",_N_),COMPRESS(NAME));
IF LAST THEN CALL SYMPUT("NVAR",COMPRESS(_N_));
RUN;

DATA NETWORK_BASE;
SET RAWDATA;

%DO I=1 %TO &NVAR.;
TARGET&I.= &&VAR&I..;
%END;

KEEPEVENT_ID
%DO I=1 %TO &NVAR.;
TARGET&I.
&&VAR&I..
%END;
;
RUN;

%MEND TMPTARGET;
%TMPTARGET;



DATANW_LAYER;
INPUT LAYER CEIL CWGT ACTFUNC $;
LABEL LAYER="层数"CEIL="神经元个数" CWGT="神经元权重个数包含常数" ACTFUNC="激活函数" ;
CARDS;
1 1 5 LOGSIG
1 2 5 LOGSIG
2 1 3 LOGSIG
2 2 3 LOGSIG
2 3 3 LOGSIG
2 4 3 LOGSIG
;
RUN;



PROC PRINT DATA=NW_LAYER LABEL;
RUN;


%MACRO RNAME(INDATA=);
PROC CONTENTS DATA=&INDATA.(DROP=EVENT_IDTARGET:) NOPRINT OUT=NCNT;
RUN;

DATA NCNT;
SET NCNT(KEEP=NAME ) END=LAST;
ID=_N_;
*当前处理的是哪条记录;
LENGTH ACT_VAR $ 32;
ACT_VAR=CATS("ACT_0_",_N_);
CALL SYMPUT(CATS("OLDVAR",ID),COMPRESS(NAME));
CALL SYMPUT(CATS("NEWVAR",ID),COMPRESS(ACT_VAR));
IF LAST THEN CALL SYMPUT("NVAR",COMPRESS(ID)) ;
RUN;




DATA NWDATA_MODEL;
SET &INDATA.;
RENAME %DO I=1 %TO &NVAR.; &&OLDVAR&I..=&&NEWVAR&I.. %END;;

TMPRANUNI=RANUNI(123456);


LENGTH DT $ 8;
DT="DP";
OUTPUT;

DT="DV";
OUTPUT;

DT="TV";
OUTPUT;
RUN;



PROC SORT DATA=NWDATA_MODEL OUT=NWDATA_MODEL(DROP=TMPRANUNI);
BY DT TMPRANUNI;
RUN;


%MEND RNAME;
%RNAME(INDATA=NETWORK_BASE);





%MACRO ACTSLT(VAR=,FUNC=,D=);
%IF &D.=N %THEN %DO;
%IF &FUNC.=LOGSIG%THEN(1/(1+EXP(-&VAR.)));
%ELSE %IF&FUNC.=TANSIG%THEN(2/(1+EXP(-2*&VAR.))-1);
%ELSE %IF&FUNC.=PURELIN%THEN(&VAR.);
%END;

%ELSE %IF &D.=Y %THEN %DO;
%IF &FUNC.=LOGSIG%THEN(1)*(EXP(-&VAR.)/((1+EXP(-&VAR.))**2));
%ELSE %IF&FUNC.=TANSIG%THEN(1)*(4*EXP(-2*&VAR.)/((1+EXP(-2*&VAR.))**2));
%ELSE %IF&FUNC.=PURELIN%THEN(1)*(1);
%END;

%MENDACTSLT;

%MACRO NETWORK(WGTSEED=12,MINERROR=0.001,ETA=0.001,ALPHA=0.7,MAXLOOPN=40000);
DATA _NULL_;
SET NW_LAYER END=LAST;
BY LAYER;
IF LAST.LAYER THEN DO;
CALL SYMPUT(CATS("CEIL",LAYER),COMPRESS(CEIL));
CALL SYMPUT(CATS("CWGT",LAYER),COMPRESS(CWGT));
END;
CALL SYMPUT(CATS("ACTFUNC_",LAYER,"_",CEIL),COMPRESS(ACTFUNC));
IF LAST THEN CALL SYMPUT("NLAYER",LAYER);
RUN;


*SASFILE WORK.NWDATA_MODEL.DATA OPEN;

DATA NETWORK_T;
RETAIN
DLP_ALLERROR DLP_AVGERROR 100
TEST_ALLERROR TEST_AVGERROR 100

LAST_DLP_AVGERROR 100
DOBS TOBS 0;

ARRAY L_T_AE LAG_TEST_AVGERROR1-LAG_TEST_AVGERROR9 (9*100);

RETAIN%DOI=1 %TO &NLAYER.;
%DO J=1 %TO &&CEIL&I..;
%DO K=1 %TO &&CWGT&I..;
WGT_&I._&J._&K.
PARTIAL_P0_WGT_&I._&J._&K.
DETAX_WGT_&I._&J._&K.
%END;
%END;
%END;
0
;

ARRAY ALLWGT WGT_:;
DO OVER ALLWGT;
ALLWGT=-1+2*RANUNI(&WGTSEED.);
END;

DO WHILE(NOT (DLP_AVGERROR<&MINERROR. OR LOOPN>&MAXLOOPN. ));
LOOPN+1;
DLP_ALLERROR =0;
TEST_ALLERROR=0;
DOBS=0;TOBS=0;
RETAIN LAST_DLP_AVGERROR 999ETA &ETA.ALPHA &ALPHA. ;

%******逐条读入数据;
DO PI=1 TO NOBS;
SET NWDATA_MODEL NOBS=NOBS POINT=PI;

**正向输入;
%DO I=1 %TO&NLAYER.;
%DO J=1 %TO &&CEIL&I..;
%******连接函数;
COMB_&I._&J.=SUM(%DO K=1 %TO&&CWGT&I..; WGT_&I._&J._&K.* %IF &K.^=&&CWGT&I.. %THEN ACT_%EVAL(&I.-1)_&K. ;%ELSE 1; ,%END;0 );
%******激活函数;
ACT_&I._&J.= %ACTSLT(VAR=COMB_&I._&J.,FUNC=&&ACTFUNC_&I._&J..,D=N);
%END;
%END;



IF DT="DP" THEN DO;
**反向修正;
%DO I=&NLAYER. %TO1 %BY-1;
%DO J=1 %TO &&CEIL&I..;
D_&I._&J.=%ACTSLT(VAR=COMB_&I._&J.,FUNC=&&ACTFUNC_&I._&J..,D=Y) *SUM(
%IF &NLAYER.=&I.%THEN-(TARGET&J.-ACT_&I._&J.) ;
%ELSE %DO;
%DO NL=1 %TO %LEFT(%NRSTR(&CEIL)%EVAL(&I.+1));
WGT_%EVAL(&I.+1)_&NL._&J.*D_%EVAL(&I.+1)_&NL.,
%END;
0
%END;
);

%DO K=1 %TO&&CWGT&I..;
PARTIAL_P0_WGT_&I._&J._&K.=D_&I._&J.* %IF &K.^=&&CWGT&I.. %THEN ACT_%EVAL(&I.-1)_&K.; %ELSE 1;;
%END;

%END;
%END;


%DOI=1 %TO &NLAYER.;
%DO J=1 %TO &&CEIL&I..;
%DO K=1 %TO &&CWGT&I..;
WGT_&I._&J._&K.=WGT_&I._&J._&K.-ETA*PARTIAL_P0_WGT_&I._&J._&K.+ALPHA*DETAX_WGT_&I._&J._&K.;
DETAX_WGT_&I._&J._&K.= -ETA*PARTIAL_P0_WGT_&I._&J._&K.+ALPHA*DETAX_WGT_&I._&J._&K.;
%END;
%END;
%END;

END;

ELSE IF DT="DV" THEN DO;
DOBS+1;
%DO I=1 %TO&NLAYER.;
%DO J=1 %TO &&CEIL&I..;
%IF &NLAYER.=&I.%THENDLP_ALLERROR+((ACT_&I._&J.-TARGET&J.)**2) ;;
%END;
%END;

END;

ELSE IF DT="TV" THEN DO;
TOBS+1;
%DO I=1 %TO&NLAYER.;
%DO J=1 %TO &&CEIL&I..;
%IF &NLAYER.=&I.%THENTEST_ALLERROR+((ACT_&I._&J.-TARGET&J.)**2) ;;
%END;
%END;

END;


END;


DLP_AVGERROR = (DLP_ALLERROR /DOBS);
TEST_AVGERROR= (TEST_ALLERROR/TOBS);

OUTPUT;




*修改步长;
IF DLP_AVGERROR<LAST_DLP_AVGERRORTHEN ETA=MIN(ETA*1.2,0.1);
ELSEIF DLP_AVGERROR>LAST_DLP_AVGERRORTHEN ETA=MAX(ETA*0.8,0.00001);



*上次误差序列;
*DLP;
LAST_DLP_AVGERROR=DLP_AVGERROR;
*TEST;
DO _TPI=9 TO 2 BY -1;
L_T_AE(_TPI)=L_T_AE(_TPI-1);
END;
L_T_AE(1)=TEST_AVGERROR;

END;

STOP;

***************;
KEEP LOOPN DLP_ALLERROR DLP_AVGERROR TEST_ALLERROR TEST_AVGERRORWGT_:ETAALPHA ;
***************;
RUN;

*SASFILE WORK.NWDATA_MODEL.DATA CLOSE;


DATA ALLWGT;
SETNETWORK_T END=LAST;
BY LOOPN;
IF LAST.LOOPN ;
OUTPUT;
KEEP LOOPN DLP_ALLERROR DLP_AVGERROR TEST_ALLERROR TEST_AVGERRORWGT_:ETA;
RUN;

PROC SORT DATA=ALLWGT OUT=ALLWGT_S;
BYTEST_AVGERROR;
RUN;

DATA MINWGT;
SET ALLWGT_S;
OUTPUT;
STOP;
RUN;

SYMBOLC=RED;
SYMBOL2 C=BLUE;
PROC GPLOT DATA=ALLWGT;
PLOT DLP_AVGERROR*LOOPN=1 TEST_AVGERROR*LOOPN=2/OVERLAY;
RUN;
QUIT;



%MEND NETWORK;
%NETWORK;



%MACRO PERFM(NEWKDIS=,INDATA=,DISTCNT=,DISWGT=,OUTDATA=);
*NEWKDIS层数字典 INDATA输入数据 DISTCNT重命名字典 DISWGT 权重字典;

DATA _NULL_;
SET &NEWKDIS. END=LAST;
BY LAYER;
IF LAST.LAYER THEN DO;
CALL SYMPUT(CATS("CEIL",LAYER),COMPRESS(CEIL));
CALL SYMPUT(CATS("CWGT",LAYER),COMPRESS(CWGT));
END;
CALL SYMPUT(CATS("ACTFUNC_",LAYER,"_",CEIL),COMPRESS(ACTFUNC));
IF LAST THEN CALL SYMPUT("NLAYER",LAYER);
RUN;



DATA NCNT;
SET &DISTCNT.(KEEP=NAME ) END=LAST;
ID=_N_;
LENGTH ACT_VAR $ 32;
ACT_VAR=CATS("ACT_0_",_N_);
CALL SYMPUT(CATS("OLDVAR",ID),COMPRESS(NAME));
CALL SYMPUT(CATS("NEWVAR",ID),COMPRESS(ACT_VAR));
IF LAST THEN CALL SYMPUT("NVAR",COMPRESS(ID)) ;
RUN;

DATA PP_DATA;
SET &INDATA.;
RENAME %DO I=1 %TO &NVAR.; &&OLDVAR&I..=&&NEWVAR&I.. %END;;
RUN;


DATA &OUTDATA.;
SETPP_DATA NOBS=NOBS END=LAST;
IF _N_=1 THEN SET&DISWGT.;
%DO I=1 %TO&NLAYER.;
%DO J=1 %TO &&CEIL&I..;
%******连接函数;
COMB_&I._&J.=SUM(%DO K=1 %TO&&CWGT&I..; WGT_&I._&J._&K.* %IF &K.^=&&CWGT&I.. %THEN ACT_%EVAL(&I.-1)_&K. ;%ELSE 1; ,%END;0 );
%******激活函数;
ACT_&I._&J.= %ACTSLT(VAR=COMB_&I._&J.,FUNC=&&ACTFUNC_&I._&J..,D=N);
%END;
%END;

KEEP EVENT_ID ACT_:;

RUN;



%MEND PERFM;



%PERFM(NEWKDIS=NW_LAYER,INDATA=RAWDATA,DISTCNT=NCNT,DISWGT=MINWGT,OUTDATA=TMPDATA);

PROC PRINT DATA=TMPDATA;
RUN;