Merge remote-tracking branch 'upstream/main' into mv_optimizer

CMakeLists.txt

@@ -50,6 +50,7 @@ add_library(neural-fortran
   src/nf/nf_loss_submodule.f90
   src/nf/nf_maxpool2d_layer.f90
   src/nf/nf_maxpool2d_layer_submodule.f90
+  src/nf/nf_metrics.f90
   src/nf/nf_network.f90
   src/nf/nf_network_submodule.f90
   src/nf/nf_optimizers.f90

README.md

@@ -20,6 +20,7 @@ Read the paper [here](https://arxiv.org/abs/1902.06714).
 * Stochastic gradient descent optimizers: Classic, momentum, Nesterov momentum,
   RMSProp, Adagrad, Adam, AdamW
 * More than a dozen activation functions and their derivatives
+* Loss functions and metrics: Quadratic, Mean Squared Error, Pearson Correlation etc.
 * Loading dense and convolutional models from Keras HDF5 (.h5) files
 * Data-based parallelism
 

example/cnn_mnist.f90

@@ -11,9 +11,6 @@ program cnn_mnist
   real, allocatable :: training_images(:,:), training_labels(:)
   real, allocatable :: validation_images(:,:), validation_labels(:)
   real, allocatable :: testing_images(:,:), testing_labels(:)
-  real, allocatable :: input_reshaped(:,:,:,:)
-  real :: acc
-  logical :: ok
   integer :: n
   integer, parameter :: num_epochs = 10
 

example/dense_mnist.f90

@@ -1,6 +1,6 @@
 program dense_mnist
 
-  use nf, only: dense, input, network, sgd, label_digits, load_mnist
+  use nf, only: dense, input, network, sgd, label_digits, load_mnist, corr
 
   implicit none
 
@@ -38,9 +38,17 @@ program dense_mnist
       optimizer=sgd(learning_rate=3.) &
     )
 
-    if (this_image() == 1) &
-      print '(a,i2,a,f5.2,a)', 'Epoch ', n, ' done, Accuracy: ', accuracy( &
-        net, validation_images, label_digits(validation_labels)) * 100, ' %'
+    block
+      real, allocatable :: output_metrics(:,:)
+      real, allocatable :: mean_metrics(:)
+      ! 2 metrics; 1st is default loss function (quadratic), other is Pearson corr.
+      output_metrics = net % evaluate(validation_images, label_digits(validation_labels), metric=corr())
+      mean_metrics = sum(output_metrics, 1) / size(output_metrics, 1)
+      if (this_image() == 1) &
+        print '(a,i2,3(a,f6.3))', 'Epoch ', n, ' done, Accuracy: ', &
+          accuracy(net, validation_images, label_digits(validation_labels)) * 100, &
+          '%, Loss: ', mean_metrics(1), ', Pearson correlation: ', mean_metrics(2)
+    end block
 
   end do epochs
 

example/get_set_network_params.f90

@@ -9,8 +9,7 @@ program get_set_network_params
   integer, parameter :: test_size = 30
   real :: xtest(test_size), ytest(test_size)
   real :: ypred1(test_size), ypred2(test_size)
-  integer :: i, n, nparam
-  real, allocatable :: parameters(:)
+  integer :: i, n
 
   print '("Getting and setting network parameters")'
   print '(60("="))'

example/quadratic.f90

@@ -24,7 +24,7 @@ program quadratic_fit
   real, allocatable :: x(:), y(:) ! training data
   real, allocatable :: xtest(:), ytest(:) ! testing data
 
-  integer :: i, n
+  integer :: i
 
   print '("Fitting quadratic function")'
   print '(60("="))'
@@ -277,7 +277,7 @@ subroutine rmsprop_optimizer( &
     real, intent(in) :: xtest(:), ytest(:)
     real, intent(in) :: learning_rate, decay_rate
     integer, intent(in) :: num_epochs
-    integer :: i, j, n
+    integer :: i, n
     real, allocatable :: ypred(:)
 
     print '(a)', 'RMSProp optimizer'
@@ -446,4 +446,4 @@ subroutine shuffle(arr)
     end do
   end subroutine shuffle
 
-end program quadratic_fit
+end program quadratic_fit

fpm.toml

@@ -1,5 +1,5 @@
 name = "neural-fortran"
-version = "0.16.1"
+version = "0.17.0"
 license = "MIT"
 author = "Milan Curcic"
 maintainer = "milancurcic@hey.com"

src/nf.f90

@@ -5,6 +5,7 @@ module nf
   use nf_layer_constructors, only: &
     conv2d, dense, flatten, input, maxpool2d, reshape
   use nf_loss, only: mse, quadratic
+  use nf_metrics, only: corr, maxabs
   use nf_network, only: network
   use nf_optimizers, only: sgd, rmsprop, adam, adagrad
   use nf_activation, only: activation_function, elu, exponential,  &

src/nf/nf_conv2d_layer.f90

@@ -89,19 +89,19 @@ pure module function get_num_params(self) result(num_params)
         !! Number of parameters
     end function get_num_params
 
-    pure module function get_params(self) result(params)
+    module function get_params(self) result(params)
       !! Return the parameters (weights and biases) of this layer.
       !! The parameters are ordered as weights first, biases second.
-      class(conv2d_layer), intent(in) :: self
+      class(conv2d_layer), intent(in), target :: self
         !! A `conv2d_layer` instance
       real, allocatable :: params(:)
         !! Parameters to get
     end function get_params
 
-    pure module function get_gradients(self) result(gradients)
+    module function get_gradients(self) result(gradients)
       !! Return the gradients of this layer.
       !! The gradients are ordered as weights first, biases second.
-      class(conv2d_layer), intent(in) :: self
+      class(conv2d_layer), intent(in), target :: self
         !! A `conv2d_layer` instance
       real, allocatable :: gradients(:)
         !! Gradients to get

src/nf/nf_conv2d_layer_submodule.f90

@@ -189,24 +189,32 @@ pure module function get_num_params(self) result(num_params)
   end function get_num_params
 
 
-  pure module function get_params(self) result(params)
-    class(conv2d_layer), intent(in) :: self
+  module function get_params(self) result(params)
+    class(conv2d_layer), intent(in), target :: self
     real, allocatable :: params(:)
 
+    real, pointer :: w_(:) => null()
+
+    w_(1:size(self % kernel)) => self % kernel
+
     params = [ &
-      pack(self % kernel, .true.), &
+      w_, &
       self % biases &
     ]
 
   end function get_params
 
 
-  pure module function get_gradients(self) result(gradients)
-    class(conv2d_layer), intent(in) :: self
+  module function get_gradients(self) result(gradients)
+    class(conv2d_layer), intent(in), target :: self
     real, allocatable :: gradients(:)
 
+    real, pointer :: dw_(:) => null()
+
+    dw_(1:size(self % dw)) => self % dw
+
     gradients = [ &
-      pack(self % dw, .true.), &
+      dw_, &
       self % db &
     ]
 
@@ -219,7 +227,7 @@ module subroutine set_params(self, params)
 
     ! Check that the number of parameters is correct.
     if (size(params) /= self % get_num_params()) then
-       error stop 'conv2d % set_params: Number of parameters does not match'
+      error stop 'conv2d % set_params: Number of parameters does not match'
     end if
 
     ! Reshape the kernel.
@@ -229,10 +237,9 @@ module subroutine set_params(self, params)
     )
 
     ! Reshape the biases.
-    self % biases = reshape( &
-      params(product(shape(self % kernel)) + 1:), &
-      [self % filters] &
-    )
+    associate(n => product(shape(self % kernel)))
+      self % biases = params(n + 1 : n + self % filters)
+    end associate
 
   end subroutine set_params
 

src/nf/nf_dense_layer.f90

@@ -92,19 +92,19 @@ pure module function get_num_params(self) result(num_params)
          !! Number of parameters in this layer
     end function get_num_params
 
-    pure module function get_params(self) result(params)
+    module function get_params(self) result(params)
       !! Return the parameters (weights and biases) of this layer.
       !! The parameters are ordered as weights first, biases second.
-      class(dense_layer), intent(in) :: self
+      class(dense_layer), intent(in), target :: self
         !! Dense layer instance
       real, allocatable :: params(:)
         !! Parameters of this layer
     end function get_params
 
-    pure module function get_gradients(self) result(gradients)
+    module function get_gradients(self) result(gradients)
       !! Return the gradients of this layer.
       !! The gradients are ordered as weights first, biases second.
-      class(dense_layer), intent(in) :: self
+      class(dense_layer), intent(in), target :: self
         !! Dense layer instance
       real, allocatable :: gradients(:)
         !! Gradients of this layer
@@ -115,7 +115,7 @@ module subroutine set_params(self, params)
       !! The parameters are ordered as weights first, biases second.
       class(dense_layer), intent(in out) :: self
         !! Dense layer instance
-      real, intent(in) :: params(:)
+      real, intent(in), target :: params(:)
         !! Parameters of this layer
     end subroutine set_params
 

src/nf/nf_dense_layer_submodule.f90

@@ -62,24 +62,32 @@ pure module function get_num_params(self) result(num_params)
   end function get_num_params
 
 
-  pure module function get_params(self) result(params)
-    class(dense_layer), intent(in) :: self
+  module function get_params(self) result(params)
+    class(dense_layer), intent(in), target :: self
     real, allocatable :: params(:)
 
+    real, pointer :: w_(:) => null()
+
+    w_(1:size(self % weights)) => self % weights
+
     params = [ &
-      pack(self % weights, .true.), &
+      w_, &
       self % biases &
     ]
 
   end function get_params
 
 
-  pure module function get_gradients(self) result(gradients)
-    class(dense_layer), intent(in) :: self
+  module function get_gradients(self) result(gradients)
+    class(dense_layer), intent(in), target :: self
     real, allocatable :: gradients(:)
 
+    real, pointer :: dw_(:) => null()
+
+    dw_(1:size(self % dw)) => self % dw
+
     gradients = [ &
-      pack(self % dw, .true.), &
+      dw_, &
       self % db &
     ]
 
@@ -88,24 +96,23 @@ end function get_gradients
 
   module subroutine set_params(self, params)
     class(dense_layer), intent(in out) :: self
-    real, intent(in) :: params(:)
+    real, intent(in), target :: params(:)
+
+    real, pointer :: p_(:,:) => null()
 
     ! check if the number of parameters is correct
     if (size(params) /= self % get_num_params()) then
       error stop 'Error: number of parameters does not match'
     end if
 
-    ! reshape the weights
-    self % weights = reshape( &
-      params(:self % input_size * self % output_size), &
-      [self % input_size, self % output_size] &
-    )
-
-    ! reshape the biases
-    self % biases = reshape( &
-      params(self % input_size * self % output_size + 1:), &
-      [self % output_size] &
-    )
+    associate(n => self % input_size * self % output_size)
+      ! reshape the weights
+      p_(1:self % input_size, 1:self % output_size) => params(1 : n)
+      self % weights = p_
+
+      ! reshape the biases
+      self % biases = params(n + 1 : n + self % output_size)
+    end associate
 
   end subroutine set_params
 

src/nf/nf_layer.f90

@@ -129,15 +129,15 @@ elemental module function get_num_params(self) result(num_params)
         !! Number of parameters in this layer
     end function get_num_params
 
-    pure module function get_params(self) result(params)
+    module function get_params(self) result(params)
       !! Returns the parameters of this layer.
       class(layer), intent(in) :: self
         !! Layer instance
       real, allocatable :: params(:)
         !! Parameters of this layer
     end function get_params
 
-    pure module function get_gradients(self) result(gradients)
+    module function get_gradients(self) result(gradients)
       !! Returns the gradients of this layer.
       class(layer), intent(in) :: self
         !! Layer instance

src/nf/nf_layer_submodule.f90

@@ -298,7 +298,7 @@ elemental module function get_num_params(self) result(num_params)
 
   end function get_num_params
 
-  pure module function get_params(self) result(params)
+  module function get_params(self) result(params)
     class(layer), intent(in) :: self
     real, allocatable :: params(:)
 
@@ -323,7 +323,7 @@ pure module function get_params(self) result(params)
 
   end function get_params
 
-  pure module function get_gradients(self) result(gradients)
+  module function get_gradients(self) result(gradients)
     class(layer), intent(in) :: self
     real, allocatable :: gradients(:)
 

src/nf/nf_loss.f90

@@ -7,25 +7,20 @@ module nf_loss
   !! loss type that extends the abstract loss derived type, and that
   !! implements concrete eval and derivative methods that accept vectors.
 
+  use nf_metrics, only: metric_type
   implicit none
 
   private
   public :: loss_type
   public :: mse
   public :: quadratic
 
-  type, abstract :: loss_type
+  type, extends(metric_type), abstract :: loss_type
   contains
-    procedure(loss_interface), nopass, deferred :: eval
     procedure(loss_derivative_interface), nopass, deferred :: derivative
   end type loss_type
 
   abstract interface
-    pure function loss_interface(true, predicted) result(res)
-      real, intent(in) :: true(:)
-      real, intent(in) :: predicted(:)
-      real :: res
-    end function loss_interface
     pure function loss_derivative_interface(true, predicted) result(res)
       real, intent(in) :: true(:)
       real, intent(in) :: predicted(:)