This sample program is the subroutine JNTDEC. It demonstrates how all training algorithms are used.
SUBROUTINE JNTDEC(METHOD)
C...JetNet subroutine Test-DECk
C...Runs a test-program using data from two overlapping Gaussian
C...distributions in the input space. The test-program uses the
C...method specified by METHOD, with values corresponding to the
C...switch MSTJN(5).
PARAMETER(MAXI=1000,MAXO=1000)
COMMON /JNDAT1/ MSTJN(40),PARJN(40),MSTJM(20),PARJM(20),
1234 COMMON /JNDAT1/x M
& OIN(MAXI),OUT(MAXO),MXNDJM
12345 7 9 11 13 15
SAVE /JNDAT1/
PARAMETER(INDIM=5,HIDDEN=10,NTRAIN=5000,NTEST=10000,NEPOCH=100)
PARAMETER(WID1=1.,WID2=2.,XI=0.00,BAYES=85.2)
DIMENSION TIN(NTRAIN+NTEST,INDIM),TOUT(NTRAIN+NTEST)
WRITE(MSTJN(6),600)
WRITE(MSTJN(6),610)INDIM
WRITE(MSTJN(6),620)WID1,WID2
WRITE(MSTJN(6),621)XI
WRITE(MSTJN(6),*)
C...Generate data:
WRITE(MSTJN(6),625)
DO 100 IPAT=1,NTRAIN+NTEST
IDUM=IPAT
IF (RJN(IDUM).GT.0.5) THEN
DO 110 I=1,INDIM
TIN(IPAT,I)=WID1*GAUSJN(IDUM)
110 CONTINUE
TOUT(IPAT)=1.0
ELSE
TIN(IPAT,1)=WID2*GAUSJN(IDUM)+XI
DO 120 I=2,INDIM
TIN(IPAT,I)=WID2*GAUSJN(IDUM)
120 CONTINUE
TOUT(IPAT)=0.0
ENDIF
100 CONTINUE
WRITE(MSTJN(6),626)
C...Set network architecture: MSTJN(1)-layered network with
C...MSTJN(11) hidden nodes, MSTJN(12) output nodes and
C...MSTJN(10) inputs.
MSTJN(1)=3
MSTJN(10)=INDIM
MSTJN(11)=HIDDEN
MSTJN(12)=1
C...Set sigmoid function:
MSTJN(3)=1
C...Initial width of weights:
PARJN(4)=0.5
C...Choose updating method
MSTJN(5)=METHOD
IF ((MSTJN(5).EQ.8).OR.(MSTJN(5).EQ.9).OR.(MSTJN(5).EQ.14).OR.
1234 COMMON /JNDAT1/x M
&(MSTJN(5).LT.0).OR.(MSTJN(5).GT.15)) THEN
12345 7 9 11 13 15
WRITE(MSTJN(6),660)
STOP 0
ENDIF
C...Initialize network:
CALL JNINIT
C...Set parameters suitable for the given method of updating
IF (MSTJN(5).EQ.0) THEN
C...Normal Backprop
PARJN(1)=2.0
PARJN(2)=0.5
PARJN(11)=0.999
ELSEIF (MSTJN(5).EQ.1) THEN
C...Manhattan
PARJN(1)=0.05
PARJN(2)=0.5
PARJN(11)=-0.99
ELSEIF (MSTJN(5).EQ.2) THEN
C...Langevin
PARJN(1)=1.0
PARJN(2)=0.5
PARJN(6)=0.01
PARJN(11)=0.999
PARJN(20)=0.99
ELSEIF (MSTJN(5).EQ.3) THEN
C...Quickprop
PARJN(1)=2.0
PARJN(2)=0.0
PARJN(6)=0.0
PARJN(11)=1.0
PARJN(20)=1.0
MSTJN(2)=NTRAIN
ELSEIF ((MSTJN(5).GE.4).AND.(MSTJN(5).LE.7)) THEN
C...Conjugate Gradient
PARJN(1)=1.0
MSTJN(2)=NTRAIN
ELSEIF ((MSTJN(5).GE.10).AND.(MSTJN(5).LE.13)) THEN
C...Scaled Conjugate Gradient
MSTJN(2)=NTRAIN
ELSEIF (MSTJN(5).EQ.15) THEN
C...Rprop
PARJN(1)=1.0
MSTJN(2)=NTRAIN
ENDIF
C...Define the size of one epoch. Note that for batch training, the
C...number of patterns per update, MSTJN(2), must be set to the
C...total number of training patterns, and hence MSTJN(9), the
C...number of updates per epoch must be set to one.
MSTJN(9)=MAX(1,NTRAIN/MSTJN(2))
C...Other parameters keep their default values.
WRITE(MSTJN(6),*)
WRITE(MSTJN(6),630)
TESTMX=0.0
TRNMX=0.0
C...Main loop over epochs:
DO 300 IEPOCH=1,NEPOCH
C...Training loop:
NRIGHT=0
DO 310 IP=1,NTRAIN
IF (MSTJN(5).LE.2) THEN
C...Note that for non-batch training it is often a good idea to pick
C...training patterns at random
IPAT=INT(RJN(IP)*FLOAT(NTRAIN))+1
ELSE
IPAT=IP
ENDIF
C...Put pattern into OIN:
DO 320 I=1,MSTJN(10)
OIN(I)=TIN(IPAT,I)
320 CONTINUE
C...Put target output value into OUT:
OUT(1)=TOUT(IPAT)
C...Invoke training algorithm:
CALL JNTRAL
C...Calculate performance on training set:
IF (ABS(OUT(1)-TOUT(IPAT)).LT.0.5) NRIGHT=NRIGHT+1
310 CONTINUE
TRAIN=FLOAT(NRIGHT)/FLOAT(NTRAIN)
IF (MOD(IEPOCH,10).EQ.0) THEN
C...Testing loop:
NRIGHT=0
DO 330 IPAT=NTRAIN+1,NTRAIN+NTEST
C...Put pattern into OIN:
DO 340 I=1,MSTJN(10)
OIN(I)=TIN(IPAT,I)
340 CONTINUE
C...Get network output:
CALL JNTEST
C...Calculate performance on test set (=generalization):
IF (ABS(OUT(1)-TOUT(IPAT)).LT.0.5) NRIGHT=NRIGHT+1
330 CONTINUE
TEST=FLOAT(NRIGHT)/FLOAT(NTEST)
IF ((MSTJN(5).GT.3).AND.(MSTJN(5).LT.15)) THEN
IF (TEST.GT.TESTMX) TESTMX=TEST
IF (TRAIN.GT.TRNMX) TRNMX=TRAIN
TEST=TESTMX
TRAIN=TRNMX
ENDIF
C...Display performance:
WRITE(MSTJN(6),640)IEPOCH,TRAIN,TEST
ENDIF
C...Terminate CG and SCG training:
IF (IEPOCH.EQ.NEPOCH-1) THEN
IF ((MSTJN(5).GT.3).AND.(MSTJN(5).LT.15)) THEN
IF (MSTJN(5).LT.9) THEN
MSTJN(5)=8
ELSE
MSTJN(5)=14
ENDIF
TRNMX=0.0
TESTMX=0.0
ENDIF
ENDIF
300 CONTINUE
WRITE(MSTJN(6),*)
WRITE(MSTJN(6),650)BAYES
IF (METHOD.EQ.0) THEN
WRITE(MSTJN(6),670)
ELSEIF (METHOD.EQ.1) THEN
WRITE(MSTJN(6),680)
ELSEIF (METHOD.EQ.2) THEN
WRITE(MSTJN(6),690)
ELSEIF (METHOD.EQ.3) THEN
WRITE(MSTJN(6),700)
ELSEIF (METHOD.EQ.4) THEN
WRITE(MSTJN(6),710)
ELSEIF (METHOD.EQ.5) THEN
WRITE(MSTJN(6),720)
ELSEIF (METHOD.EQ.6) THEN
WRITE(MSTJN(6),730)
ELSEIF (METHOD.EQ.7) THEN
WRITE(MSTJN(6),740)
ELSEIF (METHOD.EQ.10) THEN
WRITE(MSTJN(6),750)
ELSEIF (METHOD.EQ.11) THEN
WRITE(MSTJN(6),760)
ELSEIF (METHOD.EQ.12) THEN
WRITE(MSTJN(6),770)
ELSEIF (METHOD.EQ.13) THEN
WRITE(MSTJN(6),780)
ELSEIF (METHOD.EQ.15) THEN
WRITE(MSTJN(6),790)
ENDIF
600 FORMAT(31X,'JETNET Test-Deck')
610 FORMAT(15X,'Two overlapping Gaussian distributions in ',
1234 COMMON /JNDAT1/x M
&I2,' dimensions.')
12345 7 9 11 13 15
620 FORMAT(15X,'Their standard deviations are ',F3.1,' and ',F3.1)
621 FORMAT(15X,'Their mean values are separated by ',F4.2)
625 FORMAT(15X,'Generating training and test patterns...')
626 FORMAT(15X,'...done generating data.')
630 FORMAT(' Epoch / Training / General. ')
640 FORMAT(I8,2X,2(' /',F9.3,2X))
650 FORMAT(' The optimal generalization performance is ',F4.1,'%')
660 FORMAT(' Undefined training algorithm in call to JNTDEC')
670 FORMAT(' Backprop should reach (81.0 +- 2.2)% in 100 epochs')
680 FORMAT(' Manhattan should reach (84.3 +- 0.6)% in 100 epochs')
690 FORMAT(' Langevin should reach (82.9 +- 1.8)% in 100 epochs')
700 FORMAT(' Quickprop should reach (82.8 +- 8.8)% in 100 epochs')
710 FORMAT(' Polak-Ribiere CG should reach (79.0 +- 7.0)% in 100',
1234 COMMON /JNDAT1/x M
&' epochs')
12345 7 9 11 13 15
720 FORMAT(' Hestenes-Stiefel CG should reach (79.8 +- 5.6)% in 100',
1234 COMMON /JNDAT1/x M
&' epochs')
12345 7 9 11 13 15
730 FORMAT(' Fletcher-Reeves CG should reach (79.6 +- 5.6)% in 100',
1234 COMMON /JNDAT1/x M
&' epochs')
12345 7 9 11 13 15
740 FORMAT(' Shanno CG should reach (71.7 +- 11.6)% in 100 epochs')
750 FORMAT(' Polak-Ribiere SCG should reach (84.0 +- 1.6)% in 100',
1234 COMMON /JNDAT1/x M
&' epochs')
12345 7 9 11 13 15
760 FORMAT(' Hestenes-Stiefel SCG should reach (84.1 +- 2.6)% in 100',
1234 COMMON /JNDAT1/x M
&' epochs')
12345 7 9 11 13 15
770 FORMAT(' Fletcher-Reeves SCG should reach (81.4 +- 5.2)% in 100',
1234 COMMON /JNDAT1/x M
&' epochs')
12345 7 9 11 13 15
780 FORMAT(' Shanno SCG should reach (70.7 +- 8.1)% in 100 epochs')
790 FORMAT(' Rprop should reach (83.5 +- 2.2)% in 100 epochs')
RETURN
C**** END OF JNTDEC ****************************************************
END