Question

这个问题是我上一个问题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支持lambdas和ALGOL 68）。是否可以在Modern 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

根据大众需求，这不是完全重复，因此我可以无耻地重复使用我以前的材料。

您询问的是匿名函数，但您实际要做的是将略微修改的函数传递给最小化过程。您通常不想为此模拟函数对象（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中，您也可以使用函数对象或仿函数来存储函数指针的上下文，以创建词法闭包。它只是一个将捕获的上下文存储在其成员变量中的类。 C ++ 11除了为这样一个类提供语法糖之外别无其他。

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

在Fortran中实现匿名函数

2 个答案: