Counting the number of valuations via Quine algorithm in Prolog - prolog

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.

Related

Prolog power of 2 recursion

Need help creating a recursive clause is a rule: X is a power of 2 only if there is a Y such that when adding Y to Y the result is
X, and Y is a power of 2. in prolog
We are going to define this predicate recursively. The followings are the fact and rule for detecting whether a numeral
is a power of 2 or not:
• The base clause is a fact: 1 is a power of 2 (because 1=20);
• The recursive clause is a rule: X is a power of 2 only if there is a Y such that when adding Y to Y the result is
X, and Y is a power of 2.
For example, the following shows how the queries should be performed:
| ?- powerOf2(succ(succ(succ(succ(0))))).
true ?
yes
| ?- powerOf2(succ(succ(succ(0)))).
no
The first query shows that 4 is a power of 2; while the second shows that 3 is not.
can not use the built-in is/2 predicate to perform arithmetic
To make it easier to represent natural numbers in Peano notation, you can use the following predicate:
nat(0, 0).
nat(N, s(P)) :-
succ(M, N),
nat(M, P).
Examples:
?- nat(3, P).
P = s(s(s(0))) ;
false.
?- nat(5, P).
P = s(s(s(s(s(0))))) ;
false.
To get the double of a Peano number, use the predicate:
double(0, 0).
double(s(A), s(s(B))) :-
double(A, B).
Examples:
?- nat(1, P), double(P, D).
P = s(0),
D = s(s(0)) ;
false.
?- nat(3, P), double(P, D).
P = s(s(s(0))),
D = s(s(s(s(s(s(0)))))) ;
false.
To check whether a Peano number is a power of two, use the predicate:
power_of_two(s(0)).
power_of_two(s(s(N))) :-
double(M, s(s(N))),
power_of_two(M).
Example:
?- between(1,9,N), nat(N,P), power_of_two(P).
N = 1,
P = s(0) ;
N = 2,
P = s(s(0)) ;
N = 4,
P = s(s(s(s(0)))) ;
N = 8,
P = s(s(s(s(s(s(s(s(0)))))))) ;
false.
Need help creating a recursive clause
The recursive clause will be:
power_of_two(1).
power_of_two(X) :-
X > 1,
Y is X / 2,
power_of_two(Y).
A base case which handles 1 being a power of two. And a case which handles when X is greater than one, Y is half X and recursively checks that Y is a power of two.
can not use the built-in is/2 predicate to perform arithmetic
You can't, but I can for the sake of illustrating the recursive clause you asked about. I'm assuming that since it tells you to use "succ(succ(succ(succ(0))))" you already have met that and have some code for adding/subtracting/dividing which you can reuse to replace Y is X / 2.

Printing list elements - How are these two solutions different?

