Merge branch 'main' into optim_pack

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 = "[email protected]"

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_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(:)

src/nf/nf_metrics.f90

@@ -0,0 +1,72 @@
+module nf_metrics
+
+  !! This module provides a collection of metric functions.
+
+  implicit none
+
+  private
+  public :: metric_type
+  public :: corr
+  public :: maxabs
+
+  type, abstract :: metric_type
+  contains
+    procedure(metric_interface), nopass, deferred :: eval
+  end type metric_type
+
+  abstract interface
+    pure function metric_interface(true, predicted) result(res)
+      real, intent(in) :: true(:)
+      real, intent(in) :: predicted(:)
+      real :: res
+    end function metric_interface
+  end interface
+
+  type, extends(metric_type) :: corr
+    !! Pearson correlation
+  contains
+    procedure, nopass :: eval => corr_eval
+  end type corr
+
+  type, extends(metric_type) :: maxabs
+    !! Maximum absolute difference
+  contains
+    procedure, nopass :: eval => maxabs_eval
+  end type maxabs
+
+  contains
+
+  pure module function corr_eval(true, predicted) result(res)
+    !! Pearson correlation function:
+    !!
+    real, intent(in) :: true(:)
+      !! True values, i.e. labels from training datasets
+    real, intent(in) :: predicted(:)
+      !! Values predicted by the network
+    real :: res
+      !! Resulting correlation value
+    real :: m_true, m_pred
+
+    m_true = sum(true) / size(true)
+    m_pred = sum(predicted) / size(predicted)
+
+    res = dot_product(true - m_true, predicted - m_pred) / &
+      sqrt(sum((true - m_true)**2)*sum((predicted - m_pred)**2))
+
+  end function corr_eval
+
+  pure function maxabs_eval(true, predicted) result(res)
+    !! Maximum absolute difference function:
+    !!
+    real, intent(in) :: true(:)
+      !! True values, i.e. labels from training datasets
+    real, intent(in) :: predicted(:)
+      !! Values predicted by the network
+    real :: res
+      !! Resulting maximum absolute difference value
+
+    res = maxval(abs(true - predicted))
+
+  end function maxabs_eval
+
+end module nf_metrics

src/nf/nf_network.f90

@@ -3,6 +3,7 @@ module nf_network
   !! This module provides the network type to create new models.
 
   use nf_layer, only: layer
+  use nf_metrics, only: metric_type
   use nf_loss, only: loss_type
   use nf_optimizers, only: optimizer_base_type
 
@@ -28,13 +29,15 @@ module nf_network
     procedure :: train
     procedure :: update
 
+    procedure, private :: evaluate_batch_1d
     procedure, private :: forward_1d
     procedure, private :: forward_3d
     procedure, private :: predict_1d
     procedure, private :: predict_3d
     procedure, private :: predict_batch_1d
     procedure, private :: predict_batch_3d
 
+    generic :: evaluate => evaluate_batch_1d
     generic :: forward => forward_1d, forward_3d
     generic :: predict => predict_1d, predict_3d, predict_batch_1d, predict_batch_3d
 
@@ -62,6 +65,16 @@ end function network_from_keras
 
   end interface network
 
+  interface evaluate
+    module function evaluate_batch_1d(self, input_data, output_data, metric) result(res)
+      class(network), intent(in out) :: self
+      real, intent(in) :: input_data(:,:)
+      real, intent(in) :: output_data(:,:)
+      class(metric_type), intent(in), optional :: metric
+      real, allocatable :: res(:,:)
+    end function evaluate_batch_1d
+  end interface evaluate
+
   interface forward
 
     pure module subroutine forward_1d(self, input)

src/nf/nf_network_submodule.f90

@@ -337,6 +337,36 @@ pure module subroutine backward(self, output, loss)
   end subroutine backward
 
 
+  module function evaluate_batch_1d(self, input_data, output_data, metric) result(res)
+    class(network), intent(in out) :: self
+    real, intent(in) :: input_data(:,:)
+    real, intent(in) :: output_data(:,:)
+    class(metric_type), intent(in), optional :: metric
+    real, allocatable :: res(:,:)
+
+    integer :: i, n
+    real, allocatable :: output(:,:)
+
+    output = self % predict(input_data)
+
+    n = 1
+    if (present(metric)) n = n + 1
+
+    allocate(res(size(output, dim=1), n))
+
+    do concurrent (i = 1:size(output, dim=1))
+      res(i,1) = self % loss % eval(output_data(i,:), output(i,:))
+    end do
+
+    if (.not. present(metric)) return
+
+    do concurrent (i = 1:size(output, dim=1))
+      res(i,2) = metric % eval(output_data(i,:), output(i,:))
+    end do
+
+  end function evaluate_batch_1d
+
+
   pure module subroutine forward_1d(self, input)
     class(network), intent(in out) :: self
     real, intent(in) :: input(:)
@@ -566,11 +596,10 @@ module subroutine train(self, input_data, output_data, batch_size, &
     integer, intent(in) :: epochs
     class(optimizer_base_type), intent(in), optional :: optimizer
     class(loss_type), intent(in), optional :: loss
-    class(optimizer_base_type), allocatable :: optimizer_
 
     real :: pos
     integer :: dataset_size
-    integer :: batch_start, batch_end
+    integer :: batch_start
     integer :: i, j, n
     integer :: istart, iend, indices(2)
 
@@ -600,11 +629,9 @@ module subroutine train(self, input_data, output_data, batch_size, &
         ! Pull a random mini-batch from the dataset
         call random_number(pos)
         batch_start = int(pos * (dataset_size - batch_size + 1)) + 1
-        batch_end = batch_start + batch_size - 1
 
         ! FIXME shuffle in a way that doesn't require co_broadcast
         call co_broadcast(batch_start, 1)
-        call co_broadcast(batch_end, 1)
 
         ! Distribute the batch in nearly equal pieces to all images
         indices = tile_indices(batch_size)
@@ -628,7 +655,6 @@ module subroutine update(self, optimizer, batch_size)
     class(network), intent(in out) :: self
     class(optimizer_base_type), intent(in), optional :: optimizer
     integer, intent(in), optional :: batch_size
-    class(optimizer_base_type), allocatable :: optimizer_
     integer :: batch_size_
     real, allocatable :: params(:)
     integer :: n

test/CMakeLists.txt

@@ -17,6 +17,7 @@ foreach(execid
   conv2d_network
   optimizers
   loss
+  metrics
   )
   add_executable(test_${execid} test_${execid}.f90)
   target_link_libraries(test_${execid} PRIVATE neural-fortran h5fortran::h5fortran jsonfortran::jsonfortran ${LIBS})

test/test_flatten_layer.f90

@@ -9,7 +9,7 @@ program test_flatten_layer
 
   type(layer) :: test_layer, input_layer
   type(network) :: net
-  real, allocatable :: input_data(:,:,:), gradient(:,:,:)
+  real, allocatable :: gradient(:,:,:)
   real, allocatable :: output(:)
   logical :: ok = .true.
 

test/test_get_set_network_params.f90

@@ -3,7 +3,6 @@ program test_get_set_network_params
   use nf, only: conv2d, dense, flatten, input, maxpool2d, network
   implicit none
   type(network) :: net
-  integer :: n
   logical :: ok = .true.
   real :: test_params_dense(8) = [1, 2, 3, 4, 5, 6, 7, 8]
   real :: test_params_conv2d(10) = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]