connection_m.f90

!> Module containing classes representing connections (synapses)
!! in neural networks.
!!
!! It uses `neuron_t` class.
!!
!! @author Martin Beseda
!! @author Martin Mrovec
!! @date 2017
!! @todo Rewrite pass_signal method of interval_connection_t 
module connection_m
    use neuron_dummy_m
    use time_measurement_m
    use normal_m

    implicit none

    public

    !------------------!------------------------------------------------------------------------
    ! Type definitions !
    !------------------!

    !> Represents a connection between two neurons.
    type :: connection_t
        private 

        class(neuron_t), pointer :: input_neuron   !< Pointer to an input neuron
        class(neuron_t), pointer :: output_neuron  !< Pointer to an output neuron
        real                     :: weight         !< Weight of the connection

    contains

        !> Initializes the common connection_t class components
        !! 'input_neuron', 'output_neuron' and 'weight'.
        !! I.e. serves similarly to an abstract constructor.
        !! @param input_neuron Pointer to the input neuron (instance of neuron_t)
        !! @param output_neuron Pointer to the output neuron (instance of neuron_t)
        !! @param weight Weight of the connection (real number)
        procedure, private :: init_components   => init_components_impl

        !> Nullifies pointers to input and output neurons, so they
        !! don't get destroyed when the connection_t instance is 
        !! deallocated.
        procedure, private :: nullify_pointers  => nullify_pointers_impl

        !> Adds a given value to the current weight of the  
        !! connection.
        !! @param added_value Number (real) to be added to the current weight
        procedure          :: adjust_weight     => adjust_weight_impl

        !> Getter for the private 'input_neuron' component
        !! @return Pointer to the input neuron (type neuron_t, pointer)
        procedure          :: get_input_neuron  => get_input_neuron_impl

        !> Getter for the private 'output_neuron' component
        !! @return Pointer to the output neuron (type neuron_t, pointer)
        procedure          :: get_output_neuron => get_output_neuron_impl

        !> Getter for the private 'weight' component
        !! @return Weight of the connection (type real)
        procedure          :: get_weight        => get_weight_impl

        !> Passes (assigns) the product 
        !! input neuron state * weight)
        !! to an output neuron.
        procedure :: pass_signal => pass_signal_impl

        !> Desctructors for instances of the class connection_t
        final              :: destroy_connection, destroy_connection_array

    end type connection_t

    interface connection_t
        !> Constructor of connection_t class
        !! @param input_neuron Pointer to the input neuron (instance of neuron_t)
        !! @param output_neuron Pointer to the output neuron (instance of neuron_t)
        module procedure :: new_connection_2

        !> Constructor of connection_t class
        !! @param input_neuron Pointer to the input neuron (instance of neuron_t)
        !! @param output_neuron Pointer to the output neuron (instance of neuron_t)
        !! @param weight Weight of the connection (real number)
        module procedure :: new_connection_3
    end interface connection_t

    !> Represents a connection between two neurons.
    !! Able to pass a signal from an input neuron to 
    !! an output one.
    type, extends(connection_t) :: interval_connection_t
    contains

        !> Passes (assigns) the product 
        !! input neuron state * weight)
        !! to an output neuron.
        !! @todo Rewrite implementation to "interval"
        procedure :: pass_signal => pass_signal_interval_impl

    end type interval_connection_t
    
    interface interval_connection_t
        !> Constructor of interval_connection_t class
        !! @param input_neuron Pointer to the input neuron (instance of neuron_t)
        !! @param output_neuron Pointer to the output neuron (instance of neuron_t)
        module procedure :: new_interval_connection_2 
 
        !> Constructor of interval_connection_t class
        !! @param input_neuron Pointer to the input neuron (instance of neuron_t)
        !! @param output_neuron Pointer to the output neuron (instance of neuron_t)
        !! @param weight Weight of the connection (real number) 
        module procedure :: new_interval_connection_3
    end interface interval_connection_t

    contains
        !------------------------!------------------------------------------------------------------
        ! Method implementations !
        ! -----------------------!

        !--------------------!
        ! class connection_t !
        !--------------------!

        !--------------!----------------------------------------------------------------------------
        ! Constructors !
        !--------------!
        function new_connection_2(input_neuron, output_neuron) result(new_obj)
            type(neuron_t), pointer, intent(in)      :: input_neuron
            type(neuron_t), pointer, intent(in)      :: output_neuron
            real                                     :: weight
            type(connection_t), pointer              :: new_obj
            integer                                  :: values(8)  !< values(8) is used as seed

#ifdef TIME_PROFILING
            real                                     :: start_time
            call time_profiling_start(start_time)
#endif
            allocate(new_obj)

            ! Generate pseudorandom number from Gaussian distribution
            ! as connection weight
            call date_and_time(values=values)
            weight = r4_normal_01(values(8))

            call new_obj%init_components(input_neuron, output_neuron, weight)
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'new_connection_2')
#endif
        end function new_connection_2
      

        function new_connection_3(input_neuron, output_neuron, weight) result(new_obj)
            type(neuron_t), pointer, intent(in)      :: input_neuron
            type(neuron_t), pointer, intent(in)      :: output_neuron
            real, intent(in)                         :: weight
            type(connection_t), pointer              :: new_obj
#ifdef TIME_PROFILING
            real                                     :: start_time
            call time_profiling_start(start_time)
#endif
            allocate(new_obj)

            call new_obj%init_components(input_neuron, output_neuron, weight)
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'new_connection_3')
#endif
        end function new_connection_3

        !-------------!--------------------------------------------------------------------------
        ! Destructors !
        !-------------!
        subroutine destroy_connection(this)
            type(connection_t), intent(inout) :: this