I am currently going through "Programming in Prolog" by Clocksin & Mellish. One of the exercises asks to print list elements each on a line while indenting nested elements, so for example we need to print [a,b,[c,d],e,f] as:
a
b
c
d
e
f
So, here is my solution (assume we have a predicate 'indent' that prints a specified no. of spaces for indentation). I have defined two predicates 'print' & 'printelement', each takes a first argument to be printed and a second for the indentation (no. of spaces):
print([],_).
print([H|T],Indent):- H\=[_|_], % if not a list
printelement(H,Indent),
print(T,Indent).
print([H|T],Indent):- H=[_|_], NewIndent is Indent+2, % if a list, increase the indent
print(H,NewIndent), % NewIndent
print(T,Indent). % Indent
printelement(X,I):- indent(I), write(X), nl. % print individual elements
... and it does the job. On the other hand, the book presents a solution that does the job too but with a bit of going back and forth between two predicates as follows:
printA([H|T], I) :- !, J is I + 2, printA(H, J), printB(T, J), nl.
printA(X, I) :- indent(I), write(X), nl.
printB([],_).
printB([H|T], I) :- printA(H, I), printB(T, I).
There are a number of other exercises that are solved in a similar manner; and even though I can trace those solutions and validate their correctness, I am a bit confused by this approach. So, would you please help point out the differences between the above solutions? I find mine a bit more logical and straight-forward, and I don't quite get the second one!
If I had to pick between the two solutions, I actually prefer the first solution to the one in the textbook. At least I see no advantages to the second approach, and both solutions are a fairly imperative approach to Prolog. If you had a big enough list, you could do a performance comparison, if that was an important factor. Both have a somewhat awkward calling convention where you need to provide a second argument even though you don't care what it is, ultimately. The second solution has the two arbitrarily named predicates printA and printB that don't seem to have a distinguishable enough semantic meaning between them. You can call printA(MyList, 0). or printB(MyList, 0). and get (sort of) the same results (one having one extra level of indent).
Both printA/2 and print/2 treat [] as an atom rather than an empty list. Thus:
| ?- print([a,b,[],c], 0).
a
b
[]
c
And similarly for printA([a,b,[],c], 0).
If I were writing this, I would take a different approach altogether. First, I might write a predicate with 3 arguments: element_depth(List, X, D) that succeeds if X is in the multi-level list List at depth D and it fails otherwise.
element_depth(List, X, Depth) :-
element_depth(List, X, 0, Depth). % Starts with depth 0
element_depth([X|_], X, Depth, Depth) :-
\+ is_list(X).
element_depth([L|_], X, D, Depth) :-
is_list(L),
D1 #= D + 1,
element_depth(L, X, D1, Depth).
element_depth([_|Xs], X, D, Depth) :-
element_depth(Xs, X, D, Depth).
Now you have a Prolog predicate that behaves more like a predicate and less like a C function. You use it to make queries and it provides solutions. You can do queries such as:
| ?- element_depth([a,b,[d, []], c], X, D).
D = 0
X = a ? a
D = 0
X = b
D = 1
X = d
D = 0
X = c
no
| ?- element_depth([a,b,[d,[]], c], X, 1).
X = d ? ;
no
| ?- element_depth([a,b,[d,[]], c], c, D).
D = 0 ? ;
no
If you want to do a formatted printing of results, you can write a specific formatting predicate that calls it:
print_elements(L) :-
element_depth(L, X, D),
N #= D * 2,
indent(N),
write(X), nl,
fail.
Which you can then call like this:
| ?- print_elements([a,b,[d,[]], c]).
a
b
d
c
no
| ?-
This looks like a little more code, but it is more general and more Prology.

CLP(B) weighted sat_count/3 in Prolog

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

Prolog - summing up predicate results

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.

Implementing XOR function with Prolog CLPFD for 32-bit numbers

