Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
module Connection_mod
implicit none
public
! TODO smazat
!> Dummy class Neuron
!! blabla
type :: Neuron
real :: state ! TODO v realne tride 'private'!
contains
procedure :: get_state => get_state_impl
procedure :: set_state => set_state_impl
end type Neuron
!------------------!------------------------------------------------------------------------
! Type definitions !
!------------------!
!> Represents a connection between two neurons.
type, abstract :: Connection
class(Neuron), pointer, private :: input_neuron
class(Neuron), pointer, private :: output_neuron
real, private :: weight
contains
!> Adds a gven 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
! Constructors
procedure :: new_connection => new_connection_impl
! Getters and setters
procedure :: get_input_neuron => get_input_neuron_impl
procedure :: get_output_neuron => get_output_neuron_impl
procedure :: get_weight => get_weight_impl
end type Connection
type, extends(Connection) :: IntervalConnection
contains
procedure :: pass_signal => pass_signal_impl
end type IntervalConnection
!------------!------------------------------------------------------------------------------
! Interfaces !
!------------!
! For signatures of abstract functions
!interface Connection
!
!end interface Connection
contains
!------------------------!------------------------------------------------------------------
! Method implementations !
! -----------------------!
!--------------!
! class Neuron !
!--------------!
! TODO smazat
function get_state_impl(this) result(state)
class(Neuron), intent(in) :: this
real :: state
state = this%state
end function get_state_impl
! TODO smazat
subroutine set_state_impl(this, new_state)
class(Neuron), target :: this
real, intent(in) :: new_state
this%state = new_state
end subroutine set_state_impl
!------------------!
! class Connection !
!------------------!
subroutine adjust_weight_impl(this, added_value)
class(Connection), intent(inout) :: this
real, intent(in) :: added_value
this%weight = this%weight + added_value
end subroutine adjust_weight_impl
!--------------------------!
! class IntervalConnection !
!--------------------------!
subroutine pass_signal_impl(this)
class(IntervalConnection), intent(in) :: this
call this%output_neuron%set_state(5.0)
end subroutine pass_signal_impl
!--------------!------------------------------------------------------------------------
! Constructors !
!--------------!
subroutine new_connection_impl(this, input_neuron, output_neuron, weight)
class(Connection), intent(out) :: this
class(Neuron), pointer, intent(in) :: input_neuron
class(Neuron), pointer, intent(in) :: output_neuron
real, intent(in) :: weight
this%input_neuron => input_neuron
this%output_neuron => output_neuron
this%weight = weight
print *, 'Constructor!'
end subroutine new_connection_impl
!-------------------!-------------------------------------------------------------------
! Getters & Setters !
!-------------------!
function get_input_neuron_impl(this) result (input_neuron)
class(Connection), target, intent(in) :: this
class(Neuron), pointer :: input_neuron
input_neuron => this%input_neuron
end function get_input_neuron_impl
function get_output_neuron_impl(this) result (output_neuron)
class(Connection), target, intent(in) :: this
class(Neuron), pointer :: output_neuron
output_neuron => this%output_neuron
end function get_output_neuron_impl
function get_weight_impl(this) result (weight)
class(Connection), intent(in) :: this
real :: weight
weight = this%weight
end function get_weight_impl
end module Connection_mod
program a
use Connection_mod
type(Neuron), target :: n1
type(Neuron), target :: n2
type(Neuron), pointer :: n1_p
type(Neuron), pointer :: n2_p
type(Neuron), pointer :: dummy_p
type(IntervalConnection) :: con
n1 = Neuron(21)
n2 = Neuron(13)
n1_p => n1
n2_p => n2
call con%new_connection(n1, n2, 5.12)
print *, 'weight: ', con%get_weight()
dummy_p => con%get_input_neuron()
print *, dummy_p%get_state()
dummy_p => con%get_output_neuron()
print *, dummy_p%get_state()
end program a