Did you know ... Search Documentation:
Pack clpBNR -- prolog/clpBNR_toolkit.pl
PublicShow source

CLP(BNR) (library(clpBNR)) is a CLP over the domain of real numbers extended with ±∞. This module contains a number of useful utilities for specific problem domains like the optimization of linear systems, enforcing local optima conditions, and constructing centre form contractors to improve performance (e.g., Taylor extensions of constraints). For more detailed discussion, see A Guide to CLP(BNR) (HTML version included with this pack in directory docs/).

Documentation for exported predicates follows. The "custom" types include:

  • interval : a variable with a clpBNR attribute
  • numeric : an interval or a number
  • *_list : a list of *
 iterate_until(+Count:integer, Test, Goal) is nondet
Succeeds when Goal succeeds; otherwise fails. Goal will be called recursively up to Count times as long as Test succeeds Example using this predicate for simple labelling using Test small/2 and Goal midsplit/1 :
?- X::real(-1,1),iterate_until(10,small(X,0),mid_split(X)),format("X = ~w\n",X),fail;true.
X = _6288{real(-1,-1r2)}
X = _6288{real(-1r2,0)}
X = _6288{real(0,1r2)}
X = _6288{real(1r2,1)}
true.

The specific intended use case is to provide an iterator for meta-contractors such as the centre-form contractor such as midsplit/1 (example above) or as constructed by taylor_contractor/2 as in:

?- X::real,taylor_contractor({X**4-4*X**3+4*X**2-4*X+3==0},T),
iterate_until(50,small(X),(T,mid_split_one([X]))),format("X = ~w\n",X),fail;true.
X = _150{real(0.999999999926943,1.00000000007306)}
X = _150{real(2.999999999484828,3.0000000005152105)}
true.

(Aside: For some problems, solving with Taylor contractors can be a faster and more precise alternative to clpBNR:solve/1.)

 mid_split_one(+Xs:numeric_list) is nondet
Succeeds splitting the widest interval in Xs, a list of intervals; fails if Xs is not a list of intervals. See mid_split for details of interval splitting for this predicate.
See also
- mid_split/1
 mid_split(X:numeric) is nondet
Succeeds if X is an interval that can be split at its midpoint narrowing X to it's lower "half"; on backtracking X is constrained to the upper half; fails if X is not a numeric. If X is an interval, defined as:
mid_split(X) :-
        M is midpoint(X),
        ({X=<M} ; {M=<X}).

Note that mid_split succeeds if X is a number, but doesn't do anything.

Use clpBNR:small as a pre-test to avoid splitting intervals which are already small enough.

See also
- clpBNR:small/1
 cf_contractor(Xs:interval_list, As:interval_list) is semidet
Succeeds if each interval in As can be unified with the midpoints of the respective interval in Xs; otherwise fails. This predicate executes one narrowing step of the centre form contractor such as that generated by taylor_contractor. In normal usage, a direct call to cf_contractor does appear; instead use cf_contractor or in a Goal for iterate_until/3.
See also
- taylor_contractor/2, cf_solve/1, iterate_until/3
 cf_solve(+Contractor) is nondet
Equivalent to cf_solve/2 using default precision.
 cf_solve(+Contractor, +Precision:integer) is nondet
Succeeds if a solution can be found for all variables in the centre form contractor, Contractor, where the resultant domain of any variable is narrower than the limit specified by Precision (for cf_solve/1, default Precision is number of digits as defined by the environment flag clpBNR_default_precision); otherwise fails.

This is done by using iterate_until/3 limited to a count determined by the flag clpBNR_iteration_limit. Examples:

?- X::real, taylor_contractor({X**4-4*X**3+4*X**2-4*X+3==0},T), cf_solve(T).
T = cf_contractor([X], [_A]),
X:: 1.000000000...,
_A::real(-1.0Inf, 1.0Inf) ;
T = cf_contractor([X], [_A]),
X:: 3.00000000...,
_A::real(-1.0Inf, 1.0Inf) ;
false.

