Something went wrong on our end
-
Martin Beseda authoredMartin Beseda authored
net_m.f90 11.57 KiB
!> Module containing classes representing the whole
!! neural network.
!!
!! It uses 'neuron_m' module.
!!
!! @author Martin Beseda
!! @date 2018
module net_m
use data_kinds_4neuro_m
use time_measurement_m
use neuron_m
use connection_m
use container_m
implicit none
public
!-------------!------------------------------------------------------------------------------
! class net_t !
!-------------!
type :: container
class(*), pointer :: content
end type
!> Class representing a general network
type :: net_t
private
character(:), allocatable :: net_type !< Type of the net
integer(kind=integer_4neuro) :: num_of_neurons !< Number of neurons in the net
character(:), allocatable :: training_method !< Used training method
class(container_t), allocatable :: neuron_arr(:) !< Array containing all neurons
integer(kind=integer_4neuro), allocatable :: input_neuron_arr(:) !< Array of input neuron indices
integer(kind=integer_4neuro), allocatable :: output_neuron_arr(:) !< Array of output neuron indices
class(connection_t), allocatable :: connection_arr(:) !< Array of all connections
contains
!> Prints information about the network to the standard output.
procedure :: print_info => print_info_impl
!> Saves the network instance to the Fortran binary file
procedure :: save_net_bin => save_net_bin_impl
!> Implementation of write function enabling the storage of
!! allocatable arrays.
procedure :: write_sample => write_sample_impl
!> Implementation of read function enabling to read
!! the whole instance of net_t stored as binary file.
procedure :: read_sample => read_sample_impl
generic :: write(unformatted) => write_sample
generic :: read(unformatted) => read_sample
end type net_t
interface net_t
!> Constructor of net_t class
!! Loads complete info about network from file
!! @param[in] filepath Path to the file with network configuration
!! @return An instance of the class net_t
module procedure :: new_net_1
end interface net_t
!------------------!---------------------------------------------------------------------
! class mock_net_t !
!------------------!
!> Mock net_t class
type, extends(net_t) :: mock_net_t
end type mock_net_t
interface mock_net_t
!> Non-parametric constructor of mock_net_t class
!! @return An instance of the class mock_net_t
module procedure :: new_mock_net
end interface mock_net_t
contains
!------------------------!---------------------------------------------------------------
! Method implementations !
!------------------------!
!-------------!--------------------------------------------------------------------------
! class net_t !
!-------------!
!--------------!-------------------------------------------------------------------------
! Constructors !
!--------------!
!> Constructor of net_t class
!! Loads complete info about network from Fortran binary file
!! @param[in] filepath Path to the JSON file with network configuration
!! @return An instance of the class net_t
function new_net_1(filepath) result(new_obj)
character(len=*), intent(in) :: filepath
type(net_t) :: new_obj
character(len=50) :: str !TODO udelat dynamicky, ne s fixni delkou
#ifdef TIME_PROFILING
real :: start_time
call time_profiling_start(start_time)
#endif
open(unit=11, file=filepath, form="unformatted", access="stream")
read(11) new_obj
close(11)
print *,new_obj%net_type
!TODO dopsat
#ifdef TIME_PROFILING
call time_profiling_stop(start_time, 'new_net')
#endif
end function new_net_1
!> Prints information about the network to the standard output.
subroutine print_info_impl(this)
class(net_t), intent(in) :: this
#ifdef TIME_PROFILING
real :: start_time
call time_profiling_start(start_time)
#endif
write(*,*) '+--------------+'
write(*,*) '| Network info |'
write(*,*) '+--------------+'
write(*,*) 'Type: ', this%net_type
write(*,*) 'Number of neurons: ', this%num_of_neurons
!TODO dopsat
#ifdef TIME_PROFILING
call time_profiling_stop(start_time, 'print_info_impl')
#endif
end subroutine print_info_impl
!----------------!-----------------------------------------------------------------------
! Common methods !
!----------------!
!> Saves the network instance to the Fortran binary file
!! @param[in] filename Name of the file, where the net will be saved into
subroutine save_net_bin_impl(this, filename)
class(net_t), intent(in) :: this !< Instance of the class 'net_t'
character(len=*), intent(in) :: filename
#ifdef TIME_PROFILING
real :: start_time
call time_profiling_start(start_time)
#endif
open(unit=11, file=filename, form="unformatted", access='stream', position='append')
write(11) this
close(unit=11)
#ifdef TIME_PROFILING
call time_profiling_stop(start_time, 'save_net_bin_impl')
#endif
end subroutine save_net_bin_impl
!> Implementation of write function enabling the storage of
!! allocatable arrays.
!! @param[in] unit Unit (handler) where the file is written
!! @param[out] iostat Diagnostic value "returned" by the subroutine
!! @param[inout] iomsg Explaining note about error
subroutine write_sample_impl(this, unit, iostat, iomsg)
class(net_t), intent(in) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: i !< Counter
#ifdef TIME_PROFILING
real :: start_time
call time_profiling_start(start_time)
#endif
! Write a record giving sizes for the allocation
write(unit, iostat=iostat, iomsg=iomsg) SIZE(this%neuron_arr), &
SIZE(this%input_neuron_arr), &
SIZE(this%output_neuron_arr), &
SIZE(this%connection_arr)
select type(tmp => this%neuron_arr)
type is(container_t)
select type(tmp2 => this%connection_arr)
type is(connection_t)
write(unit, iostat=iostat, iomsg=iomsg) (tmp(i)%content%get_id(), &
tmp(i)%get_potential(), &
tmp(i)%get_state(), &
i=1,SIZE(this%neuron_arr)), &
this%input_neuron_arr, &
this%output_neuron_arr, &
(tmp2(i)%get_input_neuron(), &
tmp2(i)%get_output_neuron(), &
tmp2(i)%get_weight(), &
i=1,SIZE(this%connection_arr))
end select
end select
#ifdef TIME_PROFILING
call time_profiling_stop(start_time, 'write_net_sample')
#endif
end subroutine write_sample_impl
! Unformatted reading for the sample derived type
subroutine read_sample_impl(this, unit, iostat, iomsg)
class(net_t), intent(inout) :: this
integer, intent(in) :: unit
integer, intent(out) :: iostat
character(*), intent(inout) :: iomsg
integer :: i
integer :: s1, s2, s3, s4 !< Sizes of stored allocatable properties
#ifdef TIME_PROFILING
real :: start_time
call time_profiling_start(start_time)#endif
! We first have a record telling us the sizes of components
read(unit, iostat=iostat, iomsg=iomsg) s1, s2, s3, s4
! So we do the allocation
allocate(this%neuron_arr(s1), &
this%input_neuron_arr(s2), &
this%output_neuron_arr(s3), &
this%connection_arr(s4))
! And then finally the reading.
select type(tmp => this%neuron_arr)
type is(container_t)
select type(tmp2 => this%connection_arr)
type is(connection_t)
read(unit, iostat=iostat, iomsg=iomsg) (tmp(i)%id, &
tmp(i)%potential, &
tmp(i)%state, &
i=1, SIZE(this%neuron_arr)), &
this%input_neuron_arr, &
this%output_neuron_arr, &
(tmp2(i)%input_neuron, &
tmp2(i)%output_neuron, &
tmp2(i)%weight, &
i=1, SIZE(this%connection_arr))
end select
end select
#ifdef TIME_PROFILING
call time_profiling_stop(start_time, 'read_net_sample')
#endif
end subroutine read_sample_impl
!------------------!---------------------------------------------------------------------
! class mock_net_t !
!------------------!
!--------------!-------------------------------------------------------------------------
! Constructors !
!--------------!
!> Contructor of mock_net_t class
!! @return An instance of the class mock_net_t
function new_mock_net() result(new_obj)
type(mock_net_t) :: new_obj
integer :: i !< Counter
class(neuron_t), pointer :: n_p1, n_p2
class(neuron_t), pointer :: n_p(:)
type(mock_neuron_t), target :: n_tmp
#ifdef TIME_PROFILING
real :: start_time
call time_profiling_start(start_time)
#endif
new_obj%net_type = 'MOCK NETWORK'
new_obj%num_of_neurons = 5
new_obj%training_method = 'MOCK TRAINING'
! Init object
allocate(container_t :: new_obj%neuron_arr(5))
select type(tmp => new_obj%neuron_arr)
type is (container_t)
do i=1,5
n_tmp = mock_neuron_t()
tmp(i) = container_t(n_tmp)
end do
end select
new_obj%input_neuron_arr = (/1, 2/)
new_obj%output_neuron_arr = (/ 5 /)
allocate(connection_t :: new_obj%connection_arr(4))! n_p => new_obj%neuron_arr
! new_obj%connection_arr(1) = connection_t(n_p(1), n_p(3))
! connection_arr_tmp(2)%content => connection_t(neuron_arr_tmp(2)%content, neuron_arr_tmp(4))
! connection_arr_tmp(3)%content => connection_t(neuron_arr_tmp(3)%content, neuron_arr_tmp(5))
! connection_arr_tmp(4)%content => connection_t(neuron_arr_tmp(4)%content, neuron_arr_tmp(5))
!TODO dopsat init zbylych polozek
#ifdef TIME_PROFILING
call time_profiling_stop(start_time, 'new_mock_net')
#endif
end function new_mock_net
end module net_m