104 lines
2.8 KiB
FortranFixed
104 lines
2.8 KiB
FortranFixed
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
double precision function annfunc(nparams,params,nh,q,w,bph,bend)
|
|
implicit none
|
|
integer nparams,nh
|
|
!nh is the number of hidden nodes in one hiden layer
|
|
!params is the inputs
|
|
!w is the weighting coefficients for the inputs
|
|
double precision params(nparams),q(nh),
|
|
&w(nparams,nh),bph(nh),bend
|
|
integer i,v
|
|
double precision term,activatefunc
|
|
annfunc=bend
|
|
do i=1,nh
|
|
term=bph(i)
|
|
do v=1,nparams
|
|
term=term+w(v,i)*params(v)
|
|
enddo
|
|
annfunc=annfunc+q(i)*activatefunc(term)
|
|
enddo
|
|
end
|
|
|
|
subroutine derannfunc(nparams,params,nh,q,w,bph,
|
|
& bend,derq,derw,derbph,derbend)
|
|
implicit none
|
|
integer nparams,nh
|
|
!nh is the number of hidden nodes in one hiden layer
|
|
!params is the inputs
|
|
!w is the weighting coefficients for the inputs
|
|
double precision params(nparams),q(nh),w(nparams,nh),
|
|
&bph(nh),bend,derq(nh),derw(nparams,nh),derbph(nh),derbend
|
|
integer i,v
|
|
double precision term,activatefunc,gradactivatefunc
|
|
derbend=1.0d0
|
|
do i=1,nh
|
|
term=bph(i)
|
|
do v=1,nparams
|
|
term=term+w(v,i)*params(v)
|
|
enddo
|
|
derq(i)=activatefunc(term)
|
|
derbph(i)=q(i)*gradactivatefunc(term)
|
|
do v=1,nparams
|
|
derw(v,i)=derbph(i)*params(v)
|
|
enddo
|
|
enddo
|
|
end
|
|
|
|
double precision function activatefunc(x)
|
|
implicit none
|
|
double precision x,crit
|
|
parameter(crit=300)
|
|
|
|
! activatefunc=2.0d0*datan(x)/3.14159265d0
|
|
! return
|
|
|
|
if(x.gt.-crit)then
|
|
activatefunc=1.0d0/(1.0d0+dexp(-x))
|
|
else
|
|
activatefunc=dexp(x)/(1.0d0+dexp(x))
|
|
endif
|
|
return
|
|
end
|
|
|
|
double precision function gradactivatefunc(x)
|
|
implicit none
|
|
double precision x,crit
|
|
parameter(crit=600)
|
|
|
|
! gradactivatefunc=2.0d0/(3.14159265d0*(1.0d0+x*x))
|
|
! return
|
|
|
|
if(x.gt.-crit.and.x.lt.crit)then
|
|
gradactivatefunc=
|
|
& (1.0d0/(dexp(x/2.0d0)+dexp(-x/2.0d0)))**2
|
|
else
|
|
gradactivatefunc=0.0d0
|
|
endif
|
|
return
|
|
end
|
|
|
|
subroutine gradannfunc(nparams,params,nh,q,w,bph,
|
|
&der_params)
|
|
implicit none
|
|
integer nparams,nh
|
|
double precision params(nparams),der_params(nparams),
|
|
&q(nh),w(nparams,nh),bph(nh)
|
|
integer i,v
|
|
double precision term,dsigdterm,
|
|
& gradactivatefunc,activatefunc
|
|
do i=1,nparams
|
|
der_params(i)=0.0d0
|
|
enddo
|
|
do i=1,nh
|
|
term=bph(i)
|
|
do v=1,nparams
|
|
term=term+w(v,i)*params(v)
|
|
enddo
|
|
dsigdterm=gradactivatefunc(term)
|
|
do v=1,nparams
|
|
der_params(v)=der_params(v)+q(i)*dsigdterm*w(v,i)
|
|
enddo
|
|
enddo
|
|
return
|
|
end
|