!************************************************************************* !* * !* LMBNNR - Nonsmooth Optimization based NN Software for Regression * !* using LMBM (version 1.1) * !* * !* by Napsu Karmitsa 2020 (last modified 11.11.2021). * !* * !* The code is partly based on preliminary work made by Kaisa Joki * !* and Pauliina Mäkinen. * !* * !* The software is free for academic teaching and research * !* purposes but I ask you to refer the appropriate references * !* given below, if you use it. * !* * !************************************************************************* !* !* !* Codes included: !* !* lmbnnr.f03 - Mainprogram for the NNR software !* (this file). !* parameters.f03 - Parameters. Inludes modules: !* - r_precision - Precision for reals, !* - param - Parameters, !* - exe_time - Execution time. !* initlmbnnr.f03 - initialization of NN parameters and LMBM. !* Includes modules: !* - initnn - Initialization of parameters for NN. !* - initlmbm - Initialization of LMBM. !* lmbm.f03 - LMBM - limited memory bundle method. !* objfun.f03 - Computation of the function and subgradients values. !* subpro.f03 - subprograms for LMBM. !* !* Makefile - makefile. !* !* !* Calling sequence: !* !* ./lmbnnr infile nrecord ntrain nft [nH_max noutcom] !* !* with the following arguments: !* !* infile - the data set; !* nrecord - number of records in the data set; !* ntrain - size of the training set, ntrain <= nrecord; !* nft - number of features in the data set (excluding output); !* nH_max - maximum number of nodes in hidden layer, optional, 50 by default; !* noutcom - number of output column, optional, nft+1 by default. !* !* There is usually no need to tune other parameters. However, if you want to do that, modify initlmbnnr.f03. !* !* As default the results are written in !* !* results1.txt - Evaluation criteria (e.g. RMSE, MAE,...) with training and predictions; !* results2.txt - Final predictions. !* !* !* References: !* !* for LMBNNR: !* http://napsu.karmitsa/lmbnnr !* !* N. Karmitsa, S. Taheri, K. Joki, P. Mäkinen, A. Bagirov, M.M. Mäkelä, "Hyperparameter free !* NN algorithm for large-scale regression problems", TUCS Technical Report, No. 1213, !* Turku Centre for Computer Science, Turku, 2020. !* !* !* for LMBM: !* N. Haarala, K. Miettinen, M.M. Mäkelä, "Globally Convergent Limited Memory Bundle Method !* for Large-Scale Nonsmooth Optimization", Mathematical Programming, Vol. 109, No. 1, !* pp. 181-205, 2007. DOI 10.1007/s10107-006-0728-2. !* !* M. Haarala, K. Miettinen, M.M. Mäkelä, "New Limited Memory Bundle Method for Large-Scale !* Nonsmooth Optimization", Optimization Methods and Software, Vol. 19, No. 6, pp. 673-692, 2004. !* DOI 10.1080/10556780410001689225. !* !* !* Acknowledgements: !* !* The work was financially supported by the Academy of Finland (Project No. 289500). !* !************************************************************************* !* !* * PROGRAM lmbnnr * !* !* Main program for nonsmooth NN regression software with LMBM. !* !************************************************************************* PROGRAM lmbnnr USE r_precision, ONLY : prec ! Precision for reals. USE param, ONLY : zero, one, large ! Parameters. USE initnn, ONLY : & ! Initialization of NN parameters. infile, & ! Dataset file. outfile0, & ! Result file with indices, function values, and cpu-time. outfile1, & ! Result file with predictions. nft, & ! Number of input features in data, from user. nrecord, & ! Number of instances in data, from user. ntrain, & ! Size of the training set, from user. a, & ! Data matrix a(nrecord,nft+1), from input file. ascaled, & ! Scaled data matrix. mX, & ! Input variables. mY, & ! Output variables. noutcom, & ! Column number of output variable in original data. rho, & ! Penalty parameter. istop, & ! Automated stopping procedure is ! 0 - not used, ! 1 - used (recommended). asp, & ! Termination tolerance. isetx, & ! Updating method for weights, isetx = 4 by default. iscale, & ! Scaling is ! 0 - not used, ! 1 - used. ipredi, & ! Prediction is computed ! 0 - only at the termination with complite model, ! 1 - at every step. pred, & ! the values of predicted outputs tlimit, & ! Time limit, from user. nH_max, & ! Maximum number of nodes. from user. nH, & ! Current number of hidden nodes, loops from 1 to nH_max. maxdim, & ! Maximum dimension of the problem. fplain, & ! Function value without penalization. clin, & ! For scaling. dlin, & ! For scaling. init_nnpar, & ! Furher initialization of parameters. init_x, & ! Initialization of x. set_x, & ! Updating x for next round of incremental NN. scaling USE initlmbm, ONLY : & n, & ! Size of the optimization problem. forig, & ! f at x0. x ! Current x. USE lmbm_mod, ONLY : optim2 ! LMBM method for optimization. USE exe_time, ONLY : getime ! Execution time. IMPLICIT NONE ! Local REAL(KIND=prec), DIMENSION(3) :: & fstop REAL(KIND=prec) :: & rmse1,rmse2,mae1,mae2,ce1,ce2,r1,r2, & ! Validy indices. f, fpen, & ! Function values. atmp ! Auxiliary value. REAL :: & time1, & time3, & time4 INTEGER :: & count, & ! Number of commandline arguments ntest, & ! Size of the test set. i,j,k,iterm CHARACTER(len=500) :: arg ! Intrinsic Functions INTRINSIC ABS,MAX count = command_argument_count() IF (count < 1) THEN PRINT* PRINT*,'LMBNNR - Nonsmooth Optimization based NN Software for Regression using LMBM' PRINT* PRINT*,'Calling sequence:' PRINT* PRINT*,' ./lmbnnr infile nrecord ntrain nft [nH_max noutcom]' PRINT* PRINT*,'with the following arguments:' PRINT* PRINT*,' infile - the data set;' PRINT*,' nrecord - number of records in the data set;' PRINT*,' ntrain - size of the training set, ntrain <= nrecord;' PRINT*,' nft - number of features in the data set (excluding output);' PRINT*,' nH_max - maximum number of nodes in hidden layer, optional, 10 by default;' PRINT*,' noutcom - number of output column, optional, nft+1 by default.' PRINT* PRINT*,'If you want to tune other parameters, modify initlmbnnr.f03.' PRINT* PRINT*,'As default the results are written in' PRINT* PRINT*,' results1.txt - Evaluation criteria (e.g. RMSE, MAE,...) with training and predictions;' PRINT*,' results2.txt - final predictions.' PRINT* STOP END IF IF (count < 4) STOP ' Too few commandline arguments. Type ./lmbnnr for help.' CALL get_command_argument(2, arg) READ (arg,*) nrecord CALL get_command_argument(3, arg) READ (arg,*) ntrain CALL get_command_argument(4, arg) READ (arg,*) nft IF (count >= 5) THEN CALL get_command_argument(5, arg) READ (arg,*) nH_max ELSE IF (nrecord*nft <= 1000000) THEN nH_max=200 ELSE nH_max=50 END IF END IF IF (count >= 6) THEN CALL get_command_argument(6, arg) READ (arg,*) noutcom ELSE noutcom=nft+1 END IF CALL get_command_argument(1, infile) PRINT*,' Input file: ',infile PRINT*,' Number of records = ',nrecord PRINT*,' Size of the training set = ',ntrain PRINT*,' Number of features = ',nft PRINT*,' Maximum number of nodes = ',nH_max CALL init_nnpar() ! sets maximum dimension for optimization problem etc. allocate(a(nrecord,nft+1),ascaled(nrecord,nft+1),mX(nft,nrecord)) allocate(x(maxdim),mY(nrecord),pred(nrecord),clin(nft+1),dlin(nft+1)) n = nft+3 ! Size of the first optimization problem CALL init_x(x,n) fstop = -large OPEN(42,file=outfile0) OPEN(40,file=outfile1) WRITE(42,*) 'LMBNNR: indices, function values and CPU time.' WRITE(42,*) WRITE(42,*) 'Data set: ',infile WRITE(40,*) 'LMBNNR: final predictions.' WRITE(40,*) WRITE(40,*) 'Data set: ',infile WRITE(42,*) WRITE(42,*) 'Number of records: ',nrecord WRITE(42,*) 'Size of the training set: ',ntrain WRITE(42,*) 'Number of features: ',nft WRITE(42,*) 'Weight updating scheme: ',isetx WRITE(42,*) 'Regularization parameter: ',rho WRITE(42,*) IF(iscale == 1) WRITE(42,*) 'Scaling is used. ' IF(iscale == 0) WRITE(42,*) 'No scaling. ' WRITE(42,*) WRITE(42, *) ' nH |', ' rmse train |',' rmse test |',' mae train |',' mae test |', & ' ce train |',' ce test |',' r train |',' r test |', & ' f_orig |',' f |',' f_pen |',' CPU-time ' !================================================================== !Read data and arrange it to input and output matrices !================================================================== OPEN(78,file=infile,status='old',form='formatted') DO i=1,nrecord READ(78,*) (a(i,k),k=1,nft+1) !nft is the number of input parameters, in original data we have also the output END DO CLOSE(78) ! Trial scaled matrix ascaled=a IF (noutcom < nft+1) THEN ! swap features DO i = 1,nrecord atmp = ascaled(i,noutcom) ascaled(i,noutcom) = ascaled(i,nft+1) ascaled(i,nft+1) = atmp END DO END IF IF (iscale == 1) CALL scaling ! ! Output values DO i=1,nrecord mY(i) = ascaled(i,nft+1) END DO ! Input values DO i = 1, nrecord DO k = 1, nft mX(k,i) = ascaled(i,k) END DO END DO CALL getime(time1) !================================================================ outerloop: DO nH=1,nH_max ! number of hidden nodes PRINT*,'Node No.:',nH fplain=large CALL optim2(f) ! Call for LMBM PRINT*,'f final =',f CALL getime(time3) time4=time3-time1 IF(time4 > tlimit) EXIT outerloop ntest=nrecord-ntrain IF (nrecord > ntrain .AND. ipredi == 1) THEN ! there are training and test sets IF (iscale == 1) THEN CALL sccheckfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2) ELSE CALL checkfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2) END IF ! Print the solution WRITE(40,*) WRITE(40,*) 'Number of hidden nodes: ',nH WRITE(40,*) WRITE(40,*) 'Predictions for training: ',pred(1:ntrain) ! WRITE(40,*) WRITE(40,*) 'Predictions for test set: ',pred(ntrain+1:nrecord) ! fpen=zero DO i=1,n fpen=fpen+ABS(x(i)) END DO fplain=f-rho*fpen WRITE(42,603) nH,rmse1,rmse2,mae1,mae2,ce1,ce2,r1,r2,forig,fplain,f,time4 603 FORMAT(i4,f13.4,f13.4,f13.4,f13.4,f13.4,f13.4,f13.4,f13.4,f18.4,f18.4,f18.4,f12.4) END IF IF (istop == 1) THEN ! Save three previous objective function values. fstop(3)=fstop(2) fstop(2)=fstop(1) fstop(1)=f IF (fstop(3)-fstop(1) <= asp*nft .AND. nH >= 3) THEN PRINT*,' Automated termination with nH = ',nH EXIT outerloop END IF END IF IF(nH ntrain .AND. ipredi == 0) THEN ! there are training and test sets and only the final results are wanted IF (iscale == 1) THEN CALL sccheckfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2) ELSE CALL checkfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2) END IF ! Print the solution WRITE(40,*) WRITE(40,*) 'Number of hidden nodes: ',nH-1 WRITE(40,*) WRITE(40,*) WRITE(40,*) 'Predictions for training: ',pred(1:ntrain) ! WRITE(40,*) WRITE(40,*) 'Predictions for test set: ',pred(ntrain+1:nrecord) ! WRITE(42,603) nH-1,rmse1,rmse2,mae1,mae2,ce1,ce2,r1,r2,fplain,f,time4 END IF CLOSE(40) CLOSE(42) deallocate(a,ascaled,mX) deallocate(x,mY) STOP CONTAINS SUBROUTINE checkfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2) ! ! Calculates the predictions, RMSE, MAE, CE and r values for the solution x with UNscaled data. ! IMPLICIT NONE REAL(KIND=prec), DIMENSION(:), INTENT(IN) :: x ! final weights REAL(KIND=prec), DIMENSION(:), INTENT(OUT) :: pred ! predictions REAL(KIND=prec), INTENT(OUT) :: rmse1 ! RMSE value in training set REAL(KIND=prec), INTENT(OUT) :: mae1 ! MAE value in training set REAL(KIND=prec), INTENT(OUT) :: ce1 ! CE value in training set REAL(KIND=prec), INTENT(OUT) :: r1 ! r value in training set REAL(KIND=prec), INTENT(OUT) :: rmse2 ! RMSE value in test set REAL(KIND=prec), INTENT(OUT) :: mae2 ! MAE value in test set REAL(KIND=prec), INTENT(OUT) :: ce2 ! CE value in test set REAL(KIND=prec), INTENT(OUT) :: r2 ! r value in test set REAL(KIND=prec) :: e0_obs1 ! Mean of observed values in training data i.e e_0 REAL(KIND=prec) :: e0_pre1 ! Mean of predicted values in training data i.e. bar(e)_0 REAL(KIND=prec) :: fe1 ! Sum of values (e_i-e0_pre1) in training data REAL(KIND=prec) :: e0_obs2 ! Mean of observed values in test data i.e e_0 REAL(KIND=prec) :: e0_pre2 ! Mean of predicted values in test data i.e. bar(e)_0 REAL(KIND=prec) :: fe2 ! Sum of values (e_i-e0_pre1) in test data REAL(KIND=prec) :: y_pre ! Predicted value for data point i REAL(KIND=prec) :: s_ij ! Predicted value for data point i REAL(KIND=prec) :: sum_pre ! Sum of predicted values REAL(KIND=prec) :: f_quad,f_abs REAL(KIND=prec) :: rsumo1 REAL(KIND=prec) :: rsumn1 REAL(KIND=prec) :: rsumo2 REAL(KIND=prec) :: rsumn2 INTEGER :: i_w1jP, i_w0Bj, i_w0kj ! Auxiliary variables INTEGER :: i, j, k INTEGER :: i1 rmse1 = zero mae1 = zero r1 = zero ce1 = zero rmse2 = zero mae2 = zero r2 = zero ce2 = zero ! The mean of observed values in training data e0_obs1 = zero DO i = 1,ntrain e0_obs1 = e0_obs1 + mY(i) END DO e0_obs1 = e0_obs1 / REAL(ntrain,prec) ! The mean of observed values in test data e0_obs2 = zero IF (ntest > 0) THEN DO i=1,ntest i1=ntrain+i e0_obs2 = e0_obs2 + mY(i1) END DO e0_obs2 = e0_obs2/REAL(ntest,prec) END IF fe1 = zero DO i=1,ntrain ! sum_i (e_i-e_0)^2 training set fe1=fe1+(mY(i)-e0_obs1)**2 END DO fe2 = zero IF (ntest > 0) THEN DO i=1,ntest ! sum_i (e_i-e_0)^2 test set i1=ntrain+i fe2=fe2+(mY(i1)-e0_obs2)**2 END DO END IF sum_pre = zero f_quad = zero f_abs = zero e0_pre1 = zero !------------------------------ ! TRAINING SET !------------------------------ loop3: DO i=1,ntrain ! Predicted values for data point y_pre = x(1) ! w_1BP is initialized as the value of y_pre DO j = 1, nH ! Each hidden node is looked through i_w1jP = 1 + j*(nft+2) ! Index for w_1jP i_w0Bj = 1 + j*(nft+2) - 1 ! Index for w_0Bj s_ij = x(i_w0Bj) ! w_0Bj i_w0kj = 1 + (j-1)*(nft+2) DO k = 1, nft ! Inputs of data point i are looked through i_w0kj = i_w0kj + 1 ! Index for w_0kj s_ij = s_ij + x(i_w0kj)*mX(k,i) ! Update of s_ij END DO IF (s_ij >= zero) THEN y_pre = y_pre + x(i_w1jP)*s_ij END IF END DO pred(i)=y_pre sum_pre = sum_pre + y_pre ! The sum of predicted values f_quad = f_quad + (mY(i)-y_pre)**2 f_abs = f_abs + ABS(mY(i)-y_pre) END DO loop3 e0_pre1 = sum_pre/REAL(ntrain,prec) ! The mean of predicted values rsumn1 = zero rsumo1 = zero loop33: DO i=1,ntrain ! Predicted values for data points are in pred(i) rsumo1 = rsumo1 + (mY(i)-e0_obs1)*(pred(i)-e0_pre1) rsumn1 = rsumn1 + (pred(i)-e0_pre1)**2 END DO loop33 rmse1 = SQRT(f_quad/REAL(ntrain,prec)) ! RMSE for training set mae1 = f_abs/REAL(ntrain,prec) ! MAE for training set ce1 = one-f_quad/fe1 ! CE for training set r1 = rsumo1/(SQRT(rsumn1*fe1)) ! r for training set sum_pre = zero f_quad = zero f_abs = zero e0_pre1 = zero !------------------------------ ! TEST SET !------------------------------ loop3test: DO i1=1,ntest i = ntrain+i1 ! The index of the test set data point ! Predicted values for data point y_pre = x(1) ! w_1BP is initialized as the value of y_pre DO j = 1, nH ! Each hidden node is looked through i_w1jP = 1 + j*(nft+2) ! Index for w_1jP i_w0Bj = 1 + j*(nft+2) - 1 ! Index for w_0Bj s_ij = x(i_w0Bj) ! w_0Bj i_w0kj = 1 + (j-1)*(nft+2) DO k = 1, nft ! Inputs of data point i are looked through i_w0kj = i_w0kj + 1 ! Index for w_0kj s_ij = s_ij + x(i_w0kj)*mX(k,i) ! Update of s_ij END DO IF (s_ij >= 0.0_prec) THEN y_pre = y_pre + x(i_w1jP)*s_ij END IF END DO pred(i) = y_pre sum_pre = sum_pre + y_pre ! The sum of predicted values f_quad = f_quad + (mY(i)-y_pre)**2 f_abs = f_abs + ABS(mY(i)-y_pre) END DO loop3test e0_pre2 = sum_pre/REAL(ntest,prec) ! The mean of predicted values in test set rsumn2 = zero rsumo2 = zero loop33test: DO i1=1,ntest i = ntrain+i1 ! Predicted values for data points are in pred rsumo2 = rsumo2 + (mY(i)-e0_obs2)*(pred(i)-e0_pre2) rsumn2 = rsumn2 + (pred(i)-e0_pre2)**2 END DO loop33test rmse2 = SQRT(f_quad/REAL(ntest,prec)) ! RMSE for test set mae2 = f_abs/REAL(ntest,prec) ! MAE for test set ce2 = one-f_quad/fe2 ! CE for test set r2 = rsumo2/(SQRT(rsumn2*fe2)) ! r for test set END SUBROUTINE checkfinal SUBROUTINE sccheckfinal(x,pred,rmse1,rmse2,mae1,mae2,r1,r2,ce1,ce2) ! ! Calculates the predictions, RMSE, MAE, CE and r values for the solution x with SCALED data. ! IMPLICIT NONE REAL(KIND=prec), DIMENSION(:), INTENT(IN) :: x ! final weights (scaled). REAL(KIND=prec), DIMENSION(:), INTENT(OUT) :: pred ! predictions (with no scaling). REAL(KIND=prec), INTENT(OUT) :: rmse1 ! RMSE value in training set REAL(KIND=prec), INTENT(OUT) :: mae1 ! MAE value in training set REAL(KIND=prec), INTENT(OUT) :: ce1 ! CE value in training set REAL(KIND=prec), INTENT(OUT) :: r1 ! r value in training set REAL(KIND=prec), INTENT(OUT) :: rmse2 ! RMSE value in test set REAL(KIND=prec), INTENT(OUT) :: mae2 ! MAE value in test set REAL(KIND=prec), INTENT(OUT) :: ce2 ! CE value in test set REAL(KIND=prec), INTENT(OUT) :: r2 ! r value in test set REAL(KIND=prec) :: e0_obs1 ! Mean of observed values in training data i.e e_0 REAL(KIND=prec) :: e0_pre1 ! Mean of predicted values in training data i.e. bar(e)_0 REAL(KIND=prec) :: fe1 ! Sum of values (e_i-e0_pre1) in training data REAL(KIND=prec) :: e0_obs2 ! Mean of observed values in test data i.e e_0 REAL(KIND=prec) :: e0_pre2 ! Mean of predicted values in test data i.e. bar(e)_0 REAL(KIND=prec) :: fe2 ! Sum of values (e_i-e0_pre1) in test data REAL(KIND=prec) :: y_pre ! Predicted value for data point i REAL(KIND=prec) :: s_ij ! Predicted value for data point i REAL(KIND=prec) :: sum_pre ! Sum of predicted values REAL(KIND=prec) :: f_quad,f_abs REAL(KIND=prec) :: rsumo1 REAL(KIND=prec) :: rsumn1 REAL(KIND=prec) :: rsumo2 REAL(KIND=prec) :: rsumn2 INTEGER :: i_w1jP, i_w0Bj, i_w0kj ! Auxiliary variables INTEGER :: i, j, k INTEGER :: i1 rmse1 = zero mae1 = zero r1 = zero ce1 = zero rmse2 = zero mae2 = zero r2 = zero ce2 = zero ! The mean of observed values in training data (unscaled data) e0_obs1 = zero DO i = 1,ntrain e0_obs1 = e0_obs1 + a(i,noutcom) ! END DO e0_obs1 = e0_obs1 / REAL(ntrain,prec) ! The mean of observed values in test data (unscaled data) e0_obs2 = zero IF (ntest > 0) THEN DO i=1,ntest i1=ntrain+i e0_obs2 = e0_obs2 + a(i1,noutcom) ! END DO e0_obs2 = e0_obs2/REAL(ntest,prec) END IF fe1 = zero DO i=1,ntrain ! sum_i (e_i-e_0)^2 training set fe1=fe1+(a(i,noutcom)-e0_obs1)**2 END DO fe2 = zero IF (ntest > 0) THEN DO i=1,ntest ! sum_i (e_i-e_0)^2 test set i1=ntrain+i fe2=fe2+(a(i1,noutcom)-e0_obs2)**2 END DO END IF sum_pre = zero f_quad = zero f_abs = zero e0_pre1 = zero !------------------------------ ! TRAINING SET !------------------------------ ! The scaled predictions are first computed loop3: DO i=1,ntrain ! Scaled predicted values for data point y_pre = x(1) ! w_1BP is initialized as the value of y_pre DO j = 1, nH ! Each hidden node is looked through i_w1jP = 1 + j*(nft+2) ! Index for w_1jP i_w0Bj = 1 + j*(nft+2) - 1 ! Index for w_0Bj s_ij = x(i_w0Bj) ! w_0Bj i_w0kj = 1 + (j-1)*(nft+2) DO k = 1, nft ! Inputs of data point i are looked through i_w0kj = i_w0kj + 1 ! Index for w_0kj s_ij = s_ij + x(i_w0kj)*mX(k,i) ! Update of s_ij END DO IF (s_ij >= zero) THEN y_pre = y_pre + x(i_w1jP)*s_ij END IF END DO pred(i)=(y_pre-dlin(nft+1))/clin(nft+1) ! Unscaled prediction sum_pre = sum_pre + pred(i) ! The sum of predicted values (unscaled) f_quad = f_quad + (a(i,noutcom)-pred(i))**2 f_abs = f_abs + ABS(a(i,noutcom)-pred(i)) ! END DO loop3 e0_pre1 = sum_pre/REAL(ntrain,prec) ! The mean of predicted values rsumn1 = zero rsumo1 = zero loop33: DO i=1,ntrain ! Predicted values for data points are in pred(i) rsumo1 = rsumo1 + (a(i,noutcom)-e0_obs1)*(pred(i)-e0_pre1) ! y_pre=pred(i) rsumn1 = rsumn1 + (pred(i)-e0_pre1)**2 END DO loop33 rmse1 = SQRT(f_quad/REAL(ntrain,prec)) ! RMSE for training set mae1 = f_abs/REAL(ntrain,prec) ! MAE for training set ce1 = one-f_quad/fe1 ! CE for training set r1 = rsumo1/(SQRT(rsumn1*fe1)) ! r for training set sum_pre = zero f_quad = zero f_abs = zero e0_pre1 = zero !------------------------------ ! TEST SET !------------------------------ loop3test: DO i1=1,ntest i = ntrain+i1 ! The index of the test set data point ! Scaled predicted values for data point y_pre = x(1) ! w_1BP is initialized as the value of y_pre DO j = 1, nH ! Each hidden node is looked through i_w1jP = 1 + j*(nft+2) ! Index for w_1jP i_w0Bj = 1 + j*(nft+2) - 1 ! Index for w_0Bj s_ij = x(i_w0Bj) ! w_0Bj i_w0kj = 1 + (j-1)*(nft+2) DO k = 1, nft ! Inputs of data point i are looked through i_w0kj = i_w0kj + 1 ! Index for w_0kj s_ij = s_ij + x(i_w0kj)*mX(k,i) ! Update of s_ij END DO IF (s_ij >= 0.0_prec) THEN y_pre = y_pre + x(i_w1jP)*s_ij END IF END DO pred(i)=(y_pre-dlin(nft+1))/clin(nft+1) ! Unscaled prediction sum_pre = sum_pre + pred(i) ! The sum of predicted values (unscaled) f_quad = f_quad + (a(i,noutcom)-pred(i))**2 f_abs = f_abs + ABS(a(i,noutcom)-pred(i)) ! END DO loop3test e0_pre2 = sum_pre/REAL(ntest,prec) ! The mean of predicted values in test set rsumn2 = zero rsumo2 = zero loop33test: DO i1=1,ntest i = ntrain+i1 ! Predicted values for data points are in pred rsumo2 = rsumo2 + (a(i,noutcom)-e0_obs2)*(pred(i)-e0_pre2) rsumn2 = rsumn2 + (pred(i)-e0_pre2)**2 END DO loop33test rmse2 = SQRT(f_quad/REAL(ntest,prec)) ! RMSE for test set mae2 = f_abs/REAL(ntest,prec) ! MAE for test set ce2 = one-f_quad/fe2 ! CE for test set r2 = rsumo2/(SQRT(rsumn2*fe2)) ! r for test set END SUBROUTINE sccheckfinal END PROGRAM lmbnnr