Related
I recently found a small game on the Google Play app store called Cryptogram. There are dozens of apps similar to this one. The idea is to match the number to the colors such that all of the equations sound true.
I was able to get through problems 1-8 and problem 10 fairly quickly by hand, but problem 9 has proven to be more difficult for me.
Problem 9
After some time tinkering and guessing, I gave up and decided to program a solution. I have used Prolog/Datalog for some small tasks as an undergrad as well as some Project Euler problems. Previously I had seen the 15 line Sudoku solver that uses Prolog's Constraint Logic Programming over Finite Domains (clpfd) library, and I decided to give it a go myself. I'm using SWI-Prolog.
:- use_module(library(clpfd)).
problem(Colors) :-
Colors = [Pink, Cyan, Yellow, Green, Purple, Red, Brown, White, Lime],
Colors ins 0..9,
all_distinct(Colors),
% The leading digit of a number can't be 0
Pink #\= 0,
Red #\= 0,
White #\= 0,
Green #\= 0,
Lime #\= 0,
Cyan #\= 0,
% I originally tried to write a predicate generalizing numbers and a list of digits
% but got in way over my head with CLPFD.
Number1_1 #= (Pink * 1000) + (Cyan * 100) + (Pink * 10) + Yellow,
Number1_2 #= (Green * 10) + Purple,
Number1_3 #= (Cyan * 100) + (Red * 10) + Purple,
Number2_1 #= (Red * 1000) + (Brown * 100) + (White * 10) + Red,
Number2_2 #= (Lime * 10) + Yellow,
Number2_3 #= (Red * 1000) + (Lime * 100) + (Purple * 10) + Pink,
Number3_1 #= (White * 1000) + (Purple * 100) + (Cyan * 10) + White,
Number3_2 #= (Green * 1000) + (Cyan * 100) + (Yellow * 10) + Purple,
Number3_3 #= (Cyan * 1000) + (Red * 100) + (Yellow * 10) + Red,
% I'm not 100% sure whether to use floored or truncated division here.
% I thought the difference would be a float vs integer output,
% but that doesn't make sense with finite domains.
Number1_1 // Number1_2 #= Number1_3,
Number1_1 rem Number1_2 #= 0,
Number2_3 #= Number2_1 + Number2_2,
Number3_3 #= Number3_1 - Number3_2,
Number3_1 #= Number1_1 - Number2_1,
Number3_2 #= Number1_2 * Number2_2,
Number3_3 #= Number1_3 + Number2_3.
The output when I run this query in SWI-Prolog makes me feel like I'm misunderstanding a big concept in CLPFD:
?- problem([Pink, Cyan, Yellow, Green, Purple, Red, Brown, White, Lime]).
Pink in 3..9,
_7756#=Pink+10*Purple+1000*Red+100*Lime,
_7810#=1010*Pink+100*Cyan+Yellow,
all_distinct([Pink, Cyan, Yellow, Green, Purple, Red, Brown, White|...]),
Cyan in 1..7,
_7946#=1000*Cyan+10*Yellow+101*Red,
_7994#=100*Cyan+10*Yellow+1000*Green+Purple,
_8048#=10*Cyan+100*Purple+1001*White,
_8096#=100*Cyan+Purple+10*Red,
Yellow in 0..9,
_8162#=Yellow+10*Lime,
Green in 1..7,
_8216#=10*Green+Purple,
Purple in 0..9,
Red in 1..7,
_8294#=1001*Red+100*Brown+10*White,
Brown in 0..9,
White in 2..8,
Lime in 1..9,
_7756 in 1103..7568,
_8096+_7756#=_7946,
_8294+_8162#=_7756,
_8096 in 110..779,
_7810//_8216#=_8096,
_7810 in 3334..9799,
_8048+_8294#=_7810,
_7810 rem _8216#=0,
_8048 in 2313..8778,
_7946+_7994#=_8048,
_7946 in 1213..7678,
_7994 in 1100..7565,
_8216*_8162#=_7994,
_8216 in 12..79,
_8162 in 14..99,
_8294 in 1021..7486.
I would expect each color in the color list to bind to a single distinct integer in the range 0..9, but that's not what's happening. Can you help me find the solution to this problem?
EDIT
So I picked an arbitrary color and started assigning it numbers in the range that the constraint says should be valid. I ran this query with Cyan bound to 1.
?- problem([Pink, 1, Yellow, Green, Purple, Red, Brown, White, Lime]).
false.
Which doesn't make sense. The previous "output" says "Cyan in 1..7", which I thought meant that any value in that range is valid. However, if I pick another arbitrary value for Cyan:
?- problem([Pink, 2, Yellow, Green, Purple, Red, Brown, White, Lime]).
Pink = 7,
Yellow = 6,
Green = 3,
Purple = 4,
Red = 1,
Brown = 8,
White = 5,
Lime = 9.
I get the answer I was looking for. Though the Cryptogram is solved, I still don't understand why Prolog's CLPFD library didn't find it completely independently.
EDIT 2
I used your suggestions to clean up the code. I also reintroduced the predicate which relates digits to numbers. This code chunk works perfectly.
:- use_module(library(clpfd)).
digit_number(0, [], 1).
digit_number(Number, [Digit|Tail], DigitPlace) :-
digit_number(NextNumber, Tail, NextDigitPlace),
DigitPlace #= NextDigitPlace * 10,
PlaceNumber #= Digit * (NextDigitPlace),
Number #= PlaceNumber + NextNumber.
digit_number(Number, ColorList) :-
digit_number(Number, ColorList, _).
problem(Colors) :-
Colors = [Pink, Cyan, Yellow, Green, Purple, Red, Brown, White, Lime],
Colors ins 0..9,
all_distinct(Colors),
digit_number(Number1_1, [Pink, Cyan, Pink, Yellow]),
digit_number(Number1_2, [Green, Purple]),
digit_number(Number1_3, [Cyan, Red, Purple]),
digit_number(Number2_1, [Red, Brown, White, Red]),
digit_number(Number2_2, [Lime, Yellow]),
digit_number(Number2_3, [Red, Lime, Purple, Pink]),
digit_number(Number3_1, [White, Purple, Cyan, White]),
digit_number(Number3_2, [Green, Cyan, Yellow, Purple]),
digit_number(Number3_3, [Cyan, Red, Yellow, Red]),
Number1_1 // Number1_2 #= Number1_3,
Number1_1 rem Number1_2 #= 0,
Number2_1 + Number2_2 #= Number2_3,
Number3_1 - Number3_2 #= Number3_3,
Number1_1 - Number2_1 #= Number3_1,
Number1_2 * Number2_2 #= Number3_2,
Number1_3 + Number2_3 #= Number3_3,
label(Colors).
Your code works, just add label(C) :
?- problem(C), label(C).
C = [7, 2, 6, 3, 4, 1, 8, 5, 9] .
The other answer shows you one way of getting the result you want, but I would like to answer some of your questions.
I still don't understand why Prolog's CLPFD library didn't find it completely independently.
Prolog is a more-or-less declarative programming language, but (although we like to pretend, for propaganda reasons) you cannot just write down anything that is logically equivalent to your problem and expect it to be executed correctly and efficiently. In particular, the order of execution of different goals matters a lot, even though it should make no logical difference. This is especially true for arithmetic. Consider:
?- between(1, 99999999, N), N > 99999998.
N = 99999999. % correct but slooooow
?- N > 99999998, between(1, 99999999, N).
ERROR: >/2: Arguments are not sufficiently instantiated
Doing the same with CLP(FD) works much more nicely:
?- N in 1..99999999, N #> 99999998.
N = 99999999. % correct and fast!
?- N #> 99999998, N in 1..99999999.
N = 99999999. % also correct, also fast!
CLP(FD) allows you to write programs that are more correct, more declarative, and that can often be more efficient than other solutions, unless you hand-optimize them.
To achieve this, unlike normal Prolog, CLP(FD) separates the collection of constraints from the actual search for solutions. As your program goes along and creates constraints, CLP(FD) will make some simplifications, like in your example where it determines Cyan in 1..7 on its own, or in my example above where it can find the unique solution immediately. But in general, these simplifications do not solve the problem completely.
One reason for this is, simply, performance: Search can be slow. It can be faster if more constraints are known, because new constraints on already constrainted variables can only make the search space smaller, but never bigger! It makes sense to delay it until concrete answers are actually needed.
For this reason, to actually get concrete resuls, you need to call a labeling predicate that systematically enumerates solutions. In SWI-Prolog, simple ones are indomain/1 and label/1; a general one is labeling/2. This latter one even allows you to influence the search space exploration strategy, which can be useful if you have some understanding of the problem domain.
The previous "output" says "Cyan in 1..7", which I thought meant that any value in that range is valid.
Not quite: It means that if there is a valid solution for Cyan, then it is in the range 1 to 7. It doesn't give a guarantee that all values in that range are solutions. For example:
?- X in 1..5, Y in 1..5, X #< Y.
X in 1..4,
X#=<Y+ -1,
Y in 2..5.
3 is in the range 1..4, and 3 is in the range 2..5, so purely based on this we might expect a solution with X = 3 and Y = 3. But that is impossible due to the additional constraint. Only labeling will actually give you answers that are guaranteed solutions, and only if you label all the variables in the query.
See also the very nice answer here: https://stackoverflow.com/a/27218564/4391743
Edit:
% I'm not 100% sure whether to use floored or truncated division here.
% I thought the difference would be a float vs integer output,
% but that doesn't make sense with finite domains.
Number1_1 // Number1_2 #= Number1_3,
Indeed fractional division doesn't make sense here, but Prolog would have told you:
?- X in 1..5, Y in 1..5, Z #= X // Y.
X in 1..5,
X//Y#=Z,
Y in 1..5,
Z in 0..5.
?- X in 1..5, Y in 1..5, Z #= X / Y.
ERROR: Domain error: `clpfd_expression' expected, found `_G6388/_G6412'
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
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 predicate which returns true if S is equal to some equation say K + 2N + 3L = S. The money we have are 1, 5, and 10 respectively for K, N, L.
I don't want to use :- use_module(library(clpfd)), I want to solve this without it.
My intuition was to break this into subproblems like write a function breakMoney1(S,K) :- K is S. and create more helpers with one more parameter added however I am struggling with the problem of getting uninstantiated variables, when I compare.
breakMoney(S,K,N,L) :-
This is easier than you think, probably. A very naive solution following #Will Ness' suggestion would be:
break(Sum, K, N, L) :- integer(Sum), Sum >= 0,
% upper bounds for K, N, and L
K_Max is Sum div 1,
N_Max is Sum div 5,
L_Max is Sum div 10,
% enumerate possible values for K, N, and L
between(0, L_Max, L),
between(0, N_Max, N),
between(0, K_Max, K),
Sum =:= K + 5*N + 10*L.
This will "magically" turn into a clp(fd) solution with very little effort: for example, replace between with X in 0..Max, and the =:= with #=. Although, it should be enough to simply say that X #>= 0 for each of the denominations. It is a good exercise to see how much of the constraints you can remove and still get an answer:
break(Sum, K, N, L) :-
K #>= 0, N #>= 0, L #>= 0,
Sum #= K + 5*N + 10*L.
Depending on how you instantiate the arguments, you might immediately get a unique answer, or you might need to use label/1:
?- break(100, P, 8, 5).
P = 10.
?- break(10, K, N, L).
K in 0..10,
-1*K+ -5*N+ -10*L#= -10,
N in 0..2,
L in 0..1.
?- break(10, K, N, L), label([K, N, L]).
K = N, N = 0,
L = 1 ;
K = L, L = 0,
N = 2 ;
K = 5,
N = 1,
L = 0 ;
K = 10,
N = L, L = 0.
But as #lurker has pointed out, there is very little reason not to use constraint programming for this problem. Unless, of course, you have a very clever algorithm for solving this particular problem and you know for a fact that it will outsmart the generic clp(fd) solution. Even then, it might be possible to achieve the same effect by using the options to labelling/2.
Prolog is new to me. I'm trying to understand this code. If anyone could explain it step by step in child language that would be a great help ;) thankyou!
divide_by(X,D,I,R) :-
X < D,
I is 0,
R is X.
divide_by(X,D,I,R) :-
X >= D,
Q is X - D,
divide_by(Q, D, S, R),
I is S +1.
Well, I can't. You are asking the wrong question. The right question would be:
What relation does the predicate describe?
Actually, that is quite difficult to answer, as we would have go through it step-by-step. But there is a better and much cleaner way! As your program uses integers only, we can map the moded relations (<)/2, (is)/2 and the like to their declarative counterparts in CLP(FD). So I change < to #<, is to #=, >= to #>=.
:- use_module(library(clpfd)).
divide_by(X,D,I,R):-
X #< D, I #= 0, R #= X.
divide_by(X,D,I,R):-
X #>= D, Q #= X - D,
I #= S +1,
divide_by(Q, D, S, R).
The big advantage now is that I can ask Prolog what it thinks the relation is describing. Simply ask: (Don't worry about the Q=Q, it's just to reorder variables)
N ... dividend
D ... divisor
Q ... quotient
R ... remainder
?- Q=Q, divide_by(N,D,Q,R).
Q = 0, N = R, N#=<D+ -1
This answer reads as follows: The quotient is zero, the dividend and remainder is the same and the remainder is less than the divisor. So this describes all situations where 0 is the "result" or quotient.
Next answer:
; Q = 1, R+D#=N, R#=<D+ -1, N#>=D
The quotient is 1 and the dividend is the divisor plus remainder, and — as in all answers — the remainder is less than the divisor
; Q = 2, _A+D#=N, R+D#=_A, R#=<D+ -1, N#>=D, _A#>=D
This answer is the same as R+D+D#= N. The system has introduced some extra variables. Not wrong, but a bit clumsy to read.
; Q = 3, _A+D#=N, _B+D#=_A, R+D#=_B, R#=<D+ -1, N#>=D, _A#>=D, _B#>=D
; Q = 4, _A+D#=N, _B+D#=_A, _C+D#=_B, R+D#=_C, R#=<D+ -1,
N#>=D, _A#>=D, _B#>=D, _C#>=D
; ... .
And so on. Let me summarize. All answers look like that:
N#>=D, R#< D, R+D+...+D#= N
^^^^^^^ Q times
or even better:
N#>=D, R #< D, R+Q*D #= N, Q #>= 0.
So what we have answered is what this relation is describing.
When you start Prolog, focus on the declarative side. As what (set/relation) a predicate describes. The procedural side will join without any effort later on.
The first rule is called the base case. It will terminate the recursion.
divide_by(X,D,I,R):-
X < D, % this rule apply only if numerically X is < D
I is 0, % will fail if I \= 0
R is X. % if I = 0 assign expression X to R
This other it's the recursive step.
divide_by(X,D, I, R):-
X >= D, % this rule apply only if X is >= D
Q is X - D, % evaluate Q
divide_by(Q, D, S, R), % recursive call. Q & D are surely instantiated
I is S + 1. % evaluate I as S + 1
So, I would say: it will compute the integer division of X by D, with remainder R, when called in mode divide_by(+,+,-,-), that is with first two arguments bound to integers and the last two free.
Anyway, false' answer is very good, as show a possible way to reason about arithmetic that is not available in 'common' programming languages.