在 Fortran 中实现匿名函数答案

【问题标题】：Implementing anonymous functions in Fortran在 Fortran 中实现匿名函数
【发布时间】：2016-06-08 23:09:26
【问题描述】：

这个问题是我之前的问题Implementing minimization method 的后续问题。在当前问题中，我简化了我的问题，这里是示例 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 的值，它会在变量a 中返回一个函数。这个返回的函数被传递给下面的最小化函数。

%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 - 特别是函数返回函数？ Fortran 不支持Anonymous 函数（C++11 支持它作为 lambda，ALGOL 68 也支持）。在Modern Fortran(90,95,03,08)中是否可以实现这个问题？

【问题讨论】：

您使用的是什么版本的 Fortran。您可以将指针传递给最新标准（我相信是 Fortran 2003 及更高版本）中的过程
@s8129 正确，您可以通过函数指针或创建接口（或在旧 fortran 中使用 external）将函数传递给另一个函数。但是如何从函数中获取函数输出似乎是更大的问题。
@VladimirF 我同意 roygvib，“原始”问题没有讨论完整代码。在这个问题中，我有完整而具体的代码，也描述了闭包。另一个问题没有类似的东西。 Stackoverflow 不应该是找出每个问题之间的相似之处并标记每个可能的重复项的地方。主要是注意为这个问题和其他问题提供的答案。阅读此问题的人肯定会受益于 IanH 提供的详细代码。其他问答的深度与本次问答的深度不匹配。
在我看来，这是完全重复的。甚至伊恩的答案也以与这两个答案完全匹配的两点开始。顺便说一句，当您显然喜欢它时，为什么您还不接受答案？请理解，关闭根本不是不删除，它更多的是链接它们，以便下一个寻求帮助的人得到这里的所有东西。对伊恩来说，这是一个优势，因为没有人可以在这里与他的答案竞争。他也可以随时为旧问题添加一个如此详细的答案。
@VladimirF “顺便说一句，当你显然喜欢这个答案时，你为什么还不接受它？”我正在等待更多时间。尽快接受答案有人发布一个不鼓励进一步的答案，这可能会更好。至少我个人是这样认为的。

标签： matlab fortran anonymous-function

【解决方案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

【讨论】：

非常感谢您的详细回答。如果我们比较 MATLAB 和 Fortran 代码，MATLAB 代码简短、清晰且容易。另一方面，Fortran 代码涉及更多，需要高级功能。这可能是在新开发的科学软件中减少使用 Fortran 的原因之一。
@de23edced 我对两者都非常熟悉。它们是明显不同的工具，在不同领域各有优缺点。什么是最好的将取决于具体情况。请记住，示例 Fortran 代码显示了解决该问题的两种不同方法，您认为这两种语言的“高级”功能是相当主观的。顺便说一句，您的“简短、清晰和简单”的 Matlab 代码有一个错误 - 有明确的变量声明有一些好处！

【解决方案2】：

根据大众的要求，这不是一个精确重复的，因此我可以无耻地重复使用我以前的材料。

您在询问匿名函数，但您实际上想要做的是将稍作修改的函数传递给最小化过程。您通常不想为此模拟函数对象 (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。

模块过程也可以这样做，我把它留给读者作为练习，只需定义上下文（arr1,arr2）和最小化函数fun2不是在本地，而是在一个模块中。它不太灵活。

现在关闭：

即使在 C++98 中，您也可以使用 function object 或 functor 来存储函数指针的上下文以创建词法闭包。它只是一个将捕获的上下文存储在其成员变量中的类。 C++11 除了为这样的类提供语法糖外，没有做任何其他事情。

您可以在 Fortran 中创建函子，请参阅 Dynamic function creation from another function 、 Function as an output argument 和 Fortran - Return an anonymous function from subroutine 但我认为这对于您的目的来说太尴尬了。

【讨论】：