Implementing anonymous functions in Fortran

Question

This question is successor of my previous question Implementing minimization method. In current question, I simplified my problem and here is the sample MATLAB code. I want to implement it in Fortran.

%Script script1.m 
clear vars;
close all;
clc;

fun1 = @(x1,x2) 3*x1^2 + 4*x2^2 + 5*x1 + 6*x2 + 10;

lower = -2;
upper = 0;
fun5 = fun15(fun1);
%fun5 is 'intermediate' function

%calling minimization function
[location,value]=minimize1(fun5,lower,upper)

In the script1.m, I created a function handle fun1 and want to assign values to it as shown in the fun15.m

%fun15.m
function fun2 = fun15( fun1 )
arr1 = [4,5];
arr2 = [-2,3];
fun2 = @(a) fun1( ( arr1(1) + a*arr2(1)) , ( arr1(2) + a*arr2(2)));
%fun2 = @(a) @(x4,y4,x5,y5)  3*(x4+a*x5)^2 + 4*(y4+a*y5)^2 + 5*(x4+a*x5) + 6*(y4+a*y5) + 10; .....(1)
end

Instead of file fun15.m, it is quite possible to create a closure as shown by (1). Here, arr1 = [x4,y4] and arr2=[x5,y5]. We can first pass values of x4,y4,x5,y5 and it will return a function in variable a. This returned function is passed to a minimization function below.

%minimize1.m
function [loc,val] = minimize1 (fun1,lower,upper)
c1 = 1; %counter
x_1 = lower + (upper-lower)*0.382; %lower value
x_2 = lower + (upper-lower)*0.618; %upper value
f_1 = fun1(x_1); %fun1 is passed in the arguments
f_2 = fun1(x_2);
x_lower=lower;
x_upper=upper;
locx=0;

   while c1<10

        if (f_1 > f_2) 
            x_lower = x_1;
            x_1=x_2;
            f_1=f_2;
            x_2 = x_lower + (x_upper-x_lower)*0.618;
            f_2 = fun1(x_2);
        else
            x_upper = x_2;
            x_2 = x_1;
            f_2 = f_1;
            x_1 = x_lower + (x_upper-x_lower)*0.382;
            f_1 = fun1(x_1);
        end

        c1=c1+1;
   end
locx=(x_lower + x_upper)/2.0;
val = fun1(locx);

end

How to convert this into Fortran - especially function returning function? Anonymous functions are not supported by Fortran (C++11 supports it as lambdas, and ALGOL 68 as well). Is it possible to implement this problem in Modern Fortran (90,95,03,08)?

Answer 1

Fortran doesn't support anonymous functions. The simple work around is to write a function that has a name.

There are then two possible approaches in modern Fortran for capturing the value of any additional parameters required for the function beyond the variable being minimised:

• The procedure to be minimised is expressed as a deferred binding of an abstract type (a functor type), with the additional parameters for the underlying function available as components of concrete extensions of the abstract type. If necessary one of the components can be a procedure pointer or another object of a functor type.

• The procedure to be minimised is an internal (F2008) or module procedure, with the additional parameters provided by host association.

What's best depends on specific circumstances.

Examples of both approaches are in the following.

MODULE Minimizer
  IMPLICIT NONE
  PRIVATE

  INTEGER, PARAMETER, PUBLIC :: rk = KIND(1.0)

  PUBLIC :: MinimizeFunctor
  PUBLIC :: MinimizeProcedure

  TYPE, PUBLIC, ABSTRACT :: Functor
  CONTAINS
    PROCEDURE(functor_Evaluate), DEFERRED :: Evaluate
  END TYPE Functor

  ABSTRACT INTERFACE
    FUNCTION functor_Evaluate(obj, x)
      IMPORT :: Functor
      IMPORT :: rk
      IMPLICIT NONE
      CLASS(Functor), INTENT(IN) :: obj
      REAL(rk), INTENT(IN) :: x
      REAL(rk) :: functor_Evaluate
    END FUNCTION functor_Evaluate
  END INTERFACE
CONTAINS
  SUBROUTINE MinimizeFunctor(fun, lower, upper, location, value)
    CLASS(functor), INTENT(IN) :: fun
    REAL(rk), INTENT(IN) :: lower
    REAL(rk), INTENT(IN) :: upper
    REAL(rk), INTENT(OUT) :: location
    REAL(rk), INTENT(OUT) :: value

    INTEGER :: c1
    REAL(rk) :: x_1
    REAL(rk) :: x_2
    REAL(rk) :: f_1
    REAL(rk) :: f_2
    REAL(rk) :: x_lower
    REAL(rk) :: x_upper

    c1 = 1
    x_lower = lower
    x_upper = upper
    f_1 = fun%Evaluate(x_1)
    f_2 = fun%Evaluate(x_2)
    location = 0

    DO WHILE (c1 < 10)
      IF (f_1 > f_2) THEN
        x_lower = x_1
        x_1 = x_2
        f_1 = f_2
        x_2 = x_lower + (x_upper - x_lower) * 0.618_rk
        f_2 = fun%Evaluate(x_2)
      ELSE
        x_upper = x_2
        x_2 = x_1
        f_2 = f_1
        x_1 = x_lower + (x_upper - x_lower) * 0.382_rk
        f_1 = fun%Evaluate(x_1)
      END IF
      c1 = c1 + 1
    END DO

    location = (x_Lower + x_upper) / 2.0
    value = fun%Evaluate(location)
  END SUBROUTINE MinimizeFunctor


  SUBROUTINE MinimizeProcedure(fun, lower, upper, location, value)
    INTERFACE
      FUNCTION fun(x)
        IMPORT :: rk
        IMPLICIT NONE
        REAL(rk), INTENT(IN) :: x
        REAL(rk) :: fun
      END FUNCTION fun
    END INTERFACE
    REAL(rk), INTENT(IN) :: lower
    REAL(rk), INTENT(IN) :: upper
    REAL(rk), INTENT(OUT) :: location
    REAL(rk), INTENT(OUT) :: value

    INTEGER :: c1
    REAL(rk) :: x_1
    REAL(rk) :: x_2
    REAL(rk) :: f_1
    REAL(rk) :: f_2
    REAL(rk) :: x_lower
    REAL(rk) :: x_upper

    c1 = 1
    x_lower = lower
    x_upper = upper
    f_1 = fun(x_1)
    f_2 = fun(x_2)
    location = 0

    DO WHILE (c1 < 10)
      IF (f_1 > f_2) THEN
        x_lower = x_1
        x_1 = x_2
        f_1 = f_2
        x_2 = x_lower + (x_upper - x_lower) * 0.618_rk
        f_2 = fun(x_2)
      ELSE
        x_upper = x_2
        x_2 = x_1
        f_2 = f_1
        x_1 = x_lower + (x_upper - x_lower) * 0.382_rk
        f_1 = fun(x_1)
      END IF
      c1 = c1 + 1
    END DO

    location = (x_Lower + x_upper) / 2.0
    value = fun(location)
  END SUBROUTINE MinimizeProcedure