?- taylor_contractor({2*X1+5*X1**3+1==X2*(1+X2), 2*X2+5*X2**3+1==X1*(1+X1)},T), cf_solve(T).
T = cf_contractor([X2, X1], [_A, _B]),
X1:: -0.42730462...,
X2:: -0.42730462...,
_B::real(-1.0Inf, 1.0Inf),
_A::real(-1.0Inf, 1.0Inf) ;
false.
See also
- taylor_contractor/2, cf_contractor/2
 taylor_contractor(+Constraints, -Contractor) is semidet
Succeeds if a centre form contractor Contractor can be generated from one or more multivariate equality (== or =:=) constraints Constraints; otherwise fails. Example:
?- taylor_contractor({X**4-4*X**3+4*X**2-4*X+3==0},T).
T = cf_contractor([X], [_A]),
X::real(-1.509169756145379, 4.18727500493995),
_A::real(-1.0Inf, 1.0Inf).

Use the contractor with cf_solve to search for solutions, as in:

?- X::real,taylor_contractor({X**4-4*X**3+4*X**2-4*X+3==0},T), cf_solve(T).
T = cf_contractor([X], [_A]),
X:: 1.000000000...,
_A::real(-1.0Inf, 1.0Inf) ;
T = cf_contractor([X], [_A]),
X:: 3.00000000...,
_A::real(-1.0Inf, 1.0Inf) ;
false.

Multiple equality constraints are supported, as in this example of the Broyden banded problem (N=2):

?- taylor_contractor({2*X1+5*X1**3+1==X2*(1+X2), 2*X2+5*X2**3+1==X1*(1+X1)},T), cf_solve(T).
T = cf_contractor([X2, X1], [_A, _B]),
X1:: -0.42730462...,
X2:: -0.42730462...,
_B::real(-1.0Inf, 1.0Inf),
_A::real(-1.0Inf, 1.0Inf) ;
false.

Centre form contractors can converge faster than the general purpose builtin fixed point iteration provided by solve/1.

See also
- cf_solve/1
 taylor_merged_contractor(+Constraints, -Contractor) is semidet
Succeeds if a merged centre form contractor Contractor can be generated from each equality (== or =:=) constraint in Constraints; otherwise fails.
deprecated
-
  • use taylor_contractor/2 instead
 integrate(+F, -X:interval, -R) is semidet
Equivalent to integrate/4 with default precision.
 integrate(+F, -X:interval, -R, +P:integer) is semidet
Succeeds if R is the numerical integration of F over the range of interval X. F must be continuously differentiable over this range or it fails.

The number of integration steps (= 2**P) is determined by the precision parameter P (default is value of environment flag clpBNR_default_precision). Example of use with increasing precision values:

?- X::real(0.0,1.0), F=X**2, between(2,10,P),integrate(F,X,RV,P), range(RV,R), format('~w:~w\n',[P,R]), fail.
2:[0.328125,0.359375]
3:[0.33203125,0.33984375]
4:[0.3330078125,0.3349609375]
5:[0.333251953125,0.333740234375]
6:[0.33331298828125,0.33343505859375]
7:[0.3333282470703125,0.3333587646484375]
8:[0.3333320617675781,0.3333396911621094]
9:[0.33333301544189453,0.33333492279052734]
10:[0.33333325386047363,0.33333373069763184]
false.
 boundary_values(-X:interval, +Dvars:list) is semidet
Equivalent to boundary_values/4 with default precision and discarding steps list.
 boundary_values(-X:interval, +Dvars:list, +P:integer) is semidet
Equivalent to boundary_values/4 discarding steps list.
 boundary_values(-X:interval, +Dvars:list, +P:integer, -Steps:list) is semidet
