├── .gitignore ├── assets ├── gsoc.png └── nasa.png ├── fpm.toml ├── example ├── CMakeLists.txt ├── simple.f90 ├── mha_simple.f90 ├── sine.f90 ├── network_parameters.f90 ├── cnn_mnist.f90 ├── cnn_mnist_1d.f90 ├── dense_mnist.f90 ├── merge_networks.f90 └── get_set_network_params.f90 ├── src ├── nf │ ├── nf_parallel.f90 │ ├── nf_input1d_layer_submodule.f90 │ ├── nf_input2d_layer_submodule.f90 │ ├── nf_input3d_layer_submodule.f90 │ ├── nf_parallel_submodule.f90 │ ├── nf_base_layer.f90 │ ├── nf_random.f90 │ ├── nf_loss_submodule.f90 │ ├── nf_datasets_submodule.f90 │ ├── nf_datasets.f90 │ ├── io │ │ ├── nf_io_binary.f90 │ │ └── nf_io_binary_submodule.f90 │ ├── nf_input2d_layer.f90 │ ├── nf_input3d_layer.f90 │ ├── nf_reshape2d_layer_submodule.f90 │ ├── nf_input1d_layer.f90 │ ├── nf_reshape3d_layer_submodule.f90 │ ├── nf_datasets_mnist.f90 │ ├── nf_metrics.f90 │ ├── nf_flatten_layer_submodule.f90 │ ├── nf_dropout_layer_submodule.f90 │ ├── nf_cross_attention_layer.f90 │ ├── nf_maxpool2d_layer.f90 │ ├── nf_reshape3d_layer.f90 │ ├── nf_self_attention_layer.f90 │ ├── nf_flatten_layer.f90 │ ├── nf_linear2d_layer.f90 │ ├── nf_reshape2d_layer.f90 │ ├── nf_maxpool1d_layer.f90 │ ├── nf_maxpool1d_layer_submodule.f90 │ ├── nf_dropout_layer.f90 │ ├── nf_layernorm.f90 │ ├── nf_datasets_mnist_submodule.f90 │ ├── nf_embedding_layer.f90 │ ├── nf_loss.f90 │ ├── nf_linear2d_layer_submodule.f90 │ ├── nf_maxpool2d_layer_submodule.f90 │ ├── nf_dense_layer_submodule.f90 │ ├── nf_dense_layer.f90 │ ├── nf_conv2d_layer.f90 │ ├── nf_conv1d_layer.f90 │ ├── nf_embedding_layer_submodule.f90 │ ├── nf_locally_connected2d_layer.f90 │ ├── nf_layernorm_submodule.f90 │ └── nf_locally_connected2d_layer_submodule.f90 └── nf.f90 ├── CITATION.cff ├── ford.md ├── test ├── CMakeLists.txt ├── test_dense_layer.f90 ├── test_loss.f90 ├── test_input2d_layer.f90 ├── test_input3d_layer.f90 ├── test_reshape2d_layer.f90 ├── test_reshape_layer.f90 ├── test_insert_flatten.f90 ├── test_input1d_layer.f90 ├── test_dense_network.f90 ├── test_metrics.f90 ├── tuff.f90 ├── test_parametric_activation.f90 ├── test_get_set_network_params.f90 ├── test_maxpool1d_layer.f90 ├── test_conv2d_layer.f90 ├── test_conv1d_layer.f90 ├── test_maxpool2d_layer.f90 ├── test_locally_connected2d_layer.f90 ├── test_flatten_layer.f90 ├── test_optimizers.f90 ├── test_conv2d_network.f90 ├── test_conv1d_network.f90 └── test_embedding_layer.f90 ├── LICENSE ├── cmake ├── Findneural-fortran.cmake ├── options.cmake └── compilers.cmake ├── .github └── workflows │ └── ci.yml ├── CONTRIBUTING.md └── CMakeLists.txt /.gitignore: -------------------------------------------------------------------------------- 1 | *.gz 2 | *.o 3 | *.mod 4 | *.smod 5 | *.dat 6 | *.h5 7 | /build 8 | /doc 9 | -------------------------------------------------------------------------------- /assets/gsoc.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/modern-fortran/neural-fortran/HEAD/assets/gsoc.png -------------------------------------------------------------------------------- /assets/nasa.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/modern-fortran/neural-fortran/HEAD/assets/nasa.png -------------------------------------------------------------------------------- /fpm.toml: -------------------------------------------------------------------------------- 1 | name = "neural-fortran" 2 | version = "0.22.0" 3 | license = "MIT" 4 | author = "Milan Curcic" 5 | maintainer = "mcurcic@miami.edu" 6 | copyright = "Copyright 2018-2025, neural-fortran contributors" 7 | 8 | [preprocess] 9 | [preprocess.cpp] 10 | -------------------------------------------------------------------------------- /example/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | foreach(execid 2 | cnn_mnist 3 | cnn_mnist_1d 4 | dense_mnist 5 | get_set_network_params 6 | network_parameters 7 | simple 8 | sine 9 | quadratic 10 | mha_simple 11 | ) 12 | add_executable(${execid} ${execid}.f90) 13 | target_link_libraries(${execid} PRIVATE 14 | neural-fortran 15 | ${LIBS} 16 | ) 17 | endforeach() 18 | -------------------------------------------------------------------------------- /src/nf/nf_parallel.f90: -------------------------------------------------------------------------------- 1 | module nf_parallel 2 | 3 | implicit none 4 | 5 | private 6 | public :: tile_indices 7 | 8 | interface 9 | 10 | pure module function tile_indices(dims) result(res) 11 | !! Given input global array size, return start and end index 12 | !! of a parallel 1-d tile that correspond to this image. 13 | implicit none 14 | integer, intent(in) :: dims 15 | integer :: res(2) 16 | end function tile_indices 17 | 18 | end interface 19 | 20 | end module nf_parallel 21 | -------------------------------------------------------------------------------- /example/simple.f90: -------------------------------------------------------------------------------- 1 | program simple 2 | use nf, only: dense, input, network, sgd 3 | implicit none 4 | type(network) :: net 5 | real, allocatable :: x(:), y(:) 6 | integer, parameter :: num_iterations = 500 7 | integer :: n 8 | 9 | print '("Simple")' 10 | print '(60("="))' 11 | 12 | net = network([ & 13 | input(3), & 14 | dense(5), & 15 | dense(2) & 16 | ]) 17 | 18 | call net % print_info() 19 | 20 | x = [0.2, 0.4, 0.6] 21 | y = [0.123456, 0.246802] 22 | 23 | do n = 0, num_iterations 24 | 25 | call net % forward(x) 26 | call net % backward(y) 27 | call net % update(optimizer=sgd(learning_rate=1.)) 28 | 29 | if (mod(n, 50) == 0) & 30 | print '(i4,2(3x,f8.6))', n, net % predict(x) 31 | 32 | end do 33 | 34 | end program simple 35 | -------------------------------------------------------------------------------- /src/nf/nf_input1d_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_input1d_layer) nf_input1d_layer_submodule 2 | implicit none 3 | contains 4 | 5 | pure module function input1d_layer_cons(output_size) result(res) 6 | integer, intent(in) :: output_size 7 | type(input1d_layer) :: res 8 | allocate(res % output(output_size)) 9 | res % output = 0 10 | end function input1d_layer_cons 11 | 12 | module subroutine init(self, input_shape) 13 | class(input1d_layer), intent(in out) :: self 14 | integer, intent(in) :: input_shape(:) 15 | end subroutine init 16 | 17 | pure module subroutine set(self, values) 18 | class(input1d_layer), intent(in out) :: self 19 | real, intent(in) :: values(:) 20 | self % output = values 21 | end subroutine set 22 | 23 | end submodule nf_input1d_layer_submodule 24 | -------------------------------------------------------------------------------- /CITATION.cff: -------------------------------------------------------------------------------- 1 | cff-version: 1.2.0 2 | message: "If you use neural-fortran, please cite it as below." 3 | authors: 4 | - family-names: "Curcic" 5 | given-names: "Milan" 6 | orcid: "https://orcid.org/0000-0002-8822-7749" 7 | title: "neural-fortran" 8 | version: 0.5.0 9 | date-released: 2022-06-10 10 | url: "https://github.com/modern-fortran/neural-fortran" 11 | preferred-citation: 12 | type: article 13 | authors: 14 | - family-names: "Curcic" 15 | given-names: "Milan" 16 | orcid: "https://orcid.org/0000-0002-8822-7749" 17 | doi: "10.1145/3323057.3323059" 18 | journal: "ACM SIGPLAN Fortran Forum" 19 | month: 3 20 | start: 4 # First page number 21 | end: 21 # Last page number 22 | title: "A parallel Fortran framework for neural networks and deep learning" 23 | issue: 1 24 | volume: 38 25 | year: 2019 26 | -------------------------------------------------------------------------------- /src/nf/nf_input2d_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_input2d_layer) nf_input2d_layer_submodule 2 | implicit none 3 | contains 4 | 5 | pure module function input2d_layer_cons(output_shape) result(res) 6 | integer, intent(in) :: output_shape(2) 7 | type(input2d_layer) :: res 8 | allocate(res % output(output_shape(1), output_shape(2))) 9 | res % output = 0 10 | end function input2d_layer_cons 11 | 12 | module subroutine init(self, input_shape) 13 | class(input2d_layer), intent(in out) :: self 14 | integer, intent(in) :: input_shape(:) 15 | end subroutine init 16 | 17 | pure module subroutine set(self, values) 18 | class(input2d_layer), intent(in out) :: self 19 | real, intent(in) :: values(:,:) 20 | self % output = values 21 | end subroutine set 22 | 23 | end submodule nf_input2d_layer_submodule -------------------------------------------------------------------------------- /ford.md: -------------------------------------------------------------------------------- 1 | project: 2 | summary: A parallel neural net microframework 3 | src_dir: src 4 | output_dir: doc/html 5 | preprocess: true 6 | display: public 7 | protected 8 | private 9 | source: true 10 | graph: true 11 | md_extensions: markdown.extensions.toc 12 | coloured_edges: true 13 | sort: permission-alpha 14 | extra_mods: iso_fortran_env:https://gcc.gnu.org/onlinedocs/gfortran/ISO_005fFORTRAN_005fENV.html 15 | iso_c_binding:https://gcc.gnu.org/onlinedocs/gfortran/ISO_005fC_005fBINDING.html#ISO_005fC_005fBINDING 16 | author: Milan Curcic 17 | print_creation_date: true 18 | creation_date: %Y-%m-%d %H:%M %z 19 | project_github: https://github.com/modern-fortran/neural-fortran 20 | project_download: https://github.com/modern-fortran/neural-fortran/releases 21 | github: https://github.com/modern-fortran 22 | 23 | {!README.md!} 24 | -------------------------------------------------------------------------------- /test/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | add_library(tuff tuff.f90) 2 | 3 | foreach(execid 4 | input1d_layer 5 | input2d_layer 6 | input3d_layer 7 | dropout_layer 8 | linear2d_layer 9 | parametric_activation 10 | dense_layer 11 | conv1d_layer 12 | conv2d_layer 13 | locally_connected2d_layer 14 | maxpool1d_layer 15 | maxpool2d_layer 16 | flatten_layer 17 | insert_flatten 18 | reshape_layer 19 | reshape2d_layer 20 | multihead_attention_layer 21 | embedding_layer 22 | layernorm 23 | dense_network 24 | get_set_network_params 25 | conv1d_network 26 | conv2d_network 27 | optimizers 28 | loss 29 | metrics 30 | ) 31 | add_executable(test_${execid} test_${execid}.f90) 32 | target_link_libraries(test_${execid} PRIVATE tuff neural-fortran ${LIBS}) 33 | 34 | add_test(NAME test_${execid} COMMAND test_${execid}) 35 | endforeach() 36 | -------------------------------------------------------------------------------- /src/nf/nf_input3d_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_input3d_layer) nf_input3d_layer_submodule 2 | implicit none 3 | contains 4 | 5 | pure module function input3d_layer_cons(output_shape) result(res) 6 | integer, intent(in) :: output_shape(3) 7 | type(input3d_layer) :: res 8 | allocate(res % output(output_shape(1), output_shape(2), output_shape(3))) 9 | res % output = 0 10 | end function input3d_layer_cons 11 | 12 | module subroutine init(self, input_shape) 13 | class(input3d_layer), intent(in out) :: self 14 | integer, intent(in) :: input_shape(:) 15 | end subroutine init 16 | 17 | pure module subroutine set(self, values) 18 | class(input3d_layer), intent(in out) :: self 19 | real, intent(in) :: values(:,:,:) 20 | self % output = values 21 | end subroutine set 22 | 23 | end submodule nf_input3d_layer_submodule 24 | -------------------------------------------------------------------------------- /example/mha_simple.f90: -------------------------------------------------------------------------------- 1 | program mha_simple 2 | use nf, only: dense, input, network, sgd, self_attention, flatten 3 | implicit none 4 | type(network) :: net 5 | real, allocatable :: x(:, :), y(:) 6 | integer, parameter :: num_iterations = 500 7 | integer :: n 8 | 9 | print '("Simple")' 10 | print '(60("="))' 11 | 12 | net = network([ & 13 | input(3, 8), & 14 | self_attention(4), & 15 | flatten(), & 16 | dense(2) & 17 | ]) 18 | 19 | call net % print_info() 20 | 21 | allocate(x(3, 8)) 22 | call random_number(x) 23 | 24 | y = [0.123456, 0.246802] 25 | 26 | do n = 0, num_iterations 27 | 28 | call net % forward(x) 29 | call net % backward(y) 30 | call net % update(optimizer=sgd(learning_rate=1.)) 31 | 32 | if (mod(n, 50) == 0) & 33 | print '(i4,2(3x,f8.6))', n, net % predict(x) 34 | 35 | end do 36 | 37 | end program mha_simple 38 | -------------------------------------------------------------------------------- /src/nf/nf_parallel_submodule.f90: -------------------------------------------------------------------------------- 1 | #ifndef PARALLEL 2 | #define num_images() 1 3 | #define this_image() 1 4 | #endif 5 | 6 | submodule(nf_parallel) nf_parallel_submodule 7 | implicit none 8 | contains 9 | 10 | pure module function tile_indices(dims) result(res) 11 | integer, intent(in) :: dims 12 | integer :: res(2) 13 | integer :: offset, tile_size 14 | 15 | tile_size = dims / num_images() 16 | 17 | ! start and end indices assuming equal tile sizes 18 | res(1) = (this_image() - 1) * tile_size + 1 19 | res(2) = res(1) + tile_size - 1 20 | 21 | ! if we have any remainder, distribute it to the tiles at the end 22 | offset = num_images() - mod(dims, num_images()) 23 | if (this_image() > offset) then 24 | res(1) = res(1) + this_image() - offset - 1 25 | res(2) = res(2) + this_image() - offset 26 | end if 27 | 28 | end function tile_indices 29 | 30 | end submodule nf_parallel_submodule 31 | -------------------------------------------------------------------------------- /test/test_dense_layer.f90: -------------------------------------------------------------------------------- 1 | program test_dense_layer 2 | use nf, only: dense, layer, relu 3 | use tuff, only: test, test_result 4 | implicit none 5 | type(layer) :: layer1, layer2, layer3 6 | type(test_result) :: tests 7 | 8 | layer1 = dense(10) 9 | layer2 = dense(10, activation=relu()) 10 | layer3 = dense(20) 11 | call layer3 % init(layer1) 12 | 13 | tests = test("test_dense_layer", [ & 14 | test("layer name is set", layer1 % name == 'dense'), & 15 | test("layer shape is correct", all(layer1 % layer_shape == [10])), & 16 | test("layer is initialized", layer3 % initialized), & 17 | test("layer's default activation is sigmoid", layer1 % activation == 'sigmoid'), & 18 | test("user set activation works", layer2 % activation == 'relu'), & 19 | test("layer initialized after init", layer3 % initialized), & 20 | test("layer input shape is set after init", all(layer3 % input_layer_shape == [10])) & 21 | ]) 22 | 23 | end program test_dense_layer 24 | -------------------------------------------------------------------------------- /src/nf.f90: -------------------------------------------------------------------------------- 1 | module nf 2 | !! User API: everything an application needs to reference directly 3 | use nf_datasets_mnist, only: label_digits, load_mnist 4 | use nf_layer, only: layer 5 | use nf_layer_constructors, only: & 6 | conv, & 7 | dense, & 8 | dropout, & 9 | embedding, & 10 | flatten, & 11 | input, & 12 | layernorm, & 13 | linear2d, & 14 | locally_connected, & 15 | maxpool, & 16 | reshape, & 17 | self_attention 18 | use nf_loss, only: mse, quadratic 19 | use nf_metrics, only: corr, maxabs 20 | use nf_network, only: network 21 | use nf_optimizers, only: sgd, rmsprop, adam, adagrad 22 | use nf_activation, only: activation_function, elu, exponential, & 23 | gaussian, linear, relu, leaky_relu, & 24 | sigmoid, softmax, softplus, step, tanhf, & 25 | celu 26 | use nf_linear2d_layer, only: linear2d_layer 27 | use nf_multihead_attention_layer, only: multihead_attention_layer 28 | end module nf 29 | -------------------------------------------------------------------------------- /src/nf/nf_base_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_base_layer 2 | 3 | !! This module provides the abstract base layer type, to be extended by 4 | !! specific concrete types. 5 | 6 | implicit none 7 | 8 | private 9 | public :: base_layer 10 | 11 | type, abstract :: base_layer 12 | 13 | !! This type is the base for creating concrete layer instances. 14 | !! Extend this type when creating other concrete layer types. 15 | 16 | character(:), allocatable :: activation_name 17 | 18 | contains 19 | 20 | procedure(init_interface), deferred :: init 21 | 22 | end type base_layer 23 | 24 | abstract interface 25 | subroutine init_interface(self, input_shape) 26 | !! Initialize the internal layer data structures. 27 | import :: base_layer 28 | class(base_layer), intent(in out) :: self 29 | !! Layer instance 30 | integer, intent(in) :: input_shape(:) 31 | !! Shape of the input layer, i.e. the layer that precedes 32 | !! this layer 33 | end subroutine init_interface 34 | end interface 35 | 36 | end module nf_base_layer 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2018-2025 neural-fortran contributors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /example/sine.f90: -------------------------------------------------------------------------------- 1 | program sine 2 | use nf, only: dense, input, network, sgd 3 | implicit none 4 | type(network) :: net 5 | real :: x(1), y(1) 6 | real, parameter :: pi = 4 * atan(1.) 7 | integer, parameter :: num_iterations = 100000 8 | integer, parameter :: test_size = 30 9 | real :: xtest(test_size), ytest(test_size), ypred(test_size) 10 | integer :: i, n 11 | 12 | print '("Sine training")' 13 | print '(60("="))' 14 | 15 | net = network([ & 16 | input(1), & 17 | dense(5), & 18 | dense(1) & 19 | ]) 20 | 21 | call net % print_info() 22 | 23 | xtest = [((i - 1) * 2 * pi / test_size, i = 1, test_size)] 24 | ytest = (sin(xtest) + 1) / 2 25 | 26 | do n = 0, num_iterations 27 | 28 | call random_number(x) 29 | x = x * 2 * pi 30 | y = (sin(x) + 1) / 2 31 | 32 | call net % forward(x) 33 | call net % backward(y) 34 | call net % update(optimizer=sgd(learning_rate=1.)) 35 | 36 | if (mod(n, 10000) == 0) then 37 | ypred = [(net % predict([xtest(i)]), i = 1, test_size)] 38 | print '(i0,1x,f9.6)', n, sum((ypred - ytest)**2) / size(ypred) 39 | end if 40 | 41 | end do 42 | 43 | end program sine 44 | -------------------------------------------------------------------------------- /src/nf/nf_random.f90: -------------------------------------------------------------------------------- 1 | module nf_random 2 | 3 | !! Provides a random number generator with normal distribution, 4 | !! centered on zero, and a Fisher-Yates shuffle. 5 | 6 | implicit none 7 | 8 | private 9 | public :: random_normal, shuffle 10 | 11 | real, parameter :: pi = 4 * atan(1.d0) 12 | 13 | contains 14 | 15 | impure elemental subroutine random_normal(x) 16 | !! Sample random numbers from a normal distribution using a Box-Muller 17 | !! formula. 18 | real, intent(out) :: x 19 | !! Scalar or array to be filled with random numbers 20 | real :: u(2) 21 | call random_number(u) 22 | u(1) = 1 - u(1) 23 | x = sqrt(- 2 * log(u(1))) * cos(2 * pi * u(2)) 24 | end subroutine random_normal 25 | 26 | 27 | subroutine shuffle(x) 28 | !! Fisher-Yates shuffle. 29 | real, intent(in out) :: x(:) 30 | !! Array to shuffle 31 | integer :: i, j 32 | real :: r, temp 33 | 34 | do i = size(x), 2, -1 35 | call random_number(r) 36 | j = floor(r * i) + 1 37 | temp = x(i) 38 | x(i) = x(j) 39 | x(j) = temp 40 | end do 41 | 42 | end subroutine shuffle 43 | 44 | end module nf_random 45 | -------------------------------------------------------------------------------- /src/nf/nf_loss_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_loss) nf_loss_submodule 2 | 3 | implicit none 4 | 5 | contains 6 | 7 | pure module function quadratic_eval(true, predicted) result(res) 8 | real, intent(in) :: true(:) 9 | real, intent(in) :: predicted(:) 10 | real :: res 11 | res = sum((predicted - true)**2) / 2 12 | end function quadratic_eval 13 | 14 | pure module function quadratic_derivative(true, predicted) result(res) 15 | real, intent(in) :: true(:) 16 | real, intent(in) :: predicted(:) 17 | real :: res(size(true)) 18 | res = predicted - true 19 | end function quadratic_derivative 20 | 21 | pure module function mse_eval(true, predicted) result(res) 22 | real, intent(in) :: true(:) 23 | real, intent(in) :: predicted(:) 24 | real :: res 25 | res = sum((predicted - true)**2) / size(true) 26 | end function mse_eval 27 | 28 | pure module function mse_derivative(true, predicted) result(res) 29 | real, intent(in) :: true(:) 30 | real, intent(in) :: predicted(:) 31 | real :: res(size(true)) 32 | res = 2 * (predicted - true) / size(true) 33 | end function mse_derivative 34 | 35 | end submodule nf_loss_submodule 36 | -------------------------------------------------------------------------------- /example/network_parameters.f90: -------------------------------------------------------------------------------- 1 | program network_parameters 2 | ! This program demonstrates how to access network parameters (weights and 3 | ! biases) from the layers' internal data structures. 4 | use nf, only: dense, input, layer, network 5 | use nf_conv2d_layer, only: conv2d_layer 6 | use nf_dense_layer, only: dense_layer 7 | 8 | implicit none 9 | 10 | type(network) :: net 11 | integer :: n 12 | 13 | net = network([input(3), dense(5), dense(2)]) 14 | 15 | do n = 1, size(net % layers) 16 | print *, "Layer ", n, "is " // net % layers(n) % name 17 | select type (this_layer => net % layers(n) % p) 18 | type is (dense_layer) 19 | print *, " with weights of shape", shape(this_layer % weights) 20 | print *, " and ", size(this_layer % biases), " biases" 21 | print *, "Weights are:" 22 | print *, this_layer % weights 23 | type is (conv2d_layer) 24 | print *, " with kernel of shape", shape(this_layer % kernel) 25 | print *, " and ", size(this_layer % biases), " biases" 26 | print *, "Kernel is:" 27 | print *, this_layer % kernel 28 | class default 29 | print *, " with no parameters" 30 | end select 31 | end do 32 | 33 | end program network_parameters -------------------------------------------------------------------------------- /cmake/Findneural-fortran.cmake: -------------------------------------------------------------------------------- 1 | # Find the native neural-fortran includes and library 2 | # 3 | # neural-fortran_INCLUDE_DIRS - where to find nf.mod, etc. 4 | # neural-fortran_LIBRARIES - List of libraries when using neural-fortran. 5 | # neural-fortran_FOUND - True if neural-fortran found. 6 | # 7 | # To use neural-fortran_ROOT_DIR to specify the prefix directory of neural-fortran 8 | 9 | 10 | find_path(neural-fortran_INCLUDE_DIRS 11 | NAMES nf.mod 12 | HINTS ${neural-fortran_ROOT_DIR}/include ENV neural-fortran_INCLUDE_DIR) 13 | 14 | find_library(neural-fortran_LIBRARIES 15 | NAMES neural-fortran 16 | HINTS ${neural-fortran_ROOT_DIR}/lib ENV neural-fortran_LIB_DIR) 17 | 18 | include(FindPackageHandleStandardArgs) 19 | find_package_handle_standard_args(neural-fortran DEFAULT_MSG neural-fortran_LIBRARIES neural-fortran_INCLUDE_DIRS) 20 | 21 | mark_as_advanced( 22 | neural-fortran_LIBRARIES 23 | neural-fortran_INCLUDE_DIRS) 24 | 25 | if(neural-fortran_FOUND AND NOT (TARGET neural-fortran::neural-fortran)) 26 | add_library (neural-fortran::neural-fortran STATIC IMPORTED) 27 | set_target_properties(neural-fortran::neural-fortran 28 | PROPERTIES 29 | IMPORTED_LOCATION ${neural-fortran_LIBRARIES} 30 | INTERFACE_INCLUDE_DIRECTORIES ${neural-fortran_INCLUDE_DIRS}) 31 | endif() 32 | -------------------------------------------------------------------------------- /cmake/options.cmake: -------------------------------------------------------------------------------- 1 | option(PARALLEL "Parallel execution") 2 | option(${PROJECT_NAME}_BUILD_TESTING "build ${PROJECT_NAME} tests" true) 3 | option(${PROJECT_NAME}_BUILD_EXAMPLES "build ${PROJECT_NAME} examples" true) 4 | 5 | # Set output paths for modules, archives, and executables 6 | set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include) 7 | set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib) 8 | set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib) 9 | set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin) 10 | 11 | if(PARALLEL) 12 | message(STATUS "Configuring build for parallel execution") 13 | else() 14 | message(STATUS "Configuring build for serial execution; configure with -DPARALLEL=1 for a parallel build") 15 | endif() 16 | 17 | # --- Generally useful CMake project options 18 | 19 | # Rpath options necessary for shared library install to work correctly in user projects 20 | set(CMAKE_INSTALL_NAME_DIR ${CMAKE_INSTALL_PREFIX}/lib) 21 | set(CMAKE_INSTALL_RPATH ${CMAKE_INSTALL_PREFIX}/lib) 22 | set(CMAKE_INSTALL_RPATH_USE_LINK_PATH true) 23 | 24 | # Necessary for shared library with Visual Studio / Windows oneAPI 25 | set(CMAKE_WINDOWS_EXPORT_ALL_SYMBOLS true) 26 | 27 | # --- auto-ignore build directory 28 | if(NOT EXISTS ${PROJECT_BINARY_DIR}/.gitignore) 29 | file(WRITE ${PROJECT_BINARY_DIR}/.gitignore "*") 30 | endif() 31 | -------------------------------------------------------------------------------- /src/nf/nf_datasets_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_datasets) nf_datasets_submodule 2 | 3 | implicit none 4 | 5 | integer, parameter :: message_len = 128 6 | 7 | contains 8 | 9 | module subroutine download_and_unpack(url) 10 | character(*), intent(in) :: url 11 | character(:), allocatable :: command, error_message, filename 12 | integer :: cmdstat, exitstat 13 | character(message_len) :: cmdmsg 14 | 15 | filename = url(index(url, '/', back=.true.) + 1:) 16 | command = 'curl -LO ' // url 17 | 18 | call execute_command_line(command, wait=.true., & 19 | exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) 20 | 21 | if (any([exitstat, cmdstat] /= 0)) then 22 | error_message = 'cmd "' // command // '" failed' 23 | if (cmdstat /= 0) & 24 | error_message = error_message // " with message " // trim(cmdmsg) 25 | error stop error_message 26 | end if 27 | 28 | command = 'tar xvzf ' // filename 29 | 30 | call execute_command_line(command, wait=.true., & 31 | exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) 32 | 33 | if (any([exitstat, cmdstat] /= 0)) then 34 | error_message = 'cmd "' // command // '" failed' 35 | if (cmdstat /= 0) & 36 | error_message = error_message // " with message " // trim(cmdmsg) 37 | error stop error_message 38 | end if 39 | 40 | end subroutine download_and_unpack 41 | 42 | end submodule nf_datasets_submodule 43 | -------------------------------------------------------------------------------- /test/test_loss.f90: -------------------------------------------------------------------------------- 1 | program test_loss 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: mse, quadratic 5 | 6 | implicit none 7 | 8 | logical :: ok = .true. 9 | 10 | block 11 | 12 | type(mse) :: loss 13 | real :: true(2) = [1., 2.] 14 | real :: pred(2) = [3., 4.] 15 | 16 | if (.not. loss % eval(true, pred) == 4) then 17 | write(stderr, '(a)') 'expected output of mse % eval().. failed' 18 | ok = .false. 19 | end if 20 | 21 | if (.not. all(loss % derivative(true, pred) == [2, 2])) then 22 | write(stderr, '(a)') 'expected output of mse % derivative().. failed' 23 | ok = .false. 24 | end if 25 | 26 | end block 27 | 28 | block 29 | 30 | type(quadratic) :: loss 31 | real :: true(4) = [1., 2., 3., 4.] 32 | real :: pred(4) = [3., 4., 5., 6.] 33 | 34 | if (.not. loss % eval(true, pred) == 8) then 35 | write(stderr, '(a)') 'expected output of quadratic % eval().. failed' 36 | ok = .false. 37 | end if 38 | 39 | if (.not. all(loss % derivative(true, pred) == [2, 2, 2, 2])) then 40 | write(stderr, '(a)') 'expected output of quadratic % derivative().. failed' 41 | ok = .false. 42 | end if 43 | 44 | end block 45 | 46 | if (ok) then 47 | print '(a)', 'test_loss: All tests passed.' 48 | else 49 | write(stderr, '(a)') 'test_loss: One or more tests failed.' 50 | stop 1 51 | end if 52 | 53 | end program test_loss -------------------------------------------------------------------------------- /src/nf/nf_datasets.f90: -------------------------------------------------------------------------------- 1 | module nf_datasets 2 | 3 | !! This module provides URLs to archived models and datasets, 4 | !! for use in testing and examples, as well as a subroutine to download 5 | !! and unpack these files. 6 | 7 | implicit none 8 | 9 | private 10 | 11 | public :: & 12 | download_and_unpack, & 13 | keras_cnn_mnist_url, & 14 | keras_dense_mnist_url, & 15 | keras_reshape_url, & 16 | mnist_url 17 | 18 | character(*), parameter :: keras_snippets_baseurl = & 19 | 'https://github.com/neural-fortran/keras-snippets/files' 20 | character(*), parameter :: neural_fortran_baseurl = & 21 | 'https://github.com/modern-fortran/neural-fortran/files' 22 | character(*), parameter :: keras_cnn_mnist_url = & 23 | keras_snippets_baseurl // '/8892585/keras_cnn_mnist.tar.gz' 24 | character(*), parameter :: keras_dense_mnist_url = & 25 | keras_snippets_baseurl // '/8788739/keras_dense_mnist.tar.gz' 26 | character(*), parameter :: keras_reshape_url = & 27 | keras_snippets_baseurl // '/9667603/keras_reshape.tar.gz' 28 | character(*), parameter :: mnist_url = & 29 | neural_fortran_baseurl // '/8498876/mnist.tar.gz' 30 | 31 | interface 32 | 33 | module subroutine download_and_unpack(url) 34 | !! Download and unpack a file from `url`. 35 | character(*), intent(in) :: url 36 | !! URL to download from 37 | end subroutine download_and_unpack 38 | 39 | end interface 40 | 41 | end module nf_datasets 42 | -------------------------------------------------------------------------------- /test/test_input2d_layer.f90: -------------------------------------------------------------------------------- 1 | program test_input2d_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: input, layer 5 | use nf_input2d_layer, only: input2d_layer 6 | 7 | implicit none 8 | 9 | type(layer) :: test_layer 10 | real, allocatable :: output(:,:) 11 | logical :: ok = .true. 12 | 13 | test_layer = input(3, 32) 14 | 15 | if (.not. test_layer % name == 'input') then 16 | ok = .false. 17 | write(stderr, '(a)') 'input2d layer has its name set correctly.. failed' 18 | end if 19 | 20 | if (.not. test_layer % initialized) then 21 | ok = .false. 22 | write(stderr, '(a)') 'input2d layer should be marked as initialized.. failed' 23 | end if 24 | 25 | if (.not. all(test_layer % layer_shape == [3, 32])) then 26 | ok = .false. 27 | write(stderr, '(a)') 'input2d layer is created with requested size.. failed' 28 | end if 29 | 30 | if (.not. size(test_layer % input_layer_shape) == 0) then 31 | ok = .false. 32 | write(stderr, '(a)') 'input2d layer has no input layer shape.. failed' 33 | end if 34 | 35 | call test_layer % get_output(output) 36 | 37 | if (.not. all(output == 0)) then 38 | ok = .false. 39 | write(stderr, '(a)') 'input2d layer values are all initialized to 0.. failed' 40 | end if 41 | 42 | if (ok) then 43 | print '(a)', 'test_input2d_layer: All tests passed.' 44 | else 45 | write(stderr, '(a)') 'test_input2d_layer: One or more tests failed.' 46 | stop 1 47 | end if 48 | 49 | end program test_input2d_layer 50 | -------------------------------------------------------------------------------- /test/test_input3d_layer.f90: -------------------------------------------------------------------------------- 1 | program test_input3d_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: input, layer 5 | use nf_input1d_layer, only: input1d_layer 6 | 7 | implicit none 8 | 9 | type(layer) :: test_layer 10 | real, allocatable :: output(:,:,:) 11 | logical :: ok = .true. 12 | 13 | test_layer = input(3, 32, 32) 14 | 15 | if (.not. test_layer % name == 'input') then 16 | ok = .false. 17 | write(stderr, '(a)') 'input3d layer has its name set correctly.. failed' 18 | end if 19 | 20 | if (.not. test_layer % initialized) then 21 | ok = .false. 22 | write(stderr, '(a)') 'input3d layer should be marked as initialized.. failed' 23 | end if 24 | 25 | if (.not. all(test_layer % layer_shape == [3, 32, 32])) then 26 | ok = .false. 27 | write(stderr, '(a)') 'input1d layer is created with requested size.. failed' 28 | end if 29 | 30 | if (.not. size(test_layer % input_layer_shape) == 0) then 31 | ok = .false. 32 | write(stderr, '(a)') 'input3d layer has no input layer shape.. failed' 33 | end if 34 | 35 | call test_layer % get_output(output) 36 | 37 | if (.not. all(output == 0)) then 38 | ok = .false. 39 | write(stderr, '(a)') 'input3d layer values are all initialized to 0.. failed' 40 | end if 41 | 42 | if (ok) then 43 | print '(a)', 'test_input3d_layer: All tests passed.' 44 | else 45 | write(stderr, '(a)') 'test_input3d_layer: One or more tests failed.' 46 | stop 1 47 | end if 48 | 49 | end program test_input3d_layer 50 | -------------------------------------------------------------------------------- /src/nf/io/nf_io_binary.f90: -------------------------------------------------------------------------------- 1 | module nf_io_binary 2 | 3 | !! This module provides subroutines to read binary files using direct access. 4 | 5 | implicit none 6 | 7 | private 8 | public :: read_binary_file 9 | 10 | interface read_binary_file 11 | 12 | module subroutine read_binary_file_1d(filename, dtype, nrec, array) 13 | !! Read a binary file into a 1-d real array using direct access. 14 | implicit none 15 | character(*), intent(in) :: filename 16 | !! Path to the file to read 17 | integer, intent(in) :: dtype 18 | !! Number of bytes per element 19 | integer, intent(in) :: nrec 20 | !! Number of records to read 21 | real, allocatable, intent(in out) :: array(:) 22 | !! Array to store the data in 23 | end subroutine read_binary_file_1d 24 | 25 | module subroutine read_binary_file_2d(filename, dtype, dsize, nrec, array) 26 | !! Read a binary file into a 2-d real array using direct access. 27 | implicit none 28 | character(*), intent(in) :: filename 29 | !! Path to the file to read 30 | integer, intent(in) :: dtype 31 | !! Number of bytes per element 32 | integer, intent(in) :: dsize 33 | !! Number of elements in a record 34 | integer, intent(in) :: nrec 35 | !! Number of records to read 36 | real, allocatable, intent(in out) :: array(:,:) 37 | !! Array to store the data in 38 | end subroutine read_binary_file_2d 39 | 40 | end interface read_binary_file 41 | 42 | end module nf_io_binary 43 | -------------------------------------------------------------------------------- /src/nf/nf_input2d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_input2d_layer 2 | 3 | !! This module provides the `input2d_layer` type. 4 | 5 | use nf_base_layer, only: base_layer 6 | implicit none 7 | 8 | private 9 | public :: input2d_layer 10 | 11 | type, extends(base_layer) :: input2d_layer 12 | real, allocatable :: output(:,:) 13 | contains 14 | procedure :: init 15 | procedure :: set 16 | end type input2d_layer 17 | 18 | interface input2d_layer 19 | pure module function input2d_layer_cons(output_shape) result(res) 20 | !! Create a new instance of the 2-d input layer. 21 | !! Only used internally by the `layer % init` method. 22 | integer, intent(in) :: output_shape(2) 23 | !! Shape of the input layer 24 | type(input2d_layer) :: res 25 | !! 2-d input layer instance 26 | end function input2d_layer_cons 27 | end interface input2d_layer 28 | 29 | interface 30 | 31 | module subroutine init(self, input_shape) 32 | !! Only here to satisfy the language rules 33 | !! about deferred methods of abstract types. 34 | !! This method does nothing for this type and should not be called. 35 | class(input2d_layer), intent(in out) :: self 36 | integer, intent(in) :: input_shape(:) 37 | end subroutine init 38 | 39 | pure module subroutine set(self, values) 40 | class(input2d_layer), intent(in out) :: self 41 | !! Layer instance 42 | real, intent(in) :: values(:,:) 43 | !! Values to set 44 | end subroutine set 45 | 46 | end interface 47 | 48 | end module nf_input2d_layer -------------------------------------------------------------------------------- /src/nf/nf_input3d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_input3d_layer 2 | 3 | !! This module provides the `input3d_layer` type. 4 | 5 | use nf_base_layer, only: base_layer 6 | implicit none 7 | 8 | private 9 | public :: input3d_layer 10 | 11 | type, extends(base_layer) :: input3d_layer 12 | real, allocatable :: output(:,:,:) 13 | contains 14 | procedure :: init 15 | procedure :: set 16 | end type input3d_layer 17 | 18 | interface input3d_layer 19 | pure module function input3d_layer_cons(output_shape) result(res) 20 | !! Create a new instance of the 3-d input layer. 21 | !! Only used internally by the `layer % init` method. 22 | integer, intent(in) :: output_shape(3) 23 | !! Shape of the input layer 24 | type(input3d_layer) :: res 25 | !! 3-d input layer instance 26 | end function input3d_layer_cons 27 | end interface input3d_layer 28 | 29 | interface 30 | 31 | module subroutine init(self, input_shape) 32 | !! Only here to satisfy the language rules 33 | !! about deferred methods of abstract types. 34 | !! This method does nothing for this type and should not be called. 35 | class(input3d_layer), intent(in out) :: self 36 | integer, intent(in) :: input_shape(:) 37 | end subroutine init 38 | 39 | pure module subroutine set(self, values) 40 | class(input3d_layer), intent(in out) :: self 41 | !! Layer instance 42 | real, intent(in) :: values(:,:,:) 43 | !! Values to set 44 | end subroutine set 45 | 46 | end interface 47 | 48 | end module nf_input3d_layer 49 | -------------------------------------------------------------------------------- /src/nf/nf_reshape2d_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_reshape2d_layer) nf_reshape2d_layer_submodule 2 | 3 | use nf_base_layer, only: base_layer 4 | 5 | implicit none 6 | 7 | contains 8 | 9 | pure module function reshape2d_layer_cons(output_shape) result(res) 10 | integer, intent(in) :: output_shape(2) 11 | type(reshape2d_layer) :: res 12 | res % output_shape = output_shape 13 | end function reshape2d_layer_cons 14 | 15 | 16 | pure module subroutine backward(self, input, gradient) 17 | class(reshape2d_layer), intent(in out) :: self 18 | real, intent(in) :: input(:) 19 | real, intent(in) :: gradient(:,:) 20 | ! The `input` dummy argument is not used but nevertheless declared 21 | ! because the abstract type requires it. 22 | self % gradient = pack(gradient, .true.) 23 | end subroutine backward 24 | 25 | 26 | pure module subroutine forward(self, input) 27 | class(reshape2d_layer), intent(in out) :: self 28 | real, intent(in) :: input(:) 29 | self % output = reshape(input, self % output_shape) 30 | end subroutine forward 31 | 32 | 33 | module subroutine init(self, input_shape) 34 | class(reshape2d_layer), intent(in out) :: self 35 | integer, intent(in) :: input_shape(:) 36 | 37 | self % input_shape = input_shape 38 | 39 | allocate(self % gradient(input_shape(1))) 40 | self % gradient = 0 41 | 42 | allocate(self % output( & 43 | self % output_shape(1), & 44 | self % output_shape(2) & 45 | )) 46 | self % output = 0 47 | 48 | end subroutine init 49 | 50 | end submodule nf_reshape2d_layer_submodule 51 | -------------------------------------------------------------------------------- /src/nf/nf_input1d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_input1d_layer 2 | 3 | !! This module provides the `input1d_layer` type. 4 | 5 | use nf_base_layer, only: base_layer 6 | 7 | implicit none 8 | 9 | private 10 | public :: input1d_layer 11 | 12 | type, extends(base_layer) :: input1d_layer 13 | real, allocatable :: output(:) 14 | contains 15 | procedure :: init 16 | procedure :: set 17 | end type input1d_layer 18 | 19 | interface input1d_layer 20 | pure module function input1d_layer_cons(output_size) result(res) 21 | !! Create a new instance of the 1-d input layer. 22 | !! Only used internally by the `layer % init` method. 23 | integer, intent(in) :: output_size 24 | !! Size of the input layer 25 | type(input1d_layer) :: res 26 | !! 1-d input layer instance 27 | end function input1d_layer_cons 28 | end interface input1d_layer 29 | 30 | interface 31 | 32 | module subroutine init(self, input_shape) 33 | !! Only here to satisfy the language rules 34 | !! about deferred methods of abstract types. 35 | !! This method does nothing for this type and should not be called. 36 | class(input1d_layer), intent(in out) :: self 37 | integer, intent(in) :: input_shape(:) 38 | end subroutine init 39 | 40 | pure module subroutine set(self, values) 41 | !! Set values on this layer. 42 | class(input1d_layer), intent(in out) :: self 43 | !! Layer instance 44 | real, intent(in) :: values(:) 45 | !! Values to set 46 | end subroutine set 47 | 48 | end interface 49 | 50 | end module nf_input1d_layer 51 | -------------------------------------------------------------------------------- /src/nf/nf_reshape3d_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_reshape3d_layer) nf_reshape3d_layer_submodule 2 | 3 | use nf_base_layer, only: base_layer 4 | 5 | implicit none 6 | 7 | contains 8 | 9 | pure module function reshape3d_layer_cons(output_shape) result(res) 10 | integer, intent(in) :: output_shape(3) 11 | type(reshape3d_layer) :: res 12 | res % output_shape = output_shape 13 | end function reshape3d_layer_cons 14 | 15 | 16 | pure module subroutine backward(self, input, gradient) 17 | class(reshape3d_layer), intent(in out) :: self 18 | real, intent(in) :: input(:) 19 | real, intent(in) :: gradient(:,:,:) 20 | ! The `input` dummy argument is not used but nevertheless declared 21 | ! because the abstract type requires it. 22 | self % gradient = pack(gradient, .true.) 23 | end subroutine backward 24 | 25 | 26 | pure module subroutine forward(self, input) 27 | class(reshape3d_layer), intent(in out) :: self 28 | real, intent(in) :: input(:) 29 | self % output = reshape(input, self % output_shape) 30 | end subroutine forward 31 | 32 | 33 | module subroutine init(self, input_shape) 34 | class(reshape3d_layer), intent(in out) :: self 35 | integer, intent(in) :: input_shape(:) 36 | 37 | self % input_shape = input_shape 38 | 39 | allocate(self % gradient(input_shape(1))) 40 | self % gradient = 0 41 | 42 | allocate(self % output( & 43 | self % output_shape(1), & 44 | self % output_shape(2), & 45 | self % output_shape(3) & 46 | )) 47 | self % output = 0 48 | 49 | end subroutine init 50 | 51 | end submodule nf_reshape3d_layer_submodule 52 | -------------------------------------------------------------------------------- /src/nf/io/nf_io_binary_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_io_binary) nf_io_binary_submodule 2 | 3 | implicit none 4 | 5 | integer, parameter :: message_len = 128 6 | 7 | contains 8 | 9 | module subroutine read_binary_file_1d(filename, dtype, nrec, array) 10 | character(*), intent(in) :: filename 11 | integer, intent(in) :: dtype, nrec 12 | real, allocatable, intent(in out) :: array(:) 13 | integer :: fileunit 14 | character(message_len) :: io_message 15 | integer :: io_status 16 | io_status = 0 17 | open(newunit=fileunit, file=filename, access='direct', action='read', & 18 | recl=dtype * nrec, status='old', iostat=io_status, iomsg=io_message) 19 | if (io_status /= 0) error stop trim(io_message) 20 | allocate(array(nrec)) 21 | read(fileunit, rec=1) array 22 | close(fileunit) 23 | end subroutine read_binary_file_1d 24 | 25 | module subroutine read_binary_file_2d(filename, dtype, dsize, nrec, array) 26 | character(*), intent(in) :: filename 27 | integer, intent(in) :: dtype, dsize, nrec 28 | real, allocatable, intent(in out) :: array(:,:) 29 | integer :: fileunit, i 30 | character(message_len) :: io_message 31 | integer :: io_status 32 | io_status = 0 33 | open(newunit=fileunit, file=filename, access='direct', action='read', & 34 | recl=dtype * dsize, status='old', iostat=io_status, iomsg=io_message) 35 | if (io_status /= 0) error stop trim(io_message) 36 | allocate(array(dsize, nrec)) 37 | do i = 1, nrec 38 | read(fileunit, rec=i) array(:,i) 39 | end do 40 | close(fileunit) 41 | end subroutine read_binary_file_2d 42 | 43 | end submodule nf_io_binary_submodule 44 | -------------------------------------------------------------------------------- /src/nf/nf_datasets_mnist.f90: -------------------------------------------------------------------------------- 1 | module nf_datasets_mnist 2 | 3 | !! Procedures to work with MNIST dataset, usable with data format 4 | !! as provided in this repo and not the original data format (idx). 5 | 6 | implicit none 7 | 8 | private 9 | public :: label_digits, load_mnist 10 | 11 | interface 12 | 13 | pure module function label_digits(labels) result(res) 14 | !! Converts an array of individual MNIST labels (e.g. 3) 15 | !! into a form that can be used to evaluate against dense layer output, 16 | !! e.g. [0, 0, 0, 1, 0, 0, 0, 0, 0]. 17 | implicit none 18 | real, intent(in) :: labels(:) 19 | !! Array of labels with single digit values in the range 0-9 20 | real :: res(10, size(labels)) 21 | !! 10-element array of zeros and a single one indicating the digit 22 | end function label_digits 23 | 24 | module subroutine load_mnist(training_images, training_labels, & 25 | validation_images, validation_labels, & 26 | testing_images, testing_labels) 27 | !! Loads the MNIST dataset into arrays. 28 | implicit none 29 | real, allocatable, intent(in out) :: training_images(:,:) 30 | real, allocatable, intent(in out) :: training_labels(:) 31 | real, allocatable, intent(in out) :: validation_images(:,:) 32 | real, allocatable, intent(in out) :: validation_labels(:) 33 | real, allocatable, intent(in out), optional :: testing_images(:,:) 34 | real, allocatable, intent(in out), optional :: testing_labels(:) 35 | end subroutine load_mnist 36 | 37 | end interface 38 | 39 | end module nf_datasets_mnist 40 | -------------------------------------------------------------------------------- /test/test_reshape2d_layer.f90: -------------------------------------------------------------------------------- 1 | program test_reshape2d_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: input, network, reshape2d => reshape 5 | 6 | implicit none 7 | 8 | type(network) :: net 9 | real, allocatable :: sample_input(:), output(:,:) 10 | integer, parameter :: output_shape(2) = [4,4] 11 | integer, parameter :: input_size = product(output_shape) 12 | logical :: file_exists 13 | logical :: ok = .true. 14 | 15 | ! Create the network 16 | net = network([ & 17 | input(input_size), & 18 | reshape2d(output_shape(1), output_shape(2)) & 19 | ]) 20 | 21 | if (.not. size(net % layers) == 2) then 22 | write(stderr, '(a)') 'the network should have 2 layers.. failed' 23 | ok = .false. 24 | end if 25 | 26 | ! Initialize test data 27 | allocate(sample_input(input_size)) 28 | call random_number(sample_input) 29 | 30 | ! Propagate forward and get the output 31 | call net % forward(sample_input) 32 | call net % layers(2) % get_output(output) 33 | 34 | ! Check shape of the output 35 | if (.not. all(shape(output) == output_shape)) then 36 | write(stderr, '(a)') 'the reshape layer produces expected output shape.. failed' 37 | ok = .false. 38 | end if 39 | 40 | ! Check if reshaped input matches output 41 | if (.not. all(reshape(sample_input, output_shape) == output)) then 42 | write(stderr, '(a)') 'the reshape layer produces expected output values.. failed' 43 | ok = .false. 44 | end if 45 | 46 | if (ok) then 47 | print '(a)', 'test_reshape2d_layer: All tests passed.' 48 | else 49 | write(stderr, '(a)') 'test_reshape2d_layer: One or more tests failed.' 50 | stop 1 51 | end if 52 | 53 | end program test_reshape2d_layer 54 | -------------------------------------------------------------------------------- /test/test_reshape_layer.f90: -------------------------------------------------------------------------------- 1 | program test_reshape_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: input, network, reshape3d => reshape 5 | use nf_datasets, only: download_and_unpack, keras_reshape_url 6 | 7 | implicit none 8 | 9 | type(network) :: net 10 | real, allocatable :: sample_input(:), output(:,:,:) 11 | integer, parameter :: output_shape(3) = [3, 32, 32] 12 | integer, parameter :: input_size = product(output_shape) 13 | character(*), parameter :: keras_reshape_path = 'keras_reshape.h5' 14 | logical :: file_exists 15 | logical :: ok = .true. 16 | 17 | ! Create the network 18 | net = network([ & 19 | input(input_size), & 20 | reshape3d(3, 32, 32) & 21 | ]) 22 | 23 | if (.not. size(net % layers) == 2) then 24 | write(stderr, '(a)') 'the network should have 2 layers.. failed' 25 | ok = .false. 26 | end if 27 | 28 | ! Initialize test data 29 | allocate(sample_input(input_size)) 30 | call random_number(sample_input) 31 | 32 | ! Propagate forward and get the output 33 | call net % forward(sample_input) 34 | call net % layers(2) % get_output(output) 35 | 36 | if (.not. all(shape(output) == output_shape)) then 37 | write(stderr, '(a)') 'the reshape layer produces expected output shape.. failed' 38 | ok = .false. 39 | end if 40 | 41 | if (.not. all(reshape(sample_input, output_shape) == output)) then 42 | write(stderr, '(a)') 'the reshape layer produces expected output values.. failed' 43 | ok = .false. 44 | end if 45 | 46 | if (ok) then 47 | print '(a)', 'test_reshape_layer: All tests passed.' 48 | else 49 | write(stderr, '(a)') 'test_reshape_layer: One or more tests failed.' 50 | stop 1 51 | end if 52 | 53 | end program test_reshape_layer 54 | -------------------------------------------------------------------------------- /test/test_insert_flatten.f90: -------------------------------------------------------------------------------- 1 | program test_insert_flatten 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: network, input, conv, maxpool, flatten, dense, reshape 5 | 6 | implicit none 7 | 8 | type(network) :: net 9 | logical :: ok = .true. 10 | 11 | net = network([ & 12 | input(3, 32, 32), & 13 | dense(10) & 14 | ]) 15 | 16 | if (.not. net % layers(2) % name == 'flatten') then 17 | ok = .false. 18 | write(stderr, '(a)') 'flatten layer inserted after input3d.. failed' 19 | end if 20 | 21 | net = network([ & 22 | input(3, 32, 32), & 23 | conv(filters=1, kernel_width=3, kernel_height=3), & 24 | dense(10) & 25 | ]) 26 | 27 | !call net % print_info() 28 | 29 | if (.not. net % layers(3) % name == 'flatten') then 30 | ok = .false. 31 | write(stderr, '(a)') 'flatten layer inserted after conv2d.. failed' 32 | end if 33 | 34 | net = network([ & 35 | input(3, 32, 32), & 36 | conv(filters=1, kernel_width=3, kernel_height=3), & 37 | maxpool(pool_width=2, stride=2), & 38 | dense(10) & 39 | ]) 40 | 41 | if (.not. net % layers(4) % name == 'flatten') then 42 | ok = .false. 43 | write(stderr, '(a)') 'flatten layer inserted after maxpool.. failed' 44 | end if 45 | 46 | net = network([ & 47 | input(4), & 48 | reshape(1, 2, 2), & 49 | dense(4) & 50 | ]) 51 | 52 | if (.not. net % layers(3) % name == 'flatten') then 53 | ok = .false. 54 | write(stderr, '(a)') 'flatten layer inserted after reshape.. failed' 55 | end if 56 | 57 | if (ok) then 58 | print '(a)', 'test_insert_flatten: All tests passed.' 59 | else 60 | write(stderr, '(a)') 'test_insert_flatten: One or more tests failed.' 61 | stop 1 62 | end if 63 | 64 | end program test_insert_flatten -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: ci 2 | 3 | on: 4 | 5 | push: 6 | paths: 7 | - ".github/workflows/ci.yml" 8 | - "fpm.toml" 9 | - "**.f90" 10 | - "CMakelists.txt" 11 | 12 | pull_request: 13 | paths: 14 | - ".github/workflows/ci.yml" 15 | - "fpm.toml" 16 | - "**.f90" 17 | - "CMakelists.txt" 18 | 19 | jobs: 20 | 21 | gnu-cmake-debug: 22 | name: gnu-cmake-debug 23 | runs-on: ubuntu-latest 24 | steps: 25 | - uses: actions/checkout@v4 26 | - name: CMake Configure 27 | run: cmake -B build -S . -DCMAKE_BUILD_TYPE=Debug 28 | - name: Compile 29 | run: cmake --build build 30 | - name: Test 31 | run: ctest --test-dir build 32 | 33 | gnu-cmake-release: 34 | name: gnu-cmake-release 35 | runs-on: ubuntu-latest 36 | steps: 37 | - uses: actions/checkout@v4 38 | - name: CMake Configure 39 | run: cmake -B build -S . -DCMAKE_BUILD_TYPE=Release 40 | - name: Compile 41 | run: cmake --build build 42 | - name: Test 43 | run: ctest --test-dir build 44 | 45 | gnu-fpm-debug: 46 | name: gnu-fpm-debug 47 | runs-on: ubuntu-latest 48 | steps: 49 | - uses: fortran-lang/setup-fpm@v5 50 | with: 51 | fpm-version: "v0.10.1" 52 | - uses: actions/checkout@v4 53 | - name: Compile 54 | run: fpm build --profile debug 55 | - name: Test 56 | run: fpm test --profile debug 57 | 58 | gnu-fpm-release: 59 | name: gnu-fpm-release 60 | runs-on: ubuntu-latest 61 | steps: 62 | - uses: fortran-lang/setup-fpm@v5 63 | with: 64 | fpm-version: "v0.10.1" 65 | - uses: actions/checkout@v4 66 | - name: Compile 67 | run: fpm build --profile release 68 | - name: Test 69 | run: fpm test --profile release 70 | -------------------------------------------------------------------------------- /test/test_input1d_layer.f90: -------------------------------------------------------------------------------- 1 | program test_input1d_layer 2 | use iso_fortran_env, only: stderr => error_unit 3 | use nf, only: input, layer 4 | use nf_input1d_layer, only: input1d_layer 5 | implicit none 6 | type(layer) :: test_layer 7 | real, allocatable :: output(:) 8 | logical :: ok = .true. 9 | 10 | test_layer = input(3) 11 | 12 | if (.not. test_layer % name == 'input') then 13 | ok = .false. 14 | write(stderr, '(a)') 'input1d layer has its name set correctly.. failed' 15 | end if 16 | 17 | if (.not. test_layer % initialized) then 18 | ok = .false. 19 | write(stderr, '(a)') 'input1d layer should be marked as initialized.. failed' 20 | end if 21 | 22 | if (.not. all(test_layer % layer_shape == [3])) then 23 | ok = .false. 24 | write(stderr, '(a)') 'input1d layer is created with requested size.. failed' 25 | end if 26 | 27 | if (.not. size(test_layer % input_layer_shape) == 0) then 28 | ok = .false. 29 | write(stderr, '(a)') 'input1d layer has no input layer shape.. failed' 30 | end if 31 | 32 | call test_layer % get_output(output) 33 | 34 | if (.not. all(output == 0)) then 35 | ok = .false. 36 | write(stderr, '(a)') 'input1d layer values are all initialized to 0.. failed' 37 | end if 38 | 39 | select type(input_layer => test_layer % p); type is(input1d_layer) 40 | call input_layer % set([1., 2., 3.]) 41 | end select 42 | 43 | call test_layer % get_output(output) 44 | 45 | if (.not. all(output == [1., 2., 3.])) then 46 | ok = .false. 47 | write(stderr, '(a)') 'input1d layer can have its values set.. failed' 48 | end if 49 | 50 | if (ok) then 51 | print '(a)', 'test_input1d_layer: All tests passed.' 52 | else 53 | write(stderr, '(a)') 'test_input1d_layer: One or more tests failed.' 54 | stop 1 55 | end if 56 | 57 | end program test_input1d_layer 58 | -------------------------------------------------------------------------------- /test/test_dense_network.f90: -------------------------------------------------------------------------------- 1 | program test_dense_network 2 | use iso_fortran_env, only: stderr => error_unit 3 | use nf, only: dense, input, network, sgd 4 | use tuff, only: test, test_result 5 | implicit none 6 | type(network) :: net 7 | type(test_result) :: tests 8 | 9 | ! Minimal 2-layer network 10 | net = network([ & 11 | input(1), & 12 | dense(1) & 13 | ]) 14 | 15 | tests = test("test_dense_network", [ & 16 | test("network has 2 layers", size(net % layers) == 2), & 17 | test("network predicts 0.5 for input 0", all(net % predict([0.]) == 0.5)), & 18 | test(simple_training), & 19 | test(larger_network_size) & 20 | ]) 21 | 22 | contains 23 | 24 | type(test_result) function simple_training() result(res) 25 | real :: x(1), y(1) 26 | real :: tolerance = 1e-3 27 | integer :: n 28 | integer, parameter :: num_iterations = 1000 29 | type(network) :: net 30 | 31 | res % name = 'simple training' 32 | 33 | ! Minimal 2-layer network 34 | net = network([ & 35 | input(1), & 36 | dense(1) & 37 | ]) 38 | 39 | x = [0.123] 40 | y = [0.765] 41 | 42 | do n = 1, num_iterations 43 | call net % forward(x) 44 | call net % backward(y) 45 | call net % update(sgd(learning_rate=1.)) 46 | if (all(abs(net % predict(x) - y) < tolerance)) exit 47 | end do 48 | 49 | res % ok = n <= num_iterations 50 | 51 | end function simple_training 52 | 53 | type(test_result) function larger_network_size() result(res) 54 | type(network) :: net 55 | 56 | res % name = 'larger network training' 57 | 58 | ! A bit larger multi-layer network 59 | net = network([ & 60 | input(784), & 61 | dense(30), & 62 | dense(20), & 63 | dense(10) & 64 | ]) 65 | 66 | res % ok = size(net % layers) == 4 67 | 68 | end function larger_network_size 69 | 70 | end program test_dense_network -------------------------------------------------------------------------------- /src/nf/nf_metrics.f90: -------------------------------------------------------------------------------- 1 | module nf_metrics 2 | 3 | !! This module provides a collection of metric functions. 4 | 5 | implicit none 6 | 7 | private 8 | public :: metric_type 9 | public :: corr 10 | public :: maxabs 11 | 12 | type, abstract :: metric_type 13 | contains 14 | procedure(metric_interface), nopass, deferred :: eval 15 | end type metric_type 16 | 17 | abstract interface 18 | pure function metric_interface(true, predicted) result(res) 19 | real, intent(in) :: true(:) 20 | real, intent(in) :: predicted(:) 21 | real :: res 22 | end function metric_interface 23 | end interface 24 | 25 | type, extends(metric_type) :: corr 26 | !! Pearson correlation 27 | contains 28 | procedure, nopass :: eval => corr_eval 29 | end type corr 30 | 31 | type, extends(metric_type) :: maxabs 32 | !! Maximum absolute difference 33 | contains 34 | procedure, nopass :: eval => maxabs_eval 35 | end type maxabs 36 | 37 | contains 38 | 39 | pure function corr_eval(true, predicted) result(res) 40 | !! Pearson correlation function: 41 | !! 42 | real, intent(in) :: true(:) 43 | !! True values, i.e. labels from training datasets 44 | real, intent(in) :: predicted(:) 45 | !! Values predicted by the network 46 | real :: res 47 | !! Resulting correlation value 48 | real :: m_true, m_pred 49 | 50 | m_true = sum(true) / size(true) 51 | m_pred = sum(predicted) / size(predicted) 52 | 53 | res = dot_product(true - m_true, predicted - m_pred) / & 54 | sqrt(sum((true - m_true)**2)*sum((predicted - m_pred)**2)) 55 | 56 | end function corr_eval 57 | 58 | pure function maxabs_eval(true, predicted) result(res) 59 | !! Maximum absolute difference function: 60 | !! 61 | real, intent(in) :: true(:) 62 | !! True values, i.e. labels from training datasets 63 | real, intent(in) :: predicted(:) 64 | !! Values predicted by the network 65 | real :: res 66 | !! Resulting maximum absolute difference value 67 | 68 | res = maxval(abs(true - predicted)) 69 | 70 | end function maxabs_eval 71 | 72 | end module nf_metrics 73 | -------------------------------------------------------------------------------- /src/nf/nf_flatten_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_flatten_layer) nf_flatten_layer_submodule 2 | 3 | !! This module provides the concrete flatten layer type. 4 | !! It is used internally by the layer type. 5 | !! It is not intended to be used directly by the user. 6 | 7 | 8 | implicit none 9 | 10 | contains 11 | 12 | elemental module function flatten_layer_cons() result(res) 13 | type(flatten_layer) :: res 14 | end function flatten_layer_cons 15 | 16 | 17 | pure module subroutine backward(self, input, gradient) 18 | class(flatten_layer), intent(in out) :: self 19 | real, intent(in) :: input(..) 20 | real, intent(in) :: gradient(:) 21 | select rank(input) 22 | rank(2) 23 | self % gradient_2d = reshape(gradient, shape(input)) 24 | rank(3) 25 | self % gradient_3d = reshape(gradient, shape(input)) 26 | rank default 27 | error stop "Unsupported rank of input" 28 | end select 29 | end subroutine backward 30 | 31 | 32 | pure module subroutine forward(self, input) 33 | class(flatten_layer), intent(in out) :: self 34 | real, intent(in) :: input(..) 35 | select rank(input) 36 | rank(2) 37 | self % output = pack(input, .true.) 38 | rank(3) 39 | self % output = pack(input, .true.) 40 | rank default 41 | error stop "Unsupported rank of input" 42 | end select 43 | end subroutine forward 44 | 45 | 46 | module subroutine init(self, input_shape) 47 | class(flatten_layer), intent(in out) :: self 48 | integer, intent(in) :: input_shape(:) 49 | 50 | self % input_shape = input_shape 51 | self % output_size = product(input_shape) 52 | 53 | if (size(input_shape) == 2) then 54 | allocate(self % gradient_2d(input_shape(1), input_shape(2))) 55 | self % gradient_2d = 0 56 | else if (size(input_shape) == 3) then 57 | allocate(self % gradient_3d(input_shape(1), input_shape(2), input_shape(3))) 58 | self % gradient_3d = 0 59 | end if 60 | 61 | allocate(self % output(self % output_size)) 62 | self % output = 0 63 | 64 | end subroutine init 65 | 66 | end submodule nf_flatten_layer_submodule 67 | -------------------------------------------------------------------------------- /example/cnn_mnist.f90: -------------------------------------------------------------------------------- 1 | program cnn_mnist 2 | 3 | use nf, only: network, sgd, & 4 | input, conv, maxpool, flatten, dense, reshape, & 5 | load_mnist, label_digits, softmax, relu 6 | 7 | implicit none 8 | 9 | type(network) :: net 10 | 11 | real, allocatable :: training_images(:,:), training_labels(:) 12 | real, allocatable :: validation_images(:,:), validation_labels(:) 13 | real, allocatable :: testing_images(:,:), testing_labels(:) 14 | integer :: n 15 | integer, parameter :: num_epochs = 20 16 | 17 | call load_mnist(training_images, training_labels, & 18 | validation_images, validation_labels, & 19 | testing_images, testing_labels) 20 | 21 | net = network([ & 22 | input(784), & 23 | reshape(1, 28, 28), & 24 | conv(filters=8, kernel_width=3, kernel_height=3, activation=relu()), & 25 | maxpool(pool_width=2, pool_height=2, stride=2), & 26 | conv(filters=16, kernel_width=3, kernel_height=3, activation=relu()), & 27 | maxpool(pool_width=2, pool_height=2, stride=2), & 28 | dense(10, activation=softmax()) & 29 | ]) 30 | 31 | call net % print_info() 32 | 33 | epochs: do n = 1, num_epochs 34 | 35 | call net % train( & 36 | training_images, & 37 | label_digits(training_labels), & 38 | batch_size=16, & 39 | epochs=1, & 40 | optimizer=sgd(learning_rate=0.001) & 41 | ) 42 | 43 | print '(a,i2,a,f5.2,a)', 'Epoch ', n, ' done, Accuracy: ', accuracy( & 44 | net, validation_images, label_digits(validation_labels)) * 100, ' %' 45 | 46 | end do epochs 47 | 48 | print '(a,f5.2,a)', 'Testing accuracy: ', & 49 | accuracy(net, testing_images, label_digits(testing_labels)) * 100, '%' 50 | 51 | contains 52 | 53 | real function accuracy(net, x, y) 54 | type(network), intent(in out) :: net 55 | real, intent(in) :: x(:,:), y(:,:) 56 | integer :: i, good 57 | good = 0 58 | do i = 1, size(x, dim=2) 59 | if (all(maxloc(net % predict(x(:,i))) == maxloc(y(:,i)))) then 60 | good = good + 1 61 | end if 62 | end do 63 | accuracy = real(good) / size(x, dim=2) 64 | end function accuracy 65 | 66 | end program cnn_mnist 67 | -------------------------------------------------------------------------------- /test/test_metrics.f90: -------------------------------------------------------------------------------- 1 | program test_metrics 2 | use iso_fortran_env, only: stderr => error_unit 3 | use nf, only: dense, input, network, sgd, mse 4 | implicit none 5 | type(network) :: net 6 | logical :: ok = .true. 7 | 8 | ! Minimal 2-layer network 9 | net = network([ & 10 | input(1), & 11 | dense(1) & 12 | ]) 13 | 14 | training: block 15 | real :: x(1), y(1) 16 | real :: tolerance = 1e-3 17 | integer :: n 18 | integer, parameter :: num_iterations = 1000 19 | real :: quadratic_loss, mse_metric 20 | real, allocatable :: metrics(:,:) 21 | 22 | x = [0.1234567] 23 | y = [0.7654321] 24 | 25 | do n = 1, num_iterations 26 | call net % forward(x) 27 | call net % backward(y) 28 | call net % update(sgd(learning_rate=1.)) 29 | if (all(abs(net % predict(x) - y) < tolerance)) exit 30 | end do 31 | 32 | ! Returns only one metric, based on the default loss function (quadratic). 33 | metrics = net % evaluate(reshape(x, [1, 1]), reshape(y, [1, 1])) 34 | quadratic_loss = metrics(1,1) 35 | 36 | if (.not. all(shape(metrics) == [1, 1])) then 37 | write(stderr, '(a)') 'metrics array is the correct shape (1, 1).. failed' 38 | ok = .false. 39 | end if 40 | 41 | ! Returns two metrics, one from the loss function and another specified by the user. 42 | metrics = net % evaluate(reshape(x, [1, 1]), reshape(y, [1, 1]), metric=mse()) 43 | 44 | if (.not. all(shape(metrics) == [1, 2])) then 45 | write(stderr, '(a)') 'metrics array is the correct shape (1, 2).. failed' 46 | ok = .false. 47 | end if 48 | 49 | mse_metric = metrics(1,2) 50 | 51 | if (.not. all(metrics < 1e-5)) then 52 | write(stderr, '(a)') 'value for all metrics is expected.. failed' 53 | ok = .false. 54 | end if 55 | 56 | if (.not. metrics(1,1) == quadratic_loss) then 57 | write(stderr, '(a)') 'first metric should be the same as that of the loss function.. failed' 58 | ok = .false. 59 | end if 60 | 61 | end block training 62 | 63 | if (ok) then 64 | print '(a)', 'test_metrics: All tests passed.' 65 | else 66 | write(stderr, '(a)') 'test_metrics: One or more tests failed.' 67 | stop 1 68 | end if 69 | 70 | end program test_metrics 71 | -------------------------------------------------------------------------------- /example/cnn_mnist_1d.f90: -------------------------------------------------------------------------------- 1 | program cnn_mnist_1d 2 | 3 | use nf, only: network, sgd, & 4 | input, maxpool, flatten, dense, reshape, locally_connected, & 5 | load_mnist, label_digits, softmax, relu 6 | 7 | implicit none 8 | 9 | type(network) :: net 10 | 11 | real, allocatable :: training_images(:,:), training_labels(:) 12 | real, allocatable :: validation_images(:,:), validation_labels(:) 13 | real, allocatable :: testing_images(:,:), testing_labels(:) 14 | integer :: n 15 | integer, parameter :: num_epochs = 20 16 | 17 | call load_mnist(training_images, training_labels, & 18 | validation_images, validation_labels, & 19 | testing_images, testing_labels) 20 | 21 | net = network([ & 22 | input(784), & 23 | reshape(28, 28), & 24 | locally_connected(filters=8, kernel_size=3, activation=relu()), & 25 | maxpool(pool_width=2, stride=2), & 26 | locally_connected(filters=16, kernel_size=3, activation=relu()), & 27 | maxpool(pool_width=2, stride=2), & 28 | dense(10, activation=softmax()) & 29 | ]) 30 | 31 | call net % print_info() 32 | 33 | epochs: do n = 1, num_epochs 34 | 35 | call net % train( & 36 | training_images, & 37 | label_digits(training_labels), & 38 | batch_size=16, & 39 | epochs=1, & 40 | optimizer=sgd(learning_rate=0.01) & 41 | ) 42 | 43 | print '(a,i2,a,f5.2,a)', 'Epoch ', n, ' done, Accuracy: ', accuracy( & 44 | net, validation_images, label_digits(validation_labels)) * 100, ' %' 45 | 46 | end do epochs 47 | 48 | print '(a,f5.2,a)', 'Testing accuracy: ', & 49 | accuracy(net, testing_images, label_digits(testing_labels)) * 100, '%' 50 | 51 | contains 52 | 53 | real function accuracy(net, x, y) 54 | type(network), intent(in out) :: net 55 | real, intent(in) :: x(:,:), y(:,:) 56 | integer :: i, good 57 | good = 0 58 | do i = 1, size(x, dim=2) 59 | if (all(maxloc(net % predict(x(:,i))) == maxloc(y(:,i)))) then 60 | good = good + 1 61 | end if 62 | end do 63 | accuracy = real(good) / size(x, dim=2) 64 | end function accuracy 65 | 66 | end program cnn_mnist_1d 67 | -------------------------------------------------------------------------------- /example/dense_mnist.f90: -------------------------------------------------------------------------------- 1 | program dense_mnist 2 | 3 | use nf, only: dense, input, network, sgd, label_digits, load_mnist, corr, relu, softmax, dropout 4 | 5 | implicit none 6 | 7 | type(network) :: net 8 | real, allocatable :: training_images(:,:), training_labels(:) 9 | real, allocatable :: validation_images(:,:), validation_labels(:) 10 | integer :: n, num_epochs 11 | 12 | call load_mnist(training_images, training_labels, & 13 | validation_images, validation_labels) 14 | 15 | print '("MNIST")' 16 | print '(60("="))' 17 | 18 | net = network([ & 19 | input(784), & 20 | dense(64, relu()), & 21 | dropout(0.2), & 22 | dense(10, softmax()) & 23 | ]) 24 | num_epochs = 10 25 | 26 | call net % print_info() 27 | 28 | print '(a,f5.2,a)', 'Initial accuracy: ', accuracy( & 29 | net, validation_images, label_digits(validation_labels)) * 100, ' %' 30 | 31 | epochs: do n = 1, num_epochs 32 | 33 | call net % train( & 34 | training_images, & 35 | label_digits(training_labels), & 36 | batch_size=128, & 37 | epochs=1, & 38 | optimizer=sgd(learning_rate=3.) & 39 | ) 40 | 41 | block 42 | real, allocatable :: output_metrics(:,:) 43 | real, allocatable :: mean_metrics(:) 44 | ! 2 metrics; 1st is default loss function (quadratic), other is Pearson corr. 45 | output_metrics = net % evaluate(validation_images, label_digits(validation_labels), metric=corr()) 46 | mean_metrics = sum(output_metrics, 1) / size(output_metrics, 1) 47 | print '(a,i2,3(a,f6.3))', 'Epoch ', n, ' done, Accuracy: ', & 48 | accuracy(net, validation_images, label_digits(validation_labels)) * 100, & 49 | '%, Loss: ', mean_metrics(1), ', Pearson correlation: ', mean_metrics(2) 50 | end block 51 | 52 | end do epochs 53 | 54 | contains 55 | 56 | real function accuracy(net, x, y) 57 | type(network), intent(in out) :: net 58 | real, intent(in) :: x(:,:), y(:,:) 59 | integer :: i, good 60 | good = 0 61 | do i = 1, size(x, dim=2) 62 | if (all(maxloc(net % predict(x(:,i))) == maxloc(y(:,i)))) then 63 | good = good + 1 64 | end if 65 | end do 66 | accuracy = real(good) / size(x, dim=2) 67 | end function accuracy 68 | 69 | end program dense_mnist 70 | -------------------------------------------------------------------------------- /src/nf/nf_dropout_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule (nf_dropout_layer) nf_dropout_layer_submodule 2 | use nf_random, only: shuffle 3 | !! This submodule implements the procedures defined in the 4 | !! nf_dropout_layer module. 5 | 6 | contains 7 | 8 | module function dropout_layer_cons(rate) result(res) 9 | real, intent(in) :: rate 10 | type(dropout_layer) :: res 11 | res % dropout_rate = rate 12 | res % scale = 1 / (1 - rate) 13 | end function dropout_layer_cons 14 | 15 | 16 | module subroutine init(self, input_shape) 17 | class(dropout_layer), intent(in out) :: self 18 | integer, intent(in) :: input_shape(:) 19 | 20 | self % input_size = input_shape(1) 21 | 22 | ! Allocate arrays 23 | allocate(self % output(self % input_size)) 24 | allocate(self % gradient(self % input_size)) 25 | allocate(self % mask(self % input_size)) 26 | 27 | ! Initialize arrays 28 | self % output = 0 29 | self % gradient = 0 30 | self % mask = 1 ! Default mask is all ones (no dropout) 31 | 32 | end subroutine init 33 | 34 | 35 | module subroutine forward(self, input) 36 | class(dropout_layer), intent(in out) :: self 37 | real, intent(in) :: input(:) 38 | 39 | ! Generate random mask for dropout, training mode only 40 | if (self % training) then 41 | 42 | ! Set the first dropout_rate number of elements to 0, the rest to 1, 43 | ! and shuffle. Note that the selection of the elements rounds down to 44 | ! the nearest integer, so in cases where size(input) * dropout_rate is 45 | ! not an integer, the actual dropout rate will be slightly lower. 46 | self % mask = 1 47 | self % mask(:int(size(self % mask) * self % dropout_rate)) = 0 48 | call shuffle(self % mask) 49 | 50 | ! Apply dropout mask 51 | self % output = input * self % mask * self % scale 52 | 53 | else 54 | ! In inference mode, we don't apply dropout; simply pass through the input 55 | self % output = input 56 | 57 | end if 58 | 59 | end subroutine forward 60 | 61 | 62 | pure module subroutine backward(self, gradient) 63 | class(dropout_layer), intent(in out) :: self 64 | real, intent(in) :: gradient(:) 65 | self % gradient = gradient * self % mask * self % scale 66 | end subroutine backward 67 | 68 | end submodule nf_dropout_layer_submodule -------------------------------------------------------------------------------- /test/tuff.f90: -------------------------------------------------------------------------------- 1 | module tuff 2 | ! Testing Unframework for Fortran (TUFF) 3 | use iso_fortran_env, only: stderr => error_unit, stdout => output_unit 4 | implicit none 5 | 6 | private 7 | public :: test, test_result 8 | 9 | type :: test_result 10 | character(:), allocatable :: name 11 | logical :: ok = .true. 12 | real :: elapsed = 0. 13 | end type test_result 14 | 15 | interface test 16 | module procedure test_logical, test_func, test_array 17 | end interface test 18 | 19 | abstract interface 20 | function func() result(res) 21 | import :: test_result 22 | type(test_result) :: res 23 | end function func 24 | end interface 25 | 26 | contains 27 | 28 | type(test_result) function test_logical(name, cond) result(res) 29 | ! Test a single logical expression. 30 | character(*), intent(in) :: name 31 | logical, intent(in) :: cond 32 | res % name = name 33 | res % ok = .true. 34 | res % elapsed = 0. 35 | if (.not. cond) then 36 | write(stderr, '(a)') 'Test ' // trim(name) // ' failed.' 37 | res % ok = .false. 38 | end if 39 | end function test_logical 40 | 41 | 42 | type(test_result) function test_func(f) result(res) 43 | ! Test a user-provided function f that returns a test_result. 44 | ! f is responsible for setting the test name and the ok field. 45 | procedure(func) :: f 46 | real :: t1, t2 47 | res % name = '' 48 | call cpu_time(t1) 49 | res = f() 50 | call cpu_time(t2) 51 | res % elapsed = t2 - t1 52 | if (len_trim(res % name) == 0) res % name = 'Anonymous test' 53 | if (.not. res % ok) then 54 | write(stderr, '(a, f6.3)') 'Test failed: ' // trim(res % name) 55 | end if 56 | end function test_func 57 | 58 | 59 | type(test_result) function test_array(name, tests) result(suite) 60 | ! Test a suite of tests, each of which is a test_result. 61 | character(*), intent(in) :: name 62 | type(test_result), intent(in) :: tests(:) 63 | suite % ok = all(tests % ok) 64 | suite % elapsed = sum(tests % elapsed) 65 | if (suite % ok) then 66 | write(stdout, '(a)') trim(name) // ": All tests passed." 67 | else 68 | write(stderr, '(i0,a,i0,a)') count(.not. tests % ok), '/', size(tests), & 69 | " tests failed in suite: " // trim(name) 70 | end if 71 | end function test_array 72 | 73 | end module tuff -------------------------------------------------------------------------------- /example/merge_networks.f90: -------------------------------------------------------------------------------- 1 | program merge_networks 2 | use nf, only: dense, input, network, sgd 3 | use nf_dense_layer, only: dense_layer 4 | implicit none 5 | 6 | type(network) :: net1, net2, net3 7 | real, allocatable :: x1(:), x2(:) 8 | real, pointer :: y1(:), y2(:) 9 | real, allocatable :: y(:) 10 | integer, parameter :: num_iterations = 500 11 | integer :: n, nn 12 | integer :: net1_output_size, net2_output_size 13 | 14 | x1 = [0.1, 0.3, 0.5] 15 | x2 = [0.2, 0.4] 16 | y = [0.123456, 0.246802, 0.369258, 0.482604, 0.505050, 0.628406, 0.741852] 17 | 18 | net1 = network([ & 19 | input(3), & 20 | dense(2), & 21 | dense(3), & 22 | dense(2) & 23 | ]) 24 | 25 | net2 = network([ & 26 | input(2), & 27 | dense(5), & 28 | dense(3) & 29 | ]) 30 | 31 | net1_output_size = product(net1 % layers(size(net1 % layers)) % layer_shape) 32 | net2_output_size = product(net2 % layers(size(net2 % layers)) % layer_shape) 33 | 34 | ! Network 3 35 | net3 = network([ & 36 | input(net1_output_size + net2_output_size), & 37 | dense(7) & 38 | ]) 39 | 40 | do n = 1, num_iterations 41 | 42 | ! Forward propagate two network branches 43 | call net1 % forward(x1) 44 | call net2 % forward(x2) 45 | 46 | ! Get outputs of net1 and net2, concatenate, and pass to net3 47 | call net1 % get_output(y1) 48 | call net2 % get_output(y2) 49 | call net3 % forward([y1, y2]) 50 | 51 | ! First compute the gradients on net3, then pass the gradients from the first 52 | ! hidden layer on net3 to net1 and net2, and compute their gradients. 53 | call net3 % backward(y) 54 | 55 | select type (next_layer => net3 % layers(2) % p) 56 | type is (dense_layer) 57 | call net1 % backward(y, gradient=next_layer % gradient(1:net1_output_size)) 58 | call net2 % backward(y, gradient=next_layer % gradient(net1_output_size+1:size(next_layer % gradient))) 59 | end select 60 | 61 | ! Gradients are now computed on all networks and we can update the weights 62 | call net1 % update(optimizer=sgd(learning_rate=1.)) 63 | call net2 % update(optimizer=sgd(learning_rate=1.)) 64 | call net3 % update(optimizer=sgd(learning_rate=1.)) 65 | 66 | if (mod(n, 50) == 0) then 67 | print *, "Iteration ", n, ", output RMSE = ", & 68 | sqrt(sum((net3 % predict([net1 % predict(x1), net2 % predict(x2)]) - y)**2) / size(y)) 69 | end if 70 | 71 | end do 72 | 73 | end program merge_networks -------------------------------------------------------------------------------- /test/test_parametric_activation.f90: -------------------------------------------------------------------------------- 1 | program test_parametric_activation 2 | use iso_fortran_env, only: stderr => error_unit 3 | use nf, only: dense, layer 4 | use nf_dense_layer, only: dense_layer 5 | use nf_activation, only: elu, leaky_relu 6 | implicit none 7 | type(layer) :: layer1 8 | real :: alpha 9 | logical :: ok = .true. 10 | 11 | layer1 = dense(10, activation=elu()) 12 | 13 | select type(this_layer => layer1 % p) 14 | type is (dense_layer) 15 | select type(this_activation => this_layer % activation) 16 | type is (elu) 17 | alpha = this_activation % alpha 18 | end select 19 | end select 20 | 21 | if (.not. alpha == 1) then 22 | ok = .false. 23 | write(stderr, '(a)') 'default alpha for ELU is as expected.. failed' 24 | end if 25 | 26 | layer1 = dense(10, activation=elu(0.1)) 27 | 28 | select type(this_layer => layer1 % p) 29 | type is (dense_layer) 30 | select type(this_activation => this_layer % activation) 31 | type is (elu) 32 | alpha = this_activation % alpha 33 | end select 34 | end select 35 | 36 | if (.not. alpha == 0.1) then 37 | ok = .false. 38 | write(stderr, '(a)') 'User set alpha for ELU is as expected.. failed' 39 | end if 40 | 41 | layer1 = dense(10, activation=leaky_relu()) 42 | 43 | select type(this_layer => layer1 % p) 44 | type is (dense_layer) 45 | select type(this_activation => this_layer % activation) 46 | type is (leaky_relu) 47 | alpha = this_activation % alpha 48 | end select 49 | end select 50 | 51 | if (.not. alpha == 0.3) then 52 | ok = .false. 53 | write(stderr, '(a)') 'Default alpha for leaky ReLU is as expected.. failed' 54 | end if 55 | 56 | layer1 = dense(10, activation=leaky_relu(0.01)) 57 | 58 | select type(this_layer => layer1 % p) 59 | type is (dense_layer) 60 | select type(this_activation => this_layer % activation) 61 | type is (leaky_relu) 62 | alpha = this_activation % alpha 63 | end select 64 | end select 65 | 66 | if (.not. alpha == 0.01) then 67 | ok = .false. 68 | write(stderr, '(a)') 'User set alpha for leaky ReLU is as expected.. failed' 69 | end if 70 | 71 | if (ok) then 72 | print '(a)', 'test_parametric_activation: All tests passed.' 73 | else 74 | write(stderr, '(a)') 'test_parametric_activation: One or more tests failed.' 75 | stop 1 76 | end if 77 | 78 | end program test_parametric_activation 79 | -------------------------------------------------------------------------------- /src/nf/nf_cross_attention_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_cross_attention_layer 2 | use iso_fortran_env, only: stderr => error_unit 3 | use nf_activation, only: softmax 4 | use nf_linear2d_layer, only: linear2d_layer 5 | use nf_multihead_attention_layer, only: multihead_attention_layer 6 | 7 | implicit none 8 | 9 | type, extends(multihead_attention_layer) :: cross_attention_layer 10 | !! Cross Attention Layer 11 | !! Source: 12 | !! Bahdanau, D. (2014) 13 | !! Neural machine translation by jointly learning to align and translate. 14 | !! https://arxiv.org/pdf/1409.0473 15 | real, allocatable :: gradient(:, :, :) 16 | contains 17 | procedure :: forward 18 | procedure :: backward 19 | procedure :: init 20 | end type cross_attention_layer 21 | 22 | interface cross_attention_layer 23 | module procedure cross_attention_layer_cons 24 | end interface cross_attention_layer 25 | 26 | contains 27 | function cross_attention_layer_cons(n_heads) result(res) 28 | !! This function returns the `cross_attention_layer` instance. 29 | integer, intent(in) :: n_heads 30 | type(cross_attention_layer) :: res 31 | res % n_heads = n_heads 32 | end function cross_attention_layer_cons 33 | 34 | pure subroutine backward(self, input, gradient) 35 | !! Cross Attention Back propagation 36 | class(cross_attention_layer), intent(in out) :: self 37 | real, intent(in) :: input(:, :, :) 38 | real, intent(in) :: gradient(:, :) 39 | 40 | call self % common_backward(input(1, :, :), gradient) 41 | self % gradient(1, :, :) = self % query_layer % gradient 42 | self % gradient(2, :, :) = self % key_layer % gradient + self % value_layer % gradient 43 | end subroutine backward 44 | 45 | pure subroutine forward(self, input) 46 | !! Cross Attention Forward propagation 47 | !! Input Shape (kind, sequence_length, model_dimension) 48 | !! where kind is 1 for Query and 2 for Key-Value 49 | class(cross_attention_layer), intent(in out) :: self 50 | real, intent(in) :: input(:, :, :) 51 | 52 | call self % common_forward(input(1, :, :), input(2, :, :), input(2, :, :)) 53 | end subroutine forward 54 | 55 | subroutine init(self, input_shape) 56 | class(cross_attention_layer), intent(in out) :: self 57 | integer, intent(in) :: input_shape(:) 58 | 59 | call self % init_base(input_shape) 60 | allocate(self % gradient(2, self % sequence_length, self % model_dimension)) 61 | end subroutine init 62 | end module nf_cross_attention_layer 63 | -------------------------------------------------------------------------------- /src/nf/nf_maxpool2d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_maxpool2d_layer 2 | 3 | !! This module provides the 2-d maxpooling layer. 4 | 5 | use nf_base_layer, only: base_layer 6 | implicit none 7 | 8 | private 9 | public :: maxpool2d_layer 10 | 11 | type, extends(base_layer) :: maxpool2d_layer 12 | 13 | integer :: channels 14 | integer :: width 15 | integer :: height 16 | integer :: pool_size 17 | integer :: stride 18 | 19 | ! Locations (as input matrix indices) of the maximum values 20 | ! in the width (x) and height (y) dimensions 21 | integer, allocatable :: maxloc_x(:,:,:) 22 | integer, allocatable :: maxloc_y(:,:,:) 23 | 24 | real, allocatable :: gradient(:,:,:) 25 | real, allocatable :: output(:,:,:) 26 | 27 | contains 28 | 29 | procedure :: init 30 | procedure :: forward 31 | procedure :: backward 32 | 33 | end type maxpool2d_layer 34 | 35 | interface maxpool2d_layer 36 | pure module function maxpool2d_layer_cons(pool_size, stride) result(res) 37 | !! `maxpool2d` constructor function 38 | integer, intent(in) :: pool_size 39 | !! Width and height of the pooling window 40 | integer, intent(in) :: stride 41 | !! Stride of the pooling window 42 | type(maxpool2d_layer) :: res 43 | end function maxpool2d_layer_cons 44 | end interface maxpool2d_layer 45 | 46 | interface 47 | 48 | module subroutine init(self, input_shape) 49 | !! Initialize the `maxpool2d` layer instance with an input shape. 50 | class(maxpool2d_layer), intent(in out) :: self 51 | !! `maxpool2d_layer` instance 52 | integer, intent(in) :: input_shape(:) 53 | !! Array shape of the input layer 54 | end subroutine init 55 | 56 | pure module subroutine forward(self, input) 57 | !! Run a forward pass of the `maxpool2d` layer. 58 | class(maxpool2d_layer), intent(in out) :: self 59 | !! `maxpool2d_layer` instance 60 | real, intent(in) :: input(:,:,:) 61 | !! Input data (output of the previous layer) 62 | end subroutine forward 63 | 64 | pure module subroutine backward(self, input, gradient) 65 | !! Run a backward pass of the `maxpool2d` layer. 66 | class(maxpool2d_layer), intent(in out) :: self 67 | !! `maxpool2d_layer` instance 68 | real, intent(in) :: input(:,:,:) 69 | !! Input data (output of the previous layer) 70 | real, intent(in) :: gradient(:,:,:) 71 | !! Gradient from the downstream layer 72 | end subroutine backward 73 | 74 | end interface 75 | 76 | end module nf_maxpool2d_layer 77 | -------------------------------------------------------------------------------- /cmake/compilers.cmake: -------------------------------------------------------------------------------- 1 | # compiler flags for gfortran 2 | if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") 3 | 4 | if(PARALLEL) 5 | message(STATUS "Configuring to build with -fcoarray=shared") 6 | add_compile_options("$<$:-fcoarray=shared>") 7 | add_compile_definitions(PARALLEL) 8 | else() 9 | add_compile_options("$<$:-fcoarray=single>") 10 | endif() 11 | 12 | if(BLAS) 13 | add_compile_options("$<$:-fexternal-blas;${BLAS}>") 14 | list(APPEND LIBS "blas") 15 | message(STATUS "Configuring build to use BLAS from ${BLAS}") 16 | endif() 17 | 18 | add_compile_options("$<$,$>:-cpp;-fcheck=bounds;-fbacktrace>") 19 | add_compile_options("$<$,$>:-cpp;-Ofast;-fno-frontend-optimize;-fno-backtrace>") 20 | 21 | elseif(CMAKE_Fortran_COMPILER_ID MATCHES "^Intel") 22 | # compiler flags for ifort 23 | 24 | if(PARALLEL) 25 | message(STATUS "Configuring to build with -coarray=shared") 26 | if(WIN32) 27 | add_compile_options("$<$:/Qcoarray:shared>") 28 | add_link_options("$<$:/Qcoarray:shared>") 29 | else() 30 | add_compile_options("$<$:-coarray=shared>") 31 | add_link_options("$<$:-coarray=shared>") 32 | endif() 33 | add_compile_definitions(PARALLEL) 34 | else() 35 | if(WIN32) 36 | add_compile_options("$<$:/Qcoarray:shared>") 37 | add_link_options("$<$:/Qcoarray:shared>") 38 | else() 39 | add_compile_options("$<$:-coarray=shared>") 40 | add_link_options("$<$:-coarray=shared>") 41 | endif() 42 | endif() 43 | 44 | if(WIN32) 45 | string(APPEND CMAKE_Fortran_FLAGS " /assume:byterecl /fpp") 46 | else() 47 | string(APPEND CMAKE_Fortran_FLAGS " -assume byterecl -fpp") 48 | endif() 49 | add_compile_options("$<$,$>:-fpp;-check;-traceback>") 50 | add_compile_options("$<$,$>:-fpp;-O3>") 51 | 52 | elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Cray") 53 | # compiler flags for Cray ftn 54 | string(APPEND CMAKE_Fortran_FLAGS " -h noomp") 55 | add_compile_options("$<$,$>:-e Z;-O0;-g>") 56 | add_compile_options("$<$,$>:-e Z;-O3>") 57 | endif() 58 | -------------------------------------------------------------------------------- /src/nf/nf_reshape3d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_reshape3d_layer 2 | 3 | !! This module provides the concrete reshape layer type. 4 | !! It is used internally by the layer type. 5 | !! It is not intended to be used directly by the user. 6 | 7 | use nf_base_layer, only: base_layer 8 | 9 | implicit none 10 | 11 | private 12 | public :: reshape3d_layer 13 | 14 | type, extends(base_layer) :: reshape3d_layer 15 | 16 | !! Concrete implementation of a reshape layer type 17 | !! It implements only rank-1 to rank-3 reshaping. 18 | 19 | integer :: input_shape(1) 20 | integer :: output_shape(3) 21 | real, allocatable :: gradient(:) 22 | real, allocatable :: output(:,:,:) 23 | 24 | contains 25 | 26 | procedure :: backward 27 | procedure :: forward 28 | procedure :: init 29 | 30 | end type reshape3d_layer 31 | 32 | interface reshape3d_layer 33 | pure module function reshape3d_layer_cons(output_shape) result(res) 34 | !! This function returns the `reshape_layer` instance. 35 | integer, intent(in) :: output_shape(3) 36 | !! The shape of the output 37 | type(reshape3d_layer) :: res 38 | !! reshape_layer instance 39 | end function reshape3d_layer_cons 40 | end interface reshape3d_layer 41 | 42 | interface 43 | 44 | pure module subroutine backward(self, input, gradient) 45 | !! Apply the backward pass for the reshape3d layer. 46 | !! This is just flattening to a rank-1 array. 47 | class(reshape3d_layer), intent(in out) :: self 48 | !! Dense layer instance 49 | real, intent(in) :: input(:) 50 | !! Input from the previous layer 51 | real, intent(in) :: gradient(:,:,:) 52 | !! Gradient from the next layer 53 | end subroutine backward 54 | 55 | pure module subroutine forward(self, input) 56 | !! Apply the forward pass for the reshape3d layer. 57 | !! This is just a reshape from rank-1 to rank-3 array. 58 | class(reshape3d_layer), intent(in out) :: self 59 | !! Dense layer instance 60 | real, intent(in) :: input(:) 61 | !! Input from the previous layer 62 | end subroutine forward 63 | 64 | module subroutine init(self, input_shape) 65 | !! Initialize the layer data structures. 66 | !! 67 | !! This is a deferred procedure from the `base_layer` abstract type. 68 | class(reshape3d_layer), intent(in out) :: self 69 | !! Dense layer instance 70 | integer, intent(in) :: input_shape(:) 71 | !! Shape of the input layer 72 | end subroutine init 73 | 74 | end interface 75 | 76 | end module nf_reshape3d_layer 77 | -------------------------------------------------------------------------------- /src/nf/nf_self_attention_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_self_attention_layer 2 | use iso_fortran_env, only: stderr => error_unit 3 | use nf_activation, only: softmax 4 | use nf_linear2d_layer, only: linear2d_layer 5 | use nf_multihead_attention_layer, only: multihead_attention_layer 6 | 7 | implicit none 8 | 9 | type, extends(multihead_attention_layer) :: self_attention_layer 10 | !! Self Attention Layer 11 | !! Source: 12 | !! Parikh, A. P., Taeckstroem, O., Das, D., & Uszkoreit, J. (2016) 13 | !! A decomposable attention model for natural language inference. 14 | !! https://arxiv.org/pdf/1606.01933 15 | real, allocatable :: gradient(:, :) 16 | contains 17 | procedure :: forward 18 | procedure :: backward 19 | procedure :: init 20 | end type self_attention_layer 21 | 22 | interface self_attention_layer 23 | module procedure self_attention_layer_cons 24 | end interface self_attention_layer 25 | 26 | contains 27 | function self_attention_layer_cons(n_heads) result(res) 28 | !! This function returns the `self_attention_layer` instance. 29 | integer, intent(in) :: n_heads 30 | type(self_attention_layer) :: res 31 | res % n_heads = n_heads 32 | end function self_attention_layer_cons 33 | 34 | pure subroutine backward(self, input, gradient, attention_mask) 35 | !! Self Attention back propagation 36 | !! Returns sum of Query, Key and Value gradients 37 | class(self_attention_layer), intent(in out) :: self 38 | real, intent(in) :: input(:, :) 39 | real, intent(in) :: gradient(:, :) 40 | real, intent(in), optional :: attention_mask(:, :) 41 | 42 | call self % common_backward(input, gradient, attention_mask) 43 | self % gradient = & 44 | self % query_layer % gradient & 45 | + self % key_layer % gradient & 46 | + self % value_layer % gradient 47 | end subroutine backward 48 | 49 | pure subroutine forward(self, input) 50 | !! Cross Attention forward propagation 51 | !! Passes input three times into MultiHead Attention 52 | !! Input Shape: (sequence_length, model_dimension) 53 | class(self_attention_layer), intent(in out) :: self 54 | real, intent(in) :: input(:, :) 55 | 56 | call self % common_forward(input, input, input) 57 | end subroutine forward 58 | 59 | subroutine init(self, input_shape) 60 | class(self_attention_layer), intent(in out) :: self 61 | integer, intent(in) :: input_shape(:) 62 | 63 | call self % init_base(input_shape) 64 | allocate(self % gradient(self % sequence_length, self % model_dimension)) 65 | end subroutine init 66 | end module nf_self_attention_layer 67 | -------------------------------------------------------------------------------- /src/nf/nf_flatten_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_flatten_layer 2 | 3 | !! This module provides the concrete flatten layer type. 4 | !! It is used internally by the layer type. 5 | !! It is not intended to be used directly by the user. 6 | 7 | use nf_base_layer, only: base_layer 8 | 9 | implicit none 10 | 11 | private 12 | public :: flatten_layer 13 | 14 | type, extends(base_layer) :: flatten_layer 15 | 16 | !! Concrete implementation of a flatten (3-d to 1-d) layer. 17 | 18 | integer, allocatable :: input_shape(:) 19 | integer :: output_size 20 | 21 | real, allocatable :: gradient_2d(:,:) 22 | real, allocatable :: gradient_3d(:,:,:) 23 | real, allocatable :: output(:) 24 | 25 | contains 26 | 27 | procedure :: backward 28 | procedure :: forward 29 | procedure :: init 30 | 31 | end type flatten_layer 32 | 33 | interface flatten_layer 34 | elemental module function flatten_layer_cons() result(res) 35 | !! This function returns the `flatten_layer` instance. 36 | type(flatten_layer) :: res 37 | !! `flatten_layer` instance 38 | end function flatten_layer_cons 39 | end interface flatten_layer 40 | 41 | interface 42 | 43 | pure module subroutine backward(self, input, gradient) 44 | !! Apply the backward pass to the flatten layer for 2D and 3D input. 45 | !! This is a reshape operation from 1-d gradient to 2-d and 3-d input. 46 | class(flatten_layer), intent(in out) :: self 47 | !! Flatten layer instance 48 | real, intent(in) :: input(..) 49 | !! Input from the previous layer 50 | real, intent(in) :: gradient(:) 51 | !! Gradient from the next layer 52 | end subroutine backward 53 | 54 | pure module subroutine forward(self, input) 55 | !! Propagate forward the layer for 2D or 3D input. 56 | !! Calling this subroutine updates the values of a few data components 57 | !! of `flatten_layer` that are needed for the backward pass. 58 | class(flatten_layer), intent(in out) :: self 59 | !! Dense layer instance 60 | real, intent(in) :: input(..) 61 | !! Input from the previous layer 62 | end subroutine forward 63 | 64 | module subroutine init(self, input_shape) 65 | !! Initialize the layer data structures. 66 | !! 67 | !! This is a deferred procedure from the `base_layer` abstract type. 68 | class(flatten_layer), intent(in out) :: self 69 | !! Dense layer instance 70 | integer, intent(in) :: input_shape(:) 71 | !! Shape of the input layer 72 | end subroutine init 73 | 74 | end interface 75 | 76 | end module nf_flatten_layer 77 | -------------------------------------------------------------------------------- /test/test_get_set_network_params.f90: -------------------------------------------------------------------------------- 1 | program test_get_set_network_params 2 | use iso_fortran_env, only: stderr => error_unit 3 | use nf, only: conv, dense, flatten, input, network 4 | implicit none 5 | type(network) :: net 6 | logical :: ok = .true. 7 | real :: test_params_dense(8) = [1, 2, 3, 4, 5, 6, 7, 8] 8 | real :: test_params_conv2d(10) = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] 9 | 10 | ! First test get_num_params() 11 | net = network([ & 12 | input(3, 5, 5), & ! 5 x 5 image with 3 channels 13 | conv(filters=2, kernel_width=3, kernel_height=3), & ! kernel shape [2, 3, 3, 3], output shape [2, 3, 3], 56 parameters total 14 | flatten(), & 15 | dense(4) & ! weights shape [72], biases shape [4], 76 parameters total 16 | ]) 17 | 18 | if (.not. net % get_num_params() == 132) then 19 | ok = .false. 20 | write(stderr, '(a)') 'network % get_num_params() returns an expected result.. failed' 21 | end if 22 | 23 | if (.not. all(net % layers % get_num_params() == [0, 56, 0, 76])) then 24 | ok = .false. 25 | write(stderr, '(a)') 'Sizes of layer parameters are all as expected.. failed' 26 | end if 27 | 28 | ! Next, test set_params() and get_params() for a dense layer 29 | net = network([ & 30 | input(3), & 31 | dense(2) & 32 | ]) 33 | 34 | call net % set_params(test_params_dense) 35 | 36 | if (.not. all(net % get_params() == test_params_dense)) then 37 | ok = .false. 38 | write(stderr, '(a)') 'Dense network params match the params that we set to it.. failed' 39 | end if 40 | 41 | if (.not. all(net % get_params() == net % layers(2) % get_params())) then 42 | ok = .false. 43 | write(stderr, '(a)') 'Single dense layer network params match that layer''s params.. failed' 44 | end if 45 | 46 | ! Finally, test set_params() and get_params() for a conv2d layer 47 | net = network([ & 48 | input(1, 3, 3), & 49 | conv(filters=1, kernel_width=3, kernel_height=3) & 50 | ]) 51 | 52 | call net % set_params(test_params_conv2d) 53 | 54 | if (.not. all(net % get_params() == test_params_conv2d)) then 55 | ok = .false. 56 | write(stderr, '(a)') 'Conv network params match the params that we set to it.. failed' 57 | end if 58 | 59 | if (.not. all(net % get_params() == net % layers(2) % get_params())) then 60 | ok = .false. 61 | write(stderr, '(a)') 'Single conv2d layer network params match that layer''s params.. failed' 62 | end if 63 | 64 | if (ok) then 65 | print '(a)', 'test_get_set_network_params: All tests passed.' 66 | else 67 | write(stderr, '(a)') 'test_get_set_network_params: One or more tests failed.' 68 | stop 1 69 | end if 70 | 71 | end program test_get_set_network_params 72 | -------------------------------------------------------------------------------- /src/nf/nf_linear2d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_linear2d_layer 2 | 3 | use nf_activation, only: activation_function 4 | use nf_base_layer, only: base_layer 5 | 6 | implicit none 7 | 8 | private 9 | public :: linear2d_layer 10 | 11 | type, extends(base_layer) :: linear2d_layer 12 | integer :: sequence_length, in_features, out_features, batch_size 13 | 14 | real, allocatable :: weights(:,:) 15 | real, allocatable :: biases(:) 16 | real, allocatable :: output(:,:) 17 | real, allocatable :: gradient(:,:) ! input gradient 18 | real, allocatable :: dw(:,:) ! weight gradients 19 | real, allocatable :: db(:) ! bias gradients 20 | 21 | contains 22 | 23 | procedure :: backward 24 | procedure :: forward 25 | procedure :: init 26 | procedure :: get_num_params 27 | procedure :: get_params_ptr 28 | procedure :: get_gradients 29 | procedure :: get_gradients_ptr 30 | 31 | end type linear2d_layer 32 | 33 | interface linear2d_layer 34 | module function linear2d_layer_cons(out_features) result(res) 35 | integer, intent(in) :: out_features 36 | type(linear2d_layer) :: res 37 | end function linear2d_layer_cons 38 | end interface linear2d_layer 39 | 40 | interface 41 | pure module subroutine forward(self, input) 42 | class(linear2d_layer), intent(in out) :: self 43 | real, intent(in) :: input(:,:) 44 | end subroutine forward 45 | 46 | pure module subroutine backward(self, input, gradient) 47 | class(linear2d_layer), intent(in out) :: self 48 | real, intent(in) :: input(:,:) 49 | real, intent(in) :: gradient(:,:) 50 | end subroutine backward 51 | 52 | module subroutine init(self, input_shape) 53 | class(linear2d_layer), intent(in out) :: self 54 | integer, intent(in) :: input_shape(:) 55 | end subroutine init 56 | 57 | pure module function get_num_params(self) result(num_params) 58 | class(linear2d_layer), intent(in) :: self 59 | integer :: num_params 60 | end function get_num_params 61 | 62 | module subroutine get_params_ptr(self, w_ptr, b_ptr) 63 | class(linear2d_layer), intent(in), target :: self 64 | real, pointer, intent(out) :: w_ptr(:), b_ptr(:) 65 | end subroutine get_params_ptr 66 | 67 | module function get_gradients(self) result(gradients) 68 | class(linear2d_layer), intent(in), target :: self 69 | real, allocatable :: gradients(:) 70 | end function get_gradients 71 | 72 | module subroutine get_gradients_ptr(self, dw_ptr, db_ptr) 73 | class(linear2d_layer), intent(in), target :: self 74 | real, pointer, intent(out) :: dw_ptr(:), db_ptr(:) 75 | end subroutine get_gradients_ptr 76 | 77 | end interface 78 | end module nf_linear2d_layer 79 | -------------------------------------------------------------------------------- /src/nf/nf_reshape2d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_reshape2d_layer 2 | 3 | !! This module provides the concrete reshape layer type. 4 | !! It is used internally by the layer type. 5 | !! It is not intended to be used directly by the user. 6 | 7 | use nf_base_layer, only: base_layer 8 | 9 | implicit none 10 | 11 | private 12 | public :: reshape2d_layer 13 | 14 | type, extends(base_layer) :: reshape2d_layer 15 | 16 | !! Concrete implementation of a reshape layer type 17 | !! It implements only rank-1 to rank-2 reshaping. 18 | 19 | integer :: input_shape(1) 20 | integer :: output_shape(2) 21 | real, allocatable :: gradient(:) 22 | real, allocatable :: output(:,:) 23 | 24 | contains 25 | 26 | procedure :: backward 27 | procedure :: forward 28 | procedure :: init 29 | 30 | end type reshape2d_layer 31 | 32 | interface reshape2d_layer 33 | pure module function reshape2d_layer_cons(output_shape) result(res) 34 | !! This function returns the `reshape_layer` instance. 35 | integer, intent(in) :: output_shape(2) 36 | !! The shape of the output 37 | type(reshape2d_layer) :: res 38 | !! reshape_layer instance 39 | end function reshape2d_layer_cons 40 | end interface reshape2d_layer 41 | 42 | interface 43 | 44 | pure module subroutine backward(self, input, gradient) 45 | !! Apply the backward pass for the reshape2d layer. 46 | !! This is just flattening to a rank-1 array. 47 | class(reshape2d_layer), intent(in out) :: self 48 | !! Dense layer instance 49 | real, intent(in) :: input(:) 50 | !! Input from the previous layer 51 | real, intent(in) :: gradient(:,:) 52 | !! Gradient from the next layer 53 | end subroutine backward 54 | 55 | pure module subroutine forward(self, input) 56 | !! Apply the forward pass for the reshape2d layer. 57 | !! This is just a reshape from rank-1 to rank-2 array. 58 | class(reshape2d_layer), intent(in out) :: self 59 | !! Dense layer instance 60 | real, intent(in) :: input(:) 61 | !! Input from the previous layer 62 | end subroutine forward 63 | 64 | module subroutine init(self, input_shape) 65 | !! Initialize the layer data structures. 66 | !! 67 | !! This is a deferred procedure from the `base_layer` abstract type. 68 | class(reshape2d_layer), intent(in out) :: self 69 | !! Dense layer instance 70 | integer, intent(in) :: input_shape(:) 71 | !! Shape of the input layer 72 | end subroutine init 73 | 74 | end interface 75 | 76 | end module nf_reshape2d_layer 77 | -------------------------------------------------------------------------------- /src/nf/nf_maxpool1d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_maxpool1d_layer 2 | !! This module provides the 1-d maxpooling layer. 3 | 4 | use nf_base_layer, only: base_layer 5 | implicit none 6 | 7 | private 8 | public :: maxpool1d_layer 9 | 10 | type, extends(base_layer) :: maxpool1d_layer 11 | integer :: channels 12 | integer :: width ! Length of the input along the pooling dimension 13 | integer :: pool_size 14 | integer :: stride 15 | 16 | ! Location (as input matrix indices) of the maximum value within each pooling region. 17 | ! Dimensions: (channels, new_width) 18 | integer, allocatable :: maxloc(:,:) 19 | 20 | ! Gradient for the input (same shape as the input). 21 | real, allocatable :: gradient(:,:) 22 | ! Output after pooling (dimensions: (channels, new_width)). 23 | real, allocatable :: output(:,:) 24 | contains 25 | procedure :: init 26 | procedure :: forward 27 | procedure :: backward 28 | end type maxpool1d_layer 29 | 30 | interface maxpool1d_layer 31 | pure module function maxpool1d_layer_cons(pool_size, stride) result(res) 32 | !! `maxpool1d` constructor function. 33 | integer, intent(in) :: pool_size 34 | !! Width of the pooling window. 35 | integer, intent(in) :: stride 36 | !! Stride of the pooling window. 37 | type(maxpool1d_layer) :: res 38 | end function maxpool1d_layer_cons 39 | end interface maxpool1d_layer 40 | 41 | interface 42 | module subroutine init(self, input_shape) 43 | !! Initialize the `maxpool1d` layer instance with an input shape. 44 | class(maxpool1d_layer), intent(in out) :: self 45 | !! `maxpool1d_layer` instance. 46 | integer, intent(in) :: input_shape(:) 47 | !! Array shape of the input layer, expected as (channels, width). 48 | end subroutine init 49 | 50 | pure module subroutine forward(self, input) 51 | !! Run a forward pass of the `maxpool1d` layer. 52 | class(maxpool1d_layer), intent(in out) :: self 53 | !! `maxpool1d_layer` instance. 54 | real, intent(in) :: input(:,:) 55 | !! Input data (output of the previous layer), with shape (channels, width). 56 | end subroutine forward 57 | 58 | pure module subroutine backward(self, input, gradient) 59 | !! Run a backward pass of the `maxpool1d` layer. 60 | class(maxpool1d_layer), intent(in out) :: self 61 | !! `maxpool1d_layer` instance. 62 | real, intent(in) :: input(:,:) 63 | !! Input data (output of the previous layer). 64 | real, intent(in) :: gradient(:,:) 65 | !! Gradient from the downstream layer, with shape (channels, pooled width). 66 | end subroutine backward 67 | end interface 68 | 69 | end module nf_maxpool1d_layer -------------------------------------------------------------------------------- /src/nf/nf_maxpool1d_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_maxpool1d_layer) nf_maxpool1d_layer_submodule 2 | 3 | implicit none 4 | 5 | contains 6 | 7 | pure module function maxpool1d_layer_cons(pool_size, stride) result(res) 8 | integer, intent(in) :: pool_size 9 | integer, intent(in) :: stride 10 | type(maxpool1d_layer) :: res 11 | res % pool_size = pool_size 12 | res % stride = stride 13 | end function maxpool1d_layer_cons 14 | 15 | 16 | module subroutine init(self, input_shape) 17 | class(maxpool1d_layer), intent(in out) :: self 18 | integer, intent(in) :: input_shape(:) 19 | 20 | self % channels = input_shape(1) 21 | self % width = input_shape(2) / self % stride 22 | 23 | allocate(self % maxloc(self % channels, self % width)) 24 | self % maxloc = 0 25 | 26 | allocate(self % gradient(input_shape(1),input_shape(2))) 27 | self % gradient = 0 28 | 29 | allocate(self % output(self % channels, self % width)) 30 | self % output = 0 31 | 32 | end subroutine init 33 | 34 | pure module subroutine forward(self, input) 35 | class(maxpool1d_layer), intent(in out) :: self 36 | real, intent(in) :: input(:,:) 37 | integer :: input_width 38 | integer :: i, n 39 | integer :: ii 40 | integer :: iend 41 | integer :: iextent 42 | integer :: maxloc_x 43 | 44 | input_width = size(input, dim=2) 45 | 46 | iextent = input_width - mod(input_width, self % stride) 47 | 48 | ! Stride along the width of the input 49 | stride_over_input: do concurrent(i = 1:iextent:self % stride) 50 | 51 | ! Index of the pooling layer 52 | ii = i / self % stride + 1 53 | iend = i + self % pool_size - 1 54 | 55 | maxpool_for_each_channel: do concurrent(n = 1:self % channels) 56 | 57 | ! Get and store the location of the maximum value 58 | maxloc_x = maxloc(input(n, i:iend), dim=1) 59 | self % maxloc(n,ii) = maxloc_x + i - 1 60 | 61 | self % output(n,ii) = input(n, self % maxloc(n,ii)) 62 | 63 | end do maxpool_for_each_channel 64 | 65 | end do stride_over_input 66 | 67 | end subroutine forward 68 | 69 | pure module subroutine backward(self, input, gradient) 70 | class(maxpool1d_layer), intent(in out) :: self 71 | real, intent(in) :: input(:,:) 72 | real, intent(in) :: gradient(:,:) 73 | integer :: gradient_shape(2) 74 | integer :: channels, width 75 | integer :: i, n 76 | 77 | gradient_shape = shape(gradient) 78 | channels = gradient_shape(1) 79 | width = gradient_shape(2) 80 | 81 | ! The gradient of a max-pooling layer is assigned to the stored max locations 82 | do concurrent(n = 1:channels, i = 1:width) 83 | self % gradient(n, self % maxloc(n,i)) = gradient(n,i) 84 | end do 85 | 86 | end subroutine backward 87 | 88 | 89 | end submodule nf_maxpool1d_layer_submodule 90 | -------------------------------------------------------------------------------- /src/nf/nf_dropout_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_dropout_layer 2 | 3 | !! Dropout layer by Srivastava et al. (2014). 4 | !! 5 | !! Srivastava, N., Hinton, G., Krizhevsky, A., Sutskever, I. and 6 | !! Salakhutdinov, R., 2014. Dropout: a simple way to prevent neural networks 7 | !! from overfitting. The Journal of Machine Learning Research, 16(1), 8 | !! pp.1929-1958. 9 | 10 | use nf_base_layer, only: base_layer 11 | 12 | implicit none 13 | 14 | private 15 | public :: dropout_layer 16 | 17 | type, extends(base_layer) :: dropout_layer 18 | !! Concrete implementation of a dropout layer type 19 | 20 | integer :: input_size = 0 21 | 22 | real, allocatable :: output(:) 23 | real, allocatable :: gradient(:) 24 | real, allocatable :: mask(:) ! binary mask for dropout 25 | 26 | real :: dropout_rate ! probability of dropping a neuron 27 | real :: scale ! scale factor to preserve the input sum 28 | logical :: training = .true. ! set to .false. for inference 29 | 30 | contains 31 | 32 | procedure :: backward 33 | procedure :: forward 34 | procedure :: init 35 | 36 | end type dropout_layer 37 | 38 | interface dropout_layer 39 | module function dropout_layer_cons(rate) & 40 | result(res) 41 | !! This function returns the `dropout_layer` instance. 42 | real, intent(in) :: rate 43 | !! Dropout rate 44 | type(dropout_layer) :: res 45 | !! dropout_layer instance 46 | end function dropout_layer_cons 47 | end interface dropout_layer 48 | 49 | interface 50 | 51 | pure module subroutine backward(self, gradient) 52 | !! Apply the backward gradient descent pass. 53 | !! Only weight and bias gradients are updated in this subroutine, 54 | !! while the weights and biases themselves are untouched. 55 | class(dropout_layer), intent(in out) :: self 56 | !! Dropout layer instance 57 | real, intent(in) :: gradient(:) 58 | !! Gradient from the next layer 59 | end subroutine backward 60 | 61 | module subroutine forward(self, input) 62 | !! Propagate forward the layer. 63 | !! Calling this subroutine updates the values of a few data components 64 | !! of `dropout_layer` that are needed for the backward pass. 65 | class(dropout_layer), intent(in out) :: self 66 | !! Dense layer instance 67 | real, intent(in) :: input(:) 68 | !! Input from the previous layer 69 | end subroutine forward 70 | 71 | module subroutine init(self, input_shape) 72 | !! Initialize the layer data structures. 73 | !! 74 | !! This is a deferred procedure from the `base_layer` abstract type. 75 | class(dropout_layer), intent(in out) :: self 76 | !! Dropout layer instance 77 | integer, intent(in) :: input_shape(:) 78 | !! Shape of the input layer 79 | end subroutine init 80 | 81 | end interface 82 | 83 | end module nf_dropout_layer 84 | -------------------------------------------------------------------------------- /example/get_set_network_params.f90: -------------------------------------------------------------------------------- 1 | program get_set_network_params 2 | use nf, only: dense, input, network 3 | use nf_optimizers, only: sgd 4 | implicit none 5 | type(network) :: net1, net2 6 | real :: x(1), y(1) 7 | real, parameter :: pi = 4 * atan(1.) 8 | integer, parameter :: num_iterations = 100000 9 | integer, parameter :: test_size = 30 10 | real :: xtest(test_size), ytest(test_size) 11 | real :: ypred1(test_size), ypred2(test_size) 12 | integer :: i, n 13 | 14 | print '("Getting and setting network parameters")' 15 | print '(60("="))' 16 | print * 17 | print '(a)', 'First, let''s instantiate small dense network net1' 18 | print '(a)', 'of shape (1,5,1) and fit it to a sine function:' 19 | print * 20 | 21 | net1 = network([ & 22 | input(1), & 23 | dense(5), & 24 | dense(1) & 25 | ]) 26 | 27 | call net1 % print_info() 28 | 29 | xtest = [((i - 1) * 2 * pi / test_size, i=1, test_size)] 30 | ytest = (sin(xtest) + 1) / 2 31 | 32 | do n = 0, num_iterations 33 | 34 | call random_number(x) 35 | x = x * 2 * pi 36 | y = (sin(x) + 1) / 2 37 | 38 | call net1 % forward(x) 39 | call net1 % backward(y) 40 | call net1 % update(sgd(learning_rate=1.)) 41 | 42 | if (mod(n, 10000) == 0) then 43 | ypred1 = [(net1 % predict([xtest(i)]), i=1, test_size)] 44 | print '(a,i0,1x,f9.6)', 'Number of iterations, loss: ', & 45 | n, sum((ypred1 - ytest)**2) / size(ypred1) 46 | end if 47 | 48 | end do 49 | 50 | print * 51 | print '(a)', 'Now, let''s see how many network parameters there are' 52 | print '(a)', 'by printing the result of net1 % get_num_params():' 53 | print * 54 | print '("net1 % get_num_params() = ", i0)', net1 % get_num_params() 55 | print * 56 | print '(a)', 'We can see the values of the network parameters' 57 | print '(a)', 'by printing the result of net1 % get_params():' 58 | print * 59 | print '("net1 % get_params() = ", *(g0,1x))', net1 % get_params() 60 | print * 61 | print '(a)', 'Now, let''s create another network of the same shape and set' 62 | print '(a)', 'the parameters from the original network to it' 63 | print '(a)', 'by calling call net2 % set_params(net1 % get_params()):' 64 | 65 | net2 = network([ & 66 | input(1), & 67 | dense(5), & 68 | dense(1) & 69 | ]) 70 | 71 | ! Set the parameters of net1 to net2 72 | call net2 % set_params(net1 % get_params()) 73 | 74 | print * 75 | print '(a)', 'We can check that the second network now has the same' 76 | print '(a)', 'parameters as net1:' 77 | print * 78 | print '("net2 % get_params() = ", *(g0,1x))', net2 % get_params() 79 | 80 | ypred1 = [(net1 % predict([xtest(i)]), i=1, test_size)] 81 | ypred2 = [(net2 % predict([xtest(i)]), i=1, test_size)] 82 | 83 | print * 84 | print '(a)', 'We can also check that the two networks produce the same output:' 85 | print * 86 | print '("net1 output: ", *(g0,1x))', ypred1 87 | print '("net2 output: ", *(g0,1x))', ypred2 88 | 89 | print * 90 | print '("Original and cloned network outputs match: ",l)', all(ypred1 == ypred2) 91 | 92 | end program get_set_network_params 93 | -------------------------------------------------------------------------------- /src/nf/nf_layernorm.f90: -------------------------------------------------------------------------------- 1 | module nf_layernorm_layer 2 | use nf_activation, only: activation_function 3 | use nf_base_layer, only: base_layer 4 | 5 | implicit none 6 | 7 | private 8 | public :: layernorm_layer 9 | 10 | type, extends(base_layer) :: layernorm_layer 11 | !! Layer Normalization 12 | !! ((x − mean(x)) / sqrt(variance(x) + eps) * gamma + beta 13 | !! Based upon `Ba, Jimmy Lei, Jamie Ryan Kiros, and Geoffrey E. Hinton(2016)`: 14 | !! https://arxiv.org/abs/1607.06450v1 15 | integer :: sequence_length 16 | integer :: model_dimension 17 | 18 | real :: eps 19 | real, allocatable :: gamma(:) 20 | real, allocatable :: beta(:) 21 | 22 | real, allocatable :: d_gamma(:) 23 | real, allocatable :: d_beta(:) 24 | real, allocatable :: gradient(:, :) 25 | 26 | real, allocatable :: mu(:, :) 27 | real, allocatable :: sigma(:) 28 | 29 | real, allocatable :: output(:, :) 30 | 31 | ! temp storages 32 | real, allocatable, private :: normalized(:, :) 33 | real, allocatable, private :: one_over_sigma(:, :) 34 | real, allocatable, private :: gradient_by_gamma_over_sigma(:, :) 35 | contains 36 | procedure :: forward 37 | procedure :: backward 38 | procedure :: init 39 | procedure :: get_num_params 40 | procedure :: get_params_ptr 41 | procedure :: get_gradients 42 | procedure :: get_gradients_ptr 43 | end type layernorm_layer 44 | 45 | interface layernorm_layer 46 | module function layernorm_layer_cons() & 47 | result(res) 48 | type(layernorm_layer) :: res 49 | end function layernorm_layer_cons 50 | end interface layernorm_layer 51 | 52 | interface 53 | pure module subroutine forward(self, input) 54 | class(layernorm_layer), intent(in out) :: self 55 | real, intent(in) :: input(:, :) 56 | end subroutine forward 57 | 58 | pure module subroutine backward(self, input, gradient) 59 | class(layernorm_layer), intent(in out) :: self 60 | real, intent(in) :: input(:, :) 61 | real, intent(in) :: gradient(:, :) 62 | end subroutine backward 63 | 64 | module subroutine init(self, input_shape) 65 | class(layernorm_layer), intent(in out) :: self 66 | integer, intent(in) :: input_shape(:) 67 | end subroutine init 68 | 69 | pure module function get_num_params(self) result(num_params) 70 | class(layernorm_layer), intent(in) :: self 71 | integer :: num_params 72 | end function get_num_params 73 | 74 | 75 | module subroutine get_params_ptr(self, g_ptr, b_ptr) 76 | class(layernorm_layer), intent(in), target :: self 77 | real, pointer, intent(out) :: g_ptr(:), b_ptr(:) 78 | end subroutine get_params_ptr 79 | 80 | 81 | module function get_gradients(self) result(gradients) 82 | class(layernorm_layer), intent(in), target :: self 83 | real, allocatable :: gradients(:) 84 | end function get_gradients 85 | 86 | 87 | module subroutine get_gradients_ptr(self, dg_ptr, db_ptr) 88 | class(layernorm_layer), intent(in), target :: self 89 | real, pointer, intent(out) :: dg_ptr(:), db_ptr(:) 90 | end subroutine get_gradients_ptr 91 | 92 | 93 | end interface 94 | end module nf_layernorm_layer -------------------------------------------------------------------------------- /test/test_maxpool1d_layer.f90: -------------------------------------------------------------------------------- 1 | program test_maxpool1d_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: maxpool, input, layer 5 | use nf_input2d_layer, only: input2d_layer 6 | use nf_maxpool1d_layer, only: maxpool1d_layer 7 | 8 | implicit none 9 | 10 | type(layer) :: maxpool_layer, input_layer 11 | integer, parameter :: pool_size = 2, stride = 2 12 | integer, parameter :: channels = 3, length = 32 13 | integer, parameter :: input_shape(2) = [channels, length] 14 | integer, parameter :: output_shape(2) = [channels, length / 2] 15 | real, allocatable :: sample_input(:,:), output(:,:), gradient(:,:) 16 | integer :: i 17 | logical :: ok = .true., gradient_ok = .true. 18 | 19 | maxpool_layer = maxpool(pool_width=pool_size, stride=stride) 20 | 21 | if (.not. maxpool_layer % name == 'maxpool1d') then 22 | ok = .false. 23 | write(stderr, '(a)') 'maxpool1d layer has its name set correctly.. failed' 24 | end if 25 | 26 | if (maxpool_layer % initialized) then 27 | ok = .false. 28 | write(stderr, '(a)') 'maxpool1d layer should not be marked as initialized yet.. failed' 29 | end if 30 | 31 | input_layer = input(channels, length) 32 | call maxpool_layer % init(input_layer) 33 | 34 | if (.not. maxpool_layer % initialized) then 35 | ok = .false. 36 | write(stderr, '(a)') 'maxpool1d layer should now be marked as initialized.. failed' 37 | end if 38 | 39 | if (.not. all(maxpool_layer % input_layer_shape == input_shape)) then 40 | ok = .false. 41 | write(stderr, '(a)') 'maxpool1d layer input layer shape should be correct.. failed' 42 | end if 43 | 44 | if (.not. all(maxpool_layer % layer_shape == output_shape)) then 45 | ok = .false. 46 | write(stderr, '(a)') 'maxpool1d layer output layer shape should be correct.. failed' 47 | end if 48 | 49 | ! Allocate and initialize sample input data 50 | allocate(sample_input(channels, length)) 51 | do concurrent(i = 1:length) 52 | sample_input(:,i) = i 53 | end do 54 | 55 | select type(this_layer => input_layer % p); type is(input2d_layer) 56 | call this_layer % set(sample_input) 57 | end select 58 | 59 | call maxpool_layer % forward(input_layer) 60 | call maxpool_layer % get_output(output) 61 | 62 | do i = 1, length / 2 63 | if (.not. all(output(:,i) == stride * i)) then 64 | ok = .false. 65 | write(stderr, '(a)') 'maxpool1d layer forward pass correctly propagates the max value.. failed' 66 | end if 67 | end do 68 | 69 | ! Test the backward pass 70 | allocate(gradient, source=output) 71 | call maxpool_layer % backward(input_layer, gradient) 72 | 73 | select type(this_layer => maxpool_layer % p); type is(maxpool1d_layer) 74 | do i = 1, length 75 | if (mod(i,2) == 0) then 76 | if (.not. all(sample_input(:,i) == this_layer % gradient(:,i))) gradient_ok = .false. 77 | else 78 | if (.not. all(this_layer % gradient(:,i) == 0)) gradient_ok = .false. 79 | end if 80 | end do 81 | end select 82 | 83 | if (.not. gradient_ok) then 84 | ok = .false. 85 | write(stderr, '(a)') 'maxpool1d layer backward pass produces the correct dL/dx.. failed' 86 | end if 87 | 88 | if (ok) then 89 | print '(a)', 'test_maxpool1d_layer: All tests passed.' 90 | else 91 | write(stderr, '(a)') 'test_maxpool1d_layer: One or more tests failed.' 92 | stop 1 93 | end if 94 | 95 | end program test_maxpool1d_layer 96 | -------------------------------------------------------------------------------- /src/nf/nf_datasets_mnist_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_datasets_mnist) nf_datasets_mnist_submodule 2 | 3 | use nf_datasets, only: download_and_unpack, mnist_url 4 | use nf_io_binary, only: read_binary_file 5 | 6 | implicit none 7 | 8 | integer, parameter :: message_len = 128 9 | 10 | contains 11 | 12 | pure module function label_digits(labels) result(res) 13 | real, intent(in) :: labels(:) 14 | real :: res(10, size(labels)) 15 | integer :: i 16 | do i = 1, size(labels) 17 | res(:,i) = digits(labels(i)) 18 | end do 19 | contains 20 | pure function digits(x) 21 | !! Returns an array of 10 reals, with zeros everywhere 22 | !! and a one corresponding to the input digit. 23 | !! 24 | !! Example 25 | !! 26 | !! ``` 27 | !! digits(0) = [1., 0., 0., 0., 0., 0., 0., 0., 0., 0.] 28 | !! digits(1) = [0., 1., 0., 0., 0., 0., 0., 0., 0., 0.] 29 | !! digits(6) = [0., 0., 0., 0., 0., 0., 1., 0., 0., 0.] 30 | !! ``` 31 | real, intent(in) :: x 32 | !! Input digit (0-9) 33 | real :: digits(10) 34 | !! 10-element array of zeros with a single one 35 | !! indicating the input digit 36 | digits = 0 37 | digits(int(x + 1)) = 1 38 | end function digits 39 | end function label_digits 40 | 41 | 42 | module subroutine load_mnist(training_images, training_labels, & 43 | validation_images, validation_labels, & 44 | testing_images, testing_labels) 45 | real, allocatable, intent(in out) :: training_images(:,:) 46 | real, allocatable, intent(in out) :: training_labels(:) 47 | real, allocatable, intent(in out) :: validation_images(:,:) 48 | real, allocatable, intent(in out) :: validation_labels(:) 49 | real, allocatable, intent(in out), optional :: testing_images(:,:) 50 | real, allocatable, intent(in out), optional :: testing_labels(:) 51 | 52 | integer, parameter :: dtype = 4, image_size = 784 53 | integer, parameter :: num_training_images = 50000 54 | integer, parameter :: num_validation_images = 10000 55 | integer, parameter :: num_testing_images = 10000 56 | logical :: file_exists 57 | 58 | ! Check if MNIST data is present and download it if not. 59 | inquire(file='mnist_training_images.dat', exist=file_exists) 60 | if (.not. file_exists) call download_and_unpack(mnist_url) 61 | 62 | ! Load the training dataset (50000 samples) 63 | call read_binary_file('mnist_training_images.dat', & 64 | dtype, image_size, num_training_images, training_images) 65 | call read_binary_file('mnist_training_labels.dat', & 66 | dtype, num_training_images, training_labels) 67 | 68 | ! Load the validation dataset (10000 samples), for use while training 69 | call read_binary_file('mnist_validation_images.dat', & 70 | dtype, image_size, num_validation_images, validation_images) 71 | call read_binary_file('mnist_validation_labels.dat', & 72 | dtype, num_validation_images, validation_labels) 73 | 74 | ! Load the testing dataset (10000 samples), to test after training 75 | if (present(testing_images) .and. present(testing_labels)) then 76 | call read_binary_file('mnist_testing_images.dat', & 77 | dtype, image_size, num_testing_images, testing_images) 78 | call read_binary_file('mnist_testing_labels.dat', & 79 | dtype, num_testing_images, testing_labels) 80 | end if 81 | 82 | end subroutine load_mnist 83 | 84 | end submodule nf_datasets_mnist_submodule 85 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing guide 2 | 3 | This document describes the organization of the neural-fortran codebase to help 4 | guide the code contributors. 5 | 6 | ## Overall code organization 7 | 8 | The source code organization follows the usual `fpm` convention: 9 | the library code is in [src/](src/), test programs are in [test/](test/), 10 | and example programs are in [example/](example/). 11 | 12 | The top-level module that suggests the public, user-facing API is in 13 | [src/nf.f90](src/nf.f90). 14 | All other library source files are in [src/nf/](src/nf/). 15 | 16 | Most of the library code defines interfaces in modules and implementations in 17 | submodules. 18 | If you want to know only about interfaces, in other words how to call procedures 19 | and what these procedures return, you can read just the module source files and 20 | not worry about the implementation. 21 | Then, if you want to know more about the implementation, you can find it in the 22 | appropriate source file that defines the submodule. 23 | Each library source file contains either one module or one submodule. 24 | The source files that define the submodule end with `_submodule.f90`. 25 | 26 | ## Components 27 | 28 | Neural-fortran defines several components, described in a roughly top-down order: 29 | 30 | * Networks 31 | * Layers 32 | - Layer constructor functions 33 | - Concrete layer implementations 34 | * Optimizers 35 | * Activation functions 36 | 37 | ### Networks 38 | 39 | A network is the main component that the user works with, 40 | and the highest-level container in neural-fortran. 41 | A network is a collection of layers. 42 | 43 | The network container is defined by the `network` derived type 44 | in the `nf_network` module, in the [nf_network.f90](src/nf/nf_network.f90) 45 | source file. 46 | 47 | In a nutshell, the `network` type defines an allocatable array of `type(layer)` 48 | instances, and several type-bound methods for training and inference. 49 | 50 | ### Layers 51 | 52 | Layers are the main building blocks of neural-fortran and neural networks in 53 | general. 54 | There is a common, high-level layer type that maintains the data flow 55 | in and out and calls the specific layer implementations of forward and backward 56 | pass methods. 57 | 58 | When introducing a new layer type, study how the [dense](src/nf/nf_dense_layer.f90) 59 | or [convolutional](src/nf/nf_conv2d_layer.f90) concrete types are defined and 60 | implemented in their respective submodules. 61 | You will also need to follow the same use pattern in the 62 | [high-level layer type](src/nf/nf_layer.f90) and its corresponding submodule. 63 | 64 | ### Optimizers 65 | 66 | Optimizers are the algorithms that determine how the model parameters are 67 | updated during training. 68 | 69 | Optimizers are currently implmented in the [nf_optimizers.f90](src/nf/nf_optimizers.f90) 70 | source file and corresponding module. 71 | An optimizer instance is passed to the network at the `network % train()` call 72 | site. 73 | 74 | ### Activation functions 75 | 76 | Activation functions and their derivatives are defined in the 77 | [nf_activation.f90](src/nf/nf_activation.f90) source file and corresponding 78 | types. 79 | They are implemented using a base activation abstract type and concrete types 80 | for each activation function. 81 | When implementing a new activation function in the library, you need to define 82 | a new concrete type that extends the abstract activation function type. 83 | The concrete type must have `eval` and `eval_prime` methods that evaluate the 84 | function and its derivative, respectively. -------------------------------------------------------------------------------- /test/test_conv2d_layer.f90: -------------------------------------------------------------------------------- 1 | program test_conv2d_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: conv, input, layer 5 | use nf_input3d_layer, only: input3d_layer 6 | 7 | implicit none 8 | 9 | type(layer) :: conv_layer, input_layer 10 | integer, parameter :: filters = 32, kernel_size=3 11 | real, allocatable :: sample_input(:,:,:), output(:,:,:) 12 | real, parameter :: tolerance = 1e-7 13 | logical :: ok = .true. 14 | 15 | conv_layer = conv(filters, kernel_size, kernel_size) 16 | 17 | if (.not. conv_layer % name == 'conv2d') then 18 | ok = .false. 19 | write(stderr, '(a)') 'conv2d layer has its name set correctly.. failed' 20 | end if 21 | 22 | if (conv_layer % initialized) then 23 | ok = .false. 24 | write(stderr, '(a)') 'conv2d layer should not be marked as initialized yet.. failed' 25 | end if 26 | 27 | if (.not. conv_layer % activation == 'relu') then 28 | ok = .false. 29 | write(stderr, '(a)') 'conv2d layer defaults to relu activation.. failed' 30 | end if 31 | 32 | input_layer = input(3, 32, 32) 33 | call conv_layer % init(input_layer) 34 | 35 | if (.not. conv_layer % initialized) then 36 | ok = .false. 37 | write(stderr, '(a)') 'conv2d layer should now be marked as initialized.. failed' 38 | end if 39 | 40 | if (.not. all(conv_layer % input_layer_shape == [3, 32, 32])) then 41 | ok = .false. 42 | write(stderr, '(a)') 'conv2d layer input layer shape should be correct.. failed' 43 | end if 44 | 45 | if (.not. all(conv_layer % layer_shape == [filters, 30, 30])) then 46 | ok = .false. 47 | write(stderr, '(a)') 'conv2d layer input layer shape should be correct.. failed' 48 | end if 49 | 50 | ! Minimal conv2d layer: 1 channel, 3x3 pixel image; 51 | allocate(sample_input(1, 3, 3)) 52 | sample_input = 0 53 | 54 | input_layer = input(1, 3, 3) 55 | conv_layer = conv(filters, kernel_size, kernel_size) 56 | call conv_layer % init(input_layer) 57 | 58 | select type(this_layer => input_layer % p); type is(input3d_layer) 59 | call this_layer % set(sample_input) 60 | end select 61 | 62 | deallocate(sample_input) 63 | 64 | call conv_layer % forward(input_layer) 65 | call conv_layer % get_output(output) 66 | 67 | if (.not. all(abs(output) < tolerance)) then 68 | ok = .false. 69 | write(stderr, '(a)') 'conv2d layer with zero input and sigmoid function must forward to all 0.5.. failed' 70 | end if 71 | 72 | ! Minimal conv2d layer: 1 channel, 17x17 pixel image, stride=3; 73 | allocate(sample_input(1, 17, 17)) 74 | sample_input = 0 75 | 76 | input_layer = input(1, 17, 17) 77 | conv_layer = conv(filters, kernel_size, kernel_size, stride=[3, 4]) 78 | call conv_layer % init(input_layer) 79 | 80 | select type(this_layer => input_layer % p); type is(input3d_layer) 81 | call this_layer % set(sample_input) 82 | end select 83 | 84 | deallocate(sample_input) 85 | 86 | call conv_layer % forward(input_layer) 87 | call conv_layer % get_output(output) 88 | 89 | if (.not. all(abs(output) < tolerance)) then 90 | ok = .false. 91 | write(stderr, '(a)') 'conv2d layer with zero input and sigmoid function must forward to all 0.5.. failed' 92 | end if 93 | 94 | ! Summary 95 | if (ok) then 96 | print '(a)', 'test_conv2d_layer: All tests passed.' 97 | else 98 | write(stderr, '(a)') 'test_conv2d_layer: One or more tests failed.' 99 | stop 1 100 | end if 101 | 102 | end program test_conv2d_layer 103 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | # CMake version, project name, language 2 | cmake_minimum_required(VERSION 3.20) 3 | 4 | # If build type not specified, default to release 5 | if(NOT CMAKE_BUILD_TYPE) 6 | set(CMAKE_BUILD_TYPE "Release" CACHE STRING "Default build Release") 7 | endif() 8 | 9 | project(neural-fortran LANGUAGES Fortran) 10 | 11 | enable_testing() 12 | 13 | include(cmake/options.cmake) 14 | include(cmake/compilers.cmake) 15 | 16 | # library to archive (libneural-fortran.a) 17 | add_library(neural-fortran 18 | src/nf.f90 19 | src/nf/nf_activation.f90 20 | src/nf/nf_base_layer.f90 21 | src/nf/nf_conv1d_layer.f90 22 | src/nf/nf_conv1d_layer_submodule.f90 23 | src/nf/nf_conv2d_layer.f90 24 | src/nf/nf_conv2d_layer_submodule.f90 25 | src/nf/nf_cross_attention_layer.f90 26 | src/nf/nf_datasets.f90 27 | src/nf/nf_datasets_submodule.f90 28 | src/nf/nf_datasets_mnist.f90 29 | src/nf/nf_datasets_mnist_submodule.f90 30 | src/nf/nf_dense_layer.f90 31 | src/nf/nf_dense_layer_submodule.f90 32 | src/nf/nf_flatten_layer.f90 33 | src/nf/nf_flatten_layer_submodule.f90 34 | src/nf/nf_input1d_layer.f90 35 | src/nf/nf_input1d_layer_submodule.f90 36 | src/nf/nf_input2d_layer.f90 37 | src/nf/nf_input2d_layer_submodule.f90 38 | src/nf/nf_input3d_layer.f90 39 | src/nf/nf_input3d_layer_submodule.f90 40 | src/nf/nf_layer_constructors.f90 41 | src/nf/nf_layer_constructors_submodule.f90 42 | src/nf/nf_layernorm.f90 43 | src/nf/nf_layernorm_submodule.f90 44 | src/nf/nf_layer.f90 45 | src/nf/nf_layer_submodule.f90 46 | src/nf/nf_locally_connected2d_layer_submodule.f90 47 | src/nf/nf_locally_connected2d_layer.f90 48 | src/nf/nf_linear2d_layer.f90 49 | src/nf/nf_linear2d_layer_submodule.f90 50 | src/nf/nf_embedding_layer.f90 51 | src/nf/nf_embedding_layer_submodule.f90 52 | src/nf/nf_loss.f90 53 | src/nf/nf_loss_submodule.f90 54 | src/nf/nf_maxpool1d_layer.f90 55 | src/nf/nf_maxpool1d_layer_submodule.f90 56 | src/nf/nf_maxpool2d_layer.f90 57 | src/nf/nf_maxpool2d_layer_submodule.f90 58 | src/nf/nf_metrics.f90 59 | src/nf/nf_multihead_attention_layer.f90 60 | src/nf/nf_multihead_attention_layer_submodule.f90 61 | src/nf/nf_network.f90 62 | src/nf/nf_network_submodule.f90 63 | src/nf/nf_optimizers.f90 64 | src/nf/nf_parallel.f90 65 | src/nf/nf_parallel_submodule.f90 66 | src/nf/nf_random.f90 67 | src/nf/nf_reshape2d_layer.f90 68 | src/nf/nf_reshape2d_layer_submodule.f90 69 | src/nf/nf_reshape3d_layer.f90 70 | src/nf/nf_reshape3d_layer_submodule.f90 71 | src/nf/nf_self_attention_layer.f90 72 | src/nf/io/nf_io_binary.f90 73 | src/nf/io/nf_io_binary_submodule.f90 74 | src/nf/nf_dropout_layer.f90 75 | src/nf/nf_dropout_layer_submodule.f90 76 | ) 77 | 78 | target_link_libraries(neural-fortran PRIVATE) 79 | set_target_properties(neural-fortran PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include) 80 | 81 | install(TARGETS neural-fortran) 82 | 83 | # Install the module files 84 | install(DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include/ DESTINATION include) 85 | 86 | # Also install the cmake/Findneural-fortran.cmake file 87 | install(FILES cmake/Findneural-fortran.cmake DESTINATION include/cmake/neural-fortran) 88 | 89 | # Remove leading or trailing whitespace 90 | string(REGEX REPLACE "^ | $" "" LIBS "${LIBS}") 91 | 92 | if(${PROJECT_NAME}_BUILD_TESTING) 93 | message(STATUS "Building tests") 94 | add_subdirectory(test) 95 | endif() 96 | 97 | if(${PROJECT_NAME}_BUILD_EXAMPLES) 98 | message(STATUS "Building examples") 99 | add_subdirectory(example) 100 | endif() 101 | -------------------------------------------------------------------------------- /src/nf/nf_embedding_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_embedding_layer 2 | 3 | use nf_activation, only: activation_function 4 | use nf_base_layer, only: base_layer 5 | 6 | implicit none 7 | 8 | private 9 | public :: embedding_layer 10 | 11 | type, extends(base_layer) :: embedding_layer 12 | !! Embedding Layer 13 | !! Stores inputs as a trainable lookup table. Inputs are 14 | !! integer indicies in a dictionary of `vocab_size`. 15 | !! This layer converts them into a table of shape 16 | !! (`sequence_length`, `model_dimension`) 17 | integer :: sequence_length, vocab_size, model_dimension 18 | integer :: positional 19 | 20 | real, allocatable :: weights(:, :) 21 | real, allocatable :: output(:, :) 22 | real, allocatable :: dw(:, :) ! weight gradients 23 | 24 | contains 25 | 26 | procedure :: backward 27 | procedure :: forward 28 | procedure :: positional_trigonometric 29 | procedure :: positional_absolute 30 | procedure :: init 31 | procedure :: get_num_params 32 | procedure :: get_params 33 | procedure :: get_gradients 34 | procedure :: set_params 35 | 36 | end type embedding_layer 37 | 38 | interface embedding_layer 39 | module function embedding_layer_cons(vocab_size, model_dimension, positional) result(res) 40 | integer, intent(in) :: vocab_size, model_dimension 41 | integer, optional :: positional 42 | type(embedding_layer) :: res 43 | end function embedding_layer_cons 44 | end interface embedding_layer 45 | 46 | interface 47 | pure module subroutine forward(self, input) 48 | !! Get vectors by indicis in the dictionary 49 | class(embedding_layer), intent(in out) :: self 50 | integer, intent(in) :: input(:) 51 | end subroutine forward 52 | 53 | pure module subroutine backward(self, input, gradient) 54 | !! Update gradient at `input` indices 55 | !! dw_i = W_i + d_output_i 56 | class(embedding_layer), intent(in out) :: self 57 | integer, intent(in) :: input(:) 58 | real, intent(in) :: gradient(:, :) 59 | end subroutine backward 60 | 61 | pure module subroutine positional_trigonometric(self, pos) 62 | !! Sum embedding with positional info (trigonometric, not trianable) 63 | class(embedding_layer), intent(in out) :: self 64 | integer, intent(in) :: pos 65 | end subroutine positional_trigonometric 66 | 67 | pure module subroutine positional_absolute(self, pos) 68 | !! Sum embedding with absolute position 69 | class(embedding_layer), intent(in out) :: self 70 | integer, intent(in) :: pos 71 | end subroutine positional_absolute 72 | 73 | module subroutine init(self, input_shape) 74 | class(embedding_layer), intent(in out) :: self 75 | integer, intent(in) :: input_shape(:) 76 | end subroutine init 77 | 78 | pure module function get_num_params(self) result(num_params) 79 | class(embedding_layer), intent(in) :: self 80 | integer :: num_params 81 | end function get_num_params 82 | 83 | module function get_params(self) result(params) 84 | class(embedding_layer), intent(in), target :: self 85 | real, allocatable :: params(:) 86 | end function get_params 87 | 88 | module function get_gradients(self) result(gradients) 89 | class(embedding_layer), intent(in), target :: self 90 | real, allocatable :: gradients(:) 91 | end function get_gradients 92 | 93 | module subroutine set_params(self, params) 94 | class(embedding_layer), intent(in out) :: self 95 | real, intent(in), target :: params(:) 96 | end subroutine set_params 97 | end interface 98 | end module nf_embedding_layer 99 | -------------------------------------------------------------------------------- /test/test_conv1d_layer.f90: -------------------------------------------------------------------------------- 1 | program test_conv1d_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: conv, input, layer 5 | use nf_input2d_layer, only: input2d_layer 6 | 7 | implicit none 8 | 9 | type(layer) :: conv1d_layer, input_layer 10 | integer, parameter :: filters = 32, kernel_size=3 11 | real, allocatable :: sample_input(:,:), output(:,:) 12 | real, parameter :: tolerance = 1e-7 13 | logical :: ok = .true. 14 | 15 | conv1d_layer = conv(filters, kernel_size) 16 | 17 | if (.not. conv1d_layer % name == 'conv1d') then 18 | ok = .false. 19 | write(stderr, '(a)') 'conv1d layer has its name set correctly.. failed' 20 | end if 21 | 22 | if (conv1d_layer % initialized) then 23 | ok = .false. 24 | write(stderr, '(a)') 'conv1d layer should not be marked as initialized yet.. failed' 25 | end if 26 | 27 | if (.not. conv1d_layer % activation == 'relu') then 28 | ok = .false. 29 | write(stderr, '(a)') 'conv1d layer defaults to relu activation.. failed' 30 | end if 31 | 32 | input_layer = input(3, 32) 33 | call conv1d_layer % init(input_layer) 34 | 35 | if (.not. conv1d_layer % initialized) then 36 | ok = .false. 37 | write(stderr, '(a)') 'conv1d layer should now be marked as initialized.. failed' 38 | end if 39 | 40 | if (.not. all(conv1d_layer % input_layer_shape == [3, 32])) then 41 | ok = .false. 42 | write(stderr, '(a)') 'conv1d layer input layer shape should be correct.. failed' 43 | end if 44 | 45 | if (.not. all(conv1d_layer % layer_shape == [filters, 30])) then 46 | ok = .false. 47 | write(stderr, '(a)') 'conv1d layer input layer shape should be correct.. failed' 48 | end if 49 | 50 | ! Minimal conv1d layer: 1 channel, 3x3 pixel image; 51 | allocate(sample_input(1, 3)) 52 | sample_input = 0 53 | 54 | input_layer = input(1, 3) 55 | conv1d_layer = conv(filters, kernel_size) 56 | call conv1d_layer % init(input_layer) 57 | 58 | select type(this_layer => input_layer % p); type is(input2d_layer) 59 | call this_layer % set(sample_input) 60 | end select 61 | deallocate(sample_input) 62 | 63 | call conv1d_layer % forward(input_layer) 64 | call conv1d_layer % get_output(output) 65 | 66 | if (.not. all(abs(output) < tolerance)) then 67 | ok = .false. 68 | write(stderr, '(a)') 'conv1d layer with zero input and sigmoid function must forward to all 0.5.. failed' 69 | end if 70 | 71 | ! Minimal conv1d layer: 1 channel, 3x3 pixel image, stride = 3; 72 | allocate(sample_input(1, 17)) 73 | sample_input = 0 74 | 75 | input_layer = input(1, 17) 76 | conv1d_layer = conv(filters, kernel_size, stride = 3) 77 | call conv1d_layer % init(input_layer) 78 | 79 | select type(this_layer => input_layer % p); type is(input2d_layer) 80 | call this_layer % set(sample_input) 81 | end select 82 | deallocate(sample_input) 83 | 84 | call conv1d_layer % forward(input_layer) 85 | call conv1d_layer % get_output(output) 86 | 87 | if (.not. all(abs(output) < tolerance)) then 88 | ok = .false. 89 | write(stderr, '(a)') 'conv1d layer with zero input and sigmoid function must forward to all 0.5.. failed' 90 | end if 91 | 92 | !Final 93 | if (ok) then 94 | print '(a)', 'test_conv1d_layer: All tests passed.' 95 | else 96 | write(stderr, '(a)') 'test_conv1d_layer: One or more tests failed.' 97 | stop 1 98 | end if 99 | 100 | end program test_conv1d_layer 101 | -------------------------------------------------------------------------------- /src/nf/nf_loss.f90: -------------------------------------------------------------------------------- 1 | module nf_loss 2 | 3 | !! This module provides a collection of loss functions and their derivatives. 4 | !! The implementation is based on an abstract loss derived type 5 | !! which has the required eval and derivative methods. 6 | !! An implementation of a new loss type thus requires writing a concrete 7 | !! loss type that extends the abstract loss derived type, and that 8 | !! implements concrete eval and derivative methods that accept vectors. 9 | 10 | use nf_metrics, only: metric_type 11 | implicit none 12 | 13 | private 14 | public :: loss_type 15 | public :: mse 16 | public :: quadratic 17 | 18 | type, extends(metric_type), abstract :: loss_type 19 | contains 20 | procedure(loss_derivative_interface), nopass, deferred :: derivative 21 | end type loss_type 22 | 23 | abstract interface 24 | pure function loss_derivative_interface(true, predicted) result(res) 25 | real, intent(in) :: true(:) 26 | real, intent(in) :: predicted(:) 27 | real :: res(size(true)) 28 | end function loss_derivative_interface 29 | end interface 30 | 31 | type, extends(loss_type) :: mse 32 | !! Mean Square Error loss function 33 | contains 34 | procedure, nopass :: eval => mse_eval 35 | procedure, nopass :: derivative => mse_derivative 36 | end type mse 37 | 38 | type, extends(loss_type) :: quadratic 39 | !! Quadratic loss function 40 | contains 41 | procedure, nopass :: eval => quadratic_eval 42 | procedure, nopass :: derivative => quadratic_derivative 43 | end type quadratic 44 | 45 | interface 46 | 47 | pure module function mse_eval(true, predicted) result(res) 48 | !! Mean Square Error loss function: 49 | !! 50 | !! L = sum((predicted - true)**2) / size(true) 51 | !! 52 | real, intent(in) :: true(:) 53 | !! True values, i.e. labels from training datasets 54 | real, intent(in) :: predicted(:) 55 | !! Values predicted by the network 56 | real :: res 57 | !! Resulting loss value 58 | end function mse_eval 59 | 60 | pure module function mse_derivative(true, predicted) result(res) 61 | !! First derivative of the Mean Square Error loss function: 62 | !! 63 | !! L = 2 * (predicted - true) / size(true) 64 | !! 65 | real, intent(in) :: true(:) 66 | !! True values, i.e. labels from training datasets 67 | real, intent(in) :: predicted(:) 68 | !! Values predicted by the network 69 | real :: res(size(true)) 70 | !! Resulting loss values 71 | end function mse_derivative 72 | 73 | pure module function quadratic_eval(true, predicted) result(res) 74 | !! Quadratic loss function: 75 | !! 76 | !! L = sum((predicted - true)**2) / 2 77 | !! 78 | real, intent(in) :: true(:) 79 | !! True values, i.e. labels from training datasets 80 | real, intent(in) :: predicted(:) 81 | !! Values predicted by the network 82 | real :: res 83 | !! Resulting loss value 84 | end function quadratic_eval 85 | 86 | pure module function quadratic_derivative(true, predicted) result(res) 87 | !! First derivative of the quadratic loss function: 88 | !! 89 | !! L' = predicted - true 90 | !! 91 | real, intent(in) :: true(:) 92 | !! True values, i.e. labels from training datasets 93 | real, intent(in) :: predicted(:) 94 | !! Values predicted by the network 95 | real :: res(size(true)) 96 | !! Resulting loss values 97 | end function quadratic_derivative 98 | 99 | end interface 100 | 101 | end module nf_loss 102 | -------------------------------------------------------------------------------- /src/nf/nf_linear2d_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_linear2d_layer) nf_linear2d_layer_submodule 2 | use nf_base_layer, only: base_layer 3 | use nf_random, only: random_normal 4 | implicit none 5 | 6 | contains 7 | 8 | module function linear2d_layer_cons(out_features) result(res) 9 | integer, intent(in) :: out_features 10 | type(linear2d_layer) :: res 11 | 12 | res % out_features = out_features 13 | 14 | end function linear2d_layer_cons 15 | 16 | 17 | module subroutine init(self, input_shape) 18 | class(linear2d_layer), intent(in out) :: self 19 | integer, intent(in) :: input_shape(:) 20 | 21 | if (size(input_shape) /= 2) then 22 | error stop "linear2d layer requires 2D input." 23 | end if 24 | self % sequence_length = input_shape(1) 25 | self % in_features = input_shape(2) 26 | 27 | allocate(self % output(self % sequence_length, self % out_features)) 28 | allocate(self % gradient(self % sequence_length, self % in_features)) 29 | 30 | allocate(self % weights(self % in_features, self % out_features)) 31 | call random_normal(self % weights) 32 | 33 | allocate(self % biases(self % out_features)) 34 | call random_normal(self % biases) 35 | 36 | allocate(self % dw(self % in_features, self % out_features)) 37 | self % dw = 0 38 | 39 | allocate(self % db(self % out_features)) 40 | self % db = 0 41 | 42 | end subroutine init 43 | 44 | 45 | pure module subroutine forward(self, input) 46 | class(linear2d_layer), intent(in out) :: self 47 | real, intent(in) :: input(:, :) 48 | integer :: i 49 | 50 | self % output(:,:) = matmul(input(:,:), self % weights) 51 | do concurrent(i = 1:self % sequence_length) 52 | self % output(i,:) = self % output(i,:) + self % biases 53 | end do 54 | 55 | end subroutine forward 56 | 57 | 58 | pure module subroutine backward(self, input, gradient) 59 | class(linear2d_layer), intent(in out) :: self 60 | real, intent(in) :: input(:,:) 61 | real, intent(in) :: gradient(:,:) 62 | real :: db(self % out_features) 63 | real :: dw(self % in_features, self % out_features) 64 | integer :: i 65 | 66 | self % dw = self % dw + matmul(transpose(input(:,:)), gradient(:,:)) 67 | self % db = self % db + sum(gradient(:,:), 1) 68 | self % gradient(:,:) = matmul(gradient(:,:), transpose(self % weights)) 69 | end subroutine backward 70 | 71 | 72 | pure module function get_num_params(self) result(num_params) 73 | class(linear2d_layer), intent(in) :: self 74 | integer :: num_params 75 | 76 | ! Number of weights times number of biases 77 | num_params = self % in_features * self % out_features + self % out_features 78 | 79 | end function get_num_params 80 | 81 | 82 | module subroutine get_params_ptr(self, w_ptr, b_ptr) 83 | class(linear2d_layer), intent(in), target :: self 84 | real, pointer, intent(out) :: w_ptr(:), b_ptr(:) 85 | w_ptr(1:size(self % weights)) => self % weights 86 | b_ptr => self % biases 87 | end subroutine get_params_ptr 88 | 89 | 90 | module function get_gradients(self) result(gradients) 91 | class(linear2d_layer), intent(in), target :: self 92 | real, allocatable :: gradients(:) 93 | real, pointer :: dw_(:) => null() 94 | dw_(1:size(self % dw)) => self % dw 95 | gradients = [dw_, self % db] 96 | end function get_gradients 97 | 98 | 99 | module subroutine get_gradients_ptr(self, dw_ptr, db_ptr) 100 | class(linear2d_layer), intent(in), target :: self 101 | real, pointer, intent(out) :: dw_ptr(:), db_ptr(:) 102 | dw_ptr(1:size(self % dw)) => self % dw 103 | db_ptr => self % db 104 | end subroutine get_gradients_ptr 105 | 106 | 107 | end submodule nf_linear2d_layer_submodule -------------------------------------------------------------------------------- /src/nf/nf_maxpool2d_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_maxpool2d_layer) nf_maxpool2d_layer_submodule 2 | 3 | implicit none 4 | 5 | contains 6 | 7 | pure module function maxpool2d_layer_cons(pool_size, stride) result(res) 8 | integer, intent(in) :: pool_size 9 | integer, intent(in) :: stride 10 | type(maxpool2d_layer) :: res 11 | res % pool_size = pool_size 12 | res % stride = stride 13 | end function maxpool2d_layer_cons 14 | 15 | 16 | module subroutine init(self, input_shape) 17 | class(maxpool2d_layer), intent(in out) :: self 18 | integer, intent(in) :: input_shape(:) 19 | 20 | self % channels = input_shape(1) 21 | self % width = input_shape(2) / self % stride 22 | self % height = input_shape(3) / self % stride 23 | 24 | allocate(self % maxloc_x(self % channels, self % width, self % height)) 25 | self % maxloc_x = 0 26 | 27 | allocate(self % maxloc_y(self % channels, self % width, self % height)) 28 | self % maxloc_y = 0 29 | 30 | allocate(self % gradient(input_shape(1),input_shape(2),input_shape(3))) 31 | self % gradient = 0 32 | 33 | allocate(self % output(self % channels, self % width, self % height)) 34 | self % output = 0 35 | 36 | end subroutine init 37 | 38 | 39 | pure module subroutine forward(self, input) 40 | class(maxpool2d_layer), intent(in out) :: self 41 | real, intent(in) :: input(:,:,:) 42 | integer :: input_width, input_height 43 | integer :: i, j, n 44 | integer :: ii, jj 45 | integer :: iend, jend 46 | integer :: iextent, jextent 47 | integer :: maxloc_xy(2) 48 | 49 | input_width = size(input, dim=2) 50 | input_height = size(input, dim=3) 51 | 52 | iextent = input_width - mod(input_width, self % stride) 53 | jextent = input_height - mod(input_height, self % stride) 54 | 55 | ! Stride along the width and height of the input image 56 | stride_over_input: do concurrent( & 57 | i = 1:iextent:self % stride, & 58 | j = 1:jextent:self % stride & 59 | ) 60 | 61 | ! Indices of the pooling layer 62 | ii = i / self % stride + 1 63 | jj = j / self % stride + 1 64 | 65 | iend = i + self % pool_size - 1 66 | jend = j + self % pool_size - 1 67 | 68 | maxpool_for_each_channel: do concurrent(n = 1:self % channels) 69 | 70 | ! Get and store the location of the maximum value 71 | maxloc_xy = maxloc(input(n,i:iend,j:jend)) 72 | self % maxloc_x(n,ii,jj) = maxloc_xy(1) + i - 1 73 | self % maxloc_y(n,ii,jj) = maxloc_xy(2) + j - 1 74 | 75 | self % output(n,ii,jj) = & 76 | input(n,self % maxloc_x(n,ii,jj),self % maxloc_y(n,ii,jj)) 77 | 78 | end do maxpool_for_each_channel 79 | 80 | end do stride_over_input 81 | 82 | end subroutine forward 83 | 84 | 85 | pure module subroutine backward(self, input, gradient) 86 | class(maxpool2d_layer), intent(in out) :: self 87 | real, intent(in) :: input(:,:,:) 88 | real, intent(in) :: gradient(:,:,:) 89 | integer :: gradient_shape(3) 90 | integer :: channels, width, height 91 | integer :: i, j, n 92 | 93 | gradient_shape = shape(gradient) 94 | channels = gradient_shape(1) 95 | width = gradient_shape(2) 96 | height = gradient_shape(3) 97 | 98 | ! The gradient of a max-pooling layer is just a value of the downstream 99 | ! gradient at the location of the maximum value, stored during the 100 | ! forward pass. 101 | do concurrent(n = 1:channels, i = 1:width, j = 1:height) 102 | associate(ii => self % maxloc_x(n,i,j), jj => self % maxloc_y(n,i,j)) 103 | self % gradient(n,ii,jj) = gradient(n,i,j) 104 | end associate 105 | end do 106 | 107 | end subroutine backward 108 | 109 | end submodule nf_maxpool2d_layer_submodule 110 | -------------------------------------------------------------------------------- /test/test_maxpool2d_layer.f90: -------------------------------------------------------------------------------- 1 | program test_maxpool2d_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: maxpool, input, layer 5 | use nf_input3d_layer, only: input3d_layer 6 | use nf_maxpool2d_layer, only: maxpool2d_layer 7 | 8 | implicit none 9 | 10 | type(layer) :: maxpool_layer, input_layer 11 | integer, parameter :: pool_size = 2, stride = 2 12 | integer, parameter :: channels = 3, width = 32 13 | integer, parameter :: input_shape(3) = [channels, width, width] 14 | integer, parameter :: output_shape(3) = [channels, width / 2, width / 2] 15 | real, allocatable :: sample_input(:,:,:), output(:,:,:), gradient(:,:,:) 16 | integer :: i, j 17 | logical :: ok = .true., gradient_ok = .true. 18 | 19 | maxpool_layer = maxpool(pool_width=pool_size, pool_height=pool_size, stride=stride) 20 | 21 | if (.not. maxpool_layer % name == 'maxpool2d') then 22 | ok = .false. 23 | write(stderr, '(a)') 'maxpool2d layer has its name set correctly.. failed' 24 | end if 25 | 26 | if (maxpool_layer % initialized) then 27 | ok = .false. 28 | write(stderr, '(a)') 'maxpool2d layer should not be marked as initialized yet.. failed' 29 | end if 30 | 31 | input_layer = input(channels, width, width) 32 | call maxpool_layer % init(input_layer) 33 | 34 | if (.not. maxpool_layer % initialized) then 35 | ok = .false. 36 | write(stderr, '(a)') 'maxpool2d layer should now be marked as initialized.. failed' 37 | end if 38 | 39 | if (.not. all(maxpool_layer % input_layer_shape == input_shape)) then 40 | ok = .false. 41 | write(stderr, '(a)') 'maxpool2d layer input layer shape should be correct.. failed' 42 | end if 43 | 44 | if (.not. all(maxpool_layer % layer_shape == output_shape)) then 45 | ok = .false. 46 | write(stderr, '(a)') 'maxpool2d layer input layer shape should be correct.. failed' 47 | end if 48 | 49 | ! Allocate and initialize sample input data 50 | allocate(sample_input(channels, width, width)) 51 | do concurrent(i = 1:width, j = 1:width) 52 | sample_input(:,i,j) = i * j 53 | end do 54 | 55 | select type(this_layer => input_layer % p); type is(input3d_layer) 56 | call this_layer % set(sample_input) 57 | end select 58 | 59 | call maxpool_layer % forward(input_layer) 60 | call maxpool_layer % get_output(output) 61 | 62 | do j = 1, width / 2 63 | do i = 1, width / 2 64 | ! Since input is i*j, maxpool2d output must be stride*i * stride*j 65 | if (.not. all(output(:,i,j) == stride**2 * i * j)) then 66 | ok = .false. 67 | write(stderr, '(a)') 'maxpool2d layer forward pass correctly propagates the max value.. failed' 68 | end if 69 | end do 70 | end do 71 | 72 | ! Test the backward pass 73 | ! Allocate and initialize the downstream gradient field 74 | allocate(gradient, source=output) 75 | 76 | ! Make a backward pass 77 | call maxpool_layer % backward(input_layer, gradient) 78 | 79 | select type(this_layer => maxpool_layer % p); type is(maxpool2d_layer) 80 | do j = 1, width 81 | do i = 1, width 82 | if (mod(i,2) == 0 .and. mod(j,2) == 0) then 83 | if (.not. all(sample_input(:,i,j) == this_layer % gradient(:,i,j))) gradient_ok = .false. 84 | else 85 | if (.not. all(this_layer % gradient(:,i,j) == 0)) gradient_ok = .false. 86 | end if 87 | end do 88 | end do 89 | end select 90 | 91 | if (.not. gradient_ok) then 92 | ok = .false. 93 | write(stderr, '(a)') 'maxpool2d layer backward pass produces the correct dL/dx.. failed' 94 | end if 95 | 96 | if (ok) then 97 | print '(a)', 'test_maxpool2d_layer: All tests passed.' 98 | else 99 | write(stderr, '(a)') 'test_maxpool2d_layer: One or more tests failed.' 100 | stop 1 101 | end if 102 | 103 | end program test_maxpool2d_layer 104 | -------------------------------------------------------------------------------- /src/nf/nf_dense_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_dense_layer) nf_dense_layer_submodule 2 | 3 | use nf_activation, only: activation_function 4 | use nf_random, only: random_normal 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | module function dense_layer_cons(output_size, activation) & 11 | result(res) 12 | integer, intent(in) :: output_size 13 | class(activation_function), intent(in) :: activation 14 | type(dense_layer) :: res 15 | 16 | res % output_size = output_size 17 | res % activation_name = activation % get_name() 18 | allocate( res % activation, source = activation ) 19 | 20 | end function dense_layer_cons 21 | 22 | 23 | pure module subroutine backward(self, input, gradient) 24 | class(dense_layer), intent(in out) :: self 25 | real, intent(in) :: input(:) 26 | real, intent(in) :: gradient(:) 27 | real :: db(self % output_size) 28 | real :: dw(self % input_size, self % output_size) 29 | integer :: i 30 | 31 | db = gradient * self % activation % eval_prime(self % z) 32 | ! dw = matmul(reshape(input, [size(input), 1]), reshape(db, [1, size(db)])) 33 | do concurrent (i = 1:size(db)) 34 | self % dw(:,i) = self % dw(:,i) + input(:) * db(i) 35 | enddo 36 | self % gradient = matmul(self % weights, db) 37 | ! self % dw = self % dw + dw 38 | self % db = self % db + db 39 | 40 | end subroutine backward 41 | 42 | 43 | pure module subroutine forward(self, input) 44 | class(dense_layer), intent(in out) :: self 45 | real, intent(in) :: input(:) 46 | 47 | self % z = matmul(input, self % weights) + self % biases 48 | self % output = self % activation % eval(self % z) 49 | 50 | end subroutine forward 51 | 52 | 53 | pure module function get_num_params(self) result(num_params) 54 | class(dense_layer), intent(in) :: self 55 | integer :: num_params 56 | 57 | ! Number of weigths times number of biases 58 | num_params = self % input_size * self % output_size + self % output_size 59 | 60 | end function get_num_params 61 | 62 | 63 | module subroutine get_params_ptr(self, w_ptr, b_ptr) 64 | class(dense_layer), intent(in), target :: self 65 | real, pointer, intent(out) :: w_ptr(:) 66 | real, pointer, intent(out) :: b_ptr(:) 67 | w_ptr(1:size(self % weights)) => self % weights 68 | b_ptr => self % biases 69 | end subroutine get_params_ptr 70 | 71 | 72 | module subroutine get_gradients_ptr(self, dw_ptr, db_ptr) 73 | class(dense_layer), intent(in), target :: self 74 | real, pointer, intent(out) :: dw_ptr(:) 75 | real, pointer, intent(out) :: db_ptr(:) 76 | dw_ptr(1:size(self % dw)) => self % dw 77 | db_ptr => self % db 78 | end subroutine get_gradients_ptr 79 | 80 | module subroutine init(self, input_shape) 81 | class(dense_layer), intent(in out) :: self 82 | integer, intent(in) :: input_shape(:) 83 | 84 | self % input_size = input_shape(1) 85 | 86 | ! Weights are a 2-d array of shape previous layer size 87 | ! times this layer size. 88 | allocate(self % weights(self % input_size, self % output_size)) 89 | call random_normal(self % weights) 90 | self % weights = self % weights / self % input_size 91 | 92 | ! Broadcast weights to all other images, if any. 93 | #ifdef PARALLEL 94 | call co_broadcast(self % weights, 1) 95 | #endif 96 | 97 | allocate(self % biases(self % output_size)) 98 | self % biases = 0 99 | 100 | allocate(self % output(self % output_size)) 101 | self % output = 0 102 | 103 | allocate(self % z(self % output_size)) 104 | self % z = 0 105 | 106 | allocate(self % dw(self % input_size, self % output_size)) 107 | self % dw = 0 108 | 109 | allocate(self % db(self % output_size)) 110 | self % db = 0 111 | 112 | allocate(self % gradient(self % input_size)) 113 | self % gradient = 0 114 | 115 | end subroutine init 116 | 117 | end submodule nf_dense_layer_submodule 118 | -------------------------------------------------------------------------------- /test/test_locally_connected2d_layer.f90: -------------------------------------------------------------------------------- 1 | program test_locally_connected2d_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: locally_connected, input, layer 5 | use nf_input2d_layer, only: input2d_layer 6 | 7 | implicit none 8 | 9 | type(layer) :: locally_connected_1d_layer, input_layer 10 | integer, parameter :: filters = 32, kernel_size=3 11 | real, allocatable :: sample_input(:,:), output(:,:) 12 | real, parameter :: tolerance = 1e-7 13 | logical :: ok = .true. 14 | 15 | locally_connected_1d_layer = locally_connected(filters, kernel_size) 16 | 17 | if (.not. locally_connected_1d_layer % name == 'locally_connected2d') then 18 | ok = .false. 19 | write(stderr, '(a)') 'locally_connected2d layer has its name set correctly.. failed' 20 | end if 21 | 22 | if (locally_connected_1d_layer % initialized) then 23 | ok = .false. 24 | write(stderr, '(a)') 'locally_connected2d layer should not be marked as initialized yet.. failed' 25 | end if 26 | 27 | if (.not. locally_connected_1d_layer % activation == 'relu') then 28 | ok = .false. 29 | write(stderr, '(a)') 'locally_connected2d layer defaults to relu activation.. failed' 30 | end if 31 | 32 | input_layer = input(3, 32) 33 | call locally_connected_1d_layer % init(input_layer) 34 | 35 | if (.not. locally_connected_1d_layer % initialized) then 36 | ok = .false. 37 | write(stderr, '(a)') 'locally_connected2d layer should now be marked as initialized.. failed' 38 | end if 39 | 40 | if (.not. all(locally_connected_1d_layer % input_layer_shape == [3, 32])) then 41 | ok = .false. 42 | write(stderr, '(a)') 'locally_connected2d layer input layer shape should be correct.. failed' 43 | end if 44 | 45 | if (.not. all(locally_connected_1d_layer % layer_shape == [filters, 30])) then 46 | ok = .false. 47 | write(stderr, '(a)') 'locally_connected2d layer input layer shape should be correct.. failed' 48 | end if 49 | 50 | ! Minimal locally_connected_1d layer: 1 channel, 3x3 pixel image; 51 | allocate(sample_input(1, 3)) 52 | sample_input = 0 53 | 54 | input_layer = input(1, 3) 55 | locally_connected_1d_layer = locally_connected(filters, kernel_size) 56 | call locally_connected_1d_layer % init(input_layer) 57 | 58 | select type(this_layer => input_layer % p); type is(input2d_layer) 59 | call this_layer % set(sample_input) 60 | end select 61 | deallocate(sample_input) 62 | 63 | call locally_connected_1d_layer % forward(input_layer) 64 | call locally_connected_1d_layer % get_output(output) 65 | 66 | if (.not. all(abs(output) < tolerance)) then 67 | ok = .false. 68 | write(stderr, '(a)') 'locally_connected2d layer with zero input and sigmoid function must forward to all 0.5.. failed' 69 | end if 70 | 71 | ! Minimal locally_connected_1d layer: 1 channel, 3x3 pixel image, stride = 3; 72 | allocate(sample_input(1, 17)) 73 | sample_input = 0 74 | 75 | input_layer = input(1, 17) 76 | locally_connected_1d_layer = locally_connected(filters, kernel_size, stride = 3) 77 | call locally_connected_1d_layer % init(input_layer) 78 | 79 | select type(this_layer => input_layer % p); type is(input2d_layer) 80 | call this_layer % set(sample_input) 81 | end select 82 | deallocate(sample_input) 83 | 84 | call locally_connected_1d_layer % forward(input_layer) 85 | call locally_connected_1d_layer % get_output(output) 86 | 87 | if (.not. all(abs(output) < tolerance)) then 88 | ok = .false. 89 | write(stderr, '(a)') 'locally_connected2d layer with zero input and sigmoid function must forward to all 0.5.. failed' 90 | end if 91 | 92 | !Final 93 | if (ok) then 94 | print '(a)', 'test_locally_connected2d_layer: All tests passed.' 95 | else 96 | write(stderr, '(a)') 'test_locally_connected2d_layer: One or more tests failed.' 97 | stop 1 98 | end if 99 | 100 | end program test_locally_connected2d_layer 101 | -------------------------------------------------------------------------------- /src/nf/nf_dense_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_dense_layer 2 | 3 | !! This module provides the concrete dense layer type. 4 | !! It is used internally by the layer type. 5 | !! It is not intended to be used directly by the user. 6 | 7 | use nf_activation, only: activation_function 8 | use nf_base_layer, only: base_layer 9 | 10 | implicit none 11 | 12 | private 13 | public :: dense_layer 14 | 15 | type, extends(base_layer) :: dense_layer 16 | 17 | !! Concrete implementation of a dense (fully-connected) layer type 18 | 19 | integer :: input_size 20 | integer :: output_size 21 | 22 | real, allocatable :: weights(:,:) 23 | real, allocatable :: biases(:) 24 | real, allocatable :: z(:) ! matmul(x, w) + b 25 | real, allocatable :: output(:) ! activation(z) 26 | real, allocatable :: gradient(:) ! matmul(w, db) 27 | real, allocatable :: dw(:,:) ! weight gradients 28 | real, allocatable :: db(:) ! bias gradients 29 | 30 | class(activation_function), allocatable :: activation 31 | 32 | contains 33 | 34 | procedure :: backward 35 | procedure :: forward 36 | procedure :: get_gradients_ptr 37 | procedure :: get_num_params 38 | procedure :: get_params_ptr 39 | procedure :: init 40 | 41 | end type dense_layer 42 | 43 | interface dense_layer 44 | module function dense_layer_cons(output_size, activation) & 45 | result(res) 46 | !! This function returns the `dense_layer` instance. 47 | integer, intent(in) :: output_size 48 | !! Number of neurons in this layer 49 | class(activation_function), intent(in) :: activation 50 | !! Instance of the activation_function to use; 51 | !! See nf_activation.f90 for available functions. 52 | type(dense_layer) :: res 53 | !! dense_layer instance 54 | end function dense_layer_cons 55 | end interface dense_layer 56 | 57 | interface 58 | 59 | pure module subroutine backward(self, input, gradient) 60 | !! Apply the backward gradient descent pass. 61 | !! Only weight and bias gradients are updated in this subroutine, 62 | !! while the weights and biases themselves are untouched. 63 | class(dense_layer), intent(in out) :: self 64 | !! Dense layer instance 65 | real, intent(in) :: input(:) 66 | !! Input from the previous layer 67 | real, intent(in) :: gradient(:) 68 | !! Gradient from the next layer 69 | end subroutine backward 70 | 71 | pure module subroutine forward(self, input) 72 | !! Propagate forward the layer. 73 | !! Calling this subroutine updates the values of a few data components 74 | !! of `dense_layer` that are needed for the backward pass. 75 | class(dense_layer), intent(in out) :: self 76 | !! Dense layer instance 77 | real, intent(in) :: input(:) 78 | !! Input from the previous layer 79 | end subroutine forward 80 | 81 | pure module function get_num_params(self) result(num_params) 82 | !! Return the number of parameters in this layer. 83 | class(dense_layer), intent(in) :: self 84 | !! Dense layer instance 85 | integer :: num_params 86 | !! Number of parameters in this layer 87 | end function get_num_params 88 | 89 | module subroutine get_params_ptr(self, w_ptr, b_ptr) 90 | class(dense_layer), intent(in), target :: self 91 | real, pointer, intent(out) :: w_ptr(:) 92 | real, pointer, intent(out) :: b_ptr(:) 93 | end subroutine get_params_ptr 94 | 95 | module subroutine get_gradients_ptr(self, dw_ptr, db_ptr) 96 | class(dense_layer), intent(in), target :: self 97 | real, pointer, intent(out) :: dw_ptr(:) 98 | real, pointer, intent(out) :: db_ptr(:) 99 | end subroutine get_gradients_ptr 100 | 101 | module subroutine init(self, input_shape) 102 | !! Initialize the layer data structures. 103 | !! 104 | !! This is a deferred procedure from the `base_layer` abstract type. 105 | class(dense_layer), intent(in out) :: self 106 | !! Dense layer instance 107 | integer, intent(in) :: input_shape(:) 108 | !! Shape of the input layer 109 | end subroutine init 110 | 111 | end interface 112 | 113 | end module nf_dense_layer 114 | -------------------------------------------------------------------------------- /src/nf/nf_conv2d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_conv2d_layer 2 | 3 | !! This modules provides a 2-d convolutional `conv2d_layer` type. 4 | 5 | use nf_activation, only: activation_function 6 | use nf_base_layer, only: base_layer 7 | implicit none 8 | 9 | private 10 | public :: conv2d_layer 11 | 12 | type, extends(base_layer) :: conv2d_layer 13 | 14 | integer :: width 15 | integer :: height 16 | integer :: channels 17 | integer :: kernel_size 18 | integer :: filters 19 | integer :: stride(2) 20 | 21 | real, allocatable :: biases(:) ! size(filters) 22 | real, allocatable :: kernel(:,:,:,:) ! filters x channels x window x window 23 | real, allocatable :: output(:,:,:) ! filters x output_width * output_height 24 | real, allocatable :: z(:,:,:) ! kernel .dot. input + bias 25 | 26 | real, allocatable :: dw(:,:,:,:) ! weight (kernel) gradients 27 | real, allocatable :: db(:) ! bias gradients 28 | real, allocatable :: gradient(:,:,:) 29 | 30 | class(activation_function), allocatable :: activation 31 | 32 | contains 33 | 34 | procedure :: forward 35 | procedure :: backward 36 | procedure :: get_gradients_ptr 37 | procedure :: get_num_params 38 | procedure :: get_params_ptr 39 | procedure :: init 40 | 41 | end type conv2d_layer 42 | 43 | interface conv2d_layer 44 | module function conv2d_layer_cons(filters, kernel_size, activation, stride) & 45 | result(res) 46 | !! `conv2d_layer` constructor function 47 | integer, intent(in) :: filters 48 | integer, intent(in) :: kernel_size 49 | class(activation_function), intent(in) :: activation 50 | integer, intent(in) :: stride(:) 51 | type(conv2d_layer) :: res 52 | end function conv2d_layer_cons 53 | end interface conv2d_layer 54 | 55 | interface 56 | 57 | module subroutine init(self, input_shape) 58 | !! Initialize the layer data structures. 59 | !! 60 | !! This is a deferred procedure from the `base_layer` abstract type. 61 | class(conv2d_layer), intent(in out) :: self 62 | !! A `conv2d_layer` instance 63 | integer, intent(in) :: input_shape(:) 64 | !! Input layer dimensions 65 | end subroutine init 66 | 67 | pure module subroutine forward(self, input) 68 | !! Apply a forward pass on the `conv2d` layer. 69 | class(conv2d_layer), intent(in out) :: self 70 | !! A `conv2d_layer` instance 71 | real, intent(in) :: input(:,:,:) 72 | !! Input data 73 | end subroutine forward 74 | 75 | pure module subroutine backward(self, input, gradient) 76 | !! Apply a backward pass on the `conv2d` layer. 77 | class(conv2d_layer), intent(in out) :: self 78 | !! A `conv2d_layer` instance 79 | real, intent(in) :: input(:,:,:) 80 | !! Input data (previous layer) 81 | real, intent(in) :: gradient(:,:,:) 82 | !! Gradient (next layer) 83 | end subroutine backward 84 | 85 | pure module function get_num_params(self) result(num_params) 86 | !! Get the number of parameters in the layer. 87 | class(conv2d_layer), intent(in) :: self 88 | !! A `conv2d_layer` instance 89 | integer :: num_params 90 | !! Number of parameters 91 | end function get_num_params 92 | 93 | module subroutine get_params_ptr(self, w_ptr, b_ptr) 94 | !! Return pointers to the parameters (weights and biases) of this layer. 95 | class(conv2d_layer), intent(in), target :: self 96 | !! A `conv2d_layer` instance 97 | real, pointer, intent(out) :: w_ptr(:) 98 | !! Pointer to the kernel weights (flattened) 99 | real, pointer, intent(out) :: b_ptr(:) 100 | !! Pointer to the biases 101 | end subroutine get_params_ptr 102 | 103 | module subroutine get_gradients_ptr(self, dw_ptr, db_ptr) 104 | !! Return pointers to the gradients of this layer. 105 | class(conv2d_layer), intent(in), target :: self 106 | !! A `conv2d_layer` instance 107 | real, pointer, intent(out) :: dw_ptr(:) 108 | !! Pointer to the kernel weight gradients (flattened) 109 | real, pointer, intent(out) :: db_ptr(:) 110 | !! Pointer to the bias gradients 111 | end subroutine get_gradients_ptr 112 | 113 | end interface 114 | 115 | end module nf_conv2d_layer 116 | -------------------------------------------------------------------------------- /test/test_flatten_layer.f90: -------------------------------------------------------------------------------- 1 | program test_flatten_layer 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: dense, flatten, input, layer, network 5 | use nf_flatten_layer, only: flatten_layer 6 | use nf_input2d_layer, only: input2d_layer 7 | use nf_input3d_layer, only: input3d_layer 8 | 9 | implicit none 10 | 11 | type(layer) :: test_layer, input_layer 12 | type(network) :: net 13 | real, allocatable :: gradient_3d(:,:,:), gradient_2d(:,:) 14 | real, allocatable :: output(:) 15 | logical :: ok = .true. 16 | 17 | ! Test 3D input 18 | test_layer = flatten() 19 | 20 | if (.not. test_layer % name == 'flatten') then 21 | ok = .false. 22 | write(stderr, '(a)') 'flatten layer has its name set correctly.. failed' 23 | end if 24 | 25 | if (test_layer % initialized) then 26 | ok = .false. 27 | write(stderr, '(a)') 'flatten layer is not initialized yet.. failed' 28 | end if 29 | 30 | input_layer = input(1, 2, 2) 31 | call test_layer % init(input_layer) 32 | 33 | if (.not. test_layer % initialized) then 34 | ok = .false. 35 | write(stderr, '(a)') 'flatten layer is now initialized.. failed' 36 | end if 37 | 38 | if (.not. all(test_layer % layer_shape == [4])) then 39 | ok = .false. 40 | write(stderr, '(a)') 'flatten layer has an incorrect output shape.. failed' 41 | end if 42 | 43 | ! Test forward pass - reshaping from 3-d to 1-d 44 | 45 | select type(this_layer => input_layer % p); type is(input3d_layer) 46 | call this_layer % set(reshape(real([1, 2, 3, 4]), [1, 2, 2])) 47 | end select 48 | 49 | call test_layer % forward(input_layer) 50 | call test_layer % get_output(output) 51 | 52 | if (.not. all(output == [1, 2, 3, 4])) then 53 | ok = .false. 54 | write(stderr, '(a)') 'flatten layer correctly propagates forward.. failed' 55 | end if 56 | 57 | ! Test backward pass - reshaping from 1-d to 3-d 58 | 59 | ! Calling backward() will set the values on the gradient component 60 | ! input_layer is used only to determine shape 61 | call test_layer % backward(input_layer, real([1, 2, 3, 4])) 62 | 63 | select type(this_layer => test_layer % p); type is(flatten_layer) 64 | gradient_3d = this_layer % gradient_3d 65 | end select 66 | 67 | if (.not. all(gradient_3d == reshape(real([1, 2, 3, 4]), [1, 2, 2]))) then 68 | ok = .false. 69 | write(stderr, '(a)') 'flatten layer correctly propagates backward.. failed' 70 | end if 71 | 72 | ! Test 2D input 73 | test_layer = flatten() 74 | input_layer = input(2, 3) 75 | call test_layer % init(input_layer) 76 | 77 | if (.not. all(test_layer % layer_shape == [6])) then 78 | ok = .false. 79 | write(stderr, '(a)') 'flatten layer has an incorrect output shape for 2D input.. failed' 80 | end if 81 | 82 | ! Test forward pass - reshaping from 2-d to 1-d 83 | select type(this_layer => input_layer % p); type is(input2d_layer) 84 | call this_layer % set(reshape(real([1, 2, 3, 4, 5, 6]), [2, 3])) 85 | end select 86 | 87 | call test_layer % forward(input_layer) 88 | call test_layer % get_output(output) 89 | 90 | if (.not. all(output == [1, 2, 3, 4, 5, 6])) then 91 | ok = .false. 92 | write(stderr, '(a)') 'flatten layer correctly propagates forward for 2D input.. failed' 93 | end if 94 | 95 | ! Test backward pass - reshaping from 1-d to 2-d 96 | call test_layer % backward(input_layer, real([1, 2, 3, 4, 5, 6])) 97 | 98 | select type(this_layer => test_layer % p); type is(flatten_layer) 99 | gradient_2d = this_layer % gradient_2d 100 | end select 101 | 102 | if (.not. all(gradient_2d == reshape(real([1, 2, 3, 4, 5, 6]), [2, 3]))) then 103 | ok = .false. 104 | write(stderr, '(a)') 'flatten layer correctly propagates backward for 2D input.. failed' 105 | end if 106 | 107 | net = network([ & 108 | input(1, 28, 28), & 109 | flatten(), & 110 | dense(10) & 111 | ]) 112 | 113 | ! Test that the output layer receives 784 elements in the input 114 | if (.not. all(net % layers(3) % input_layer_shape == [784])) then 115 | ok = .false. 116 | write(stderr, '(a)') 'flatten layer correctly chains input3d to dense.. failed' 117 | end if 118 | 119 | if (ok) then 120 | print '(a)', 'test_flatten_layer: All tests passed.' 121 | else 122 | write(stderr, '(a)') 'test_flatten_layer: One or more tests failed.' 123 | stop 1 124 | end if 125 | 126 | end program test_flatten_layer 127 | -------------------------------------------------------------------------------- /src/nf/nf_conv1d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_conv1d_layer 2 | !! This modules provides a 1-d convolutional `conv1d` type. 3 | 4 | use nf_activation, only: activation_function 5 | use nf_base_layer, only: base_layer 6 | implicit none 7 | 8 | private 9 | public :: conv1d_layer 10 | 11 | type, extends(base_layer) :: conv1d_layer 12 | 13 | integer :: width 14 | integer :: height 15 | integer :: channels 16 | integer :: kernel_size 17 | integer :: filters 18 | integer :: stride 19 | 20 | real, allocatable :: biases(:) ! size(filters) 21 | real, allocatable :: kernel(:,:,:) ! filters x channels x window 22 | real, allocatable :: output(:,:) ! filters x output_width 23 | real, allocatable :: z(:,:) ! kernel .dot. input + bias 24 | 25 | real, allocatable :: dw(:,:,:) ! weight (kernel) gradients 26 | real, allocatable :: db(:) ! bias gradients 27 | real, allocatable :: gradient(:,:) 28 | 29 | class(activation_function), allocatable :: activation 30 | 31 | contains 32 | 33 | procedure :: forward 34 | procedure :: backward 35 | procedure :: get_gradients_ptr 36 | procedure :: get_num_params 37 | procedure :: get_params_ptr 38 | procedure :: init 39 | 40 | end type conv1d_layer 41 | 42 | interface conv1d_layer 43 | module function conv1d_layer_cons(filters, kernel_size, activation, stride) & 44 | result(res) 45 | !! `conv1d_layer` constructor function 46 | integer, intent(in) :: filters 47 | integer, intent(in) :: kernel_size 48 | class(activation_function), intent(in) :: activation 49 | integer, intent(in) :: stride 50 | type(conv1d_layer) :: res 51 | end function conv1d_layer_cons 52 | end interface conv1d_layer 53 | 54 | interface 55 | 56 | module subroutine init(self, input_shape) 57 | !! Initialize the layer data structures. 58 | !! 59 | !! This is a deferred procedure from the `base_layer` abstract type. 60 | class(conv1d_layer), intent(in out) :: self 61 | !! A `conv1d_layer` instance 62 | integer, intent(in) :: input_shape(:) 63 | !! Input layer dimensions 64 | end subroutine init 65 | 66 | pure module subroutine forward(self, input) 67 | !! Apply a forward pass on the `conv1d` layer. 68 | class(conv1d_layer), intent(in out) :: self 69 | !! A `conv1d_layer` instance 70 | real, intent(in) :: input(:,:) 71 | !! Input data 72 | end subroutine forward 73 | 74 | pure module subroutine backward(self, input, gradient) 75 | !! Apply a backward pass on the `conv1d` layer. 76 | class(conv1d_layer), intent(in out) :: self 77 | !! A `conv1d_layer` instance 78 | real, intent(in) :: input(:,:) 79 | !! Input data (previous layer) 80 | real, intent(in) :: gradient(:,:) 81 | !! Gradient (next layer) 82 | end subroutine backward 83 | 84 | pure module function get_num_params(self) result(num_params) 85 | !! Get the number of parameters in the layer. 86 | class(conv1d_layer), intent(in) :: self 87 | !! A `conv1d_layer` instance 88 | integer :: num_params 89 | !! Number of parameters 90 | end function get_num_params 91 | 92 | module subroutine get_params_ptr(self, w_ptr, b_ptr) 93 | !! Return pointers to the parameters (weights and biases) of this layer. 94 | class(conv1d_layer), intent(in), target :: self 95 | !! A `conv1d_layer` instance 96 | real, pointer, intent(out) :: w_ptr(:) 97 | !! Pointer to the kernel weights (flattened) 98 | real, pointer, intent(out) :: b_ptr(:) 99 | !! Pointer to the biases 100 | end subroutine get_params_ptr 101 | 102 | module subroutine get_gradients_ptr(self, dw_ptr, db_ptr) 103 | !! Return pointers to the gradients of this layer. 104 | class(conv1d_layer), intent(in), target :: self 105 | !! A `conv1d_layer` instance 106 | real, pointer, intent(out) :: dw_ptr(:) 107 | !! Pointer to the kernel weight gradients (flattened) 108 | real, pointer, intent(out) :: db_ptr(:) 109 | !! Pointer to the bias gradients 110 | end subroutine get_gradients_ptr 111 | 112 | end interface 113 | 114 | end module nf_conv1d_layer 115 | -------------------------------------------------------------------------------- /test/test_optimizers.f90: -------------------------------------------------------------------------------- 1 | program test_optimizers 2 | 3 | use nf, only: dense, input, network, rmsprop, sgd, adam, adagrad 4 | use iso_fortran_env, only: stderr => error_unit 5 | 6 | implicit none 7 | type(network) :: net(6) 8 | real, allocatable :: x(:), y(:) 9 | real, allocatable :: ypred(:) 10 | integer, parameter :: num_iterations = 1000 11 | integer :: n 12 | logical :: ok = .true. 13 | logical :: converged = .false. 14 | 15 | ! Instantiate a network and copy an instance to the rest of the array 16 | net(1) = network([input(3), dense(5), dense(2)]) 17 | net(2:) = net(1) 18 | 19 | x = [0.2, 0.4, 0.6] 20 | y = [0.123456, 0.246802] 21 | 22 | do n = 0, num_iterations 23 | 24 | call net(1) % forward(x) 25 | call net(1) % backward(y) 26 | call net(1) % update(optimizer=sgd(learning_rate=1.)) 27 | 28 | ypred = net(1) % predict(x) 29 | converged = check_convergence(y, ypred) 30 | if (converged) exit 31 | 32 | end do 33 | 34 | if (.not. converged) then 35 | write(stderr, '(a)') 'sgd should converge in simple training.. failed' 36 | ok = .false. 37 | end if 38 | 39 | converged = .false. 40 | 41 | do n = 0, num_iterations 42 | 43 | call net(2) % forward(x) 44 | call net(2) % backward(y) 45 | call net(2) % update(optimizer=sgd(learning_rate=1., momentum=0.9)) 46 | 47 | ypred = net(2) % predict(x) 48 | converged = check_convergence(y, ypred) 49 | if (converged) exit 50 | 51 | end do 52 | 53 | if (.not. converged) then 54 | write(stderr, '(a)') & 55 | 'sgd(momentum) should converge in simple training.. failed' 56 | ok = .false. 57 | end if 58 | 59 | converged = .false. 60 | 61 | do n = 0, num_iterations 62 | 63 | call net(3) % forward(x) 64 | call net(3) % backward(y) 65 | call net(3) % update(optimizer=sgd(learning_rate=1., momentum=0.9, nesterov=.true.)) 66 | 67 | ypred = net(3) % predict(x) 68 | converged = check_convergence(y, ypred) 69 | if (converged) exit 70 | 71 | end do 72 | 73 | if (.not. converged) then 74 | write(stderr, '(a)') & 75 | 'sgd(nesterov) should converge in simple training.. failed' 76 | ok = .false. 77 | end if 78 | 79 | ! Resetting convergence flag 80 | converged = .false. 81 | 82 | do n = 0, num_iterations 83 | 84 | call net(4) % forward(x) 85 | call net(4) % backward(y) 86 | call net(4) % update(optimizer=rmsprop(learning_rate=0.01, decay_rate=0.9)) 87 | 88 | ypred = net(4) % predict(x) 89 | converged = check_convergence(y, ypred) 90 | if (converged) exit 91 | 92 | end do 93 | 94 | if (.not. converged) then 95 | write(stderr, '(a)') 'rmsprop should converge in simple training.. failed' 96 | ok = .false. 97 | end if 98 | 99 | ! Test Adam optimizer 100 | converged = .false. 101 | 102 | do n = 0, num_iterations 103 | 104 | call net(5) % forward(x) 105 | call net(5) % backward(y) 106 | call net(5) % update(optimizer=adam(learning_rate=0.01, beta1=0.9, beta2=0.999)) 107 | 108 | ypred = net(5) % predict(x) 109 | converged = check_convergence(y, ypred) 110 | if (converged) exit 111 | 112 | end do 113 | 114 | if (.not. converged) then 115 | write(stderr, '(a)') 'adam should converge in simple training.. failed' 116 | ok = .false. 117 | end if 118 | 119 | ! Test Adagrad optimizer 120 | converged = .false. 121 | 122 | do n = 0, num_iterations 123 | 124 | call net(6) % forward(x) 125 | call net(6) % backward(y) 126 | call net(6) % update(optimizer=adagrad(learning_rate=0.01, weight_decay_l2=1e-4, learning_rate_decay=0.99)) 127 | 128 | ypred = net(5) % predict(x) 129 | converged = check_convergence(y, ypred) 130 | if (converged) exit 131 | 132 | end do 133 | 134 | if (.not. converged) then 135 | write(stderr, '(a)') 'adagrad should converge in simple training.. failed' 136 | ok = .false. 137 | end if 138 | 139 | 140 | if (ok) then 141 | print '(a)', 'test_optimizers: All tests passed.' 142 | else 143 | write(stderr, '(a)') 'test_optimizers: One or more tests failed.' 144 | stop 1 145 | end if 146 | 147 | contains 148 | 149 | pure logical function check_convergence(y, ypred) result(converged) 150 | ! Check convergence of ypred to y based on RMSE < tolerance. 151 | real, intent(in) :: y(:), ypred(:) 152 | real, parameter :: tolerance = 1e-3 153 | converged = sqrt(sum((ypred - y)**2) / size(y)) < tolerance 154 | end function check_convergence 155 | 156 | end program test_optimizers 157 | -------------------------------------------------------------------------------- /test/test_conv2d_network.f90: -------------------------------------------------------------------------------- 1 | program test_conv2d_network 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: conv, input, network, dense, sgd, maxpool 5 | 6 | implicit none 7 | 8 | type(network) :: net 9 | real, allocatable :: sample_input(:,:,:), output(:,:,:) 10 | logical :: ok = .true. 11 | 12 | ! 3-layer convolutional network 13 | net = network([ & 14 | input(3, 32, 32), & 15 | conv(filters=16, kernel_width=3, kernel_height=3), & 16 | conv(filters=32, kernel_width=3, kernel_height=3) & 17 | ]) 18 | 19 | if (.not. size(net % layers) == 3) then 20 | write(stderr, '(a)') 'conv2d network should have 3 layers.. failed' 21 | ok = .false. 22 | end if 23 | 24 | ! Test for output shape 25 | allocate(sample_input(3, 32, 32)) 26 | sample_input = 0 27 | 28 | call net % forward(sample_input) 29 | call net % layers(3) % get_output(output) 30 | 31 | if (.not. all(shape(output) == [32, 28, 28])) then 32 | write(stderr, '(a)') 'conv2d network output should have correct shape.. failed' 33 | ok = .false. 34 | end if 35 | 36 | deallocate(sample_input, output) 37 | 38 | training1: block 39 | 40 | type(network) :: cnn 41 | real :: y(1) 42 | real :: tolerance = 1e-4 43 | integer :: n 44 | integer, parameter :: num_iterations = 1000 45 | 46 | ! Test training of a minimal constant mapping 47 | allocate(sample_input(1, 5, 5)) 48 | call random_number(sample_input) 49 | 50 | cnn = network([ & 51 | input(1, 5, 5), & 52 | conv(filters=1, kernel_width=3, kernel_height=3), & 53 | conv(filters=1, kernel_width=3, kernel_height=3), & 54 | dense(1) & 55 | ]) 56 | 57 | y = [0.1234567] 58 | 59 | do n = 1, num_iterations 60 | call cnn % forward(sample_input) 61 | call cnn % backward(y) 62 | call cnn % update(optimizer=sgd(learning_rate=1.)) 63 | 64 | if (all(abs(cnn % predict(sample_input) - y) < tolerance)) exit 65 | end do 66 | 67 | if (.not. n <= num_iterations) then 68 | write(stderr, '(a)') & 69 | 'convolutional network 1 should converge in simple training.. failed' 70 | ok = .false. 71 | end if 72 | 73 | end block training1 74 | 75 | training2: block 76 | 77 | type(network) :: cnn 78 | real :: x(1, 8, 8) 79 | real :: y(1) 80 | real :: tolerance = 1e-4 81 | integer :: n 82 | integer, parameter :: num_iterations = 1000 83 | 84 | call random_number(x) 85 | y = [0.1234567] 86 | 87 | cnn = network([ & 88 | input(1, 8, 8), & 89 | conv(filters=1, kernel_width=3, kernel_height=3), & 90 | maxpool(pool_width=2, pool_height=2, stride=2), & 91 | conv(filters=1, kernel_width=3, kernel_height=3), & 92 | dense(1) & 93 | ]) 94 | 95 | do n = 1, num_iterations 96 | call cnn % forward(x) 97 | call cnn % backward(y) 98 | call cnn % update(optimizer=sgd(learning_rate=1.)) 99 | if (all(abs(cnn % predict(x) - y) < tolerance)) exit 100 | end do 101 | 102 | if (.not. n <= num_iterations) then 103 | write(stderr, '(a)') & 104 | 'convolutional network 2 should converge in simple training.. failed' 105 | ok = .false. 106 | end if 107 | 108 | end block training2 109 | 110 | training3: block 111 | 112 | type(network) :: cnn 113 | real :: x(1, 12, 12) 114 | real :: y(9) 115 | real :: tolerance = 1e-4 116 | integer :: n 117 | integer, parameter :: num_iterations = 5000 118 | 119 | call random_number(x) 120 | y = [0.12345, 0.23456, 0.34567, 0.45678, 0.56789, 0.67890, 0.78901, 0.89012, 0.90123] 121 | 122 | cnn = network([ & 123 | input(1, 12, 12), & 124 | conv(filters=1, kernel_width=3, kernel_height=3), & ! 1x12x12 input, 1x10x10 output 125 | maxpool(pool_width=2, pool_height=2, stride=2), & ! 1x10x10 input, 1x5x5 output 126 | conv(filters=1, kernel_width=3, kernel_height=3), & ! 1x5x5 input, 1x3x3 output 127 | dense(9) & ! 9 outputs 128 | ]) 129 | 130 | do n = 1, num_iterations 131 | call cnn % forward(x) 132 | call cnn % backward(y) 133 | call cnn % update(optimizer=sgd(learning_rate=1.)) 134 | if (all(abs(cnn % predict(x) - y) < tolerance)) exit 135 | end do 136 | 137 | if (.not. n <= num_iterations) then 138 | write(stderr, '(a)') & 139 | 'convolutional network 3 should converge in simple training.. failed' 140 | ok = .false. 141 | end if 142 | 143 | end block training3 144 | 145 | 146 | if (ok) then 147 | print '(a)', 'test_conv2d_network: All tests passed.' 148 | else 149 | write(stderr, '(a)') 'test_conv2d_network: One or more tests failed.' 150 | stop 1 151 | end if 152 | 153 | end program test_conv2d_network 154 | -------------------------------------------------------------------------------- /test/test_conv1d_network.f90: -------------------------------------------------------------------------------- 1 | program test_conv1d_network 2 | 3 | use iso_fortran_env, only: stderr => error_unit 4 | use nf, only: conv, input, network, dense, sgd, maxpool 5 | 6 | implicit none 7 | 8 | type(network) :: net 9 | real, allocatable :: sample_input(:,:), output(:,:) 10 | logical :: ok = .true. 11 | 12 | ! 3-layer convolutional network 13 | net = network([ & 14 | input(3, 32), & 15 | conv(filters=16, kernel_width=3), & 16 | conv(filters=32, kernel_width=3) & 17 | ]) 18 | 19 | if (.not. size(net % layers) == 3) then 20 | write(stderr, '(a)') 'conv2d network should have 3 layers.. failed' 21 | ok = .false. 22 | end if 23 | 24 | ! Test for output shape 25 | allocate(sample_input(3, 32)) 26 | sample_input = 0 27 | 28 | call net % forward(sample_input) 29 | call net % layers(3) % get_output(output) 30 | 31 | if (.not. all(shape(output) == [32, 28])) then 32 | write(stderr, '(a)') 'conv1d network output should have correct shape.. failed' 33 | ok = .false. 34 | end if 35 | 36 | deallocate(sample_input, output) 37 | 38 | training1: block 39 | 40 | type(network) :: cnn 41 | real :: y(1) 42 | real :: tolerance = 1e-4 43 | integer :: n 44 | integer, parameter :: num_iterations = 1000 45 | 46 | ! Test training of a minimal constant mapping 47 | allocate(sample_input(1, 5)) 48 | call random_number(sample_input) 49 | 50 | cnn = network([ & 51 | input(1, 5), & 52 | conv(filters=1, kernel_width=3), & 53 | conv(filters=1, kernel_width=3), & 54 | dense(1) & 55 | ]) 56 | 57 | y = [0.1234567] 58 | 59 | do n = 1, num_iterations 60 | call cnn % forward(sample_input) 61 | call cnn % backward(y) 62 | call cnn % update(optimizer=sgd(learning_rate=1.)) 63 | 64 | if (all(abs(cnn % predict(sample_input) - y) < tolerance)) exit 65 | end do 66 | 67 | if (.not. n <= num_iterations) then 68 | write(stderr, '(a)') & 69 | 'convolutional network 1 should converge in simple training.. failed' 70 | ok = .false. 71 | end if 72 | 73 | end block training1 74 | 75 | training2: block 76 | 77 | type(network) :: cnn 78 | real :: x(1, 8) 79 | real :: y(1) 80 | real :: tolerance = 1e-4 81 | integer :: n 82 | integer, parameter :: num_iterations = 1000 83 | 84 | call random_number(x) 85 | y = [0.1234567] 86 | 87 | cnn = network([ & 88 | input(1, 8), & 89 | conv(filters=1, kernel_width=3), & 90 | maxpool(pool_width=2, stride=2), & 91 | conv(filters=1, kernel_width=3), & 92 | dense(1) & 93 | ]) 94 | 95 | do n = 1, num_iterations 96 | call cnn % forward(x) 97 | call cnn % backward(y) 98 | call cnn % update(optimizer=sgd(learning_rate=1.)) 99 | if (all(abs(cnn % predict(x) - y) < tolerance)) exit 100 | end do 101 | 102 | if (.not. n <= num_iterations) then 103 | write(stderr, '(a)') & 104 | 'convolutional network 2 should converge in simple training.. failed' 105 | ok = .false. 106 | end if 107 | 108 | end block training2 109 | 110 | training3: block 111 | 112 | type(network) :: cnn 113 | real :: x(1, 12) 114 | real :: y(9) 115 | real :: tolerance = 1e-4 116 | integer :: n 117 | integer, parameter :: num_iterations = 5000 118 | 119 | call random_number(x) 120 | y = [0.12345, 0.23456, 0.34567, 0.45678, 0.56789, 0.67890, 0.78901, 0.89012, 0.90123] 121 | 122 | cnn = network([ & 123 | input(1, 12), & 124 | conv(filters=1, kernel_width=3), & ! 1x12x12 input, 1x10x10 output 125 | maxpool(pool_width=2, stride=2), & ! 1x10x10 input, 1x5x5 output 126 | conv(filters=1, kernel_width=3), & ! 1x5x5 input, 1x3x3 output 127 | dense(9) & ! 9 outputs 128 | ]) 129 | 130 | do n = 1, num_iterations 131 | call cnn % forward(x) 132 | call cnn % backward(y) 133 | call cnn % update(optimizer=sgd(learning_rate=1.)) 134 | if (all(abs(cnn % predict(x) - y) < tolerance)) exit 135 | end do 136 | 137 | if (.not. n <= num_iterations) then 138 | write(stderr, '(a)') & 139 | 'convolutional network 3 should converge in simple training.. failed' 140 | ok = .false. 141 | end if 142 | 143 | end block training3 144 | 145 | 146 | if (ok) then 147 | print '(a)', 'test_conv1d_network: All tests passed.' 148 | else 149 | write(stderr, '(a)') 'test_conv1d_network: One or more tests failed.' 150 | stop 1 151 | end if 152 | 153 | end program test_conv1d_network 154 | -------------------------------------------------------------------------------- /src/nf/nf_embedding_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | #define NONE 0 2 | #define TRIGONOMETRIC 1 3 | #define ABSOLUTE 2 4 | 5 | submodule(nf_embedding_layer) nf_embedding_layer_submodule 6 | implicit none 7 | contains 8 | module function embedding_layer_cons(vocab_size, model_dimension, positional) result(res) 9 | integer, intent(in) :: vocab_size, model_dimension 10 | integer, optional :: positional 11 | type(embedding_layer) :: res 12 | 13 | res % vocab_size = vocab_size 14 | res % model_dimension = model_dimension 15 | if (.not. present(positional)) then 16 | res % positional = NONE 17 | else 18 | res % positional = positional 19 | end if 20 | end function embedding_layer_cons 21 | 22 | module subroutine init(self, input_shape) 23 | class(embedding_layer), intent(in out) :: self 24 | integer, intent(in) :: input_shape(:) 25 | 26 | self % sequence_length = input_shape(1) 27 | 28 | allocate(self % output(self % sequence_length, self % model_dimension)) 29 | 30 | allocate(self % weights(self % vocab_size, self % model_dimension)) 31 | self % weights = 0.1 32 | 33 | allocate(self % dw(self % vocab_size, self % model_dimension)) 34 | self % dw = 0.0 35 | end subroutine init 36 | 37 | pure module subroutine forward(self, input) 38 | class(embedding_layer), intent(in out) :: self 39 | integer, intent(in) :: input(:) 40 | integer :: i, index 41 | 42 | do concurrent(i = 1: self % sequence_length) 43 | index = input(i) 44 | if (index > size(self % weights, 1)) then 45 | index = 1 46 | elseif (index == 0) then 47 | index = 1 48 | end if 49 | 50 | self % output(i, :) = self % weights(index, :) 51 | 52 | if (self % positional == TRIGONOMETRIC) then 53 | call self % positional_trigonometric(i) 54 | elseif (self % positional == ABSOLUTE) then 55 | call self % positional_absolute(i) 56 | end if 57 | end do 58 | end subroutine forward 59 | 60 | pure module subroutine backward(self, input, gradient) 61 | class(embedding_layer), intent(in out) :: self 62 | integer, intent(in) :: input(:) 63 | real, intent(in) :: gradient(:, :) 64 | integer :: i 65 | 66 | do concurrent(i = 1: self % sequence_length) 67 | self % dw(input(i), :) = self % dw(input(i), :) + gradient(i, :) 68 | end do 69 | end subroutine backward 70 | 71 | pure module subroutine positional_trigonometric(self, pos) 72 | class(embedding_layer), intent(in out) :: self 73 | integer, intent(in) :: pos 74 | integer :: i 75 | real :: theta 76 | 77 | do concurrent(i = 1: floor(real(self % model_dimension) / 2)) 78 | theta = (pos - 1) / 10000 ** (real(2 * (i-1)) / self % model_dimension) 79 | self % output(pos, 2 * i - 1) = self % output(pos, 2 * i - 1) + sin(theta) 80 | self % output(pos, 2 * i) = self % output(pos, 2 * i) + cos(theta) 81 | end do 82 | end subroutine positional_trigonometric 83 | 84 | pure module subroutine positional_absolute(self, pos) 85 | class(embedding_layer), intent(in out) :: self 86 | integer, intent(in) :: pos 87 | integer :: i 88 | 89 | do concurrent(i = 1: self % model_dimension) 90 | self % output(pos, i) = self % output(pos, i) + pos - 1 91 | end do 92 | end subroutine positional_absolute 93 | 94 | pure module function get_num_params(self) result(num_params) 95 | class(embedding_layer), intent(in) :: self 96 | integer :: num_params 97 | num_params = self % vocab_size * self % model_dimension 98 | end function get_num_params 99 | 100 | module function get_params(self) result(params) 101 | class(embedding_layer), intent(in), target :: self 102 | real, allocatable :: params(:) 103 | real, pointer :: w_(:) => null() 104 | 105 | w_(1: product(shape(self % weights))) => self % weights 106 | params = w_ 107 | end function get_params 108 | 109 | module function get_gradients(self) result(gradients) 110 | class(embedding_layer), intent(in), target :: self 111 | real, allocatable :: gradients(:) 112 | real, pointer :: dw_(:) => null() 113 | 114 | dw_(1: product(shape(self % dw))) => self % dw 115 | gradients = dw_ 116 | end function get_gradients 117 | 118 | module subroutine set_params(self, params) 119 | class(embedding_layer), intent(in out) :: self 120 | real, intent(in), target :: params(:) 121 | 122 | real, pointer :: p_(:,:) => null() 123 | 124 | ! check if the number of parameters is correct 125 | if (size(params) /= self % get_num_params()) then 126 | error stop 'Error: number of parameters does not match' 127 | end if 128 | 129 | associate(n => self % vocab_size * self % model_dimension) 130 | ! reshape the weights 131 | p_(1:self % vocab_size, 1:self % model_dimension) => params(1 : n) 132 | self % weights = p_ 133 | end associate 134 | 135 | end subroutine set_params 136 | end submodule nf_embedding_layer_submodule 137 | -------------------------------------------------------------------------------- /src/nf/nf_locally_connected2d_layer.f90: -------------------------------------------------------------------------------- 1 | module nf_locally_connected2d_layer 2 | !! This modules provides a 1-d convolutional `locally_connected2d` type. 3 | 4 | use nf_activation, only: activation_function 5 | use nf_base_layer, only: base_layer 6 | implicit none 7 | 8 | private 9 | public :: locally_connected2d_layer 10 | 11 | type, extends(base_layer) :: locally_connected2d_layer 12 | 13 | integer :: width 14 | integer :: height 15 | integer :: channels 16 | integer :: kernel_size 17 | integer :: filters 18 | integer :: stride 19 | 20 | real, allocatable :: biases(:,:) ! size(filters) 21 | real, allocatable :: kernel(:,:,:,:) ! filters x channels x window x window 22 | real, allocatable :: output(:,:) ! filters x output_width * output_height 23 | real, allocatable :: z(:,:) ! kernel .dot. input + bias 24 | 25 | real, allocatable :: dw(:,:,:,:) ! weight (kernel) gradients 26 | real, allocatable :: db(:,:) ! bias gradients 27 | real, allocatable :: gradient(:,:) 28 | 29 | class(activation_function), allocatable :: activation 30 | 31 | contains 32 | 33 | procedure :: forward 34 | procedure :: backward 35 | procedure :: get_gradients 36 | procedure :: get_gradients_ptr 37 | procedure :: get_num_params 38 | procedure :: get_params_ptr 39 | procedure :: init 40 | 41 | end type locally_connected2d_layer 42 | 43 | interface locally_connected2d_layer 44 | module function locally_connected2d_layer_cons(filters, kernel_size, activation, stride) & 45 | result(res) 46 | !! `locally_connected2d_layer` constructor function 47 | integer, intent(in) :: filters 48 | integer, intent(in) :: kernel_size 49 | class(activation_function), intent(in) :: activation 50 | integer, intent(in) :: stride 51 | type(locally_connected2d_layer) :: res 52 | end function locally_connected2d_layer_cons 53 | end interface locally_connected2d_layer 54 | 55 | interface 56 | 57 | module subroutine init(self, input_shape) 58 | !! Initialize the layer data structures. 59 | !! 60 | !! This is a deferred procedure from the `base_layer` abstract type. 61 | class(locally_connected2d_layer), intent(in out) :: self 62 | !! A `locally_connected2d_layer` instance 63 | integer, intent(in) :: input_shape(:) 64 | !! Input layer dimensions 65 | end subroutine init 66 | 67 | pure module subroutine forward(self, input) 68 | !! Apply a forward pass on the `locally_connected2d` layer. 69 | class(locally_connected2d_layer), intent(in out) :: self 70 | !! A `locally_connected2d_layer` instance 71 | real, intent(in) :: input(:,:) 72 | !! Input data 73 | end subroutine forward 74 | 75 | pure module subroutine backward(self, input, gradient) 76 | !! Apply a backward pass on the `locally_connected2d` layer. 77 | class(locally_connected2d_layer), intent(in out) :: self 78 | !! A `locally_connected2d_layer` instance 79 | real, intent(in) :: input(:,:) 80 | !! Input data (previous layer) 81 | real, intent(in) :: gradient(:,:) 82 | !! Gradient (next layer) 83 | end subroutine backward 84 | 85 | pure module function get_num_params(self) result(num_params) 86 | !! Get the number of parameters in the layer. 87 | class(locally_connected2d_layer), intent(in) :: self 88 | !! A `locally_connected2d_layer` instance 89 | integer :: num_params 90 | !! Number of parameters 91 | end function get_num_params 92 | 93 | module subroutine get_params_ptr(self, w_ptr, b_ptr) 94 | class(locally_connected2d_layer), intent(in), target :: self 95 | real, pointer, intent(out) :: w_ptr(:) 96 | !! Pointer to the kernel weights (flattened) 97 | real, pointer, intent(out) :: b_ptr(:) 98 | !! Pointer to the biases 99 | end subroutine get_params_ptr 100 | 101 | module function get_gradients(self) result(gradients) 102 | !! Return the gradients of this layer. 103 | !! The gradients are ordered as weights first, biases second. 104 | class(locally_connected2d_layer), intent(in), target :: self 105 | !! A `locally_connected2d_layer` instance 106 | real, allocatable :: gradients(:) 107 | !! Gradients to get 108 | end function get_gradients 109 | 110 | module subroutine get_gradients_ptr(self, dw_ptr, db_ptr) 111 | class(locally_connected2d_layer), intent(in), target :: self 112 | real, pointer, intent(out) :: dw_ptr(:) 113 | !! Pointer to the kernel weight gradients (flattened) 114 | real, pointer, intent(out) :: db_ptr(:) 115 | !! Pointer to the bias gradients 116 | end subroutine get_gradients_ptr 117 | 118 | end interface 119 | 120 | end module nf_locally_connected2d_layer 121 | -------------------------------------------------------------------------------- /src/nf/nf_layernorm_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_layernorm_layer) nf_layernorm_layer_submodule 2 | implicit none 3 | contains 4 | module function layernorm_layer_cons() & 5 | result(res) 6 | type(layernorm_layer) :: res 7 | 8 | res % eps = 1e-5 9 | end function layernorm_layer_cons 10 | 11 | pure module subroutine forward(self, input) 12 | class(layernorm_layer), intent(in out) :: self 13 | real, intent(in) :: input(:, :) 14 | integer :: i 15 | 16 | ! mu = x - MEAN_last_dim(x) 17 | do concurrent(i = 1: self % model_dimension) 18 | self % mu(:, i) = input(:, i) - (sum(input, dim=2) / self % model_dimension) 19 | end do 20 | 21 | ! square root of variance shifted be eps 22 | self % sigma = sqrt((sum(self % mu ** 2, dim=2) / self % model_dimension) + self % eps) 23 | 24 | ! normalize mu by variance by first axis 25 | do concurrent(i = 1: self % model_dimension) 26 | self % normalized(:, i) = self % mu(:, i) / self % sigma 27 | end do 28 | 29 | ! forward through trainable params gamma and beta 30 | do concurrent(i = 1: self % sequence_length) 31 | self % output(i, :) = self % normalized(i, :) * self % gamma + self % beta 32 | end do 33 | end subroutine forward 34 | 35 | pure module subroutine backward(self, input, gradient) 36 | class(layernorm_layer), intent(in out) :: self 37 | real, intent(in) :: input(:, :) 38 | real, intent(in) :: gradient(:, :) 39 | 40 | self % one_over_sigma = (1 / spread(self % sigma, dim=2, ncopies=self % model_dimension)) 41 | self % gradient_by_gamma_over_sigma = & 42 | gradient & 43 | * spread(self % gamma, dim=1, ncopies=self % sequence_length) & 44 | * self % one_over_sigma 45 | 46 | ! d_output/d_gamma = sum(d_output/d_y * mu/sigma) 47 | self % d_gamma = sum(gradient * self % mu * self % one_over_sigma, dim=1) 48 | 49 | ! d_output/d_beta = sum(d_output/d_y) * 1 50 | self % d_beta = sum(gradient, dim=1) 51 | 52 | ! From this article: 53 | ! https://robotchinwag.com/posts/layer-normalization-deriving-the-gradient-for-the-backward-pass/ 54 | ! d_output/d_x = d_output/d_y * gamma/sigma 55 | ! - d_output/d_y 56 | ! - sum(d_output/d_y * gamma/sigma) / len 57 | ! - mu * sum(d_output/d_y * gamma * mu * sigma^(03)) / len 58 | self % gradient = & 59 | self % gradient_by_gamma_over_sigma & 60 | - spread(& 61 | sum(self % gradient_by_gamma_over_sigma, dim=2),& 62 | dim=2,& 63 | ncopies=self % model_dimension& 64 | ) / self % model_dimension & 65 | - self % mu * spread(& 66 | sum(self % gradient_by_gamma_over_sigma * self % mu * (self % one_over_sigma ** 2), dim=2),& 67 | dim=2,& 68 | ncopies=self % model_dimension& 69 | ) / self % model_dimension 70 | end subroutine backward 71 | 72 | module subroutine init(self, input_shape) 73 | class(layernorm_layer), intent(in out) :: self 74 | integer, intent(in) :: input_shape(:) 75 | 76 | if (size(input_shape) /= 2) then 77 | error stop "LayerNorm Layer accepts 2D input" 78 | end if 79 | self % sequence_length = input_shape(1) 80 | self % model_dimension = input_shape(2) 81 | 82 | ! default initialization from PyTorch 83 | allocate(self % gamma(self % model_dimension)) 84 | self % gamma = 1. 85 | allocate(self % beta(self % model_dimension)) 86 | self % beta = 0. 87 | 88 | allocate(self % d_gamma(self % model_dimension)) 89 | allocate(self % d_beta(self % model_dimension)) 90 | allocate(self % gradient(self % sequence_length, self % model_dimension)) 91 | 92 | allocate(self % mu(self % sequence_length, self % model_dimension)) 93 | allocate(self % sigma(self % sequence_length)) 94 | 95 | allocate(self % output(self % sequence_length, self % model_dimension)) 96 | 97 | allocate(self % normalized, mold=self % mu) 98 | allocate(self % one_over_sigma, mold=self % mu) 99 | allocate(self % gradient_by_gamma_over_sigma, mold=self % mu) 100 | end subroutine init 101 | 102 | pure module function get_num_params(self) result(num_params) 103 | class(layernorm_layer), intent(in) :: self 104 | integer :: num_params 105 | 106 | ! Number of weights times number of biases 107 | num_params = 2 * self % model_dimension 108 | 109 | end function get_num_params 110 | 111 | module subroutine get_params_ptr(self, g_ptr, b_ptr) 112 | class(layernorm_layer), intent(in), target :: self 113 | real, pointer, intent(out) :: g_ptr(:), b_ptr(:) 114 | g_ptr => self % gamma 115 | b_ptr => self % beta 116 | end subroutine get_params_ptr 117 | 118 | 119 | module function get_gradients(self) result(gradients) 120 | class(layernorm_layer), intent(in), target :: self 121 | real, allocatable :: gradients(:) 122 | gradients = [self % d_gamma, self % d_beta] 123 | end function get_gradients 124 | 125 | 126 | module subroutine get_gradients_ptr(self, dg_ptr, db_ptr) 127 | class(layernorm_layer), intent(in), target :: self 128 | real, pointer, intent(out) :: dg_ptr(:), db_ptr(:) 129 | dg_ptr => self % d_gamma 130 | db_ptr => self % d_beta 131 | end subroutine get_gradients_ptr 132 | 133 | end submodule nf_layernorm_layer_submodule 134 | -------------------------------------------------------------------------------- /test/test_embedding_layer.f90: -------------------------------------------------------------------------------- 1 | program test_embedding_layer 2 | use iso_fortran_env, only: stderr => error_unit 3 | use nf_embedding_layer, only: embedding_layer 4 | use nf_layer, only: layer 5 | use nf_layer_constructors, only: embedding_constructor => embedding 6 | implicit none 7 | 8 | logical :: ok = .true. 9 | integer :: sample_input(3) = [2, 1, 3] 10 | 11 | call test_simple(ok, sample_input) 12 | call test_positional_trigonometric(ok, sample_input) 13 | call test_positional_absolute(ok, sample_input) 14 | 15 | if (ok) then 16 | print '(a)', 'test_embedding_layer: All tests passed.' 17 | else 18 | write(stderr, '(a)') 'test_embedding_layer: One or more tests failed.' 19 | error stop 1 20 | end if 21 | 22 | contains 23 | subroutine test_simple(ok, sample_input) 24 | logical, intent(in out) :: ok 25 | integer, intent(in) :: sample_input(:) 26 | 27 | real :: sample_gradient(3, 2) = reshape([0.1, 0.2, 0.3, 0.4, 0.6, 0.6], [3, 2]) 28 | real :: output_flat(6) 29 | real :: expected_output_flat(6) = reshape([0.3, 0.1, 0.5, 0.4, 0.2, 0.6], [6]) 30 | real :: dw_flat(8) 31 | real :: expected_dw_flat(8) = reshape([0.2, 0.1, 0.3, 0., 0.6, 0.4, 0.6, 0.], [8]) 32 | type(embedding_layer) :: embedding 33 | 34 | embedding = embedding_layer(vocab_size=4, model_dimension=2) 35 | call embedding % init([3]) 36 | embedding % weights = reshape([0.1, 0.3, 0.5, 0.7, 0.2, 0.4, 0.6, 0.8], [4, 2]) 37 | 38 | call embedding % forward(sample_input) 39 | 40 | output_flat = reshape(embedding % output, [6]) 41 | if (.not. all(output_flat.eq.expected_output_flat)) then 42 | ok = .false. 43 | write(stderr, '(a)') 'forward returned incorrect values.. failed' 44 | end if 45 | 46 | call embedding % backward(sample_input, sample_gradient) 47 | dw_flat = reshape(embedding % dw, shape(dw_flat)) 48 | if (.not. all(dw_flat.eq.expected_dw_flat)) then 49 | ok = .false. 50 | write(stderr, '(a)') 'backward returned incorrect dw values.. failed' 51 | end if 52 | end subroutine test_simple 53 | 54 | subroutine test_positional_trigonometric(ok, sample_input) 55 | logical, intent(in out) :: ok 56 | integer, intent(in) :: sample_input(:) 57 | 58 | real :: output_flat(12) 59 | real :: expected_output_flat(12) = reshape([& 60 | 0.3, 0.941471, 1.4092975,& 61 | 1.3, 0.64030236, 0.08385316,& 62 | 0.3, 0.10999984, 0.51999867,& 63 | 1.3, 1.09995, 1.4998& 64 | ], [12]) 65 | type(embedding_layer) :: embedding 66 | 67 | real :: theta 68 | integer :: i, pos 69 | 70 | embedding = embedding_layer(vocab_size=5, model_dimension=4, positional=1) 71 | call embedding % init([3]) 72 | embedding % weights = reshape([& 73 | 0.1, 0.3, 0.5, 0.7, 0.2,& 74 | 0.1, 0.3, 0.5, 0.7, 0.2,& 75 | 0.1, 0.3, 0.5, 0.7, 0.2,& 76 | 0.1, 0.3, 0.5, 0.7, 0.2& 77 | ], [5, 4]) 78 | 79 | call embedding % forward(sample_input) 80 | 81 | output_flat = reshape(embedding % output, [12]) 82 | if (.not. all(abs(output_flat - expected_output_flat) <= (1e-06 + 1e-05 * abs(expected_output_flat)))) then 83 | ok = .false. 84 | write(stderr, '(a)') 'trigonometric positional encoding returned incorrect values.. failed' 85 | end if 86 | end subroutine test_positional_trigonometric 87 | 88 | subroutine test_positional_absolute(ok, sample_input) 89 | logical, intent(in out) :: ok 90 | integer, intent(in) :: sample_input(:) 91 | 92 | real :: output_flat(12) 93 | real :: expected_output_flat(12) = reshape([& 94 | 0.3, 1.1, 2.5,& 95 | 0.3, 1.1, 2.5,& 96 | 0.3, 1.1, 2.5,& 97 | 0.3, 1.1, 2.5& 98 | ], [12]) 99 | type(embedding_layer) :: embedding 100 | 101 | real :: theta 102 | integer :: i, pos 103 | 104 | embedding = embedding_layer(vocab_size=5, model_dimension=4, positional=2) 105 | call embedding % init([3]) 106 | embedding % weights = reshape([& 107 | 0.1, 0.3, 0.5, 0.7, 0.2,& 108 | 0.1, 0.3, 0.5, 0.7, 0.2,& 109 | 0.1, 0.3, 0.5, 0.7, 0.2,& 110 | 0.1, 0.3, 0.5, 0.7, 0.2& 111 | ], [5, 4]) 112 | 113 | call embedding % forward(sample_input) 114 | 115 | output_flat = reshape(embedding % output, [12]) 116 | if (.not. all(abs(output_flat - expected_output_flat) <= (1e-06 + 1e-05 * abs(expected_output_flat)))) then 117 | ok = .false. 118 | write(stderr, '(a)') 'absolute positional encoding returned incorrect values.. failed' 119 | end if 120 | end subroutine test_positional_absolute 121 | 122 | subroutine test_embedding_constructor(ok, sample_input) 123 | logical, intent(in out) :: ok 124 | integer, intent(in) :: sample_input(:) 125 | 126 | type(layer) :: embedding_constructed 127 | 128 | embedding_constructed = embedding_constructor(sequence_length=3, vocab_size=5, model_dimension=4) 129 | embedding_constructed = embedding_constructor(sequence_length=3, vocab_size=5, model_dimension=4, positional=0) 130 | embedding_constructed = embedding_constructor(sequence_length=3, vocab_size=5, model_dimension=4, positional=1) 131 | embedding_constructed = embedding_constructor(sequence_length=3, vocab_size=5, model_dimension=4, positional=2) 132 | end subroutine test_embedding_constructor 133 | end program test_embedding_layer 134 | -------------------------------------------------------------------------------- /src/nf/nf_locally_connected2d_layer_submodule.f90: -------------------------------------------------------------------------------- 1 | submodule(nf_locally_connected2d_layer) nf_locally_connected2d_layer_submodule 2 | 3 | use nf_activation, only: activation_function 4 | use nf_random, only: random_normal 5 | 6 | implicit none 7 | 8 | contains 9 | 10 | module function locally_connected2d_layer_cons(filters, kernel_size, activation, stride) result(res) 11 | integer, intent(in) :: filters 12 | integer, intent(in) :: kernel_size 13 | class(activation_function), intent(in) :: activation 14 | integer, intent(in) :: stride 15 | type(locally_connected2d_layer) :: res 16 | 17 | res % kernel_size = kernel_size 18 | res % filters = filters 19 | res % activation_name = activation % get_name() 20 | res % stride = stride 21 | allocate(res % activation, source = activation) 22 | end function locally_connected2d_layer_cons 23 | 24 | module subroutine init(self, input_shape) 25 | class(locally_connected2d_layer), intent(in out) :: self 26 | integer, intent(in) :: input_shape(:) 27 | 28 | self % channels = input_shape(1) 29 | self % width = (input_shape(2) - self % kernel_size) / self % stride +1 30 | 31 | if (mod(input_shape(2) - self % kernel_size , self % stride) /= 0) self % width = self % width + 1 32 | 33 | ! Output of shape: filters x width 34 | allocate(self % output(self % filters, self % width)) 35 | self % output = 0 36 | 37 | allocate(self % kernel(self % filters, self % width, self % channels, self % kernel_size)) 38 | call random_normal(self % kernel) 39 | self % kernel = self % kernel / real(self % kernel_size**2) 40 | 41 | allocate(self % biases(self % filters, self % width)) 42 | self % biases = 0 43 | 44 | allocate(self % z, mold=self % output) 45 | self % z = 0 46 | 47 | allocate(self % gradient(input_shape(1), input_shape(2))) 48 | self % gradient = 0 49 | 50 | allocate(self % dw, mold=self % kernel) 51 | self % dw = 0 52 | 53 | allocate(self % db, mold=self % biases) 54 | self % db = 0 55 | end subroutine init 56 | 57 | pure module subroutine forward(self, input) 58 | class(locally_connected2d_layer), intent(in out) :: self 59 | real, intent(in) :: input(:,:) 60 | integer :: input_width 61 | integer :: j, n 62 | integer :: iws, iwe 63 | 64 | input_width = size(input, dim=2) 65 | 66 | do j = 1, self % width 67 | iws = self % stride * (j-1) + 1 68 | iwe = min(iws + self % kernel_size - 1, input_width) 69 | do n = 1, self % filters 70 | self % z(n, j) = sum(self % kernel(n, j, :, 1:iwe-iws+1) * input(:, iws:iwe)) + self % biases(n, j) 71 | end do 72 | end do 73 | self % output = self % activation % eval(self % z) 74 | end subroutine forward 75 | 76 | pure module subroutine backward(self, input, gradient) 77 | class(locally_connected2d_layer), intent(in out) :: self 78 | real, intent(in) :: input(:,:) 79 | real, intent(in) :: gradient(:,:) 80 | integer :: input_width 81 | integer :: j, n, k 82 | integer :: iws, iwe 83 | real :: gdz(self % filters, self % width) 84 | real :: db_local(self % filters, self % width) 85 | real :: dw_local(self % filters, self % width, self % channels, self % kernel_size) 86 | 87 | input_width = size(input, dim=2) 88 | 89 | do j = 1, self % width 90 | gdz(:, j) = gradient(:, j) * self % activation % eval_prime(self % z(:, j)) 91 | end do 92 | 93 | do n = 1, self % filters 94 | do j = 1, self % width 95 | db_local(n, j) = gdz(n, j) 96 | end do 97 | end do 98 | 99 | dw_local = 0.0 100 | self % gradient = 0.0 101 | 102 | do n = 1, self % filters 103 | do j = 1, self % width 104 | iws = self % stride * (j-1) + 1 105 | iwe = min(iws + self % kernel_size - 1, input_width) 106 | do k = 1, self % channels 107 | dw_local(n, j, k, 1:iwe-iws+1) = dw_local(n, j, k, 1:iwe-iws+1) + input(k, iws:iwe) * gdz(n, j) 108 | self % gradient(k, iws:iwe) = self % gradient(k, iws:iwe) + self % kernel(n, j, k, 1:iwe-iws+1) * gdz(n, j) 109 | end do 110 | end do 111 | end do 112 | 113 | self % dw = self % dw + dw_local 114 | self % db = self % db + db_local 115 | end subroutine backward 116 | 117 | pure module function get_num_params(self) result(num_params) 118 | class(locally_connected2d_layer), intent(in) :: self 119 | integer :: num_params 120 | num_params = product(shape(self % kernel)) + product(shape(self % biases)) 121 | end function get_num_params 122 | 123 | module subroutine get_params_ptr(self, w_ptr, b_ptr) 124 | class(locally_connected2d_layer), intent(in), target :: self 125 | real, pointer, intent(out) :: w_ptr(:) 126 | real, pointer, intent(out) :: b_ptr(:) 127 | w_ptr(1:size(self % kernel)) => self % kernel 128 | b_ptr(1:size(self % biases)) => self % biases 129 | end subroutine get_params_ptr 130 | 131 | module function get_gradients(self) result(gradients) 132 | class(locally_connected2d_layer), intent(in), target :: self 133 | real, allocatable :: gradients(:) 134 | gradients = [self % dw, self % db] 135 | end function get_gradients 136 | 137 | module subroutine get_gradients_ptr(self, dw_ptr, db_ptr) 138 | class(locally_connected2d_layer), intent(in), target :: self 139 | real, pointer, intent(out) :: dw_ptr(:) 140 | real, pointer, intent(out) :: db_ptr(:) 141 | dw_ptr(1:size(self % dw)) => self % dw 142 | db_ptr(1:size(self % db)) => self % db 143 | end subroutine get_gradients_ptr 144 | 145 | end submodule nf_locally_connected2d_layer_submodule 146 | --------------------------------------------------------------------------------