Commit 7cebaa0d authored by Stanislav Paláček's avatar Stanislav Paláček

v1.1

parent 5bccd18e
......@@ -30,6 +30,12 @@ implicit none
MODULE PROCEDURE skalujvstupyzpetld
END INTERFACE
INTERFACE nactiparametr
MODULE PROCEDURE nactiparametrreal
MODULE PROCEDURE nactiparametrint
END INTERFACE
contains
!Banery vytvořené pomocí:
!figlet -f banner inicializace
......@@ -1898,7 +1904,7 @@ end function
type(learn_dataset) :: datai
real :: chybatestn
real :: chybatestn,chybatestp
logical :: ex
......@@ -1906,6 +1912,8 @@ end function
real :: targeterr
integer :: minepoch,maxepoch
kalmanparfile='inifiles/kallman.par'
inquire(file=kalmanparfile,exist=ex)
......@@ -1919,6 +1927,8 @@ end function
call nactiparametr(kalmanparfile,'lambda0',lambda0)
call nactiparametr(kalmanparfile,'lambda',lambda)
call nactiparametr(kalmanparfile,'targeterr',targeterr)
call nactiparametr(kalmanparfile,'minepoch',minepoch)
call nactiparametr(kalmanparfile,'maxepoch',maxepoch)
!přiřazení počtu prvků datai
......@@ -2040,12 +2050,26 @@ end function
!>> výpočet chyby sítě pro dané vzorové data
sit%chybasite=errfun(sit,vzordata)
chybatestn=errfun(sit,kontrdata)
chybatestn=errfun(sit,kontrdata)
if (nepoch > minepoch) then
if (chybatestp-chybatestn < 0) then
exit
end if
chybatestp=chybatestn
else
chybatestp=chybatestn
end if
if (nepoch > maxepoch) then
print*, 'Dosažen maximální počet epoch'
exit
end if
call ulozvahy(sit)
print*,"chyba ucicich dat=",sit%chybasite, "chyba testovacich dat=",chybatestn
if (sit%chybasite < targeterr) exit
end if
......@@ -2067,6 +2091,9 @@ end function
write(fileid,fmt=*) ' lambda0=0.99'
write(fileid,fmt=*) ' lambda=0.95'
write(fileid,fmt=*) ' targeterr=1e-5 !cilova chyba site, ktere chceme dosahnout(v normovanem stavu)'
write(fileid,fmt=*) ' minepoch=10 !počet epoch které uběhnou než se začne testovat podmínka na &
snížení chyby testovacích dat '
write(fileid,fmt=*) ' maxepoch=1000000'
close(fileid)
......@@ -2267,8 +2294,68 @@ end function
end subroutine
subroutine nactiparametrint(soubor,charpar,par)
character(len=*),intent(in) :: soubor
character(len=*),intent(in) :: charpar
integer,intent(out) :: par
integer :: fileid,ierr,pos
character(len=:),allocatable :: buffer,label
logical :: existuje,loaded
fileid=42
loaded=.false.
inquire(file=soubor,exist=existuje)
if (.not. existuje) then
print*,'subroutine nactiparametr: File ',soubor,' was not found.'
STOP
end if
open(fileid,file=soubor)
ierr=0
do while (ierr==0)
if(allocated(buffer)) then
deallocate(buffer)
end if
allocate(character(len=256) :: buffer)
read(fileid,'(A)',iostat=ierr) buffer
buffer=trim(buffer)
if (ierr == 0) then
pos=scan(buffer,'=')
label=buffer(1:pos-1)
buffer=buffer(pos+1:)
if (adjustl(label)==charpar) then
read(buffer,*,iostat=ierr) par
if (ierr /=0) then
print*,'subroutine nactiparametr: parameter ',charpar,' bad specified in file ',soubor
STOP
end if
ierr=-1
loaded=.true.
end if
end if
end do
if (.not. loaded) then
print*, 'subroutine nactiparametr: parameter ',charpar,' was not found in file ',soubor
STOP
end if
close(fileid)
end subroutine nactiparametrint
subroutine nactiparametr(soubor,charpar,par)
subroutine nactiparametrreal(soubor,charpar,par)
character(len=*),intent(in) :: soubor
character(len=*),intent(in) :: charpar
real,intent(out) :: par
......@@ -2327,6 +2414,6 @@ end function
close(fileid)
end subroutine nactiparametr
end subroutine nactiparametrreal
end module neuronka
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