******************************************** PROGRAM JETNET_TEST *** CALL QCDREAD CALL TESTJET END SUBROUTINE QCDREAD common/fcom/xsbg(15,400000),ntot DIMENSION XV(15) CHARACTER*20, filename PRINT*,'GIVE FILENAME WHERE simulated DATA RESIDES ' READ*,filename open(30, file=filename, form='formatted',status='old') PRINT*,'FILE OPENED ', filename PRINT*,'BE PATIENT, DATA BEING READ ' PRINT*,'=====****======' PRINT*,'THE 11 VARIABLES ARE : ' PRINT*,'ENERGETIC CLUSTER IN JET 1,2 ' PRINT*,'BOOSTS GAMMABETA JET 1,2 ' PRINT*,'ENERGY GAPES1,2 FOR 1&4 CLSUTER IN JET 1,2' PRINT*,'DIRECTED SPHERICITY JET 1,2 ' PRINT*,'4 CLUSTER BOOST JET1,JET2 ' PRINT*,'FRACTIONAL ENERGY OUTSIDE TWO JETS ' PRINT*,'======******======' NT=0 20 READ(30,100, END=200) IP,XV 100 FORMAT(I10,7F10.6/8F10.6) NT = NT + 1 DO K=1,15 XSBG(K,NT) = XV(K) ENDDO GOTO 20 200 CONTINUE CLOSE(30) NTOT = NT PRINT*,'ALL OVER, NT,NTOT =', IP,NTOT CALL NEUSCALE(12) END SUBROUTINE NEUSCALE(NVAR) COMMON/FCOM/XSBG(15,400000),NTOT COMMON/NXAVG/XAV(50) DIMENSION XV(15) DO I=1,NTOT XSBG(12,I) = XSBG(15,I) ** FOR SIMPLICITY I WANT TO USE THIS FOR TRIAL DO J=1,NVAR XV(J)=XSBG(J,I) ENDDO CALL VARINIT(XV,NVAR) ENDDO ********************************************* Scale factors DO I=1,11 PRINT*,'VARIABLE AVERAGE =',I, XAV(I) ENDDO *** Now Scale .... DO I=1, NTOT DO J=1, NVAR XSBG(J,I) =XSBG(J,I)/XAV(J) ENDDO ENDDO C*************************************************** END ************************************************************* SUBROUTINE SETJTNT(NVAR,NHIDDEN,METHOD) C...SET UP JETNET ROUTINE PARAMETER(MAXI=1000,MAXO=1000) COMMON /JNDAT1/ MSTJN(40),PARJN(40),MSTJM(20),PARJM(20), & OIN(MAXI),OUT(MAXO),MXNDJM 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) 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 ! 3 LAYERED NET MSTJN(10)=NVAR ! NUMBER OF INPUT VARIABLES MSTJN(11)=NHIDDEN ! NUMBER OF HIDDEN NODES MSTJN(12)=1 ! ONE OUTPUT NODE C...Set sigmoid function: MSTJN(3)=1 C...Initial width of weights: c PARJN(4)=0.5 C...Choose updating method MSTJN(5)=METHOD 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)=0.25 ! Good choice needs some experience PARJN(2)=0.5 PARJN(3)=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 ENDIF END C*********************************************************************** SUBROUTINE TESTJET PARAMETER(MAXI=1000,MAXO=1000) COMMON /JNDAT1/ MSTJN(40),PARJN(40),MSTJM(20),PARJM(20), & OIN(MAXI),OUT(MAXO),MXNDJM SAVE /JNDAT1/ ********* REST COMMON/FCOM/XSBG(15,400000),NTOT ! The array where data stored C** THIS IS THE ARRAY CONTAINING DATA, YOU CAN HAVE YOUR OWN C** ARRAY OR READ FROM DATA FILES WHICHEVER CONVENIENT DIMENSION TRGT(10), OUTNET(10),XV(50) DATA BR/0.40/ , NCYCLE/500/ ,DC/0.3/ ,JCYCLE/5/ ************* PRINT*,'GIVE NUMBER OF INPUTS, 11 IS GOOD CHOICE ' READ*,NVAR PRINT*,'GIVE NUMBER OF NODES IN THE HIDDEN LAYER ' READ*,NHIDDEN ************************** METHOD = 0 !Feed-Forward-Back-Propagation CALL SETJTNT(NVAR, NHIDDEN, METHOD) ***** KNODE = 1 **** THE NODE FOR WHICH SUMMARY IS REQUIRED !!!! IN CASE OF TWO CLASSES **** THIS IS ALWAYS THE CASE. c** now train NTRAIN = NTOT/2 NTEST = NTOT-NTRAIN PRINT*,'NTOT,NTRAIN,NTEST =',NTOT,NTRAIN,NTEST MSTJN(2) = 50 ! for some silly reason choice is relevant c** not give good result, one can try 100 to 1000 as well. c** small numbers make network jump **** c*** set cycles do kc=1,ncycle !TRAINING CYCLES/SWEEPS diff=0. nbb=0 nxb=0 do i=1,ntrain ! START TRAINING IPAT = INT(RANF(DUM)*NTRAIN)+1 ! PICK UP RANDOMLY do j=1,NVAR OIN(J)=XSBG(J,IPAT) enddo mcfl=xsbg(15,IPAT) if(mcfl.lt.5) then TRGT(1) =0.01 c**** target value for the background if(ranf(dum).lt.br)then ! ONLY PART OF BACKGROUND AS THEY ARE MORE C** EVEN THOUGH IT IS NOT VERY IMPORTANT BUT AVOIDES USELESS COMPUTING *** keep background and signal events at the same level for the purpose *** of training. *** **** HERE OUT(1)=TRGT(1) CALL JNTRAL diffx=abs(TRGT(1) - OUT(1)) diff= diff + diffx**2 nxb=nxb+1 endif else TRGT(1) = 0.99 c****** target value for the signal .......... OUT(1)=TRGT(1) CALL JNTRAL diffx=abs(TRGT(1) - OUT(1)) diff= diff + diffx**2 nbb=nbb+1 endif enddo ! TRAINING PART **************************************************** nevt=nbb+nxb diff= diff/float(nevt) DIFF=SQRT(DIFF) print*,'nbb, nxb,nevt,diff, cycle = ',nbb, nxb,nevt,diff, kc c* go to next cycle and see if want to change any parameter etc like eta, alfa if(mod(kc,jcycle).eq.0) then ! GIVE THE STATUS AFTER NTH CYCLE c************************************************ c* test where we are c** intialise the two routines for efficiency and muon counting CALL NEUSTAT(1, TRGT, OUTNET, KNODE) ! BOOK THE STAT ********************* *** testing the stuff for purinty etc diff =0. DO I = NTRAIN, NTOT DO J = 1, NVAR OIN(J)=XSBG(J,I) ENDDO MCFL=XSBG(15,I) CALL JNTEST ** IF(MCFL.EQ.5) THEN TRGT(1) =0.99 ELSEIF(MCFL.LT.5) THEN TRGT(1)=0.01 ENDIF DIFFX=ABS(TRGT(1) - OUT(1)) DIFF= DIFF + DIFFX**2 ************ get the efficiency OUTNET(1)=OUT(1) CALL NEUSTAT(2, TRGT, OUTNET, KNODE) ! FILL THE STAT ENDDO ! FROM NTRAIN TO NTOT STUFF c****** get the relevant statistics etc...... CALL NEUSTAT(3, TRGT, OUTNET, KNODE) ! REPORT THE OUTCOM DIFF =DIFF/FLOAT(NTOT-NTRAIN) DIFF =SQRT(DIFF) PRINT*,'ERROR ON TEST PATS ', DIFF endif ! FROM MOD(KC,JCYCLE). enddo !KC = CYCLES CHANGE LOOP **************************************** return end ************************************************************************** ************************************************************** SUBROUTINE NEUSTAT(ICALL, TRGT, OUTNET, NODE) *** Provide Purity and Efficiency for a Given NODE *** and Print in Histogrammable form. DIMENSION XNET(200),BNET(200),ALLNET(200) DIMENSION PUR(200),SUMB(200),SUMALL(200) DIMENSION TRGT(10),OUTNET(10) C********** THIS ROUTINE IS USED TO GET EFFICIENCY AND PURITY DATA NCHAN/25/ IF(ICALL.EQ.1) THEN C* INITIALISE IBALL =0 XCHN=FLOAT(NCHAN) DO IC=1,NCHAN XNET(IC)=0. BNET(IC)=0. ALLNET(IC)=0. ENDDO RETURN ENDIF C*********** PUT IN HISTOGRAM FORM IF(ICALL.EQ.2) THEN XOUT =OUTNET(NODE) ICHN=INT(XOUT*XCHN) +1 ALLNET(ICHN)= ALLNET(ICHN) + 1. IF(TRGT(NODE).GT.0.5)THEN IBALL = IBALL + 1 BNET(ICHN)=BNET(ICHN)+1. ENDIF ******** IF(TRGT(NODE).LT.0.5) THEN XNET(ICHN)=XNET(ICHN)+1. ENDIF ENDIF ! FILL ARRAYS ***************************************************** IF(ICALL.LT.3) RETURN SB=0. SL=0. do i=1,nchan pur(i)=0. sumb(i)=0. sumall(i)=0. enddo DO L=1,NCHAN M=NCHAN-L+1 SB=SB+BNET(M) SUMB(M)=SB SL=SL+ALLNET(M) SUMALL(M)=SL ENDDO DO K=1,NCHAN PUR(K)=0. IF(SUMALL(K).GT.0) THEN PUR(K)=SUMB(K)/SUMALL(K) ENDIF IF(IBALL.GT.0)THEN SUMB(K)=SUMB(K)/FLOAT(IBALL) ENDIF ENDDO c****** if it is data then purity and efficiency have absolutely no meening. **** write out the last set information for plotting if necessary OPEN(60,FILE ='netout.dat',form ='formatted',status ='unknown') c write(60,1)nchan c 1 format(5x,'total bins = ', i10) PRINT*,'****** Summary For Node = ', NODE PRINT*,' XNET, BNET, ALLNET, PUR, EFF, CHAN' DO I=1, NCHAN IX=I WRITE(6,2) XNET(I), BNET(I), ALLNET(I),PUR(I),SUMB(I),IX write(60,2) xnet(i),bnet(i),allnet(i),pur(i),sumb(i),IX 2 format(3f10.2,2f10.4,i5) enddo close(60) *********************************** c CALL NEUDUMP(70) RETURN END ************************************************************************* *************************************************************** subroutine varinit(xv,nv) COMMON/NXAVG/XAV(50) dimension xv(50) logical first data first/.true./ if(first)then do i=1,nv xav(i)=0. enddo first=.false. fc=0. endif do i=1,nv xav(i)=(xav(i)*fc+xv(i))/(fc+1.) enddo fc=fc+1. return end