Logtalk 2.30.7 files.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1973 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
pmoura
@@ -13,15 +13,10 @@
|
||||
comment is 'Find the root of a function in the interval [A, B] given a maximum aproximation error.',
|
||||
argnames is ['Function', 'A', 'B', 'Error', 'Zero']]).
|
||||
|
||||
:- public(find_root/6).
|
||||
:- mode(find_root(+object_identifier, +float, +float, +float, -float, -object_identifier), one).
|
||||
:- info(find_root/6, [
|
||||
comment is 'Find the root of a function in the interval [A, B] given a maximum aproximation error. Return the method used.',
|
||||
argnames is ['Function', 'A', 'B', 'Error', 'Zero', 'Method']]).
|
||||
|
||||
:- end_protocol.
|
||||
|
||||
|
||||
|
||||
:- protocol(functionp).
|
||||
|
||||
:- info([
|
||||
@@ -33,18 +28,19 @@
|
||||
:- public(eval/2).
|
||||
:- mode(eval(+float, -float), one).
|
||||
:- info(eval/2, [
|
||||
comment is 'Calculate the function value.',
|
||||
comment is 'Calculates the function value.',
|
||||
argnames is ['X', 'Fx']]).
|
||||
|
||||
:- public(evald/2).
|
||||
:- mode(evald(+float, -float), one).
|
||||
:- info(evald/2, [
|
||||
comment is 'Calculate the value of the function derivative.',
|
||||
comment is 'Calculates the value of the function derivative.',
|
||||
argnames is ['X', 'DFx']]).
|
||||
|
||||
:- end_protocol.
|
||||
|
||||
|
||||
|
||||
:- object(f1,
|
||||
implements(functionp)).
|
||||
|
||||
@@ -53,12 +49,14 @@
|
||||
|
||||
eval(X, Y) :-
|
||||
Y is X * X - 4.
|
||||
|
||||
evald(X, Y) :-
|
||||
Y is 2 * X.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
|
||||
:- object(f2,
|
||||
implements(functionp)).
|
||||
|
||||
@@ -74,6 +72,7 @@
|
||||
:- end_object.
|
||||
|
||||
|
||||
|
||||
:- object(f3,
|
||||
implements(functionp)).
|
||||
|
||||
@@ -89,41 +88,30 @@
|
||||
:- end_object.
|
||||
|
||||
|
||||
:- object(function_root,
|
||||
implements(find_rootp)).
|
||||
|
||||
:- info([
|
||||
version is 1.1,
|
||||
author is 'Paulo Moura and Paulo Nunes',
|
||||
date is 2006/11/26,
|
||||
comment is 'Multi-threading interface to root finding algorithms.']).
|
||||
:- object(f4,
|
||||
implements(functionp)).
|
||||
|
||||
:- threaded.
|
||||
% x + x^2*sin(2.0/x)
|
||||
% 0.0
|
||||
|
||||
eval(X, Y) :-
|
||||
Y is X + (X**2)*sin(2.0/X).
|
||||
|
||||
find_root(Function, A, B, Error, Zero) :-
|
||||
find_root(Function, A, B, Error, Zero, _).
|
||||
|
||||
find_root(Function, A, B, Error, Zero, Algorithm) :-
|
||||
threaded_race(
|
||||
( try_method(bisection, Function, A, B, Error, Zero)
|
||||
; try_method(newton, Function, A, B, Error, Zero)
|
||||
; try_method(muller, Function, A, B, Error, Zero)
|
||||
)),
|
||||
threaded_exit(try_method(Algorithm, Function, A, B, Error, Zero)).
|
||||
|
||||
try_method(Algorithm, Function, A, B, Error, Zero) :-
|
||||
Algorithm::find_root(Function, A, B, Error, Zero).
|
||||
evald(X, Y) :-
|
||||
Y is 1 + 2*X*sin(2.0/X) - 2*cos(2.0/X).
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
|
||||
:- object(bisection,
|
||||
implements(find_rootp)).
|
||||
|
||||
:- info([
|
||||
version is 1.1,
|
||||
version is 1.2,
|
||||
author is 'Paulo Moura and Paulo Nunes',
|
||||
date is 2006/11/26,
|
||||
date is 2007/7/7,
|
||||
comment is 'Bisection algorithm.']).
|
||||
|
||||
find_root(Function, A, B, Error, Zero) :-
|
||||
@@ -133,19 +121,15 @@
|
||||
true
|
||||
; Fa < 0.0, Fb > 0.0
|
||||
),
|
||||
X0 is (A + B) / 2,
|
||||
X0 is (A + B) / 2.0,
|
||||
Function::eval(X0, F0),
|
||||
bisection(Function, A, B, X0, F0, Error, Zero).
|
||||
|
||||
bisection(_, _, _, Xn1, 0.0, _, Xn1) :-
|
||||
bisection(_, _, _, Xn, Fn, Error, Xn) :-
|
||||
abs(Fn) < Error,
|
||||
!.
|
||||
|
||||
bisection(_, Xn1, Xn, _, _, Error, Xn1) :-
|
||||
abs(Xn1 - Xn) < Error,
|
||||
!.
|
||||
|
||||
bisection(Function, An, Bn, _, _, Error, Zero) :-
|
||||
Xn1 is (An + Bn) / 2,
|
||||
Xn1 is (An + Bn) / 2.0,
|
||||
Function::eval(Xn1, Fn1),
|
||||
Function::eval(An, FAn),
|
||||
( Fn1*FAn < 0.0 ->
|
||||
@@ -159,42 +143,29 @@
|
||||
:- end_object.
|
||||
|
||||
|
||||
|
||||
:- object(newton,
|
||||
implements(find_rootp)).
|
||||
|
||||
:- info([
|
||||
version is 1.1,
|
||||
author is 'Paulo Moura and Paulo Nunes',
|
||||
date is 2006/11/26,
|
||||
version is 1.2,
|
||||
author is 'Paul Crocker... No More Coffee',
|
||||
date is 2007/07/06,
|
||||
comment is 'Newton algorithm.']).
|
||||
|
||||
find_root(Function, Xa, Xb, Deviation, Zero) :-
|
||||
X0 is (Xa + Xb) / 2,
|
||||
newton(Function, X0, Deviation, Zero).
|
||||
find_root(Function, Xa, Xb, Deviation, Zero) :-
|
||||
Ac is (Xb - Xa) / 2,
|
||||
newton(Function, Xa, Ac, Deviation, Zero).
|
||||
|
||||
newton(Function, X0, Deviation, Zero) :-
|
||||
Xn1 is X0,
|
||||
Function::eval(Xn1, Fn1),
|
||||
Function::evald(Xn1, DFn1),
|
||||
Ac is -(Fn1 / DFn1),
|
||||
newton(Function, Xn1, Deviation, Fn1, Ac, Zero).
|
||||
|
||||
% test deviation
|
||||
newton(_, Xn1, Deviation, _, Ac, Xn1) :-
|
||||
abs(Ac) < Deviation,
|
||||
newton(_, Zero, Ac, Deviation, Zero) :-
|
||||
abs(Ac) < Deviation,
|
||||
!.
|
||||
|
||||
% test solution
|
||||
newton(_, Xn1, _, 0.0, _, Xn1) :-
|
||||
!.
|
||||
|
||||
% calc
|
||||
newton(Function, Xn, Deviation, _, Ac, Zero) :-
|
||||
Xn1 is Xn + Ac,
|
||||
Function::eval(Xn1, Fn1),
|
||||
Function::evald(Xn1, DFn1),
|
||||
Ac1 is (-(Fn1 / DFn1)),
|
||||
newton(Function, Xn1, Deviation, Fn1, Ac1, Zero).
|
||||
newton(Function, X0, Ac, Deviation, Zero):-
|
||||
Xn1 is X0 + Ac,
|
||||
Function::eval(Xn1, Fx),
|
||||
Function::evald(Xn1, DFx),
|
||||
Ac2 is -(Fx/DFx),
|
||||
newton(Function, Xn1, Ac2, Deviation, Zero).
|
||||
|
||||
:- end_object.
|
||||
|
||||
@@ -203,66 +174,90 @@
|
||||
implements(find_rootp)).
|
||||
|
||||
:- info([
|
||||
version is 1.1,
|
||||
version is 1.2,
|
||||
author is 'Paulo Moura and Paulo Nunes',
|
||||
date is 2006/11/26,
|
||||
comment is 'Muller algorithm.']).
|
||||
|
||||
find_root(Function, Xa, Xb, Deviation, Zero) :-
|
||||
Xc is (Xa + Xb) / 2,
|
||||
Xc is (Xa + Xb) / 2.0,
|
||||
muller(Function, Xa, Xc, Xb, Deviation, Zero).
|
||||
|
||||
muller(Function, Xa, Xb, Xc, Deviation, Zero) :-
|
||||
Function::eval(Xa, Ya),
|
||||
Function::eval(Xb, Yb),
|
||||
Function::eval(Xc, Yc),
|
||||
H1 is (Xb - Xa),
|
||||
DDba is ((Yb - Ya) / H1),
|
||||
Ac is (Deviation + 1),
|
||||
H1 is Xb - Xa,
|
||||
DDba is (Yb - Ya) / H1,
|
||||
Ac is Deviation + 1.0,
|
||||
muller(Function, Xa, Xb, Xc, Deviation, Ya, Yb, Yc, Ac, H1, DDba, Zero).
|
||||
|
||||
% complex
|
||||
muller(_, _, _, complex, _, _, _, _, _, _, _, complex) :-
|
||||
!.
|
||||
|
||||
% test deviation
|
||||
muller(_, _, _, Xc, Deviation, _, _, _, Ac, _, _, Xc) :-
|
||||
abs(Ac) < Deviation,
|
||||
!.
|
||||
|
||||
% test solution
|
||||
muller(_, _, _, Xc, _, _, _, 0.0, _, _, _, Xc) :-
|
||||
!.
|
||||
|
||||
% calc
|
||||
muller(Function, Xa, Xb, Xc, Deviation, _, Yb, Yc, _, _, DDba, Zero) :-
|
||||
H2n is (Xc - Xb),
|
||||
DDcbn is ((Yc - Yb) / H2n),
|
||||
Cn is ((DDcbn - DDba) / (Xc - Xa)),
|
||||
Bn is (DDcbn + H2n * Cn),
|
||||
Rn is (Bn * Bn - 4.0 * Yc * Cn),
|
||||
% complex
|
||||
% write(Rn),
|
||||
H2n is Xc - Xb,
|
||||
DDcbn is (Yc - Yb) / H2n,
|
||||
Cn is (DDcbn - DDba) / (Xc - Xa),
|
||||
Bn is DDcbn + H2n * Cn,
|
||||
Rn is Bn * Bn - 4.0 * Yc * Cn,
|
||||
( Rn < 0.0 ->
|
||||
muller(Function, _, _, complex, Deviation, _, _, _, _, _, _, Zero),
|
||||
!, fail
|
||||
fail
|
||||
; V is sqrt(Rn)
|
||||
),
|
||||
( Bn > 0.0 ->
|
||||
Dn is (Bn + V)
|
||||
; Dn is (Bn - V)
|
||||
Dn is Bn + V
|
||||
; Dn is Bn - V
|
||||
),
|
||||
Acn is (-(2 * Yc / Dn)),
|
||||
Acn is -(2 * Yc / Dn),
|
||||
Xan is Xb,
|
||||
Xbn is Xc,
|
||||
Xcn is Xc + Acn,
|
||||
|
||||
Yan is Yb,
|
||||
Ybn is Yc,
|
||||
Function::eval(Xcn, Ycn),
|
||||
|
||||
H1n is H2n,
|
||||
DDban is DDcbn,
|
||||
muller(Function, Xan, Xbn, Xcn, Deviation, Yan, Ybn, Ycn, Acn, H1n, DDban, Zero).
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
|
||||
:- object(function_root,
|
||||
implements(find_rootp)).
|
||||
|
||||
:- info([
|
||||
version is 2.0,
|
||||
author is 'Paulo Moura and Paulo Nunes',
|
||||
date is 2007/07/05,
|
||||
comment is 'Multi-threading interface to root finding algorithms.']).
|
||||
|
||||
:- threaded.
|
||||
|
||||
:- public(find_root/6).
|
||||
:- mode(find_root(+object_identifier, +float, +float, +float, -float, -object_identifier), one).
|
||||
:- info(find_root/6, [
|
||||
comment is 'Finds the root of a function in the interval [A, B] given a maximum aproximation error. Returns the method used.',
|
||||
argnames is ['Function', 'A', 'B', 'Error', 'Zero', 'Method']]).
|
||||
|
||||
find_root(Function, A, B, Error, Zero, Algorithm) :-
|
||||
threaded((
|
||||
(bisection::find_root(Function, A, B, Error, Zero), Algorithm = bisection)
|
||||
; (newton::find_root(Function, A, B, Error, Zero), Algorithm = newton)
|
||||
; (muller::find_root(Function, A, B, Error, Zero), Algorithm = muller)
|
||||
)).
|
||||
|
||||
% an alternative, possibly better definition would be to make the methods simply fail in case of error:
|
||||
%
|
||||
% find_root(Function, A, B, Error, Zero, Algorithm) :-
|
||||
% threaded((
|
||||
% (catch(bisection::find_root(Function, A, B, Error, Zero), _, fail), Algorithm = bisection)
|
||||
% ; (catch(newton::find_root(Function, A, B, Error, Zero), _, fail), Algorithm = newton)
|
||||
% ; (catch(muller::find_root(Function, A, B, Error, Zero), _, fail), Algorithm = muller)
|
||||
% )).
|
||||
|
||||
find_root(Function, A, B, Error, Zero) :-
|
||||
find_root(Function, A, B, Error, Zero, _).
|
||||
|
||||
:- end_object.
|
||||
|
||||
Reference in New Issue
Block a user