07.363 Logic Programming: Lecture 16

Constraint Logic Programming
  
  Terms in Prolog are a ``free algebra'' --- two terms are equal
    if they are identical, and there are no algebraic laws for terms
  This is why 1+1=2 fails!
  Best we can do within Prolog is ``peano numbers''
    
      plus( 0,    X, X ).
      plus( s(X), Y, s(Z) ) :- plus( X, Y, Z ).
    
    Now plus(s(0), s(0), s(s(0))) succeeds.  But this is only
    feasible for small integers.
  


Half-pie approaches

  
  Use special predicate to evaluate arithmetic expressions
    
      Z is X + Y
    
  ``Freeze'' goals until variables are bound
    
      plus(X,Y,Z) :-
          freeze( X, freeze( Y, Z is X+Y ) ).
    
    SICStus Prolog has a more general when/2 facility.

  

  Still cannot solve for X in Z and Y are known.



Constraints

  
  Clean and general solution to these problems
  E.g. 2+X=Z+3 is handled as in algebra.  When X or
    Z is known, the value of the other variable is known also.
  If a constraint cannot be satisfied, then backtrack (usual
    Prolog behaviour)
  



A Taxonomy

  There are many different kinds of constraint satisfaction systems.

  Depends on the domain of interpretation and the predicates and
  functions defined on the domain.

  E.g. domain may be boolean, with equality and functions and/or/not.
  Call this CLP(Boolean).

  Other common ones include CLP(R) for rational numbers,
  CLP() for reals, and CLP(FD) for finite domains.

  Prolog is CLP(Trees), where there are no functions and the only
  predicate is equality.



Languages available: CLP(R)

  Available on cs12 and cs13.  Has built-in constraint
  solver for reals.  Type clpr.

  clpr uses ``eval-quote'' scheme: a goal A+B is
  interpreted as an arithmetic function, not a Prolog term.

  
    | ?- X = 1 + 1.
    X = 2
    | ?- X = quote(1 + 1).
    X = 1 ^+ 1.
  

SICStus Prolog

  Several constraint solvers in libraries. 
    
   :- use_module( library(clpr) ). Reals
or :- use_module( library(clpq) ). Rationals
or :- use_module( library(clpb) ). Booleans
    

    Uses ``quote-eval'' scheme: A+B is a Prolog term;
    A+B is arithmetic function.   Change to eval-quote with: 
    
   :- use_module(library('clpqr/expand')), expand.
    



Examples
  
    fib( 0, 1 ).
    fib( 1, 1 ).
    fib( N, F1+F2 ) :-
        N >= 2,
        fib( N-1, F1 ),
        fib( N-2, F2 ).
  

  This predicate is invertible, despite the arithmetic
  
    | ?- fib( N, 89 ).
    N = 10
  



Mortage example

  
	mg(P, 1, I, B, MP) :-
		B = P*I - MP.
	mg(P, T, I, B, MP) :-
	        T > 1,
		mg( P*I - MP, T-1, I, B, MP ).
  

   Read ``a sum  is borrowed for  years at (one plus) interest rate
   and repayments MP, will leave a balance of .

  
    | ?- mg( P, 12, 1.01, B, Mp ).
    B=1.1268250301319698*P-12.682503013196973*Mp
  


How if works (more or less)

  A simple Prolog ``meta'' interpreter:

  
	solve( true ).
	solve( (G1, G2) ) :-
	    solve( G1 ),
	    solve( G2 ).
	solve( Goal ) :-
	    clause(Goal, Body),
	    solve( Body ).
  

  Rules are stored as unit clauses for clause/2.




In CLP languages, a rule is represented by

  
    clause( Head, Body, Constraints ).
  

  We now use a procedure solve/3

  
    acc_info( constraints, C, In, Out,
              merge_constraints(C, In, Out) ).
    pred_info( solve, 1, [constraints] ).

    solve( true ) -->> [].
    solve( (G1, G2) ) -->>
        solve( G1 ),
        solve( G2 ).
    solve( Goal )
        clause( Goal, Body, Constraint ),
        [Constraint]:constraints,
        solve( Body ).
  




Merge-constraints


  can solve linear equations;

  can solve linear inequalities; e.g. X>Y, X<Y  can
    simplify to fail, even if the values of both X and Y are
    unknown.

    Or, X=< 1, X>= 1 can be solved to give the binding X=1;

  can eliminate redundant constraints: e.g. in X=<Y. Y =<Z. X =< Z
  the constraint X =< Z is redundant;

  
  Trade-off: simplification is expensive; may be better to continue with
  unsatisfyable constraints.