Did you know ... Search Documentation:
Pack modeling -- prolog/modeling.pl
PublicShow source
author
- Francois Fages
version
- 1.1.4

This module provides a constraint-based mathematical modeling language in the spirit of MiniZinc in Prolog (A MiniZinc parser is planned to be added to this library in a next release).

The pack includes 5 modules with the following dependencies quantifiers.pl --> arrays.pl --> clp.pl --> modeling.pl --> examplesFLOPS2024.pl

library(examplesFLOPS2024) contains the examples and benchmark presented in the article:

  • F. Fages. A Constraint-based Mathematical Modeling Library in Prolog with Answer Constraint Semantics. 17th International Symposium on Functional and Logic Programming, FLOPS 2024. May 15, 2024 - May 17, 2024, Kumamoto, Japan. LNCS, Springer-Verlag.

library(quantifiers) defines bounded quantifiers with "in" domain and "where" conditions, let bindings, and a multifile user-defined predicate for defining shorthand/3 functional notations in expressions, e.g. conditional expressions with if/3 term.

library(arrays) defines multidimensional arrays for constraints on subscripted variables and the Array[Indices] shorthand/3 notation.

library(clp) is a frontend to library(clpr) and library(clpfd) to define hybrid constraints and allow shorthand notations such as Array[Indices] in constraints and domains.

Below is the example of a goal that can be written in this library to solve the 4-queens placement problem and pretty-print the chessboard, using subscripted variables (arrays) instead of lists, bounded quantifiers instead of recursion and functional notations in let bindings and constraints.

?- N=4, int_array(Queens, [N], 1..N),
  
  for_all([I in 1..N-1, D in 1..N-I],
    (Queens[I] #\= Queens[I+D],
     Queens[I] #\= Queens[I+D]+D,
     Queens[I] #\= Queens[I+D]-D)),
  
  satisfy(Queens),
  
  for_all([I, J] in 1..N,
    let([QJ = Queens[J],
         Q = if(QJ = I, 'Q', '.'),
         B = if(J = N, '\n', ' ')],
        format("~w~w",[Q,B]))).
. . Q .
Q . . .
. . . Q
. Q . .
N = 4,
Queens = array(2, 4, 1, 3) ;
. Q . .
. . . Q
Q . . .
. . Q .
N = 4,
Queens = array(3, 1, 4, 2) ;
false.

Below is an example of hybrid reified clpr clpfd constraint defined in library(clp).

?- array(A, [3]), truth_value({A[1] < 3.14}, B).
A = array(_A, _, _),
when((nonvar(_A);nonvar(B)), clp:clpr_reify(_A<3.14, _A>=3.14, B)).

?- array(A, [3]), truth_value({A[1] < 3.14}, B), {A[1]=2.7}.
A = array(2.7, _, _),
B = 1.
 int_array(?Array, ?Dimensions)
Array is an array of integer numbers or variables of dimensions Dimensions.
 float_array(?Array, ?Dimensions)
Array is an array of real numbers or variables of dimensions Dimensions.
 satisfy(+Term)
enumerate all solutions of the variables contained or related to Term, with smallest-domain first-fail and-choice heuristics ff.
 satisfy(+Term, +Options)
same as satisfy/1 with the Options from library(clpfd) predicate labeling/2.
 satisfy_attvars(+Term)
same as satisfy/1 but enumerating the values of the variables in term and in their attributes.
 satisfy_attvars(+Term, +Options)
same as satisfy/2 but enumerating also the values of the variables contained in the attributes of the variables in Term.
 minimize(+Expr, +Term)
enumerate all solutions of the variables contained in Term in increasing order of Expr.
 minimize(+Expr, +Term, +Options)
same as minimize/2 using extra library(clpfd) labeling/2 options
 maximize(+Expr, +Term)
enumerate all solutions of the variables contained in Term in decreasing order of Expr.
 maximize(+Expr, +Term, +Options)
same as maximize/2 using extra library(clpfd) labeling/2 options

Undocumented predicates

The following predicates are exported, but not or incorrectly documented.

 int_array(Arg1, Arg2, Arg3)
 bool_array(Arg1, Arg2)
 float_array(Arg1, Arg2, Arg3)