Commit c510e0c7 authored by Stanislav Paláček's avatar Stanislav Paláček

v1.30

Přidána druhá přechodová funkce
parent 7d515d30
......@@ -13,7 +13,6 @@ program neuron4dyn
integer :: nprvkukrivka
!Interface pro subroutinu inicializace:
!*********************************************************************************
! *
......@@ -85,7 +84,11 @@ program neuron4dyn
if (.not. a%vycislidata) then
!call backpropagation3(a,ucicidata,kontrolnidata,sigmoid,linear,dsigmoid,dlinear,kvchybfun,gradkvchybfun)
if (a%actf==1) then
call AGEKF(a,ucicidata,kontrolnidata,sigmoid,linear,dsigmoid,dlinear,kvchybfun,gradkvchybfun)
else if (a%actf==2) then
call AGEKF(a,ucicidata,kontrolnidata,hsigmoid,linear,dhsigmoid,dlinear,kvchybfun,gradkvchybfun)
end if
call ulozvahy(a)
!call simulated_annealing(a,ucicidata,kontrolnidata,sigmoid,linear,kvchybfun)
!call ulozvahy(a,inisoubor)
......
......@@ -19,6 +19,7 @@ private
TYPE network
character(len=:),allocatable :: inisoubor
integer :: pocetvrstev
integer :: actf=1
real :: chybasite
type(layer),dimension(:),pointer :: vrstvy
integer :: nbiasvah
......
......@@ -6,6 +6,7 @@ implicit none
private
!veřejné procedury a funkce
public :: inicializace,vycisli_sit,sigmoid,linear,dsigmoid,dlinear !>> Datový typ obsahující parametry sítě
public :: hsigmoid,dhsigmoid
public :: kvchybfun,gradkvchybfun,ulozdata
public :: constr_signals,nacti_data,ulozvahy,backpropagation,backpropagation2,backpropagation3,backpropagation4
public :: simulated_annealing,skalujlearndata,skalujvstupy,skalujvstupyzpet,skalujvystupy,initscale,GEKF,AGEKF
......@@ -85,14 +86,14 @@ implicit none
logical :: newini
integer :: narg,arglen
character(len=:), allocatable :: buffer
character(len=:), allocatable :: buffer,nastavenisite
newini=.false.
!načtení názvu inicializačního souboru, souboru sdaty a s testovacími daty
narg=command_argument_count()
do i=1,narg
call get_command_argument(i,length=arglen)
allocate(character(len=arglen) :: buffer)
......@@ -162,7 +163,7 @@ implicit none
end select
end do
if (.not. allocated(sit%inisoubor)) then
sit%inisoubor='specifikacesite.ini'
end if
......@@ -176,9 +177,9 @@ implicit none
testovacidata='kontrolnidata.dat'
end if
end if
!>>
!>>
fileid=999
!>> kontrola, jestli existují vstupní soubory
inquire(file=sit%inisoubor,exist=existuje)
......@@ -199,9 +200,24 @@ implicit none
STOP
end if
!>> inicializační soubor pro přechodové funkce
nastavenisite='inifiles/netwset.ini'
inquire(file='inifiles',exist=existuje)
if (.not. existuje) then
call execute_command_line('mkdir inifiles')
end if
inquire(file=nastavenisite,exist=existuje)
if (.not. existuje) then
call createsetnetwork(nastavenisite)
else
call nactiparametr(nastavenisite,'actf',sit%actf)
end if
!>>Otevření inicializačního souboru
open(fileid,file=sit%inisoubor)
!>>Načtení počtu vrstev
read(fileid,fmt=*,iostat=readstat) pocvrstev
if (readstat/=0) then
......@@ -210,26 +226,26 @@ implicit none
end if
!>> Alokace struktury sítě
allocate(netwstr(pocvrstev),stat=alocerr)
allocate(netwstr(pocvrstev),stat=alocerr)
if (alocerr /= 0) STOP 'netwstr: požadavek na alokaci zamítnut'
!>> načtení struktury sítě
!>> načtení struktury sítě
read(fileid,fmt=*,iostat=readstat) netwstr
if (readstat/=0) then
write(*,*) '2. radek: V souboru ',sit%inisoubor,' spatne zapsana struktura site.'
STOP
end if
!>> alokace proměnné sit datového typu network
!>> alokace aktivací (výstupy z neuronů) a váhovaných vstupů do jednotlivých neuronů
call sit%createnetw(pocvrstev,netwstr)
deallocate(netwstr)
!TADY BUDE NAČÍTÁNÍ ŠKÁLOVACÍCH PARAMETRŮ
read(fileid,fmt=*,iostat=readstat)
!TADY JE NAČÍTÁNÍ ŠKÁLOVACÍCH PARAMETRŮ
read(fileid,fmt=*,iostat=readstat)
if (readstat /= 0) then
close(fileid)
else
......@@ -247,9 +263,9 @@ implicit none
end if
!\>
!\>
read(fileid,fmt=*,iostat=readstat) !vynechání řádku
read(fileid,fmt=*,iostat=readstat) !vynechání řádku
if (readstat /= 0) then !v inisouboru nejsou váhy
close(fileid)
else
......@@ -264,23 +280,28 @@ implicit none
close(fileid)
exit lloop
end if
end do kloop
end do jloop
end do lloop
!>> konec načítání vah
!>> konec načítání vah
end if
if (readstat == 0) then
read(fileid,fmt=*,iostat=readstat)
!>> načtení biasů
lloop2: do l=2,sit%pocetvrstev
if (readstat == 0) then
read(fileid,fmt=*,iostat=readstat)
!>> načtení biasů
lloop2: do l=2,sit%pocetvrstev
jloop2: do j=1,sit%vrstvy(l)%Nneuronu
read(fileid,fmt=*,iostat=readstat) sit%vrstvy(l)%biasy(j)
end do jloop2
end do lloop2
if (readstat /= 0) then
read(fileid,fmt=*,iostat=readstat)
read(fileid,fmt=*,iostat=readstat) sit%actf
end if
close(fileid)
else !>> vygeneruje váhy a biasy a uloží je
print*,'Generuji se vahy a biasy z nahodneho rozdeleni'
......@@ -288,23 +309,45 @@ implicit none
call random_gauss(sit%vrstvy(l)%vahy,0.0,1.0/sqrt(real(sit%vrstvy(1)%Nneuronu))) !generování vah a biasů z gaussova
! rozdělení - střední hodnota 0 a standartní odchylka je 1/sqrt(počet vstupních signálu)
call random_gauss(sit%vrstvy(l)%biasy,0.0,1.0)
end do
end do
call ulozvahy(sit)
end if
if (newini) then
l=len(sit%inisoubor)
l=len(sit%inisoubor)
allocate(character(len=l+8) :: buffer)
buffer=sit%inisoubor(1:l-4)//"_learned.ini"
sit%inisoubor=buffer
buffer=sit%inisoubor(1:l-4)//"_learned.ini"
sit%inisoubor=buffer
print*,sit%inisoubor
end if
close(fileid)
!>>Zavření inicializačního souboru
end subroutine
!vytvoření inicializačního souboru pro přenosové funkce
subroutine createsetnetwork(parfile)
character(len=:),allocatable,intent(in) :: parfile
integer :: fileid
fileid=42
open(fileid,file=parfile)
write(fileid,fmt=*) ' actf=1'
write(fileid,fmt=*) ' '
write(fileid,fmt=*) 'Nastavení aktivační funkce ve vnitřních vrstvách'
write(fileid,fmt=*) ' actf=1: sigmoida'
write(fileid,fmt=*) ' actf=2: pro x>0 sigmoida; pro x<=0 konstantní funkce 0'
close(fileid)
end subroutine createsetnetwork
subroutine initscale(sit,ucicidata)
type(network) :: sit
type(learn_dataset) :: ucicidata
......@@ -452,6 +495,8 @@ implicit none
write(fileid,fmt=*) sit%vrstvy(l)%biasy(j)
end do jloop2
end do lloop2
write(fileid,fmt=*) 'Přechodové funkce ve vnitřních vrstvách'
write(fileid,fmt=*) sit%actf
close(fileid)
end subroutine ulozvahy
......@@ -682,6 +727,36 @@ end function
end function
!>> Hybridní sigomida: pro x<0 f=0, pro x>0 sigomida
function hsigmoid(x)
real, intent(in) :: x(:,:)
real :: hsigmoid(size(x,1),size(x,2))
integer :: i,j
do i=1,size(x,1)
do j=1,size(x,2)
if (x(i,j) <=0) then
hsigmoid(i,j)=0
else
hsigmoid(i,j)=1/(1+exp(-x(i,j)))
end if
end do
end do
end function hsigmoid
function dhsigmoid(x)
real, intent(in) :: x(:,:)
real :: dhsigmoid(size(x,1),size(x,2))
real :: hsigm(size(x,1),size(x,2))
hsigm=hsigmoid(x)
dhsigmoid=hsigm*(1-hsigm)
end function dhsigmoid
!#####################################################
!# #
!# #### # # # # ##### #### # # ###### #
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment