Cryptarithmetic puzzle (Prolog) - prolog

I was asked to write a Prolog code to solve the cryptarithmetic puzzle, using "generate and test". For example I get solve([R,O,B],[B,E,R,T],[N,O,R,E,S]) and I need to find an assign for the letters.
So I wrote this code:
sum(List1,List2,SumList) :-
append(List1,List2,List3),
append(List3,SumList,AllList),
assign([0,1,2,3,4,5,6,7,8,9],AllList),
add_zero(List1,List1Z),
add_zero(List2,List2Z),
add_zero(SumList,SumListZ),
name(Num1,List1Z),
name(Num2,List2Z),
name(SumNum,SumListZ),
SumNum is Num1+Num2,
!.
remove(X,[X|Xs],Xs).
remove(X,[_|Ys],Res) :-
remove(X,Ys,Res).
assign(Digits,[X|Tail]) :-
nonvar(X),
!,
assign(Digits,Tail).
assign(Digits,[X|Tail]) :-
remove(X,Digits,D1),
assign(D1,Tail).
assign(_,[]) :-
!.
add_zero([X|Tail1],[Y|Tail2]) :-
!,
Y is X+48,
add_zero(Tail1,Tail2).
add_zero([],[]) :-
!.
But I have a bug and I can't find it... can you help me?

The problem with your code is that in the second clause of remove/3 you are not keeping the item which is not removed.
It should read:
remove(X,[Y|Ys],[Y|Res]):-
remove(X,Ys,Res).
I tried your code with SEND + MORE = MONEY and it worked fine after fixing that procedure.
However it did not find a solution for ROB + BERT = NORES... According to this site, which has many solvers, your equation has no solution.

Related

List processing calculation in Prolog to find a destination friends will visit

I'm trying to write a predicate that calculates which destination a group of friends will visit.
The friends list their countries of preferences like this
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
I want to write a predicate called where that takes 2 arguments to perform the calculation.
The formula I have in mind is that the first country is worth 3 points, the second one is worth 2 points, and the last one is worth 1 point.
Here's an example of what I'm trying to achieve.
?- where([marie,jean,sasha,helena,emma],Country).
peru .
So far I have this
where([], X).
where([H|T], N) :- choice(H, [A|B]), where(T,N).
It lets me iterate through all the different friends and shows their choices but I can't iterate through the list of choices and assign points to the destinations.
How should I go about iterating through the list of choices for each friend and assigning points to calculate the best destination?
While this will solve your problem, I know it uses many predicates that you have not seen. So think of this an opportunity to excel and learn a lot.
Even if you don't understand it all, there is enough detail and intermediate results in the test that you should be able to navigate your way to a proper solution you create.
Also this is by no means efficient, it was just a quick proof of concept I did to see how this could be done.
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
destinations(Destinations) :-
findall(D1,choice(_,D1),D2),
flatten(D2,D3),
list_to_set(D3,Destinations).
init_weights(Destinations,Weights) :-
empty_assoc(Assoc),
init_weights(Destinations,Assoc,Weights).
init_weights([],Weights,Weights).
init_weights([H|T],Assoc0,Weights) :-
put_assoc(H,Assoc0,0,Assoc1),
init_weights(T,Assoc1,Weights).
update_weights([C1,C2,C3],Weights0,Weights) :-
del_assoc(C1,Weights0,Value0,Weights1),
Value1 is Value0 + 3,
put_assoc(C1,Weights1,Value1,Weights2),
del_assoc(C2,Weights2,Value2,Weights3),
Value3 is Value2 + 2,
put_assoc(C2,Weights3,Value3,Weights4),
del_assoc(C3,Weights4,Value4,Weights5),
Value5 is Value4 + 1,
put_assoc(C3,Weights5,Value5,Weights).
person_weight(Person,Weights0,Weights) :-
choice(Person,[C1,C2,C3]),
update_weights([C1,C2,C3],Weights0,Weights).
people(People) :-
findall(Person,choice(Person,_),People).
choice(Destination) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
people(People),
update_choices(People,Weights0,Weights1),
cross_ref_assoc(Weights1,Weights),
max_assoc(Weights, _, Destination),
true.
cross_ref_assoc(Assoc0,Assoc) :-
assoc_to_list(Assoc0,List0),
maplist(key_reverse,List0,List),
list_to_assoc(List,Assoc).
key_reverse(Key-Value,Value-Key).
update_choices([],Weights,Weights).
update_choices([Person|People],Weights0,Weights) :-
person_weight(Person,Weights0,Weights1),
update_choices(People,Weights1,Weights).
Tests
:- begin_tests(destination).
test(destinations) :-
destinations([peru, greece, vietnam]).
test(init_weights) :-
destinations(Destinations),
init_weights(Destinations,Weights),
assoc_to_list(Weights,[greece-0, peru-0, vietnam-0]).
test(update_weights) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
update_weights([peru,greece,vietnam],Weights0,Weights),
assoc_to_list(Weights,[greece-2,peru-3,vietnam-1]).
test(person_weight) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
person_weight(jean,Weights0,Weights),
assoc_to_list(Weights,[greece-3,peru-2,vietnam-1]).
test(people) :-
people([marie,jean,sasha,helena,emma]).
test(update_choices) :-
destinations(Destinations),
init_weights(Destinations,Weights0),
people(People),
update_choices(People,Weights0,Weights),
assoc_to_list(Weights,[greece-10,peru-12,vietnam-8]).
test(cross_ref_assoc) :-
List0 = [1-a,2-b,3-c],
list_to_assoc(List0,Assoc0),
cross_ref_assoc(Assoc0,Assoc),
assoc_to_list(Assoc,[a-1,b-2,c-3]).
test(choice) :-
choice(peru).
:- end_tests(destination).
As suggested by GuyCoder, you need an accumulator to sum each person preferences, and foldl/N allows to does exactly this.
choice(marie, [peru,greece,vietnam]).
choice(jean, [greece,peru,vietnam]).
choice(sasha, [vietnam,peru,greece]).
choice(helena,[peru,vietnam,greece]).
choice(emma, [greece,peru,vietnam]).
where(People,Where) :-
foldl([Person,State,Updated]>>(choice(Person,C),update(State,C,Updated)),
People,
[0=greece,0=peru,0=vietnam],
Pref),
aggregate(max(S,S=W),member(S=W,Pref),max(_,_=Where)).
% sort(Pref,Sorted),
% last(Sorted,_=Where).
update(S0,[A,B,C],S3) :-
update(S0,3,A,S1),
update(S1,2,B,S2),
update(S2,1,C,S3).
update(L,V,C,U) :-
append(X,[Y=C|Z],L),
P is Y+V,
append(X,[P=C|Z],U).
I have left commented the last two goals replaced by the single goal aggregate/3, so you can try to understand the syntax...

Skip/pass non-standard prolog code

I'm developing under SWI-Prolog, but my target is Erlog (https://github.com/rvirding/erlog). I need a way to use non-standard Prolog syntax.
Is there a way to write prolog code that will be disregarded by the SWI-compiler i.e. make it invisible.
Here is example how does it look like :
do_stuff(G,Amt) :- ecall(erlog_demo:efunc('Elixir.Blah':stuff({G,Amt})).
I was thinking if there is a way for SWI to skip that and I have another declaration that does nothing.
do_stuff(_,_).
One option probably is to comment it and then use parser to remove the comment before running in Erlog, but this seem cumbersome.
Any other ideas.
======
is_dialect(swi) :- catch(current_prolog_flag(dialect, swi), _, fail).
:- if(is_dialect(swi)).
do_stuff(_,_).
:- else.
do_stuff(G,Amt) :- ecall(erlog_demo:efunc('Elixir.Blah':stuff({G,Amt})).
:- endif.
Syntax error: Operator expected
I use this idiom to keep code running in different implementations
:- if(swi).
gen_hash_lin_probe(Key, HashTable, Value) :-
arg(_, HashTable, E),
nonvar(E),
E = Key-Value.
:- elif(yap).
gen_hash_lin_probe(Key, HashTable, Value) :-
HashTable =.. [htlp|Args],
nth1(_, Args, E),
nonvar(E),
E = Key-Value.
:- endif.
where predicates swi/0 or yap/0 are imported from this module(prolog_impl)
:- module(prolog_impl, [swi/0, yap/0, prolog_impl/1]).
swi :- prolog_impl(swi).
yap :- prolog_impl(yap).
prolog_impl(K) :-
F =.. [K,_,_,_,_],
current_prolog_flag(version_data, F).
One closing parenthesis is missing in the "else" branch.
do_stuff(G,Amt) :- ecall(erlog_demo:efunc('Elixir.Blah':stuff({G,Amt})). % BAD
do_stuff(G,Amt) :- ecall(erlog_demo:efunc('Elixir.Blah':stuff({G,Amt}))). % OK!
Simply count the number of opening parentheses. When . (period, full-step) is reached the difference count of opening vs closing must amount to exactly zero.
Hope that helps!
This answer is based, in part, on
#Capelli's answer and your comments on his candidate solution.
We propose a different way. Follow the dots step-by-step...
For a start, we take the following simplified and shortened snippet.
:- if(true). p(3).
:- elif(false). p(4+3).
:- endif.
In above sample we can see that the "else" branch is never taken, ever.
So... could we, in principle, put arbitrary text and binary data there?
:- if(true). p(3).
:- elif(false). p (4);;[ p())
:- endif.
нет! Upon (re-)loading, we get: ⚠ Syntax error: Operator expected
TIL that all sections between elif and endif must be valid Prolog text.
Let's try something different which was inspired by that phrases you used, in particular: "[...] use non-standard Prolog syntax [...] code that will be disregarded [...] make it invisible [...]"
To me, the phrase "non-standard syntax" indicates that new operator(s) might be introduced (or old ones redefined):
:- op(500,xfx,=>).
:- if(true). p(2).
:- elif(false). p(3 => 3).
:- endif.
Consider the following variation:
:- if(true). p(2).
:- elif(false). :- op(500,xfx,=>). % is moving the `op/3` here ok?
p(3 => 3).
:- endif.
нет! Upon (re-)loading, we get: ⚠ Unterminated conditional compilation from [...]
There is another way! We can proceed by inserting a special-purpose end_of_file fact to tell the Prolog text reader to disregard everything after end_of_file.
We use it like this:
% snip_at_end.pl
xxx1.
xxx2.
end_of_file.
xxx3.
:- op (500, xfx,eat). % broken syntax (pt.1)
1 ]][[ v % broken syntax (pt.2)
Simple test using SICStus Prolog:
$ sicstus
SICStus 4.3.2 (x86_64-linux-glibc2.12): Fri May 8 01:05:09 PDT 2015
[... License information ...]
| ?- compile(snip_at_end).
% compiling /home/stefan/prolog/snip_at_end.pl...
% compiled /home/stefan/prolog/snip_at_end.pl in module user, 40 msec 400672 bytes
yes
| ?- xxx1.
yes
| ?- xxx2.
yes
| ?- xxx3.
! Existence error in user:xxx3/0
! procedure user:xxx3/0 does not exist
! goal: user:xxx3
Hope this helps! I'm curious / interested if my answer fits your problem:)

Re-assigning variables for cryptarithmetic puzzle in Prolog

I'm using Prolog to solve generic cryptarithmetic puzzles for a homework assignment. I'll talk about this in the context of SEND + MORE = MONEY.
The partial code that my professor gave me reduces the 3 input lists, i.e. [S,E,N,D], [M,O,R,E], [M,O,N,E,Y], to a unique variable list, i.e [S,E,N,D,M,O,R,Y]. I've gotten it to a point where I recursively assign a unique value between 0 and 9 to each variable in the reduced list.
My question is, how do I then reassign the values in the reduced list to the values in each of the 3 input lists? My code is as follows:
solve_expression(L1,L2,L3) :-
variables(L1,L2,L3,L),
bind(L).
bind(L) :-
assign_members(L,[0,1,2,3,4,5,6,7,8,9]),
is_unique(L).
assign_members([],L) :-
is_unique(L).
assign_members([H|T],L) :-
member(H,L),
assign_members(T,L).
is_unique([H|T]) :-
unique(H,T),
is_unique(T).
is_unique([]).
/** professor's code below */
unique(_,[]).
unique(X,[Y|Z]) :-
X \== Y,
unique(X,Z).
merge([],L,L).
merge([X|Y],Z,[X|L]) :-
unique(X,Z),
!,
merge(Y,Z,L).
merge([_|Y],Z,L) :-
merge(Y,Z,L).
variables(A,B,C,V) :-
merge(A,B,W),
merge(C,W,V).
Keep in mind this is for a homework assignment, so I am not looking for the answer, just a hint as to how I may accomplish this. Also, I've only been using Prolog for about a week.
Thank you!

how can I print items in a list one by one

I have my answers in a list by findall and the list is called answers.
Now answers can have 0 , 1 or more items.
0 answer I can solve with display_answers([]).
1 answer I can solve with display_answer ([X]).
Can I do more then 1 display_answer([X|X]) and then use foreach to print all the answers ?
Or is there a better way ?
Roelof
Edit1 :
I tried this:
% Displays the output of siblings(X,Y) and takes care that
% there are no duplicates.
display_siblings(Person) :-
findall(Person-Y, siblings(Person,Y), Sibs),
display_the_siblings(Sibs).
% Display a message if there are no siblings found.
display_the_siblings([]) :-
write('Er zijn geen zussen/broers bekend').
% Displays a message if one sibling is found.
display_the_siblings([X-Y]) :-
write('The enigste broer of zuster is '),
write(Y).
% Display a message if there are more then 1 siblings found.
display_the_siblings([[X-Y|X-Y]) :-
write('Alle zusterparen zijn : \n'),
But if I use recursion then when Sibs is one then the wrong predicate is used.
So the question is still what do I take as parameters to make the last predicate work.
I have in my ~/.plrc (the SWI-Prolog basic configuration file on Linux) this definition
setln(Pattern, Goal) :-
setof(Pattern, Goal, List), maplist(writeln, List).
that just allows a sorted display of solutions, in case I need it... for instance
?- setln(M, current_module(M)).
ansi_term
apply
arithmetic
base32
...
My prolog is kinda rusty, but in general you do this with recursion on the list using the [Head|Tail]. Something like:
display_answer([]) :- !.
display_answer( [Head|Tail] ) :-
print( Head ),
display_answer( Tail ).
Hope it helps. Have fun...

prolog question find maximum using negation operator \+

I have got some values H, and I would like to find the maximum one using \+, how can i do it?
maxValue(X) :-
Get(Id, X),
\+( Get(Id, Y), X < Y ).
don't have a clue....please help, thanks!
Using negation is one way to find the maximum. And it really works.
Here is an example:
p(2).
p(1).
p(3).
?- p(X), \+ (p(Y), Y > X).
X = 3
But the complexity will be O(n*n) where n is
the number of facts. But the maximum can be
determined in O(n). So maybe the following is
more efficient for large fact bases:
:- dynamic(the_max/1).
update_max(X) :-
the_max(Y), X>Y, !, retract(the_max(Y)), assertz(the_max(X)).
update_max(_).
find_max(X) :-
assertz(the_max(0)),
(p(Y), update_max(Y), fail; true),
retract(the_max(X)).
?- find_max(X).
X = 3
But watch out, when you use it from multiple threads,
you need to adapt it a little, i.e. make the_max
thread local.
Best Regards
See also these questions/answers:
Prolog query to find largest element in database?
Max out of values defined by prolog clauses

Resources