I try to implement efficient exclusive-or (XOR) in Prolog CLPFD. This should be simple predicate like:
xor(A, B, AxorB).
A, B, AxorB are natural numbers (with 0) and AxorB is a result of A xor B.
My main problem is with efficiency. Firstly, I wasn't able to find any way to XOR two number without breaking those numbers into separate parts that could be further processed/constrained, and the process of breaking those numbers (creating proper constraints and then resolving them) is taking some processing time. Secondly, I wans't able to come up with any efficient way to "simulate" XOR functions on natural numbers other than presented in the second code below.
Lets start from my first code. This is the most simple XOR implementation possible and it works only for 1 bit values (0 and 1):
xor_1bit_values(A, B, AxorB) :-
AxorB #= (A + B) mod 2.
To use it for numbers larger than 1, numbers must be broken into bits:
xor_number(A, B, Result, Bits) :-
Count is Bits - 1,
xor_number(A, B, Result, Count, 0).
xor_number(A, B, Result, 0, Sum) :-
xor_1bit_values(A, B, Xor),
Result #= Xor + Sum.
xor_number(A, B, Result, Count, Sum) :-
P is 2^Count,
X #= A / P,
Y #= B / P,
xor_1bit_values(X, Y, Tmp),
NewSum #= Sum + P*Tmp,
NewCount is Count - 1,
xor_number(A, B, Result, NewCount, NewSum).
Sample input and output:
?- time(xor_number(123456789, 987654321, R, 32)).
% 943 inferences, 0.000 CPU in 0.001 seconds (0% CPU, Infinite Lips)
R = 1032168868
Now, this is too slow for my purposes, as in my code I have sometimes need to guess A and B when I have AxorB where all of these should be 32-bit numbers. And for numbers that need more than 10 bits this goes into literal millions of inferences that seem to increase expotentially. And I use the best labeling strategies, XOR arguments swapping and other tricks to speed up calculations.
So, I tried to do some maths. What I devised is XOR function for 2-bit values (0, 1, 2, 3):
xor_2bit_values(A, B, Result) :-
Result #= ((A + B*((-1)^A)) mod 4).
To use it in numbers larger than 3 there is code similar to what I presented before:
xor_number2(A, B, Result, Bits) :-
Count is (Bits / 2) - 1,
xor_number2(A, B, Result, Count, 0).
xor_number2(A, B, Result, 0, Sum) :-
xor_2bit_values(A, B, Xor),
Result #= Xor + Sum,
!.
xor_number2(A, B, Result, Count, Sum) :-
P is 4^Count,
X #= A / P,
Y #= B / P,
xor_2bit_values(X, Y, Tmp),
NewSum #= Sum + P*Tmp,
NewCount is Count - 1,
xor_number2(A, B, Result, NewCount, NewSum).
This seems to work nearly 50% faster than the first code. But still, two-fold difference is still too small for me.
So, my question for you is this: how can I implement efficient XOR for 32-bit numbers? If this is not possible on modern machines and you can prove it by some sort of calcucation then it is also a nice answer to my question. Eventually, how can I best improve my code? Maybe you have some ideas how to deal with numbers without breaking them apart or how to XOR numbers in other way?
Additional info: If it happens to you to try my code to guess two from three arguments or XOR, then because of possibility to freely swap arguments of that functions (which comes from its mathematical properties) I recommend setting A as bound variable and B and AxorB as unbound. CLPFD seems to work fastest that way. Also, the best labeling strategy would be labeling([bisect], [B,AxorB].
I think I would try to precompute some table of 'bit chunks', and then, using modulo and division (both supported operations), would do N lookups into the table. The idea it's that a lookup could work faster than the (huge!) arithmetic expansion performed by the library. This is the usual 'trade space for time' trick.
/** <module> bits_clpfd
*
* naive implementation of basic bit operations on constrained variables
* --------
*
* source file /home/carlo/prolog/bits_clpfd.pl
* created at dom mag 18 07:57:03 2014
*
* #author carlo
* #version 0.9.9
* #copyright carlo
* #license LGPL v2.1
*/
:- module(bits_clpfd,
[bits_clpfd_prepare_lut/2
]).
:- use_module(library(clpfd)).
:- dynamic lut_and_or_xor/5.
:- dynamic chunk_size/2.
%% bits_clpfd_prepare_lut(Bits, Max) is det.
%
% setup the lookup table for basic most operations on constrained variables
% the cost is mainly controlled by Bits, being the LUT size 2^(Bits*2)
%
% #arg Bits how many bits to store
% #arg Max describe Max
%
bits_clpfd_prepare_lut(Bits, BMax) :-
( nonvar(Bits) ; Bits = 4 ),
( nonvar(BMax) ; BMax = 32 ),
retractall(chunk_size(_, _)),
Max is 1 << BMax,
assert(chunk_size(Bits, Max)),
retractall(lut_and_or_xor(_,_, _,_,_)),
N is (1 << Bits) - 1,
forall((between(0, N, A), between(0, N, B)), (
And is A /\ B,
Or is A \/ B,
Xor is A xor B,
assertz(lut_and_or_xor(A,B, And,Or,Xor))
)).
%% xor_clpfd(A, B, C) is nondet.
%
% naive constraint A xor B #= C
%
% #arg A constrained variable
% #arg B constrained variable
% #arg C constrained variable
%
xor_clpfd(A, B, C) :-
maplist(check_domain_range, [A,B,C]),
split_apply_xor(1, A, B, C).
split_apply_xor(L, A, B, C) :-
chunk_size(NBits, Max),
( L < Max
-> Mod is (2 << NBits),
Am #= A mod Mod,
Bm #= B mod Mod,
Cm #= C mod Mod,
lut_and_or_xor(Am, Bm, _, _, Cm),
Ad #= A / Mod,
Bd #= B / Mod,
Cd #= C / Mod,
M is L << NBits,
split_apply_xor(M, Ad, Bd, Cd)
; true
).
check_domain_range(V) :-
chunk_size(_, Max),
assertion((fd_dom(V, Inf .. Sup), Inf>=0, Sup < Max)).
:- begin_tests(bits_clpfd).
test(1) :-
bits_clpfd_prepare_lut(2, 4),
Vs = [A,B,C], Vs ins 0..15,
A #= 1, B #= 1, C #= 0,
xor_clpfd(A, B, C).
:- end_tests(bits_clpfd).
test
?- run_tests(bits_clpfd).
% PL-Unit: bits_clpfd
Warning: /home/carlo/prolog/bits_clpfd.pl:83:
PL-Unit: Test 1: Test succeeded with choicepoint
done
% test passed
true.
anyway, this is a naive approach, the right one should be to compile your own run_propagator/2. But I've never done it...
Maybe it wasn't available then but now, we can do this:
Y in 0..5, X #= Y xor 1, label([Y]).
From the docs, it's written that:
The bitwise operations ()/1, (/)/2, (/)/2, (>>)/2, (<<)/2, lsb/1, msb/1, popcount/1 and (xor)/2 are also supported.
See if you can adapt this for your purposes.

Resources