问题描述
这个问题是我之前的问题实现最小化方法的后续问题.在当前问题中，我简化了我的问题，这里是示例 MATLAB 代码.我想在 Fortran 中实现它.
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)
在 script1.m 中，我创建了一个函数句柄 fun1 并希望为它分配值，如 fun15.m
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
代替文件 fun15.m，很可能创建一个闭包，如(1)所示.这里，arr1 = [x4,y4] 和 arr2=[x5,y5].我们可以先传递 x4,y4,x5,y5 的值，它会在变量 a 中返回一个函数.这个返回的函数被传递给下面的最小化函数.
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
如何将其转换为 Fortran - 特别是函数返回函数?Fortran 不支持 匿名 函数(C++11 支持它作为 lambda，而 ALGOL 68同样).是否可以在 Modern Fortran (90,95,03,08) 中实现这个问题?
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 不支持匿名函数.简单的解决方法是编写一个具有名称的函数.
Fortran doesn't support anonymous functions. The simple work around is to write a function that has a name.
在现代 Fortran 中有两种可能的方法来捕获函数所需的任何附加参数的值，而不是被最小化的变量:
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.
要最小化的过程是内部 (F2008) 或模块过程，附加参数由主机关联提供.
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 中实现匿名函数的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！