#ifdef TIME_PROFILING
            real                              :: start_time
            call time_profiling_start(start_time)
#endif
            call this%nullify_pointers()
#ifdef TIME_PROFILING
            call time_profiling_start(start_time, 'destroy_connection')
#endif
        end subroutine destroy_connection

        subroutine destroy_connection_array(this)
            type(connection_t), intent(inout) :: this(:)
            integer                           :: i
#ifdef TIME_PROFILING
            real                              :: start_time
            call time_profiling_start(start_time)
#endif
            do i = 1, size(this)
                call this(i)%nullify_pointers()
            end do
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'destroy_connection_array')
#endif
        end subroutine destroy_connection_array

        !-------------------!-------------------------------------------------------------------
        ! Getters & Setters !
        !-------------------!
        function get_input_neuron_impl(this) result (input_neuron)
            class(connection_t), target, intent(in) :: this
            class(neuron_t), pointer                :: input_neuron
#ifdef TIME_PROFILING
            real                                    :: start_time
            call time_profiling_start(start_time)
#endif
            input_neuron => this%input_neuron
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time,'get_input_neuron_impl')
#endif
        end function get_input_neuron_impl

        function get_output_neuron_impl(this) result (output_neuron)
            class(connection_t), target, intent(in) :: this
            class(neuron_t), pointer                :: output_neuron
#ifdef TIME_PROFILING
            real                                    :: start_time
            call time_profiling_start(start_time)
#endif
            output_neuron => this%output_neuron
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'get_output_neuron_impl')
#endif
        end function get_output_neuron_impl

        function get_weight_impl(this) result (weight)
            class(connection_t), intent(in) :: this
            real                            :: weight
#ifdef TIME_PROFILING
            real                            :: start_time
            call time_profiling_start(start_time)
#endif
            weight = this%weight
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'get_weight_impl')
#endif
        end function get_weight_impl


        !----------------!-------------------------------------------------------------------------
        ! Common methods !
        !----------------!
        subroutine init_components_impl(this, input_neuron, output_neuron, weight) 
            class(connection_t), intent(inout) :: this
            type(neuron_t), pointer            :: input_neuron
            type(neuron_t), pointer            :: output_neuron
            real, intent(in)                   :: weight

#ifdef TIME_PROFILING
            real                               :: start_time
            call time_profiling_start(start_time);
#endif

            this%input_neuron  => input_neuron
            this%output_neuron => output_neuron
            this%weight        = weight

#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'init_components_impl');
#endif
        end subroutine init_components_impl
            
        subroutine nullify_pointers_impl(this)
            class(connection_t), intent(inout) :: this
#ifdef TIME_PROFILING
            real                               :: start_time
            call time_profiling_start(start_time)
#endif
            nullify(this%input_neuron)
            nullify(this%output_neuron)
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'nullify_pointers_impl')
#endif
        end subroutine nullify_pointers_impl

        subroutine adjust_weight_impl(this, added_value)
            class(connection_t), intent(inout) :: this
            real, intent(in)                   :: added_value
#ifdef TIME_PROFILING
            real                               :: start_time
            call time_profiling_start(start_time)
#endif
            this%weight = this%weight + added_value 
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'adjust_weight_impl')
#endif
        end subroutine adjust_weight_impl

        subroutine pass_signal_impl(this)
            class(connection_t), intent(in) :: this
#ifdef TIME_PROFILING
            real                                     :: start_time
            call time_profiling_start(start_time)
#endif
            call this%output_neuron%set_state(this%input_neuron%get_state() * this%weight)
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'pass_signal_impl')
#endif
        end subroutine pass_signal_impl

        !-----------------------------!
        ! class interval_connection_t !
        !-----------------------------!
        subroutine pass_signal_interval_impl(this)
            class(interval_connection_t), intent(in) :: this
#ifdef TIME_PROFILING
            real                                     :: start_time
            call time_profiling_start(start_time)
#endif
            call this%output_neuron%set_state(this%input_neuron%get_state() * this%weight)
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'pass_signal_interval_impl')
#endif
        end subroutine pass_signal_interval_impl

        !--------------!------------------------------------------------------------------------
        ! Constructors !
        !--------------!
        function new_interval_connection_2(input_neuron, output_neuron) result(new_obj)
            type(neuron_t), pointer              :: input_neuron
            type(neuron_t), pointer              :: output_neuron
            real                                 :: weight
            type(interval_connection_t), pointer :: new_obj
#ifdef TIME_PROFILING
            real                                 :: start_time
            call time_profiling_start(start_time)
#endif
            allocate(new_obj)

            ! todo change to random numbers from Gaussian distribution
            call random_seed()
            call random_number(weight)

            call new_obj%init_components(input_neuron, output_neuron, weight)
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'new_interval_connection_2')
#endif
        end function new_interval_connection_2

        function new_interval_connection_3(input_neuron, output_neuron, weight) result(new_obj)
            type(neuron_t), pointer              :: input_neuron
            type(neuron_t), pointer              :: output_neuron
            real, intent(in)                     :: weight
            type(interval_connection_t), pointer :: new_obj
#ifdef TIME_PROFILING
            real                                 :: start_time
            call time_profiling_start(start_time)
#endif
            allocate(new_obj)

            call new_obj%init_components(input_neuron, output_neuron, weight)
#ifdef TIME_PROFILING
            call time_profiling_stop(start_time, 'new_interval_connection_3')
#endif
        end function new_interval_connection_3


end module connection_m