subroutine NeuralNetRegres(idowhat,nx0,nobs0,nh0,xsamp0, &ysamp0,yatxsamp0,rsq,w,bph,q,bend,xnew,ypred) implicit none include 'NeuralNetRegres.h' ! !=============Inputs regardless of idowhat========================= !idowhat: =1, fit the data and estimate the coefficients. Provide the ! initial guess for the coefficients or set bend to -9999 ! =2, coefficients are already available, calculate y at xnew !nx0: the number of independent (x) variables !nobs0: the total number of samples !nh0: the total number of hidden nodes to use. One hidden layer is ! assumed. !============When idowhat=1======================================== ! --------Inputs-------- !xsamp0: the values of the independent (x) variables !ysamp0: the values of the dependent (y) variable. y is one dimension. ! --------Outputs------- !w: the slope coefficient to time the normalized x in the activation function !bph: the intercept coefficient in the activation function !q: the coefficient to time the value of the activation function !bend: the residual constant in the neural network regression !yatxsamp0: the predicted y value at xsamp0 !rsq: R squared !============When idowhat=2========================================= ! --------Inputs-------- !w: the slope coefficient to time the normalized x in the activation function !bph: the intercept coefficient in the activation function !q: the coefficient to time the value of the activation function !bend: the residual constant in the neural network regression !xnew: the new x point who y value is to be estimated (when idowhat=2) ! --------Outputs------- !ypred: the predicted y value at xnew ! integer idowhat,nx0,nobs0,nh0 double precision xsamp0(nobs0,nx0),ysamp0(nobs0), & yatxsamp0(nobs0),rsq,w(nx0,nh0),bph(nh0),q(nh0), & bend,xnew(nx0),ypred !============Locals========================================= integer i,j,ndim,ny,INFO,iderivative,iregrestype !iregrestype=0, ordinary distance regression double precision xnormk(nx0),xnormb(nx0),std,fmean, & xmin,xmax,fatbeta,fatbeta0,fatbetacp,ftol, & beta(nx0*nh0+2*nh0+1),betacp(nx0*nh0+2*nh0+1),rms, & agrind,ran2,annfunc,weitx(1:nobs0,1:nx0), & weity(1:nobs0),shortx(1:nobs0,1:nx0), & shorty(1:nobs0),yv(nobs0),fn9999,tiny parameter(ftol=1.0d-8,iderivative=1,iregrestype=0, &fn9999=-9999.0d0,tiny=1.0d-8) external funkmin_neural,f1dim_neural,FCN_neural ! if(idowhat.eq.1)then !Regression nx=nx0 nobs=nobs0 nh=nh0 !xnormk: the slope of the linear transformation for xsamp0 !xnormb: the intercept of the linear transformation for xsamp0 !Transform xsamp to become bounded (-1,1) so that different independent variables !are comparable in magnitude !xmin ~ -1 !xmax ~ +1 do i=1,nobs ysamp(i)=ysamp0(i) weity(i)=1.0d0 do j=1,nx weitx(i,j)=1.0d0 enddo enddo do i=1,nx call stdmaxmeanmin(nobs,xsamp0(1:nobs,i:i), & std,fmean,xmin,xmax) if(xmax.eq.xmin)then xnormk(i)=1.0d0 xnormb(i)=0.0d0 else xnormk(i)=2.0d0/(xmax-xmin) xnormb(i)=-(xmax+xmin)/(xmax-xmin) endif do j=1,nobs xsamp(j,i)=xnormk(i)*xsamp0(j,i)+xnormb(i) enddo enddo ndim=2*nh+nh*nx+1 do i=1,ndim betamin(i)=-1.0d+20 betamax(i)=1.0d+20 enddo if(dabs(bend-fn9999).lt.tiny)then !no initial guess. Use the general guess do i=1,ndim beta(i)=(ran2()-0.5d0)*2.0d0 enddo else !initial guess provided. transform the guessed bph and w coefficients to correspond !to the transformed x. do i=1,nh0 do j=1,nx0 w(j,i)=w(j,i)/xnormk(j) enddo enddo do i=1,nh0 do j=1,nx0 bph(i)=bph(i)-w(j,i)*xnormb(j) enddo enddo call coeff_beta(2,nx,nh,beta,w(1:nx,1:nh),bph,q,bend) endif do i=1,ndim betacp(i)=beta(i) if(beta(i).lt.betamin(i).or.beta(i).gt.betamax(i))then ! write(*,*)'Inproper initial guess in NeuralNetRegres.f' beta(i)=ran2() endif betacp(i)=beta(i) enddo call funkmin_neural(ndim,beta,fatbeta0) INFO=iregrestype ny=1 fatbeta=fatbeta0 90 call odr_leastsquare(ndim,FCN_neural,beta,nobs, &xsamp(1:nobs,1:nx),nx,ysamp(1:nobs),ny,weitx(1:nobs,1:nx), &weity(1:nobs),iderivative,shortx(1:nobs,1:nx),shorty(1:nobs), &fatbeta,INFO) call funkmin_neural(ndim,beta,fatbeta) ! if((fatbeta0-fatbeta).gt.ftol)then ! fatbeta0=fatbeta ! do i=1,ndim ! betacp(i)=beta(i) ! enddo ! goto 90 ! endif if(fatbeta.gt.fatbeta0)then j=0 do i=1,ndim beta(i)=betacp(i) if(beta(i).lt.betamin(i).or.beta(i).gt.betamax(i))j=1 enddo fatbeta=fatbeta0 if(j.ne.0)then do i=1,ndim beta(i)=(ran2()-0.5d0)*2.0d0 enddo call funkmin_neural(ndim,beta,fatbeta) endif endif 100 fatbetacp=fatbeta call nongradopt(ndim,funkmin_neural,f1dim_neural, &beta,betamin,betamax,ftol,fatbeta) ! call RepeatCompassSearch(ndim,beta,fatbeta, ! &betamin,betamax,funkmin_neural,f1dim_neural,ftol) ! if(dabs(fatbetacp-fatbeta).gt.ftol)goto 100 call funkmin_neural(ndim,beta,fatbeta) call coeff_beta(idowhat,nx,nh,beta,w(1:nx,1:nh),bph,q,bend) !transform the estimated bph and w coefficients so that the original x !values can be used directly. do i=1,nh0 do j=1,nx0 bph(i)=bph(i)+w(j,i)*xnormb(j) enddo enddo do i=1,nh0 do j=1,nx0 w(j,i)=w(j,i)*xnormk(j) enddo enddo do i=1,nobs0 yatxsamp0(i)=annfunc(nx0,xsamp0(i:i,1:nx0),nh0,q, & w(1:nx0,1:nh0),bph,bend) enddo call rsq_rms(ysamp0,yatxsamp0,nobs0,rsq,rms,agrind) endif if(idowhat.eq.2)then !Predict y at x with the regression coefficients already estimated ypred=annfunc(nx0,xnew,nh0,q,w(1:nx0,1:nh0),bph,bend) endif return end !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&