Menu
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)?
435
Anonymous functions are implemented using the Closure class. printf("Hello %s\r\n", $name); };
An anonymous function is a function that was declared without any named identifier to refer to it. As such, an anonymous function is usually not accessible after its initial creation. Normal function definition: function hello() { alert('Hello world'); } hello();
The advantage of an anonymous function is that it does not have to be stored in a separate file. This can greatly simplify programs, as often calculations are very simple and the use of anonymous functions reduces the number of code files necessary for a program.
An anonymous function is not accessible after its initial creation, it can only be accessed by a variable it is stored in as a function as a value. 3. This function is useful for all scenarios. An anonymous function can be useful for creating IIFE(Immediately Invoked Function Expression).
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
By popular demand this is not an exact duplicate and I can therefore shamelessly reuse my former material.
You are asking about anonymous functions, but what you want to actually do is to pass a slightly modified function to a minimazation procedure. You normally don't want to emulate function objects for that (Fortran minimization of a function with additional arguments)
1. The simplest way of passing such a procedure is by using an internal procedure:
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
note: passing internal procedures and pointers to them requires Fortran 2008.
arr1,arr2) and the minimized function fun2 not locally, but in a module. It is less flexible.Now to closures:
Even in C++98 you could use a function object or functor to store the context of a function pointer to create a lexical closure. It is just a class which stores the captured context in its member variables. C++11 doesn't do anything else than just providing a syntactic sugar for such a class.
You can make a functor in Fortran, see Dynamic function creation from another function , Function as an output argument and Fortran - Return an anonymous function from subroutine but I consider it being way too awkward for your purpose.
35
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
