在Fortran中实现匿名函数 [英] Implementing anonymous functions in Fortran

问题描述

这个问题是我以前的问题的继承者实现最小化方法。在当前的问题中，我简化了我的问题，这里是示例MATLAB代码。我想在Fortran中实现它。

 ％Script script1.m 
 clear vars; 
关闭所有; 
 clc; 
 $ b $ fun1 = @（x1，x2）3 * x1 ^ 2 + 4 * x2 ^ 2 + 5 * x1 + 6 * x2 + 10; 
 
 lower = -2; 
 upper = 0; 
 fun5 = fun15（fun1）; 
％fun5是'intermediate'函数
 
％调用最小化函数
 [location，value] = minimize1（fun5，lower，upper）
  

在script1.m中，我创建了一个函数句柄 fun1 并且想要赋值如 fun15.m

所示 $ b

 ％fun15.m 
函数fun2 = fun15（fun1）
 arr1 = [4,5]; 
 arr2 = [-2,3]; （a）fun1（（arr1（1）+ a * arr2（1）），（arr1（2）+ a * arr2（2）））; 
 fun2 = 
％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 
函数[loc，val] = minimize1（fun1，lower，upper）
 c1 = 1; ％counter 
 x_1 = lower +（upper-lower）* 0.382; ％较低值
 x_2 =较低+（较高 - 较低）* 0.618; ％上限值
 f_1 = fun1（x_1）; ％fun1传入参数
 f_2 = fun1（x_2）; 
 x_lower = lower; 
 x_upper = upper; 
 locx = 0; 
 
，而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）; 
结束
 
 c1 = c1 + 1; 
 end 
 locx =（x_lower + x_upper）/2.0; 
 val = fun1（locx）; 
 
 end 
  

如何将其转换为Fortran - 尤其是函数返回函数？ Fortran不支持匿名函数（C ++ 11支持它作为lambdas，而ALGOL 68以及）。是否有可能在Modern Fortran中实现此问题（90,95,03,08）？

解决方案

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

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

• 要被最小化的过程被表示为抽象类型（函子类型）的延迟绑定，其中底层函数的附加参数可用作抽象类型的具体扩展。如果需要，其中一个组件可以是一个过程指针或一个仿函数类型的另一个对象。




• 要最小化的过程是内部（F2008）或模块程序，并提供由主机关联提供的附加参数。


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

这两种方法的例子如下。



  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 ::评估
 END TYPE函数
 
抽象接口
 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 （函子），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 $ b $ r 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 
 
位置=（x_Lower + x_upper）/ 2.0 
 value = fun％评估（位置）
 END SUBROUTINE MinimizeFunctor 
 
 
子程序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）:: locat ion 
 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 =较低
 x_upper =较高
 f_1 =有趣（x_1）
 f_2 =有趣（x_2）
位置= 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 
值= fun（位置）
 END SUBROUTINE MinimizeProcedure 
 END MODULE最小化
 
 MODULE m 
 USE最小化
 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 ::评估
 END TYPE MyFunctor 
 
抽象接口
 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 = obj％fun_ptr（ &安培; 
 obj％arr1（1）+ x * obj％arr2（1），& 
 obj％arr1（2）+ x * obj％arr2（2））
 END 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 *，位置，值
 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 
包含
函数fun（x）
 REAL（rk） ，INTENT（IN）:: x 
 REAL（rk）:: fun 
 
 fun = fun1（& 
 arr1（1）+ x * arr2（1），& amp ; 
 arr1（2）+ x * arr2（2））
 END FUNCTION fun 
 END SUBROUTINE RunProcedure 
 END MODULE m 
 
程序p 
 USE m 
 IMPLICIT NONE 
 CALL RunFunctor 
 CALL RunProcedure 
 END PROGRAM p 
  




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)?

解决方案

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

这篇关于在Fortran中实现匿名函数的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！