nf_loss.f90

module nf_loss

  !! This module provides a collection of loss functions and their derivatives.
  !! The implementation is based on an abstract loss derived type
  !! which has the required eval and derivative methods.
  !! An implementation of a new loss type thus requires writing a concrete
  !! 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, extends(metric_type), abstract :: loss_type
  contains
    procedure(loss_derivative_interface), nopass, deferred :: derivative
  end type loss_type

  abstract interface
    pure function loss_derivative_interface(true, predicted) result(res)
      real, intent(in) :: true(:)
      real, intent(in) :: predicted(:)
      real :: res(size(true))
    end function loss_derivative_interface
  end interface

  type, extends(loss_type) :: mse
    !! Mean Square Error loss function
  contains
    procedure, nopass :: eval => mse_eval
    procedure, nopass :: derivative => mse_derivative
  end type mse

  type, extends(loss_type) :: quadratic
    !! Quadratic loss function
  contains
    procedure, nopass :: eval => quadratic_eval
    procedure, nopass :: derivative => quadratic_derivative
  end type quadratic

  interface

    pure module function mse_eval(true, predicted) result(res)
      !! Mean Square Error loss function:
      !!
      !!   L  = sum((predicted - true)**2) / size(true)
      !!
      real, intent(in) :: true(:)
        !! True values, i.e. labels from training datasets
      real, intent(in) :: predicted(:)
        !! Values predicted by the network
      real :: res
        !! Resulting loss value
    end function mse_eval

    pure module function mse_derivative(true, predicted) result(res)
      !! First derivative of the Mean Square Error loss function:
      !!
      !!   L  = 2 * (predicted - true) / size(true)
      !!
      real, intent(in) :: true(:)
        !! True values, i.e. labels from training datasets
      real, intent(in) :: predicted(:)
        !! Values predicted by the network
      real :: res(size(true))
        !! Resulting loss values
    end function mse_derivative

    pure module function quadratic_eval(true, predicted) result(res)
      !! Quadratic loss function:
      !!
      !!   L  = sum((predicted - true)**2) / 2
      !!
      real, intent(in) :: true(:)
        !! True values, i.e. labels from training datasets
      real, intent(in) :: predicted(:)
        !! Values predicted by the network
      real :: res
        !! Resulting loss value
    end function quadratic_eval

    pure module function quadratic_derivative(true, predicted) result(res)
      !! First derivative of the quadratic loss function:
      !!
      !!   L' =  predicted - true
      !!
      real, intent(in) :: true(:)
        !! True values, i.e. labels from training datasets
      real, intent(in) :: predicted(:)
        !! Values predicted by the network
      real :: res(size(true))
        !! Resulting loss values
    end function quadratic_derivative

  end interface

end module nf_loss