For the CLP(B) library of SWI-Prolog,
I want to implement a weighted version of sat_count/2
sat_count(Sat0, N) :-
catch((parse_sat(Sat0, Sat),
sat_bdd(Sat, BDD),
sat_roots(Sat, Roots),
roots_and(Roots, _-BDD, _-BDD1),
% we mark variables that occur in Sat0 as visited ...
term_variables(Sat0, Vs),
maplist(put_visited, Vs),
% ... so that they do not appear in Vs1 ...
bdd_variables(BDD1, Vs1),
partition(universal_var, Vs1, Univs, Exis),
% ... and then remove remaining variables:
foldl(universal, Univs, BDD1, BDD2),
foldl(existential, Exis, BDD2, BDD3),
variables_in_index_order(Vs, IVs),
foldl(renumber_variable, IVs, 1, VNum),
bdd_count(BDD3, VNum, Count0),
var_u(BDD3, VNum, P),
% Do not unify N directly, because we are not prepared
% for propagation here in case N is a CLP(B) variable.
N0 is 2^(P - 1)*Count0,
% reset all attributes and Aux variables
throw(count(N0))),
count(N0),
N = N0).
I did not find a detailed documentation of the library for modifying the code.
How to implement a weighted version of sat_count/2?
EDIT 1 (01/11/2017):
Thank you #mat for your reply, I can't add comments because I've not enough reputation.
weighted_sat_count/3 should take a list of couples of weights, one for each variable (a weight for True and a weight for False state) and then the other two parameters are the same of sat_count/2.
The Count is the sum of weights of each admissible assignment. The weight of each admissible assignment is the product of the weight of each variable.
The algorithm to calculate the result is:
bdd_weight(BDD_node)
if BDD_node is 1-terminal return 1
if BDD_node is 0-terminal return 0
t_child <- 1-child of BDD_node
f_child <- 0-child of BDD_node
return (weight[BDD_node, 1] * bdd_weight(t_child) + weight[BDD_node, 0] * bdd_weight(f_child))
The algorithm can be more efficient with a map of visited node associated with calculated weight.
weight[,] is the list of couples of weights, 1 for True and 0 for False.
EDIT 2 (03/11/2017):
For example:
A+B+C, a simple SAT formula
List of couple for weights: [(0.7, 0.3), (0.9, 0.1), (0.5, 0.5)], one for each varible
?- weighted_sat_count([(0.7, 0.3), (0.9, 0.1), (0.5, 0.5)], +([A, B, C]), Count).
Count =
0.7*0.9*0.5 +
0.3*0.9*0.5 +
0.7*0.1*0.5 +
...
A non-efficient solution, based on modifying another part of a simple sat solver, starts with looking at a more simpler count code:
% my_sat_count(+List, -Integer)
my_sat_count([X|L], C) :-
findall(D, (X=0, my_sat_count(L,D);
X=1, my_sat_count(L,D)), H),
sum_list(H, C).
my_sat_count([], 1).
% sum_list(+List, -Number)
sum_list([D|L], C) :-
sum_list(L, H),
C is D+H.
sum_list([], 0).
To see that this simple code works, lets make an example (can be run in both SWI-Prolog or Jekejeke Prolog with the Minlog Extension):
Jekejeke Prolog 2, Runtime Library 1.2.5
(c) 1985-2017, XLOG Technologies GmbH, Switzerland
?- use_module(library(finite/clpb)).
% 8 consults and 0 unloads in 93 ms.
Yes
?- sat(X#Y#Z), labeling([X,Y,Z]).
X = 0, Y = 0, Z = 1 ;
X = 0, Y = 1, Z = 0 ;
X = 1, Y = 0, Z = 0 ;
X = 1, Y = 1, Z = 1
?- sat(X#Y#Z), my_sat_count([X,Y,Z],N).
N = 4,
Now adding weighting is a simple extension as follows:
% my_weighted_sat_count(+List, +Pairs, -Float)
my_weighted_sat_count([X|L], [(P,Q)|R], C) :-
findall(D, (X=0, my_weighted_sat_count(L,R,J), D is P*J;
X=1, my_weighted_sat_count(L,R,J), D is Q*J), H),
sum_list(H, C).
my_weighted_sat_count([], _, 1.0).
Here are some example runs:
?- sat(X#Y#Z), my_weighted_sat_count([X,Y,Z],
[(0.5,0.5),(0.4,0.6),(0.3,0.7)],W).
W = 0.5
?- sat(X#Y#Z), my_weighted_sat_count([X,Y,Z],
[(0.3,0.7),(0.3,0.7),(0.3,0.7)],W).
W = 0.532
Related
how can I do increment on backtracking ... so that goal(S) receives incremented number .. every time it fails on the next run I want to get the next number
S1 is S + 1,goal(S1)
does not work, because :
?- S=0, S1 is S+1.
S = 0,
S1 = 1.
?- S=0,between(1,3,_), S1 is S+1.
S = 0,
S1 = 1 ;
S = 0,
S1 = 1 ;
S = 0,
S1 = 1.
this work
%%counting
baz(..,C) :- .... arg(...), Y is X + 1, nb_setarg(...), goal(Y), ...
foo(..C) :- ....baz(....,C)..., foo(...C).
%%counter
blah :- ....foo(....,counter(0))...
this is not working, i think cause the recursive foo() would force baz() to initialize counter(0)... but i'm good with #sligo solution above
baz(..) :- C = counter(0), .... arg(...), Y is X + 1, nb_setarg(...), goal(Y), ...
foo(..) :- ....baz(....)..., foo(...).
so that goal(S) receives incremented number .. every time it fails on the next run I want to get the next number
That's what between/3 does? Every time on backtracking it makes the next number:
goal(X) :-
write('inside goal, X is '),
write(X),
nl.
test :-
between(0, 3, S),
goal(S).
e.g.
?- test.
inside goal, X is 0
true ;
inside goal, X is 1
true ;
inside goal, X is 2
true ;
inside goal, X is 3
true ;
Edit: From the help for between/3:
between(+Low, +High, ?Value)
Low and High are integers, High >=Low. If Value is an integer,
Low =<Value =<High. When Value is a variable it is successively
bound to all integers between Low and High. If High is inf or
infinite between/3 is true iff Value >=Low, a feature that is
particularly interesting for generating integers from a certain value.
(And see the comments on the help page by LogicalCaptain)
Use non-backtrackable destructive assignment predicate nb_setarg/3:
?- C = counter(0), between(1, 3, _), arg(1, C, X), Y is X + 1, nb_setarg(1, C, Y).
C = counter(1),
X = 0,
Y = 1 ;
C = counter(2),
X = 1,
Y = 2 ;
C = counter(3),
X = 2,
Y = 3.
Alternatives:
foo(C) :-
between(1, inf, C),
goal(C),
!.
baz(C) :-
C = counter(0),
repeat,
arg(1, C, X),
Y is X + 1,
nb_setarg(1, C, Y),
goal(Y),
!.
goal(X) :-
X > 9.
Examples:
?- foo(C).
C = 10.
?- baz(C).
C = counter(10).
My logic teacher said in passing that Quines algorithm
can be also used to count valuations. Unfortunately I
cannot get my head around how this is done in Prolog?
The program would for example give, using
the syntax from the answer in Quines algorithm:
?- sat_count(X+Y, C).
C = 3
Since the truth table for the disjunction X+Y
has 3 rows that valuate to true:
X Y X+Y
0 0 0
0 1 1
1 0 1
1 1 1
Point of departure is Quines algorithm with its core predicate eval/2 which has the following specification. The source code of the Quine algorithm and the solution to the question can be found here.
/**
* eval(A, R):
* The predicate succeeds in R with a partial evaluated
* Boolean formula. The predicate starts with the leaves
* and calls simp after forming new nodes.
*/
% eval(+Formula, -Formula)
We first experimented with a labeling predicate, that
will list all valuations without counting them. The predicate
has a fast fail feature, if the partially evaluated formula
is false (0) then labeling needs not to proceed, otherwise we
simply probe the boolean values:
/**
* labeling(L, A):
* The predicate labels the variables from the list L in the formula A.
*/
% labeling(+List, +Formula)
labeling(_, A) :- A == 0, !, fail.
labeling([X|L], A) :- value(X), eval(A, B), labeling(L, B).
labeling([], A) :- A == 1.
Here is an example run:
?- labeling([X,Y], X+Y).
X = 0,
Y = 1 ;
X = 1,
Y = 0 ;
X = 1,
Y = 1
From the labeling predicate we derived a counting predicate
using findall/3 from the ISO core standard. Instead of
succeeding at the end we return 1, inbetween we sum the counts.
This does the job and also profits from fast failing:
/**
* count(L, A, N):
* The predicate silently labels the variables from the list L in the
* formula A and succeeds in N with the count of the solutions.
*/
% count(+List, +Formula, -Integer)
count(_, A, C) :- A == 0, !, C = 0.
count([X|L], A, D) :-
findall(C, (value(X), eval(A, B), count(L, B, C)), R),
sum(R, 0, D).
count([], A, 1) :- A == 1.
Here is an example run:
?- count([X,Y], X+Y, C).
C = 3
The implementation might profit from some optimizations that we didn't implement. For example assigning values to a variable that does not anymore occure in the formula could be optimized away.
test(X, Y) :-
X ins 1..3,
Y ins 1..3,
X #\= Y.
Here is my attempt at doing it. The goal would be to type this into SWI-Prolog so that this output comes out.
?- test(X, Y).
X = 1
Y = 2 ;
X = 2,
Y = 1;
X = 3,
Y = 1 ;
... etc.
I'm actually trying to solve the 8-queens problem using prolog and have this so far.
eight_queens(Qs, L) :-
Qs = [ [X1,Y1], [X2, Y2], [X3, Y3], [X4, Y4], [X5, Y5], [X6, Y6], [X7, Y7], [X8, Y8], [X9, Y9] ],
Qs ins 1..9,
X1 #\= X2,
X1 #\= X3,
...
etc.
But I keep getting this error: "Arguments are not sufficiently instantiated" for both the test function and the eight_queens problem.
Besides the observation about in/2 and ins/2 posted by #coder, that solve your imminent problem, I would add the following points that are good to keep in mind when using CLP(FD):
1. Always make labeling the last goal
First let's observe the answers for the variant marked as 2nd way using ins in #coder's post but without the goal label/1:
test(X, Y) :-
[X,Y] ins 1..3,
X #\= Y.
?- test(X,Y).
X in 1..3, % residual goal
X#\=Y, % residual goal
Y in 1..3. % residual goal
Since there is no unique answer to the query, Prolog answers with residual goals (see section A.8.8 of the CLP(FD) manual) for more information). These residual goals are constraints that are being propagated and with every additional (non-redundant) constraint the domain is narrowed. If this does not lead to a unique solution like in the example above you can get concrete values by labeling the constrained variables (e.g. with label/1). This observation suggests to use labeling as the last goal:
?- test(X,Y), label([X,Y]).
X = 1,
Y = 2 ;
X = 1,
Y = 3 ;
X = 2,
Y = 1 ;
X = 2,
Y = 3 ;
X = 3,
Y = 1 ;
X = 3,
Y = 2.
This is obviously the same result as with #coders version but the three pairs (X,Y) = (1,1) ∨ (2,2) ∨ (3,3) are not considered when labeling due to the constraint X#\=Y being posted before the goal label([X,Y]). In #coder's version it is the other way around: label([X,Y]) is delivering all three pairs as possible solutions and the last goal X#\=Y is eliminating them subsequently. To see this just leave the last goal as a comment and query the predicate:
test(X,Y):- [X,Y] ins 1..3, label([X,Y]). %, X#\=Y.
?- test(X,Y).
X = Y, Y = 1 ; % <- (1,1)
X = 1,
Y = 2 ;
X = 1,
Y = 3 ;
X = 2,
Y = 1 ;
X = Y, Y = 2 ; % <- (2,2)
X = 2,
Y = 3 ;
X = 3,
Y = 1 ;
X = 3,
Y = 2 ;
X = Y, Y = 3. % <- (3,3)
The difference is minuscule in this example, so there's nothing wrong with #coder's version. But in general this might lead to a big difference if the constraints posted after labeling exclude a lot of candidates. So it's good practice to always put labeling as the last goal.
2. Separate labeling from the actual relation
Coming from the previous observations it is opportune to divide the predicate into a core relation that is posting all the constraints and labeling. Consider the restructured predicate test/2 as a template:
test(X,Y) :-
test_(X,Y,L), % the core relation
label(L). % labeling
test_(X,Y,L) :-
L=[X,Y], % variables to be labeled in a flat list
L ins 1..3,
X#\=Y.
The predicate test_/3 is describing the actual relation by posting all the necessary constraints and has a list as an additional argument that contains all the variables to be labeled. Obtaining the latter might not be trivial, depending on the data structures your arguments come with (consider for example a list of lists as an argument that you want to turn into a flat list for labeling). So the predicate test/2 is only calling test_/3 and subsequently the labeling goal. This way you have a clean and easily readable separation.
3. Try different labeling strategies
The goal label(L) is the simplest way to do labeling. It is equivalent to labeling([],L). The first argument of labeling/2 is a list of options that gives you some control over the search process, e.g. labeling([ff],L) labels the leftmost variable with the smallest domain next, in order to detect infeasibility early. Depending on the problem you are trying to solve different labeling strategies can lead to results faster or slower. See the documentation of labeling/2 for available labeling strategies and further examples.
ins is used for lists, in is used for single variable so in your example:
test(X, Y) :-
X ins 1..3,
Y ins 1..3,
X #\= Y.
X,Y are assumed to be lists. This does not produces a syntax error, but produces error when trying to run it with X,Y not being lists.
Also when using in Low..High doesn't mean that the variable is int just X=<High and X>=Low. In order to put the constraint to be integers use label/1:
:- use_module(library(clpfd)).
%using in/
test(X,Y):- X in 1..3,Y in 1..3,label([X,Y]), X#\=Y.
%2nd way using ins
test(X,Y):- [X,Y] ins 1..3, label([X,Y]), X#\=Y.
Example:
?- test(X,Y).
X = 1,
Y = 2 ;
X = 1,
Y = 3 ;
X = 2,
Y = 1 ;
X = 2,
Y = 3 ;
X = 3,
Y = 1 ;
X = 3,
Y = 2 ;
false.
Let's say i have the following predicate:
func1(X,B,R)
I provide it with a certain X and B and in return it gives me 5 different results for R.
EDIT:
The X and B do not specify a range. rather, X specify an integer (say 120) and B specifies all integers (starting from 1) whose cubic is less than X.
What func1 does is calculating R as the result the remainder.
In this case where X=120:
B = 1, R = 119 (120-1^3)
B = 2, R = 112 (120-2^3)
B = 3, R = 93 (120-3^3)
B = 4, R = 56 (120-4^3)
It would not calculate B=5 since 5^3 = 125 which is greater than 120, so it stops here.
How can i make a predicate such as:
func2(R,S)
That would accept all of the results given by R, sum them up and store them in S?
Thanks!
To start with, since the values of B are totally derivable from the value of X, I wouldn't include both as arguments in func1. I'll introduce a predicate func3/2 which is true if the second argument is derivable from the first (i.e., func3(X, B) is true if B is derivable from X):
func1(X, R) :-
func3(X, B),
...
What will happen if you query func1(120, R) is you'd get one or more results for R. Then you can use findall/3 as I indicated in my comment:
func2(X, S) :-
findall(R, func1(X, R), Rs),
sumlist(Rs, S).
To define func3/2 the cleanest approach would be to use CLP(FD):
:- use_module(library(clpfd)).
func3(X, B) :-
B #>= 0,
(X - B^3) #>= 0,
label([B]).
Here's an example of what func3 does:
?- func3(120, B).
B = 1 ;
B = 2 ;
B = 3 ;
B = 4.
A much less desirable way to do this if you can't use CLP(FD) would be to use between and define the upper limit of B to be the greatest integer not exceeding the cube root of X:
func3(X, B) :-
Limit is floor(exp(log(X) / 3)),
between(1, Limit, B).
Which yields the same result as above.
I have this code that uses an upper bound variable N that is supposed to terminate for X and Y of the pythagorean triple. However it only freezes when it reaches the upper bound. Wasn't sure how to use the cut to stop the backtracking. Code is:
is_int(0).
is_int(X) :- is_int(Y), X is Y+1.
minus(S,S,0).
minus(S,D1,D2) :- S>0, S1 is S-1, minus(S1,D1,D3), D2 is D3+1.
pythag(X,Y,Z,N) :- int_triple(X,Y,Z,N), Z*Z =:= X*X + Y*Y.
int_triple(X,Y,Z,N) :- is_int(S), minus(S,X,S1), X>0, X<N,
minus(S1,Y,Z), Y>0, Y<N.
Will be called, for example with,
?- pythag(X,Y,Z,20).
First, let us test your solution:
?- pythag(X,Y,Z,20).
X = 4, Y = 3, Z = 5
; X = 3, Y = 4, Z = 5
; X = 8, Y = 6, Z = 10
; X = 6, Y = 8, Z = 10
; X = 12, Y = 5, Z = 13
; X = 5, Y = 12, Z = 13
; X = 12, Y = 9, Z = 15
; X = 9, Y = 12, Z = 15
; X = 15, Y = 8, Z = 17
; X = 8, Y = 15, Z = 17
; X = 16, Y = 12, Z = 20
; X = 12, Y = 16, Z = 20
; loops.
Looks perfect to me! All answers are correct solutions! ... up to and including this last solution. After that, your program loops.
Before we try to identify the problem, just hold on for a moment: You must be pretty patient to go through 12 (that is: twelve) answers only to find that loop. Do you think that this method will also work for bigger cases? How many answers are you willing to look at before you give up? Isn't there a simpler way to find out about the problem?
There is one interesting observation here: The answers found have (almost) nothing to do with the looping of the program! That is: By looking at the answers, you get (frequently – as in this case) no clue about the actual cause of the loop! So why not turn off all the answers and concentrate on the relevant part! In fact, we can do this as follows:
?- pythag(X,Y,Z,20), false.
loops.
Now, all answers have been removed due to the goal false. What remains is just the final outcome: either termination, or non-termination, or some error. Nothing else. This should facilitate our observations about termination a bit - no more blinding answers scrolling over the screen. Note that this does not solve the problem in general. After all, how long are we willing to wait? 1s ? 1m?
The actual reason of non-termination can be best understood by looking at a relevant failure slice. That is a fragment of the program whose non-termination implies the non-termination of the whole program. See this answer for more details. Here is the relevant failure slice of your program for query pythag(X,Y,Z,20), false:
pythag(X,Y,Z,N) :-
int_triple(X,Y,Z,N), false,
Z*Z =:= X*X + Y*Y.
int_triple(X,Y,Z,N) :-
is_int(S), false,
minus(S,X,S1), X>0, X<N,
minus(S1,Y,Z), Y>0, Y<N.
is_int(0) :- false.
is_int(X) :-
is_int(Y), false,
X is Y+1.
Note that there are not many things left of your program. E.g., the actual equation is gone (that's more or less the logic part...). Still, this fragment is relevant. And as long as you do not change something within that fragment, the problem will persist! That is guaranteed for a pure monotonic program as this one...
Here is my preferred solution: It uses length/2 and between/3, two frequently supported predicates of the Prolog prologue.
pythag2(X,Y,Z,N) :-
length(_, N),
between(1,N,X),
between(1,N,Y),
between(1,N,Z),
Z*Z =:= X*X + Y*Y.
I was recently as well thinking about a Prolog solution to
find Pythagorean triples. I came up with a slightly different
code. Assume we have a function:
isqrt(a) = floor(sqrt(a))
It is then enough to enumerate x and y, and to check whether
x*x+y*y is the square of some z. Namely to check for:
h = x*x+y*y, z = isqrt(h), z*z = h ?
The function isqrt can be implemented via bisection. For
symmetry breaking we can enumerate y after x. Assuming
N = 99 the resulting code is:
% between(+Integer, +Integer, -Integer)
between(Lo, Hi, _) :-
Lo > Hi, !, fail.
between(Lo, _, Lo).
between(Lo, Hi, X) :-
Lo2 is Lo+1, between(Lo2, Hi, X).
% bisect(+Integer, +Integer, +Integer, -Integer)
bisect(Lo, Hi, X, Y) :-
Lo+1 < Hi, !,
M is (Lo+Hi) // 2,
S is M*M,
(S > X -> bisect(Lo, M, X, Y);
S < X -> bisect(M, Hi, X, Y);
M = Y).
bisect(Lo, _, _, Lo).
% pythago(-List)
pythago(X) :-
X = [A,B,C],
between(1, 99, A),
between(A, 99, B),
H is A*A+B*B,
bisect(0, H, H, C),
C =< 99, H =:= C*C.
There should be 50 such Pythagorean tripples, see also Sloan's A046083:
?- findall(-, pythago(_), L), length(L, N).
N = 52.
One might like to cross check with the following
CLP(FD) solution.
:- use_module(library(clpfd)).
% pythago3(-List)
pythago3(X) :-
X = [A,B,C],
X ins 1..99,
A*A+B*B #= C*C,
A #=< B,
label(X).
It gives the same number of solutions:
?- findall(-, pythago3(_), L), length(L, N).
N = 50.