Succeeds if a solution can be found to the boundary value problem specified by the independent variable X and the list of dependent variables defined by Dvars. Each dependent variable definition is a compound term of the form dV(Y, Fxy, Yi, Yf). The initial and final values of the independent variable for the purposes of the boundary value problem are specified by the lower and upper values of the domain of X. The arguments of for dvar/4 are:
  • Y : the dependent variable for this definition
  • Fxy : an expression defining the derivative of Y with respect to X
  • Yi : the value of Y when X takes the value of its lower bound
  • Yf : the value of Y when X takes the value of its upper bound The intent of this predicate is to find values for any of the unspecified boundary values (i.e., any Yi,Yf). An unbound Yi and Yf can be any evaluable arithmetic expression. The actual dependent and independent variables (X and Y's respectively) are unchanged.

    The optional third argument P defines a precision value, a positive integer (default = environment flag clpBNR_default_precision), which controls the the numerical integration; larger P means smaller step size.

    The arity 4 version has an additional (final) argument which is unified with a list of the step values generated by the integration; each value is a tuple of the form (X,Ys).

    This predicate fails if any of the arguments are invalid (generates an error message if clpBNR debug topic is enabled) or if a solution to the boundary value problem cannot be found. Examples for X in the range 0..1 and derivative of Y = -2*X*Y:

    ?- X::real(0,1), boundary_values(X,[dV(Y, -2*X*Y,1,Yf)]).
    X::real(0, 1),
    Yf:: 0.368... .
    
    ?- X::real(0,1),boundary_values(X,[dV(Y, -2*X*Y,1,Yf)],9).
    X::real(0, 1),
    Yf:: 0.36788... .
    
    ?- X::real(0,1), boundary_values(X,[dV(Y, -2*X*Y,Yi,1/e)]).
    X::real(0, 1),
    Yi:: 1.00... .
    
    ?- debug(clpBNR).
    true.
    
    ?- X=42, boundary_values(X,[dV(Y, -2*X*Y,Yi,1/e)]).
    % Invalid argument(s): boundary_values(42,[dV(_10836,-2*42*_10836,_10850,1/e)],6)
    false.

    As with any application requiring numerical integration, care must be taken to avoid instability problems (more discussion in A Guide to CLP(BNR).

 lin_minimum(+ObjF, Constraints:{}, ?Min:numeric) is semidet
Succeeds if the global minimum value of the objective function ObjF subject to Constraints can be unified with Min; otherwise fails. Both the objective function and Constraints must be linear, i.e., only subexpressions summing of the form X*C (or C*X) are permitted since the actual computation is done using library(simplex). Narrowing of minimizers (variables in ObjF) is limited to that constrained by the Min result to accomodate multiple sets of minimizers. (See lin_minimize/3 to use minimizers used to derive Min.) A solution generator, e.g., clpBNR:solve/1 can be used to search for alternative sets of minimizers. "Universal Mines" example from the User Guide:
?- [M_Idays,M_IIdays,M_IIIdays]::integer(0,7),
lin_minimum(20*M_Idays+22*M_IIdays+18*M_IIIdays,
{4*M_Idays+6*M_IIdays+M_IIIdays>=54,4*M_Idays+4*M_IIdays+6*M_IIIdays>=65}, Min).
Min = 284,
M_Idays::integer(2, 7),
M_IIdays::integer(4, 7),
M_IIIdays::integer(2, 7).

?- [M_Idays,M_IIdays,M_IIIdays]::integer(0,7),
lin_minimum(20*M_Idays+22*M_IIdays+18*M_IIIdays,
{4*M_Idays+6*M_IIdays+M_IIIdays>=54,4*M_Idays+4*M_IIdays+6*M_IIIdays>=65}, Min),
solve([M_Idays,M_IIdays,M_IIIdays]).
M_Idays = 2,
M_IIdays = 7,
M_IIIdays = 5,
Min = 284 ;
false.

For linear systems, lin_minimum/3, lin_maximum/3 can be significantly faster than using the more general purpose clpBNR:global_minimum/3, clpBNR:global_maximum/3

See also
- lin_minimize/3, library(simplex)
 lin_maximum(+ObjF, Constraints:{}, ?Max:numeric) is semidet
Succeeds if the global minimum value of the objective function ObjF subject to Constraints can be unified with Max; otherwise fails. This is the corresponding predicate to lin_minimum/3 for finding global maxima.
See also
- lin_minimum/3, lin_maximize/3
 lin_minimize(+ObjF, Constraints:{}, ?Min:numeric) is semidet
Succeeds if the global minimum value of the objective function ObjF subject to Constraints can be unified with Min; otherwise fails. This behaves identically to lin_minimum/3 except variables in ObjF will be narrowed to the values used in calculating the final value of Min. Any other sets of minimizers corresponding to Min are removed from the solution space. "Universal Mines" example from the User Guide:
?- [M_Idays,M_IIdays,M_IIIdays]::integer(0,7),
lin_minimize(20*M_Idays+22*M_IIdays+18*M_IIIdays,
{4*M_Idays+6*M_IIdays+M_IIIdays>=54,4*M_Idays+4*M_IIdays+6*M_IIIdays>=65}, Min).
M_Idays = 2,
M_IIdays = 7,
M_IIIdays = 5,
Min = 284.
See also
- lin_minimum/3
 lin_maximize(+ObjF, Constraints:{}, ?Max:numeric) is semidet
Succeeds if the global maximum value of the objective function ObjF subject to Constraints can be unified with Max; otherwise fails. This behaves identically to lin_maximum/3 except variables in ObjF will be narrowed to the values used in calculating the final value of Max. Any other sets of minimizers corresponding to Min are removed from the solution space.
See also
- lin_maximum/3
 local_minima(+ObjF) is semidet
Succeeds if the value of objective function ObjF can be constrained to be a local minimum, i.e, it's "slope" is 0 in every dimension; otherwise fails. This requires that a partial derivative of ObjF exists for each variable. local_minima should be executed prior to a call to clpBNR:global_minimum using the same objective function, e.g.,
?- X::real(0,10), OF=X**3-6*X**2+9*X+6, local_minima(OF), global_minimum(OF,Z).
OF = X**3-6*X**2+9*X+6,
X:: 3.00000000000000...,
Z:: 6.000000000000... .

Using any local optima predicate can significantly improve performance compared to searching for global optima (clpBNR:global_*) without local constraints.

See also
- clpBNR:local_minima/2
 local_maxima(+ObjF) is semidet
Succeeds if the value of objective function ObjF can be constrained to be a local maximum, i.e, it's "slope" is 0 in every dimension; otherwise fails. This requires that a partial derivative of ObjF exists for each variable. local_maxima should be executed prior to a call to clpBNR:global_maximum using the same objective function, e.g.,
?- X::real(0,10), OF=X**3-6*X**2+9*X+6, local_maxima(OF), global_maximum(OF,Z).
OF = X**3-6*X**2+9*X+6,
X:: 1.000000000000000...,
Z:: 10.0000000000000... .
See also
- clpBNR:local_maxima/2
 local_minima(+ObjF, +Constraints:{}) is semidet
Succeeds if the value of objective function ObjF can be constrained to be a local minimum, i.e, it's "slope" is 0 in every dimension, subject to Constraints; otherwise fails. This requires that a partial derivative of ObjF, and any subexpression in Constraints, exists for each variable. local_minima should be executed prior to a call to clpBNR:global_minimum using the same objective function, e.g.,
?- [X1,X2]::real, OF=X1**4*exp(-0.01*(X1*X2)**2),
local_minima(OF,{2*X1**2+X2**2==10}), global_minimum(OF,Z), solve([X1,X2]).
OF = X1**4*exp(-0.01*(X1*X2)**2),
X1::real(-1.703183936003284e-108, 1.703183936003284e-108),
X2:: -3.16227766016838...,
Z:: 0.0000000000000000... ;
OF = X1**4*exp(-0.01*(X1*X2)**2),
X1::real(-1.703183936003284e-108, 1.703183936003284e-108),
X2:: 3.16227766016838...,
Z:: 0.0000000000000000... .
See also
- clpBNR:local_minima/1
 local_maxima(+ObjF, +Constraints:{}) is semidet
Succeeds if the value of objective function ObjF can be constrained to be a local maximum, i.e, it's "slope" is 0 in every dimension; otherwise fails. This requires that a partial derivative of ObjF, and any subexpression in Constraints, exists for each variable. local_maxima should be executed prior to a call to clpBNR:global_maximum using the same objective function, e.g.,
?- [X1,X2]::real,OF=X1**4*exp(-0.01*(X1*X2)**2),
local_maxima(OF,{2*X1**2+X2**2==10}), global_maximum(OF,Z),solve([X1,X2]).
OF = X1**4*exp(-0.01*(X1*X2)**2),
X1:: -2.23606797749979...,
X2:: 0.0000000000000000...,
Z:: 25.0000000000000... ;
OF = X1**4*exp(-0.01*(X1*X2)**2),
X1:: 2.23606797749979...,
X2:: 0.0000000000000000...,
Z:: 25.0000000000000... .
See also
- clpBNR:local_maxima/1