diff --git a/CMakeLists.txt b/CMakeLists.txt index 667b5d73..bde0fc33 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -17,6 +17,10 @@ include(cmake/compilers.cmake) add_library(neural-fortran src/nf.f90 src/nf/nf_activation.f90 + src/nf/nf_avgpool1d_layer.f90 + src/nf/nf_avgpool1d_layer_submodule.f90 + src/nf/nf_avgpool2d_layer.f90 + src/nf/nf_avgpool2d_layer_submodule.f90 src/nf/nf_base_layer.f90 src/nf/nf_conv1d_layer.f90 src/nf/nf_conv1d_layer_submodule.f90 diff --git a/src/nf.f90 b/src/nf.f90 index f644826d..20611957 100644 --- a/src/nf.f90 +++ b/src/nf.f90 @@ -3,6 +3,8 @@ module nf use nf_datasets_mnist, only: label_digits, load_mnist use nf_layer, only: layer use nf_layer_constructors, only: & + avgpool1d, & + avgpool2d, & conv1d, & conv2d, & dense, & diff --git a/src/nf/nf_avgpool1d_layer.f90 b/src/nf/nf_avgpool1d_layer.f90 new file mode 100644 index 00000000..631f4895 --- /dev/null +++ b/src/nf/nf_avgpool1d_layer.f90 @@ -0,0 +1,66 @@ +module nf_avgpool1d_layer + !! This module provides the 1-d average pooling layer. + + use nf_base_layer, only: base_layer + implicit none + + private + public :: avgpool1d_layer + + type, extends(base_layer) :: avgpool1d_layer + integer :: channels + integer :: width ! Length of the input along the pooling dimension + integer :: pool_size + integer :: stride + + ! Gradient for the input (same shape as the input). + real, allocatable :: gradient(:,:) + ! Output after pooling (dimensions: (channels, new_width)). + real, allocatable :: output(:,:) + contains + procedure :: init + procedure :: forward + procedure :: backward + end type avgpool1d_layer + + interface avgpool1d_layer + pure module function avgpool1d_layer_cons(pool_size, stride) result(res) + !! `avgpool1d` constructor function. + integer, intent(in) :: pool_size + !! Width of the pooling window. + integer, intent(in) :: stride + !! Stride of the pooling window. + type(avgpool1d_layer) :: res + end function avgpool1d_layer_cons + end interface avgpool1d_layer + + interface + module subroutine init(self, input_shape) + !! Initialize the `avgpool1d` layer instance with an input shape. + class(avgpool1d_layer), intent(in out) :: self + !! `avgpool1d_layer` instance. + integer, intent(in) :: input_shape(:) + !! Array shape of the input layer, expected as (channels, width). + end subroutine init + + pure module subroutine forward(self, input) + !! Run a forward pass of the `avgpool1d` layer. + class(avgpool1d_layer), intent(in out) :: self + !! `avgpool1d_layer` instance. + real, intent(in) :: input(:,:) + !! Input data (output of the previous layer), with shape (channels, width). + end subroutine forward + + pure module subroutine backward(self, input, gradient) + !! Run a backward pass of the `avgpool1d` layer. + class(avgpool1d_layer), intent(in out) :: self + !! `avgpool1d_layer` instance. + real, intent(in) :: input(:,:) + !! Input data (output of the previous layer). + real, intent(in) :: gradient(:,:) + !! Gradient from the downstream layer, with shape (channels, pooled width). + end subroutine backward + end interface + + end module nf_avgpool1d_layer + \ No newline at end of file diff --git a/src/nf/nf_avgpool1d_layer_submodule.f90 b/src/nf/nf_avgpool1d_layer_submodule.f90 new file mode 100644 index 00000000..8e022fbf --- /dev/null +++ b/src/nf/nf_avgpool1d_layer_submodule.f90 @@ -0,0 +1,87 @@ +submodule(nf_avgpool1d_layer) nf_avgpool1d_layer_submodule + implicit none + +contains + + pure module function avgpool1d_layer_cons(pool_size, stride) result(res) + implicit none + integer, intent(in) :: pool_size + integer, intent(in) :: stride + type(avgpool1d_layer) :: res + + res % pool_size = pool_size + res % stride = stride + end function avgpool1d_layer_cons + + + module subroutine init(self, input_shape) + implicit none + class(avgpool1d_layer), intent(in out) :: self + integer, intent(in) :: input_shape(:) + ! input_shape is expected to be (channels, width) + + self % channels = input_shape(1) + ! The new width is the integer division of the input width by the stride. + self % width = input_shape(2) / self % stride + + ! Allocate the gradient array corresponding to the input dimensions. + allocate(self % gradient(input_shape(1), input_shape(2))) + self % gradient = 0 + + ! Allocate the output array (after pooling). + allocate(self % output(self % channels, self % width)) + self % output = 0 + end subroutine init + + + pure module subroutine forward(self, input) + implicit none + class(avgpool1d_layer), intent(in out) :: self + real, intent(in) :: input(:,:) + integer :: input_width + integer :: i, n + integer :: ii, iend + integer :: iextent + + input_width = size(input, dim=2) + ! Ensure we only process complete pooling regions. + iextent = input_width - mod(input_width, self % stride) + + ! Loop over the input with a step size equal to the stride and over all channels. + do concurrent (i = 1:iextent: self % stride, n = 1:self % channels) + ! Compute the index in the pooled (output) array. + ii = (i - 1) / self % stride + 1 + ! Determine the ending index of the current pooling region. + iend = min(i + self % pool_size - 1, input_width) + + ! Compute the average over the pooling region. + self % output(n, ii) = sum(input(n, i:iend)) / (iend - i + 1) + end do + end subroutine forward + + + pure module subroutine backward(self, input, gradient) + implicit none + class(avgpool1d_layer), intent(in out) :: self + real, intent(in) :: input(:,:) + real, intent(in) :: gradient(:,:) + integer :: channels, pooled_width + integer :: i, n, j, istart, iend + real :: scale_factor + + channels = size(gradient, dim=1) + pooled_width = size(gradient, dim=2) + + ! The gradient for average pooling is distributed evenly over the pooling window. + do concurrent (n = 1:channels, i = 1:pooled_width) + istart = (i - 1) * self % stride + 1 + iend = min(istart + self % pool_size - 1, size(input, dim=2)) + scale_factor = 1.0 / (iend - istart + 1) + + do j = istart, iend + self % gradient(n, j) = gradient(n, i) * scale_factor + end do + end do + end subroutine backward + +end submodule nf_avgpool1d_layer_submodule \ No newline at end of file diff --git a/src/nf/nf_avgpool2d_layer.f90 b/src/nf/nf_avgpool2d_layer.f90 new file mode 100644 index 00000000..fcf8b970 --- /dev/null +++ b/src/nf/nf_avgpool2d_layer.f90 @@ -0,0 +1,66 @@ +module nf_avgpool2d_layer + !! This module provides the 2-d average pooling layer. + + use nf_base_layer, only: base_layer + implicit none + + private + public :: avgpool2d_layer + + type, extends(base_layer) :: avgpool2d_layer + integer :: channels + integer :: height ! Height of the input + integer :: width ! Width of the input + integer :: pool_size ! Pooling window size (height, width) + integer :: stride ! Stride (height, width) + + ! Gradient for the input (same shape as the input: channels, height, width). + real, allocatable :: gradient(:,:,:) + ! Output after pooling (dimensions: (channels, new_height, new_width)). + real, allocatable :: output(:,:,:) + contains + procedure :: init + procedure :: forward + procedure :: backward + end type avgpool2d_layer + + interface avgpool2d_layer + pure module function avgpool2d_layer_cons(pool_size, stride) result(res) + !! `avgpool2d` constructor function. + integer, intent(in) :: pool_size + !! Pooling window size (height, width). + integer, intent(in) :: stride + !! Stride (height, width). + type(avgpool2d_layer) :: res + end function avgpool2d_layer_cons + end interface avgpool2d_layer + + interface + module subroutine init(self, input_shape) + !! Initialize the `avgpool2d` layer instance with an input shape. + class(avgpool2d_layer), intent(in out) :: self + !! `avgpool2d_layer` instance. + integer, intent(in) :: input_shape(:) + !! Array shape of the input layer, expected as (channels, height, width). + end subroutine init + + pure module subroutine forward(self, input) + !! Run a forward pass of the `avgpool2d` layer. + class(avgpool2d_layer), intent(in out) :: self + !! `avgpool2d_layer` instance. + real, intent(in) :: input(:,:,:) + !! Input data (output of the previous layer), with shape (channels, height, width). + end subroutine forward + + pure module subroutine backward(self, input, gradient) + !! Run a backward pass of the `avgpool2d` layer. + class(avgpool2d_layer), intent(in out) :: self + !! `avgpool2d_layer` instance. + real, intent(in) :: input(:,:,:) + !! Input data (output of the previous layer). + real, intent(in) :: gradient(:,:,:) + !! Gradient from the downstream layer, with shape (channels, pooled_height, pooled_width). + end subroutine backward + end interface + +end module nf_avgpool2d_layer diff --git a/src/nf/nf_avgpool2d_layer_submodule.f90 b/src/nf/nf_avgpool2d_layer_submodule.f90 new file mode 100644 index 00000000..3029b826 --- /dev/null +++ b/src/nf/nf_avgpool2d_layer_submodule.f90 @@ -0,0 +1,94 @@ +submodule(nf_avgpool2d_layer) nf_avgpool2d_layer_submodule + implicit none + +contains + + pure module function avgpool2d_layer_cons(pool_size, stride) result(res) + implicit none + integer, intent(in) :: pool_size + integer, intent(in) :: stride + type(avgpool2d_layer) :: res + + res % pool_size = pool_size + res % stride = stride + end function avgpool2d_layer_cons + + + module subroutine init(self, input_shape) + implicit none + class(avgpool2d_layer), intent(in out) :: self + integer, intent(in) :: input_shape(:) + ! input_shape is expected to be (channels, width, height) + + self % channels = input_shape(1) + self % width = input_shape(2) / self % stride + self % height = input_shape(3) / self % stride + + ! Allocate the gradient array corresponding to the input dimensions. + allocate(self % gradient(input_shape(1), input_shape(2), input_shape(3))) + self % gradient = 0 + + ! Allocate the output array (after pooling). + allocate(self % output(self % channels, self % width, self % height)) + self % output = 0 + end subroutine init + + + pure module subroutine forward(self, input) + implicit none + class(avgpool2d_layer), intent(in out) :: self + real, intent(in) :: input(:,:,:) + integer :: input_width, input_height + integer :: i, j, n + integer :: ii, jj, iend, jend + integer :: iextent, jextent + + input_width = size(input, dim=2) + input_height = size(input, dim=3) + + ! Ensure we only process complete pooling regions. + iextent = input_width - mod(input_width, self % stride) + jextent = input_height - mod(input_height, self % stride) + + ! Loop over the input with a step size equal to the stride and over all channels. + do concurrent (i = 1:iextent:self % stride, j = 1:jextent:self % stride, n = 1:self % channels) + ii = (i - 1) / self % stride + 1 + jj = (j - 1) / self % stride + 1 + + iend = min(i + self % pool_size - 1, input_width) + jend = min(j + self % pool_size - 1, input_height) + + ! Compute the average over the pooling region. + self % output(n, ii, jj) = sum(input(n, i:iend, j:jend)) / ((iend - i + 1) * (jend - j + 1)) + end do + end subroutine forward + + + pure module subroutine backward(self, input, gradient) + implicit none + class(avgpool2d_layer), intent(in out) :: self + real, intent(in) :: input(:,:,:) + real, intent(in) :: gradient(:,:,:) + integer :: channels, pooled_width, pooled_height + integer :: i, j, n, x, y, istart, iend, jstart, jend + real :: scale_factor + + channels = size(gradient, dim=1) + pooled_width = size(gradient, dim=2) + pooled_height = size(gradient, dim=3) + + ! The gradient for average pooling is distributed evenly over the pooling window. + do concurrent (n = 1:channels, i = 1:pooled_width, j = 1:pooled_height) + istart = (i - 1) * self % stride + 1 + iend = min(istart + self % pool_size - 1, size(input, dim=2)) + jstart = (j - 1) * self % stride + 1 + jend = min(jstart + self % pool_size - 1, size(input, dim=3)) + scale_factor = 1.0 / ((iend - istart + 1) * (jend - jstart + 1)) + + do concurrent (x = istart:iend, y = jstart:jend) + self % gradient(n, x, y) = gradient(n, i, j) * scale_factor + end do + end do + end subroutine backward + +end submodule nf_avgpool2d_layer_submodule diff --git a/src/nf/nf_layer_constructors.f90 b/src/nf/nf_layer_constructors.f90 index d3f06ca3..401ac502 100644 --- a/src/nf/nf_layer_constructors.f90 +++ b/src/nf/nf_layer_constructors.f90 @@ -9,6 +9,8 @@ module nf_layer_constructors private public :: & + avgpool1d, & + avgpool2d, & conv1d, & conv2d, & dense, & @@ -179,6 +181,50 @@ module function flatten() result(res) !! Resulting layer instance end function flatten + module function avgpool1d(pool_size, stride) result(res) + !! 1-d avgpooling layer constructor. + !! + !! This layer is for downscaling other layers, typically `conv1d`. + !! + !! Example: + !! + !! ``` + !! use nf, only :: avgpool1d, layer + !! type(layer) :: avgpool1d_layer + !! avgpool1d_layer = avgpool1d(pool_size=2) + !! avgpool1d_layer = avgpool1d(pool_size=2, stride=3) + !! ``` + integer, intent(in) :: pool_size + !! Width of the pooling window, commonly 2 + integer, intent(in), optional :: stride + !! Stride of the pooling window, commonly equal to `pool_size`; + !! Defaults to `pool_size` if omitted. + type(layer) :: res + !! Resulting layer instance + end function avgpool1d + + module function avgpool2d(pool_size, stride) result(res) + !! 2-d avgpooling layer constructor. + !! + !! This layer is for downscaling other layers, typically `conv2d`. + !! + !! Example: + !! + !! ``` + !! use nf, only :: avgpool2d, layer + !! type(layer) :: avgpool2d_layer + !! avgpool2d_layer = avgpool2d(pool_size=2) + !! avgpool2d_layer = avgpool2d(pool_size=2, stride=3) + !! ``` + integer, intent(in) :: pool_size + !! Width of the pooling window, commonly 2 + integer, intent(in), optional :: stride + !! Stride of the pooling window, commonly equal to `pool_size`; + !! Defaults to `pool_size` if omitted. + type(layer) :: res + !! Resulting layer instance + end function avgpool2d + module function conv1d(filters, kernel_size, activation) result(res) !! 1-d convolutional layer constructor. !! @@ -303,7 +349,7 @@ module function maxpool2d(pool_size, stride) result(res) type(layer) :: res !! Resulting layer instance end function maxpool2d - + module function linear2d(out_features) result(res) !! Rank-2 (sequence_length, out_features) linear layer constructor. !! sequence_length is determined at layer initialization, based on the diff --git a/src/nf/nf_layer_constructors_submodule.f90 b/src/nf/nf_layer_constructors_submodule.f90 index 1665d38a..4f01391d 100644 --- a/src/nf/nf_layer_constructors_submodule.f90 +++ b/src/nf/nf_layer_constructors_submodule.f90 @@ -1,6 +1,8 @@ submodule(nf_layer_constructors) nf_layer_constructors_submodule use nf_layer, only: layer + use nf_avgpool1d_layer, only: avgpool1d_layer + use nf_avgpool2d_layer, only: avgpool2d_layer use nf_conv1d_layer, only: conv1d_layer use nf_conv2d_layer, only: conv2d_layer use nf_dense_layer, only: dense_layer @@ -140,6 +142,62 @@ module function flatten() result(res) end function flatten + module function avgpool1d(pool_size, stride) result(res) + integer, intent(in) :: pool_size + integer, intent(in), optional :: stride + integer :: stride_ + type(layer) :: res + + if (pool_size < 2) & + error stop 'pool_size must be >= 2 in a avgpool1d layer' + + ! Stride defaults to pool_size if not provided + if (present(stride)) then + stride_ = stride + else + stride_ = pool_size + end if + + if (stride_ < 1) & + error stop 'stride must be >= 1 in a avgpool1d layer' + + res % name = 'avgpool1d' + + allocate( & + res % p, & + source=avgpool1d_layer(pool_size, stride_) & + ) + + end function avgpool1d + + module function avgpool2d(pool_size, stride) result(res) + integer, intent(in) :: pool_size + integer, intent(in), optional :: stride + integer :: stride_ + type(layer) :: res + + if (pool_size < 2) & + error stop 'pool_size must be >= 2 in a avgpool2d layer' + + ! Stride defaults to pool_size if not provided + if (present(stride)) then + stride_ = stride + else + stride_ = pool_size + end if + + if (stride_ < 1) & + error stop 'stride must be >= 1 in a avgpool2d layer' + + res % name = 'avgpool2d' + + allocate( & + res % p, & + source=avgpool2d_layer(pool_size, stride_) & + ) + + end function avgpool2d + module function input1d(layer_size) result(res) integer, intent(in) :: layer_size type(layer) :: res @@ -228,7 +286,6 @@ module function maxpool2d(pool_size, stride) result(res) end function maxpool2d - module function reshape2d(dim1, dim2) result(res) integer, intent(in) :: dim1, dim2 type(layer) :: res diff --git a/src/nf/nf_layer_submodule.f90 b/src/nf/nf_layer_submodule.f90 index eebedaa9..dc062a6b 100644 --- a/src/nf/nf_layer_submodule.f90 +++ b/src/nf/nf_layer_submodule.f90 @@ -1,6 +1,8 @@ submodule(nf_layer) nf_layer_submodule use iso_fortran_env, only: stderr => error_unit + use nf_avgpool1d_layer, only: avgpool1d_layer + use nf_avgpool2d_layer, only: avgpool2d_layer use nf_conv1d_layer, only: conv1d_layer use nf_conv2d_layer, only: conv2d_layer use nf_dense_layer, only: dense_layer @@ -54,6 +56,10 @@ pure module subroutine backward_1d(self, previous, gradient) ! Upstream layers permitted: input2d, input3d, conv1d, conv2d, locally_connected1d, maxpool1d, maxpool2d select type(prev_layer => previous % p) + type is(avgpool1d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(avgpool2d_layer) + call this_layer % backward(prev_layer % output, gradient) type is(input2d_layer) call this_layer % backward(prev_layer % output, gradient) type is(locally_connected1d_layer) @@ -141,6 +147,8 @@ pure module subroutine backward_2d(self, previous, gradient) select type(prev_layer => previous % p) type is(maxpool1d_layer) call this_layer % backward(prev_layer % output, gradient) + type is(avgpool1d_layer) + call this_layer % backward(prev_layer % output, gradient) type is(reshape2d_layer) call this_layer % backward(prev_layer % output, gradient) type is(input2d_layer) @@ -156,6 +164,8 @@ pure module subroutine backward_2d(self, previous, gradient) select type(prev_layer => previous % p) type is(maxpool1d_layer) call this_layer % backward(prev_layer % output, gradient) + type is(avgpool1d_layer) + call this_layer % backward(prev_layer % output, gradient) type is(reshape2d_layer) call this_layer % backward(prev_layer % output, gradient) type is(input2d_layer) @@ -171,6 +181,25 @@ pure module subroutine backward_2d(self, previous, gradient) select type(prev_layer => previous % p) type is(maxpool1d_layer) call this_layer % backward(prev_layer % output, gradient) + type is(avgpool1d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(reshape2d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(locally_connected1d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(input2d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(conv1d_layer) + call this_layer % backward(prev_layer % output, gradient) + end select + + type is(avgpool1d_layer) + + select type(prev_layer => previous % p) + type is(maxpool1d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(avgpool1d_layer) + call this_layer % backward(prev_layer % output, gradient) type is(reshape2d_layer) call this_layer % backward(prev_layer % output, gradient) type is(locally_connected1d_layer) @@ -208,6 +237,8 @@ pure module subroutine backward_3d(self, previous, gradient) select type(prev_layer => previous % p) type is(maxpool2d_layer) call this_layer % backward(prev_layer % output, gradient) + type is(avgpool2d_layer) + call this_layer % backward(prev_layer % output, gradient) type is(input3d_layer) call this_layer % backward(prev_layer % output, gradient) type is(conv2d_layer) @@ -224,6 +255,24 @@ pure module subroutine backward_3d(self, previous, gradient) call this_layer % backward(prev_layer % output, gradient) type is(maxpool2d_layer) call this_layer % backward(prev_layer % output, gradient) + type is(avgpool2d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(input3d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(reshape3d_layer) + call this_layer % backward(prev_layer % output, gradient) + end select + + type is(avgpool2d_layer) + + ! Upstream layers permitted: conv2d, input3d, maxpool2d, reshape3d + select type(prev_layer => previous % p) + type is(conv2d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(maxpool2d_layer) + call this_layer % backward(prev_layer % output, gradient) + type is(avgpool2d_layer) + call this_layer % backward(prev_layer % output, gradient) type is(input3d_layer) call this_layer % backward(prev_layer % output, gradient) type is(reshape3d_layer) @@ -356,6 +405,36 @@ module subroutine forward(self, input) call this_layer % forward(prev_layer % output) end select + type is(avgpool1d_layer) + + ! Upstream layers permitted: input1d, locally_connected1d, maxpool1d, reshape2d + select type(prev_layer => input % p) + type is(input2d_layer) + call this_layer % forward(prev_layer % output) + type is(locally_connected1d_layer) + call this_layer % forward(prev_layer % output) + type is(maxpool1d_layer) + call this_layer % forward(prev_layer % output) + type is(reshape2d_layer) + call this_layer % forward(prev_layer % output) + type is(conv1d_layer) + call this_layer % forward(prev_layer % output) + end select + + type is(avgpool2d_layer) + + ! Upstream layers permitted: input3d, conv2d, maxpool2d, reshape3d + select type(prev_layer => input % p) + type is(input3d_layer) + call this_layer % forward(prev_layer % output) + type is(conv2d_layer) + call this_layer % forward(prev_layer % output) + type is(maxpool2d_layer) + call this_layer % forward(prev_layer % output) + type is(reshape3d_layer) + call this_layer % forward(prev_layer % output) + end select + type is(flatten_layer) ! Upstream layers permitted: input2d, input3d, conv2d, maxpool1d, maxpool2d, reshape2d, reshape3d, locally_connected2d @@ -374,6 +453,10 @@ module subroutine forward(self, input) call this_layer % forward(prev_layer % output) type is(maxpool2d_layer) call this_layer % forward(prev_layer % output) + type is(avgpool1d_layer) + call this_layer % forward(prev_layer % output) + type is(avgpool2d_layer) + call this_layer % forward(prev_layer % output) type is(reshape2d_layer) call this_layer % forward(prev_layer % output) type is(reshape3d_layer) @@ -481,6 +564,8 @@ pure module subroutine get_output_2d(self, output) allocate(output, source=this_layer % output) type is(maxpool1d_layer) allocate(output, source=this_layer % output) + type is(avgpool1d_layer) + allocate(output, source=this_layer % output) type is(locally_connected1d_layer) allocate(output, source=this_layer % output) type is(conv1d_layer) @@ -518,6 +603,8 @@ pure module subroutine get_output_3d(self, output) allocate(output, source=this_layer % output) type is(maxpool2d_layer) allocate(output, source=this_layer % output) + type is(avgpool2d_layer) + allocate(output, source=this_layer % output) type is(reshape3d_layer) allocate(output, source=this_layer % output) class default @@ -563,6 +650,10 @@ impure elemental module subroutine init(self, input) self % layer_shape = shape(this_layer % output) type is(maxpool2d_layer) self % layer_shape = shape(this_layer % output) + type is(avgpool1d_layer) + self % layer_shape = shape(this_layer % output) + type is(avgpool2d_layer) + self % layer_shape = shape(this_layer % output) end select self % input_layer_shape = input % layer_shape @@ -617,6 +708,10 @@ elemental module function get_num_params(self) result(num_params) num_params = 0 type is (maxpool2d_layer) num_params = 0 + type is (avgpool1d_layer) + num_params = 0 + type is (avgpool2d_layer) + num_params = 0 type is (flatten_layer) num_params = 0 type is (reshape2d_layer) @@ -662,6 +757,10 @@ module function get_params(self) result(params) ! No parameters to get. type is (maxpool2d_layer) ! No parameters to get. + type is (avgpool1d_layer) + ! No parameters to get. + type is (avgpool2d_layer) + ! No parameters to get. type is (flatten_layer) ! No parameters to get. type is (reshape2d_layer) @@ -707,6 +806,10 @@ module function get_gradients(self) result(gradients) ! No gradients to get. type is (maxpool2d_layer) ! No gradients to get. + type is (avgpool1d_layer) + ! No gradients to get. + type is (avgpool2d_layer) + ! No gradients to get. type is (flatten_layer) ! No gradients to get. type is (reshape2d_layer) @@ -784,6 +887,16 @@ module subroutine set_params(self, params) write(stderr, '(a)') 'Warning: calling set_params() ' & // 'on a zero-parameter layer; nothing to do.' + type is (avgpool1d_layer) + ! No parameters to set. + write(stderr, '(a)') 'Warning: calling set_params() ' & + // 'on a zero-parameter layer; nothing to do.' + + type is (avgpool2d_layer) + ! No parameters to set. + write(stderr, '(a)') 'Warning: calling set_params() ' & + // 'on a zero-parameter layer; nothing to do.' + type is (linear2d_layer) call this_layer % set_params(params) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index ec4e139e..3005a5fd 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -1,4 +1,6 @@ foreach(execid + avgpool1d_layer + avgpool2d_layer input1d_layer input2d_layer input3d_layer diff --git a/test/test_avgpool1d_layer.f90 b/test/test_avgpool1d_layer.f90 new file mode 100644 index 00000000..9d2a3583 --- /dev/null +++ b/test/test_avgpool1d_layer.f90 @@ -0,0 +1,99 @@ +program test_avgpool1d_layer + + use iso_fortran_env, only: stderr => error_unit + use nf, only: avgpool1d, input, layer + use nf_input2d_layer, only: input2d_layer + use nf_avgpool1d_layer, only: avgpool1d_layer + + implicit none + + type(layer) :: avgpool_layer, input_layer + integer, parameter :: pool_size = 2, stride = 2 + integer, parameter :: channels = 3, length = 32 + integer, parameter :: input_shape(2) = [channels, length] + integer, parameter :: output_shape(2) = [channels, length / 2] + real, allocatable :: sample_input(:,:), output(:,:), gradient(:,:) + integer :: i + logical :: ok = .true., gradient_ok = .true. + + avgpool_layer = avgpool1d(pool_size) + + if (.not. avgpool_layer % name == 'avgpool1d') then + ok = .false. + write(stderr, '(a)') 'avgpool1d layer has its name set correctly.. failed' + end if + + if (avgpool_layer % initialized) then + ok = .false. + write(stderr, '(a)') 'avgpool1d layer should not be marked as initialized yet.. failed' + end if + + input_layer = input(channels, length) + call avgpool_layer % init(input_layer) + + if (.not. avgpool_layer % initialized) then + ok = .false. + write(stderr, '(a)') 'avgpool1d layer should now be marked as initialized.. failed' + end if + + if (.not. all(avgpool_layer % input_layer_shape == input_shape)) then + ok = .false. + write(stderr, '(a)') 'avgpool1d layer input layer shape should be correct.. failed' + end if + + if (.not. all(avgpool_layer % layer_shape == output_shape)) then + ok = .false. + write(stderr, '(a)') 'avgpool1d layer output layer shape should be correct.. failed' + end if + + ! Allocate and initialize sample input data + allocate(sample_input(channels, length)) + do concurrent(i = 1:length) + sample_input(:,i) = i + end do + + select type(this_layer => input_layer % p); type is(input2d_layer) + call this_layer % set(sample_input) + end select + + call avgpool_layer % forward(input_layer) + call avgpool_layer % get_output(output) + + do i = 1, length / 2 + ! For input values [1,2,3,4,...], avgpool1d with pool_size=2, stride=2: + ! output(:,i) = avg of [2*i-1, 2*i] = (2*i-1 + 2*i)/2 = (4*i-1)/2 + if (.not. all(output(:,i) == (4*i-1)/2.0)) then + ok = .false. + write(stderr, '(a)') 'avgpool1d layer forward pass correctly propagates the avg value.. failed' + end if + end do + + ! Test the backward pass + allocate(gradient, source=output) + call avgpool_layer % backward(input_layer, gradient) + + select type(this_layer => avgpool_layer % p); type is(avgpool1d_layer) + do i = 1, length + ! For avgpool1d, each input in a pool window receives gradient(:,i/2) / pool_size if i is even, + ! and gradient(:,(i+1)/2) / pool_size if i is odd (since stride=2, pool_size=2) + if (mod(i,2) == 0) then + if (.not. all(this_layer % gradient(:,i) == gradient(:,i/2) / 2.0)) gradient_ok = .false. + else + if (.not. all(this_layer % gradient(:,i) == gradient(:,(i+1)/2) / 2.0)) gradient_ok = .false. + end if + end do + end select + + if (.not. gradient_ok) then + ok = .false. + write(stderr, '(a)') 'avgpool1d layer backward pass produces the correct dL/dx.. failed' + end if + + if (ok) then + print '(a)', 'test_avgpool1d_layer: All tests passed.' + else + write(stderr, '(a)') 'test_avgpool1d_layer: One or more tests failed.' + stop 1 + end if + +end program test_avgpool1d_layer diff --git a/test/test_avgpool2d_layer.f90 b/test/test_avgpool2d_layer.f90 new file mode 100644 index 00000000..bc633fb9 --- /dev/null +++ b/test/test_avgpool2d_layer.f90 @@ -0,0 +1,113 @@ +program test_avgpool2d_layer + + use iso_fortran_env, only: stderr => error_unit + use nf, only: avgpool2d, input, layer + use nf_input3d_layer, only: input3d_layer + use nf_avgpool2d_layer, only: avgpool2d_layer + + implicit none + + type(layer) :: avgpool_layer, input_layer + integer, parameter :: pool_size = 2, stride = 2 + integer, parameter :: channels = 3, width = 32 + integer, parameter :: input_shape(3) = [channels, width, width] + integer, parameter :: output_shape(3) = [channels, width / 2, width / 2] + real, allocatable :: sample_input(:,:,:), output(:,:,:), gradient(:,:,:) + integer :: i, j + logical :: ok = .true., gradient_ok = .true. + + avgpool_layer = avgpool2d(pool_size) + + if (.not. avgpool_layer % name == 'avgpool2d') then + ok = .false. + write(stderr, '(a)') 'avgpool2d layer has its name set correctly.. failed' + end if + + if (avgpool_layer % initialized) then + ok = .false. + write(stderr, '(a)') 'avgpool2d layer should not be marked as initialized yet.. failed' + end if + + input_layer = input(channels, width, width) + call avgpool_layer % init(input_layer) + + if (.not. avgpool_layer % initialized) then + ok = .false. + write(stderr, '(a)') 'avgpool2d layer should now be marked as initialized.. failed' + end if + + if (.not. all(avgpool_layer % input_layer_shape == input_shape)) then + ok = .false. + write(stderr, '(a)') 'avgpool2d layer input layer shape should be correct.. failed' + end if + + if (.not. all(avgpool_layer % layer_shape == output_shape)) then + ok = .false. + write(stderr, '(a)') 'avgpool2d layer input layer shape should be correct.. failed' + end if + + ! Allocate and initialize sample input data + allocate(sample_input(channels, width, width)) + do concurrent(i = 1:width, j = 1:width) + sample_input(:,i,j) = i * j + end do + + select type(this_layer => input_layer % p); type is(input3d_layer) + call this_layer % set(sample_input) + end select + + call avgpool_layer % forward(input_layer) + call avgpool_layer % get_output(output) + + do j = 1, width / 2 + do i = 1, width / 2 + ! For input(:,i,j) = i*j, avgpool2d with pool_size=2, stride=2: + ! window: (2*i-1,2*j-1), (2*i,2*j-1), (2*i-1,2*j), (2*i,2*j) + ! avg = (a + b + c + d) / 4 + if (.not. all(output(:,i,j) == ( & + (2*i-1)*(2*j-1) + (2*i)*(2*j-1) + (2*i-1)*(2*j) + (2*i)*(2*j) & + ) / 4.0)) then + ok = .false. + write(stderr, '(a)') 'avgpool2d layer forward pass correctly propagates the avg value.. failed' + end if + end do + end do + + ! Test the backward pass + ! Allocate and initialize the downstream gradient field + allocate(gradient, source=output) + + ! Make a backward pass + call avgpool_layer % backward(input_layer, gradient) + + select type(this_layer => avgpool_layer % p); type is(avgpool2d_layer) + do j = 1, width + do i = 1, width + ! Each input in a 2x2 window receives gradient(:,i/2,j/2) / 4 if both i,j even, + ! gradient(:,(i+1)/2,(j+1)/2) / 4 if both i,j odd, etc. + if (mod(i,2) == 0 .and. mod(j,2) == 0) then + if (.not. all(this_layer % gradient(:,i,j) == gradient(:,i/2,j/2) / 4.0)) gradient_ok = .false. + else if (mod(i,2) == 1 .and. mod(j,2) == 0) then + if (.not. all(this_layer % gradient(:,i,j) == gradient(:,(i+1)/2,j/2) / 4.0)) gradient_ok = .false. + else if (mod(i,2) == 0 .and. mod(j,2) == 1) then + if (.not. all(this_layer % gradient(:,i,j) == gradient(:,i/2,(j+1)/2) / 4.0)) gradient_ok = .false. + else + if (.not. all(this_layer % gradient(:,i,j) == gradient(:,(i+1)/2,(j+1)/2) / 4.0)) gradient_ok = .false. + end if + end do + end do + end select + + if (.not. gradient_ok) then + ok = .false. + write(stderr, '(a)') 'avgpool2d layer backward pass produces the correct dL/dx.. failed' + end if + + if (ok) then + print '(a)', 'test_avgpool2d_layer: All tests passed.' + else + write(stderr, '(a)') 'test_avgpool2d_layer: One or more tests failed.' + stop 1 + end if + +end program test_avgpool2d_layer