END MODULE Minimizer

MODULE m
  USE Minimizer
  IMPLICIT NONE
  PRIVATE

  PUBLIC :: RunFunctor
  PUBLIC :: RunProcedure

  TYPE, EXTENDS(Functor) :: MyFunctor
    PROCEDURE(fun_ptr_intf), POINTER, NOPASS :: fun_ptr
    INTEGER :: arr1(2)
    INTEGER :: arr2(2)
  CONTAINS
    PROCEDURE :: Evaluate
  END TYPE MyFunctor

  ABSTRACT INTERFACE
    FUNCTION fun_ptr_intf(x1, x2)
      IMPORT :: rk
      IMPLICIT NONE
      REAL(rk), INTENT(IN) :: x1
      REAL(rk), INTENT(IN) :: x2
      REAL(rk) :: fun_ptr_intf
    END FUNCTION fun_ptr_intf
  END INTERFACE
CONTAINS
  FUNCTION Evaluate(obj, x)
    CLASS(MyFunctor), INTENT(IN) :: obj
    REAL(rk), INTENT(IN) :: x
    REAL(rk) :: Evaluate

    Evaluate = obj%fun_ptr(  &
        obj%arr1(1) + x * obj%arr2(1),  &
        obj%arr1(2) + x * obj%arr2(2) )
  END FUNCTION Evaluate

  FUNCTION fun1(x1, x2)
    REAL(rk), INTENT(IN) :: x1
    REAL(rk), INTENT(IN) :: x2
    REAL(rk) :: fun1

    fun1 = 3 * x1**2 + 4 * x2**2 + 5 * x1 + 6 * x2 + 10.0_rk
  END FUNCTION fun1

  SUBROUTINE RunFunctor
    TYPE(MyFunctor) :: obj
    REAL(rk) :: location
    REAL(rk) :: value

    obj%fun_ptr => fun1

    obj%arr1 = [ 4, 5]
    obj%arr2 = [-2, 3]
    CALL MinimizeFunctor(obj, 0.0_rk, 1.0_rk, location, value)
    PRINT *, location, value
  END SUBROUTINE RunFunctor

  SUBROUTINE RunProcedure
    REAL(rk) :: location
    REAL(rk) :: value
    INTEGER :: arr1(2)
    INTEGER :: arr2(2)

    arr1 = [ 4, 5]
    arr2 = [-2, 3]
    CALL MinimizeProcedure(fun, 0.0_rk, 1.0_rk, location, value)
    PRINT *, location, value
  CONTAINS
    FUNCTION fun(x)
      REAL(rk), INTENT(IN) :: x
      REAL(rk) :: fun

      fun = fun1(  &
          arr1(1) + x * arr2(1),  &
          arr1(2) + x * arr2(2) )
    END FUNCTION fun
  END SUBROUTINE RunProcedure
END MODULE m

PROGRAM p
  USE m
  IMPLICIT NONE
  CALL RunFunctor
  CALL RunProcedure
END PROGRAM p

Answer 2

By popular demand this is not an exact duplicate and I can therefore shamelessly reuse my former material.

You are asking about anonymous functions, but what you want to actually do is to pass a slightly modified function to a minimazation procedure. You normally don't want to emulate function objects for that (Fortran minimization of a function with additional arguments)

1. The simplest way of passing such a procedure is by using an internal procedure:

subroutine outer(fun1)
  use minimization, only: minimize
  interface
    real function fun1(x,y)
      real, intent(in) :: x, y
    end function
  end interface

  real, dimension(2) :: arr1, arr2

  arr1=...; arr2=...

  call minimize(fun2)

contains

  real function fun2(a)
    real, intent(in) :: a
    fun2 = fun1( ( arr1(1) + a*arr2(1)) , ( arr1(2) + a*arr2(2)))
  end function
end subroutine

note: passing internal procedures and pointers to them requires Fortran 2008.

2. You can do the same with module procedures too, I leave it as an exercise for the reader, just define the context (arr1,arr2) and the minimized function fun2 not locally, but in a module. It is less flexible.

---

Now to closures:

Even in C++98 you could use a function object or functor to store the context of a function pointer to create a lexical closure. It is just a class which stores the captured context in its member variables. C++11 doesn't do anything else than just providing a syntactic sugar for such a class.

You can make a functor in Fortran, see Dynamic function creation from another function , Function as an output argument and Fortran - Return an anonymous function from subroutine but I consider it being way too awkward for your purpose.