在 Fortran 中实现匿名函数

Question

这个问题是我上一个问题的后续问题。在当前问题中，我简化了我的问题，这里是示例 MATLAB 代码。我想在 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)

在 script1.m 中，我创建了一个函数句柄 fun1 并希望为其赋值，如 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

而不是文件 fun15.m，很有可能创建如 (1) 所示的闭包。这里，arr1 = [x4,y4] 和 arr2=[x5,y5]。我们可以先传递 x4,y4,x5,y5 的值，它会 return 变量 a 中的一个函数。这个 returned 函数被传递给下面的最小化函数。

%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

如何将其转换为 Fortran - 尤其是函数 returning 函数？ Anonymous Fortran 不支持函数（C++11 支持它作为 lambda，ALGOL 68 也支持）。是否可以在现代 Fortran (90,95,03,08) 中实现此问题？

Answer 1

Fortran 不支持匿名函数。简单的解决方法是编写一个具有名称的函数。

现代 Fortran 中有两种可能的方法来捕获函数所需的任何附加参数的值，超出被最小化的变量：

要最小化的过程表示为抽象类型（仿函数类型）的延迟绑定，底层函数的附加参数可用作抽象类型的具体扩展的组件。如有必要，组件之一可以是过程指针或仿函数类型的另一个对象。
要最小化的过程是一个内部(F2008)或模块过程，具有主机协会提供的附加参数。

什么是最好的取决于具体情况。

两种方法的示例如下。

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

根据大众的要求，这不是完全的副本，因此我可以无耻地重复使用我以前的 material.

你问的是匿名函数，但你实际上想做的是将稍微修改过的函数传递给最小化过程。您通常不想为此模拟函数对象 (Fortran minimization of a function with additional arguments)

1。传递此类过程的最简单方法是使用 内部过程 :

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

注意：传递内部过程和指向它们的指针需要 Fortran 2008。

您也可以对 模块过程 做同样的事情，我把它留作 reader 的练习，只需定义上下文（arr1， arr2) 和最小化函数 fun2 不是在本地，而是在模块中。它不太灵活。

现在关闭：

即使在 C++98 中，您也可以使用 函数对象 或函子来存储函数指针的上下文以创建词法闭包。它只是一个 class ，它将捕获的上下文存储在其成员变量中。 C++11 除了为这样的 class.

提供语法糖外，没有做任何其他事情。

您可以在 Fortran 中创建仿函数，请参阅 Dynamic function creation from another function , Function as an output argument and Fortran - Return an anonymous function from subroutine，但我认为这对于您的目的来说太笨拙了。

在 Fortran 中实现匿名函数

Implementing anonymous functions in Fortran

matlab

fortran

anonymous-function