I started to learn Prolog and I can't solve a difficult task for me.
On Halloween, three friends - Bob, Mark, Alex, chose the costumes of three ghosts: a ghost, a zombie, a werewolf. It is known that:
Bob is the tallest.
The one who chose the werewolf costume is shorter than the one who chose the ghost costume.
Alex didn't fit the werewolf costume.
None of the friends have the same name as the Halloween character from the selected costumes.
Which costume did each of the friends choose?
I solved the problem mathematically, but it is impossible to describe its solution in Prolog.
(the previous versions of this answer suffered from the "premature implementation syndrome". Here's another take on it)
I started to learn Prolog and I can't solve a difficult task for me. [...] it is impossible to describe its solution in Prolog.
Nah! :) If we can say it in English we can say it in Prolog:
task( Sol) :-
On Halloween, three friends - Bob, Mark, Alex, chose the costumes of three ghosts: a ghost, a zombie, a werewolf.
Sol = [bob-C1, mark-C2, alex-C3],
permutation( [ghost, zombie, werewolf], [C1,C2,C3]),
It is known that:
Bob is the tallest.
select( bob-_, Sol, ShorterOnes),
The one who chose the werewolf costume is shorter than the one who chose the ghost costume.
member( _-werewolf, ShorterOnes),
Alex didn't fit the werewolf costume.
C3 \= werewolf,
None of the friends have the same name as the Halloween character from the selected costumes.
Apparently, there is one Bob the Ghost, so
C1 \= ghost,
Which costume did each of the friends choose?
true. % nothing more to say
So we were able to describe the problem in Prolog, after all.
Having described the problem properly, we already have our program to find the solution.
Testing:
13 ?- task(X).
X = [bob-zombie, mark-werewolf, alex-ghost] ;
false.
This can be written a tiny bit shorter if we realize that selecting bob as the tallest
select( bob-_, Sol, ShorterOnes),
member( _-werewolf, ShorterOnes),
leaves us with mark and alex as the shorter ones:
task( [bob-C1, mark-C2, alex-C3]) :-
permutation( [ghost, zombie, werewolf], [C1,C2,C3]),
member( werewolf, [C2, C3]),
C3 \= werewolf,
C1 \= ghost.
Glancing at this short code for a minute, we realize that it can be further simplified to
task( [bob-C1, mark-C2, alex-C3]) :-
permutation( [ghost, zombie, werewolf], [C1,C2,C3]),
( werewolf = C2 ; werewolf = C3 ),
C3 \= werewolf,
C1 \= ghost.
and this to
task( [bob-C1, mark-C2, alex-C3]) :-
permutation( [ghost, zombie, werewolf], [C1,C2,C3]),
werewolf = C2,
C1 \= ghost.
and this to
task( [bob-C1, mark-werewolf, alex-C3]) :-
permutation( [ghost, zombie], [C1,C3]),
C1 \= ghost.
and this to
task( [bob-zombie, mark-werewolf, alex-ghost]).
And this version we don't even need to run.
Here is a solution using clpb .
:- use_module(library(clpb)).
solve :-
/* Alex is wearing one of the following costumes */
sat(card([1], [Alex * GhostA , Alex * ZombieA , Alex * WerewolfA])),
/* Bob is wearing one of the following costumes */
sat(card([1], [Bob * GhostB , Bob * ZombieB , Bob * WerewolfB])),
/* Mark is wearing one of the following costumes */
sat(card([1], [Mark * GhostM , Mark * ZombieM , Mark * WerewolfM])),
/* Alex wears only one of the following costumes */
sat(card([1], [GhostA, ZombieA, WerewolfA])),
/* Bob wears only one of the following costumes */
sat(card([1], [GhostB, ZombieB, WerewolfB])),
/* Mark wears only one of the following costumes */
sat(card([1], [GhostM, ZombieM, WerewolfM])),
/* There is only one ghost costume */
sat(card([1], [GhostA, GhostB, GhostM])),
/* There is only one zombie costume */
sat(card([1], [ZombieA, ZombieB, ZombieM])),
/* There is only one werewolf costume */
sat(card([1], [WerewolfA, WerewolfB, WerewolfM])),
/* Alex didn't fit the werewolf costume. */
sat(Alex * ~WerewolfA),
/* Bob can't wear the ghost costume. */
sat(Bob * ~GhostB),
/* Bob is the tallest */
sat(BobHigherA * ~AlexHigherB),
sat(BobHigherM * ~MarkHigherB),
/* For Alex and Mark we don't know */
sat(AlexHigherM * ~MarkHigherA + ~AlexHigherM * MarkHigherA ),
/* The one who chose the werewolf costume is shorter than the one who chose the ghost costume. */
sat((WerewolfB * GhostA) =< (BobHigherA < AlexHigherB)),
sat((WerewolfB * GhostM) =< (BobHigherM < MarkHigherB)),
sat((WerewolfA * GhostB) =< (AlexHigherB < BobHigherA)),
sat((WerewolfA * GhostM) =< (AlexHigherM < MarkHigherA)),
sat((WerewolfM * GhostB) =< (MarkHigherB < BobHigherM)),
sat((WerewolfM * GhostA) =< (MarkHigherA < AlexHigherM)),
/* We solve the puzzle */
labeling([GhostA, ZombieA, WerewolfA, GhostB, ZombieB, WerewolfB, GhostM, ZombieM, WerewolfM]),
writef('Alex => Ghost %d Zombie %d Werewolf %d\n', [GhostA, ZombieA, WerewolfA]),
writef('Bob => Ghost %d Zombie %d Werewolf %d\n', [GhostB, ZombieB, WerewolfB]),
writef('Mark => Ghost %d Zombie %d Werewolf %d\n', [GhostM, ZombieM, WerewolfM]).
The answer is
?- solve.
Alex => Ghost 1 Zombie 0 Werewolf 0
Bob => Ghost 0 Zombie 1 Werewolf 0
Mark => Ghost 0 Zombie 0 Werewolf 1
true.
[EDIT] After a search on the internet, I found these Halloween characters: Bob the ghost, Alex the werewolf and Mark the Zombie. So there is no need of the fact that "Alex didn't fit the werewolf costume."
We get now :
:- use_module(library(clpb)).
solve :-
/* Alex is wearing one of the following costumes */
sat(card([1], [Alex * GhostA , Alex * ZombieA , Alex * WerewolfA])),
/* Bob is wearing one of the following costumes */
sat(card([1], [Bob * GhostB , Bob * ZombieB , Bob * WerewolfB])),
/* Mark is wearing one of the following costumes */
sat(card([1], [Mark * GhostM , Mark * ZombieM , Mark * WerewolfM])),
/* Alex wears only one of the following costumes */
sat(card([1], [GhostA, ZombieA, WerewolfA])),
/* Bob wears only one of the following costumes */
sat(card([1], [GhostB, ZombieB, WerewolfB])),
/* Mark wears only one of the following costumes */
sat(card([1], [GhostM, ZombieM, WerewolfM])),
/* There is only one ghost costume */
sat(card([1], [GhostA, GhostB, GhostM])),
/* There is only one zombie costume */
sat(card([1], [ZombieA, ZombieB, ZombieM])),
/* There is only one werewolf costume */
sat(card([1], [WerewolfA, WerewolfB, WerewolfM])),
/* Alex can't wear the zombie costume. */
sat(Alex * ~ZombieA),
/* Bob can't wear the ghost costume. */
sat(Bob * ~GhostB),
/* Mark can't wear the werewolf costume. */
sat(Mark * ~WerewolfM),
/* Bob is the tallest */
sat(BobHigherAlex * ~AlexHigherBob),
sat(BobHigherMark * ~MarkHigherBob),
/* For Alex and Mark we don't know */
sat(AlexHigherMark * ~MarkHigherAlex + ~AlexHigherMark * MarkHigherAlex ),
/* The one who chose the werewolf costume is shorter than the one who chose the ghost costume. */
sat((WerewolfB * GhostA) =< (BobHigherAlex < AlexHigherBob)),
sat((WerewolfB * GhostM) =< (BobHigherMark < MarkHigherBob)),
sat((WerewolfA * GhostB) =< (AlexHigherBob < BobHigherAlex)),
sat((WerewolfA * GhostM) =< (AlexHigherMark < MarkHigherAlex)),
sat((WerewolfM * GhostB) =< (MarkHigherBob < BobHigherMark)),
sat((WerewolfM * GhostA) =< (MarkHigherAlex < AlexHigherMark)),
/* We solve the puzzle */
labeling([GhostA, ZombieA, WerewolfA, GhostB, ZombieB, WerewolfB, GhostM, ZombieM, WerewolfM]),
writef('Alex => Ghost %d Zombie %d Werewolf %d\n', [GhostA, ZombieA, WerewolfA]),
writef('Bob => Ghost %d Zombie %d Werewolf %d\n', [GhostB, ZombieB, WerewolfB]),
writef('Mark => Ghost %d Zombie %d Werewolf %d\n', [GhostM, ZombieM, WerewolfM]).
And the solution is now
?- solve.
Alex => Ghost 0 Zombie 0 Werewolf 1
Bob => Ghost 0 Zombie 1 Werewolf 0
Mark => Ghost 1 Zombie 0 Werewolf 0
true.
Using dif:
go(Sol) :-
Sol = [bob-Bob, mark-Mark, alex-Alex],
% werewolf is not tallest (Bob)
dif(Bob, werewolf),
dif(Alex, werewolf),
% Not usual names
dif(Bob, ghost),
permutation([Bob, Mark, Alex], [ghost, zombie, werewolf]).
Result in swi-prolog:
?- go(Sol).
Sol = [bob-zombie, mark-werewolf, alex-ghost] ;
false.
Related
Stuck on a Prolog problem. I know the answer (because I did it on paper first), but I cannot figure out how to get Prolog to come up with the answer.
Problem:
Bill eats a snack every night, having a different fruit and different
nuts each night. From the statements below, identify what Bill had for
a snack for each weeknight last week.
a) The apple was eaten later in the week than the mango.
b) The banana was eaten later in the week than both the almonds and
peanuts, but earlier in the week than the pear.
c) The cashews were eaten earlier in the week than both the banana and
the apricot, but later in the week than the peanuts.
d) The pecans were not eaten the evening after the almonds.
e) Bill ate walnuts one night.
Note that the problem is about 5 weeknights (Monday through Friday),
and mentions 5 kinds of fruit and 5 kinds of nuts. Your program should
solve the problem and print out the solution, which will be a set of 5
triples like (Monday, apple, pecans), ... (Friday, mango, walnuts).
Clearly, these are not the correct answers, but just values to show
you what the solution will look like.
Code so far:
before_in_week(X, Y, Days) :-
nth1(Xi, Days, X),
nth1(Yi, Days, Y),
Xi < Yi.
print_solve([Head|Tail]) :-
write(Head),
nl,
print_solve(Tail).
solve(A) :-
% all triples
A = [[day1, fruit1, nut1],
[day2, fruit2, nut2],
[day3, fruit3, nut3],
[day4, fruit4, nut4],
[day5, fruit5, nut5]],
Days = [monday, tuesday, wednesday, thursday, friday],
Days = [day1, day2, day3, day4, day5],
Fruits = [apple,banana,pear,mango,apricot],
permutation(Fruits, [fruit1, fruit2, fruit3, fruit4, fruit5]),
Nuts = [almonds,pecans,cashews,peanuts,walnuts],
permutation(Nuts, [nut1, nut2, nut3, nut4, nut5]),
% clue 1 - mango before apple
fruit5 \= mango,
member([C1,mango,_], A),
member([C2,apple,_], A), before_in_week(C1,C2,Days),
% clue 2 - banana after almonds and peanuts, but before pear
fruit5 \= banana,
member([C1,banana,_], A),
member([C2,pear,_], A), before_in_week(C1,C2,Days),
member([C3,_,almonds], A), before_in_week(C3,C1,Days),
member([C4,_,peanuts], A), before_in_week(C4,C1,Days),
% clue 3 - cashews before banana and apricot, but after peanuts
nut5 \= peanuts,
member([C1,_,cashews], A),
member([C2,_,peanuts], A), before_in_week(C1,C2,Days),
member([C3,banana,_], A), before_in_week(C3,C1,Days),
member([C4,apricot,_], A), before_in_week(C4,C1,Days),
% clue 4 - pecans not night after almonds
nut5 \= almonds,
% clue 5 - ate walnuts one night
print_solve(A).
First, there is really no need to print anything manually. Prolog's top level does this for you, if you enter the query solve(A). yet,
second, there is no solution. That is really what you are interested in. There is a very simple and very general method to narrow down the source of failure. Simply generalize away all the goals, one after the other. I like to do this by adding a * in front like so:
:- op(950, fy, *).
*_0.
solve(A) :-
* A = [[day1, fruit1, nut1], [day2, fruit2, nut2], [day3, fruit3, nut3],
[day4, fruit4, nut4], [day5, fruit5, nut5]],
Days = [monday|_/*[tuesday, wednesday, thursday, friday]*/],
Days = [day1|_/*[day2, day3, day4, day5]*/],
* Fruits = [apple,banana,pear,mango,apricot],
* permutation(Fruits, [fruit1, fruit2, fruit3, fruit4, fruit5]),
* Nuts = [almonds,pecans,cashews,peanuts,walnuts],
* permutation(Nuts, [nut1, nut2, nut3, nut4, nut5]),
% clue 1 - mango before apple
* fruit5 \= mango,
* member([C1,mango,_], A),
* member([C2,apple,_], A), before_in_week(C1,C2,Days),
% clue 2 - banana after almonds and peanuts, but before pear
* fruit5 \= banana,
* member([C1,banana,_], A),
* member([C2,pear,_], A), before_in_week(C1,C2,Days),
* member([C3,_,almonds], A), before_in_week(C3,C1,Days),
* member([C4,_,peanuts], A), before_in_week(C4,C1,Days),
% clue 3 - cashews before banana and apricot, but after peanuts
* nut5 \= peanuts,
* member([C1,_,cashews], A),
* member([C2,_,peanuts], A), before_in_week(C1,C2,Days),
* member([C3,banana,_], A), before_in_week(C3,C1,Days),
* member([C4,apricot,_], A), before_in_week(C4,C1,Days),
% clue 4 - pecans not night after almonds
* nut5 \= almonds.
% clue 5 - ate walnuts one night
In this program slice, which is a generalization of your original program, it boils down to the inability to succeed for
Days = [monday|_], Days = [day1|_]
You have to change there something. day1 is a constant, it rather should be a variable.
Later, replace all X \= const by dif(X, const).
Your biggest issue is that you are using atoms (fruit4) but you should use variables (Fruit4). Note the capitalization at the start.
Also, you're doing a permutation that you don't need. Prolog does all of the permutations you need via backtracking. That's what make Prolog such an interesting language.
Try this code:
?- solve(A),print_solve(A).
solve(A) :-
A = [[monday,_,_],[tuesday,_,_],[wednesday,_,_],[thursday,_,_],[friday,_,_]],
%clue 1 - mango before apple
before([_,mango,_],[_,apple,_],A),
% clue 2 - banana after almonds and peanuts, but before pear
before([_,_,almonds],[_,banana,_],A),
before([_,_,peanuts],[_,banana,_],A),
before([_,banana,_],[_,pear,_],A),
% clue 3 - cashews before banana and apricot, but after peanuts
before([_,_,cashews],[_,banana,_],A),
before([_,_,cashews],[_,apricot,_],A),
before([_,_,peanuts],[_,_,cashews],A),
% clue 4 - pecans not night after almonds
append(H,[[_,_,almonds],[_,_,_]|T],A),
(member([_,_,pecans],H);member([_,_,pecans],T)),
% clue 5 - ate walnuts one night
member([_,_,walnuts],A),
true.
print_solve([]).
print_solve([Head|Tail]) :-
write(Head),
nl,
print_solve(Tail).
before(X,Y,Days) :-
append(A,B,Days),
member(X,A),
member(Y,B).
That gives me:
[monday, mango, peanuts]
[tuesday, apple, cashews]
[wednesday, apricot, almonds]
[thursday, banana, walnuts]
[friday, pear, pecans]
Yes.
The puzzle can be easily solved by means of one of workhorses of Prolog: generate-and-test. The key is modelling expressions over domain variables (constraints) making easy to check if they are satisfied.
snacks(Week) :-
% model the problem with domain variables,
% make the symbolic associations explicit
% this is the 'generation phase'
Nuts = [
almonds:Almonds,
cashews:Cashews,
pecans:Pecans,
peanuts:Peanuts,
walnuts:_Walnuts
],
Fruits = [
apple:Apple,
banana:Banana,
pear:Pear,
mango:Mango,
apricot:Apricot
],
% since we are going to use plain arithmetic, assign numbers before attempt to evaluate constraints
assign_days(Nuts),
assign_days(Fruits),
% now the 'application symbols' are bound to integers, then we can
% code actual constraint expressions in a simple way...
% this is the 'test phase'
% a) The apple was eaten later in the week than the mango.
Apple>Mango,
% b) The banana was eaten later in the week than both the almonds and peanuts,
% but earlier in the week than the pear.
Banana>Almonds,Banana>Peanuts,Banana<Pear,
% c) The cashews were eaten earlier in the week than both the banana and the apricot,
% but later in the week than the peanuts.
Cashews<Banana,Cashews<Apricot,Cashews>Peanuts,
% d) The pecans were not eaten the evening after the almonds.
Pecans=\=Almonds+1,
% e) Bill ate walnuts one night.
% no constraints, just existance
% when we get here, domain variables satisfy the constraints
% just format the workspace in easy to read list
findall((Day,Fruit,Nut),(
nth1(NDay,['Monday','Tuesday','Wednesday','Thursday','Friday'],Day),
memberchk(Fruit:NDay,Fruits),
memberchk(Nut:NDay,Nuts)
),Week).
assign_days(Snacks) :-
numlist(1,5,Nums),
permutation(Nums,Perm),
maplist([Day,_:Day]>>true,Perm,Snacks).
I am trying to solve Einstein Riddle in Prolog.
I am having a difficulty with the program I wrote, the basic method was to add all constraints and let Prolog figure out the only possible solutions.
The problem is that Prolog finds 0 solutions. I have isolated the constraint that makes the program go from a given solution to no solutions, but I don't understand why.
/*There are five houses*/
exists(A, list(A,_,_,_,_)).
exists(A, list(_,A,_,_,_)).
exists(A, list(_,_,A,_,_)).
exists(A, list(_,_,_,A,_)).
exists(A, list(_,_,_,_,A)).
middle_house(A, list(_,_,A,_,_)).
first_house(A, list(A,_,_,_,_)).
nextTo(A, B, list(B,A,_,_,_)).
nextTo(A, B, list(_,B,A,_,_)).
nextTo(A, B, list(_,_,B,A,_)).
nextTo(A, B, list(_,_,_,B,A)).
nextTo(A, B, list(A,B,_,_,_)).
nextTo(A, B, list(_,A,B,_,_)).
nextTo(A, B, list(_,_,A,B,_)).
nextTo(A, B, list(_,_,_,A,B)).
/* each statement will be described using the clues
house conatins: Color,Owner, Drinks, Smokes, Pet*/
riddle(Houses):-
/*exists(house(red, englishman, _,_,_),Houses),*/
nextTo(house(_,norwegian,_,_,_), house(blue,_,_,_,_), Houses),
exists(house(_,spanish,_,_, dog), Houses),
exists(house(green, _, coffee, _,_), Houses),
exists(house(_, ukrain, tea,_,_), Houses),
nextTo(house(white,_,_,_,_), house(green,_,_,_,_), Houses),
exists(house(_,_,_,marlbero, cat),Houses),
exists(house(yellow,_,_,time,_), Houses),
middle_house(house(_,_,milk,_,_), Houses),
first_house(house(_,norwegian,_,_,_), Houses),
nextTo(house(_,_,_,_,fox), house(_,_,_,montena,_), Houses),
nextTo(house(_,_,_,time,_), house(_,_,_,_,horse), Houses),
exists(house(_,_,orange,lucky,_), Houses),
exists(house(_,japanese,parlament,_), Houses).
The current solution to this is this:
?- riddle(Houses).
Houses = list( house(green, norwegian, coffee, marlbero, cat),
house(white, spanish, orange, lucky, dog),
house(yellow, norwegian, milk, time, fox),
house(blue, ukrain, tea, montena, horse),
house(_G7257, japanese, parlament, _G7260)).
and if I uncomment the first line then that same statement returns false.
I would like help understanding why this is the case.
I noted that in the partial solution the Norwegian appears twice and that this might indicate the problem.
Here is a general way how you can solve this problem for yourself. Actually, you really started in a quite promising direction: You tried to remove goals. But then, who was at fault in your case? The line you commented out or the rest? You cannot say that for sure, since the resulting program already worked. But there is a very similar and much more promising way: Try to generalize your program as much as possible such that it still fails. In this manner, you will obtain a smaller program that is responsible for the failure. That is, within the remaining visible part has to be an error!
Here is what I got by removing goals (adding a * in front) and by replacing some terms by _.
:- initialization(riddle(_Sol)).
:- op(950, fy, *).
*_.
riddle(Houses):-
exists(house(red, _/* englishman */, _,_,_),Houses),
nextTo(house(_,_/* norwegian */,_,_,_), house(blue,_,_,_,_), Houses),
* exists(house(_,spanish,_,_, dog), Houses),
* exists(house(green, _, coffee, _,_), Houses),
* exists(house(_, ukrain, tea,_,_), Houses),
nextTo(house(white,_,_,_,_), house(green,_,_,_,_), Houses),
* exists(house(_,_,_,marlbero, cat),Houses),
exists(house(yellow,_,_,_/* time */,_), Houses),
* middle_house(house(_,_,milk,_,_), Houses),
* first_house(house(_,norwegian,_,_,_), Houses),
* nextTo(house(_,_,_,_,fox), house(_,_,_,montena,_), Houses),
* nextTo(house(_,_,_,time,_), house(_,_,_,_,horse), Houses),
* exists(house(_,_,orange,lucky,_), Houses),
exists(house(_,_/* japanese */,_/* parlament */,_), Houses).
This fragment still fails, thus the error has to be in the visible part of the program.
It seems to be essential that all the house colors are present. There is only one goal that does not contain any house color at all... see it?
I am working on a project where I have to build an engine that is able to generate a bunch of premises and, given a true fact, tell what else can be deduced. Example given:
If John plays football then Mary makes cookies.
If Eric listens to rock then john doesn't play Football.
If Eric doesn't listen to rock then john plays Football.
Either Eric listens to rock or Luiza listens to rock.
When the given true fact is "Luiza listens to rock", then the solution should be:
Eric listens to rock = false
John plays football = true
Mary makes cookies = true
When the true fact is "Eric listens to rock", then the solution should be:
Luiza listens to rock = false
Jonh plays football = false
Mary makes cookies = (can't solve)
When the true fact is "John plays football", then the solution should be:
Mary makes cookies = true
Luiza listens to rock = (can't solve)
Jonh plays football = (can't solve)
Question: is Prolog the correct tool for solving this kind of problem? Code examples are appreciated.
Yes, Prolog would be awesome for this.
Here's an example of a similar problem:
/*
1. Mr. K made his sighting at some point earlier in the week than the one who saw the balloon, but at some point later in the week, than the one who spotted the Kite ( who isn't Ms. G ).
2. Friday's sighting was made by either Ms. Barn or the one who saw a plane ( or both ).
3. Mr. Nik did not make his sighting on Tuesday.
4. Mr. K isn't the one whose object turned out to be a telephone pole.
*/
?-
% Set up a list of lists to be the final solution
Days = [[tuesday,_,_],[wednesday,_,_],[thursday,_,_],[friday,_,_]],
/* 1 */ before([_,mr_k,_],[_,_,balloon],Days),
/* 1 */ before([_,_,kite],[_,mr_k,_],Days),
/* 2 */ (member([friday,ms_barn,_],Days);
member([friday,_,plane],Days);
member([friday,ms_barn,plane],Days)),
% Fill in the rest of the people
members([[_,mr_k,_],[_,ms_barn,_],[_,ms_g,_],[_,mr_nik,_]],Days),
% Fill in the rest of the objects
members([[_,_,balloon],[_,_,kite],[_,_,plane],[_,_,tele_pole]],Days),
% Negations should be done after the solution is populated
/* 1 */ member([_,NOT_ms_g,kite],Days), NOT_ms_g \= ms_g,
/* 3 */ member([tuesday,NOT_mr_nik,_],Days), NOT_mr_nik \= mr_nik,
/* 4 */ member([_,NOT_mr_k,tele_pole],Days), NOT_mr_k \= mr_k,
write(Days),
nl,
fail.
% Checks that `X` comes before `Y`
% in the list `Ds`
before(X,Y,Ds) :-
remainder(X,Ds,Rs),
member(Y,Rs).
% Finds a member of a list and
% unifies the third parameter such
% that it is the remaining elements in
% the list after the found member
remainder(X,[X|Ds],Ds).
remainder(X,[_|Ds],Rs) :- remainder(X,Ds,Rs).
% An extended version of `member` that
% checks if the members of the first list
% are all members of the second
members([],_).
members([X|Xs],Ds) :-
member(X,Ds),
members(Xs,Ds).
It produces the following result:
[[tuesday, ms_g, tele_pole], [wednesday, mr_nik, kite], [thursday, mr_k, plane], [friday, ms_barn, balloon]]
I'm trying to solve the Einstein riddle using Prolog. Task is
The Norwegian lives in the first house .
The English lives in the Red House .
The Swedish HAS Dogs As pets .
The Danish drinks tea .
The Green House is on the left of the White House.
The man who lives in the green house drinks coffee .
The man who smokes Pall Mall rears birds .
The man living in the Yellow House smokes Dunhill .
The man who lives in the Middle house drinks milk .
The man who smokes Blends lives next to the one who Has Cats .
The man who keeps horses lives next to the one who smokes Dunhill .
The man who smokes Blue Master drinks beer .
The German smokes Prince .
The Norwegian lives next to the Blue House side .
The man who smokes Blends is Neighbour do of the one who drinks water .
Someone has one aquarium with fish .
The program:
neighbor(Rua):-
length(Rua, 5),
Rua = [casa(_,noruegues,_,_,_)|_],
member(casa(vermelha,ingles,_,_,_),Rua),
member(casa(_,sueco,_,_,cachorros),Rua),
member(casa(_,dinamarques,cha,_,_),Rua),
esquerda(casa(verde,_,_,_,_), casa(branca,_,_,_,_),Rua),
member(casa(verde,_,cafe,_,_),Rua),
member(casa(_,_,_,pallmall,passaros),Rua),
member(casa(amarela,_,_,dunhill,_),Rua),
Rua = [_,_,casa(_,_,leite,_,_),_,_],
ao_lado(casa(_,_,_,blends,_), casa(_,_,_,_,gatos),Rua),
ao_lado(casa(_,_,_,_,cavalos), casa(_,_,_,dunhill,_),Rua),
member(casa(_,_,cerveja,bluemaster,_),Rua),
member(casa(_,alemao,_,prince,_),Rua),
ao_lado(casa(_,noruegues,_,_,_), casa(azul,_,_,_,_),Rua),
ao_lado(casa(_,_,_,blends,_), casa(_,_,agua,_,_),Rua),
member(casa(_,_,_,_,peixes),Rua).
ao_lado([X,Y|_],X, Y).
ao_lado([X,Y|_],Y, X).
ao_lado([_|L],X, Y):-
ao_lado(L, X, Y).
esquerda([A|As], A, E) :-
member2(E, As).
esquerda([_|As], A, E) :-
esquerda(As, A, E).
Here is one reason you have to address to solve this problem. Below program fragment has quite a lot of goals removed, yet it still fails. The visible part alone is already responsible for the failure. Can you spot the reason from this fragment?
(For more on this method see
this
explanation.)
:- op(950, fy, *).
*_.
:- initialization(neighbor(_Rua)).
neighbor(_/*Rua*/):-
* length(Rua, 5),
* Rua = [casa(_,noruegues,_,_,_)|_],
* member(casa(vermelha,ingles,_,_,_),Rua),
* member(casa(_,sueco,_,_,cachorros),Rua),
* member(casa(_,dinamarques,cha,_,_),Rua),
esquerda(casa(_/*verde*/,_,_,_,_), _/*casa(branca,_,_,_,_)*/,Rua),
* member(casa(verde,_,cafe,_,_),Rua),
* member(casa(_,_,_,pallmall,passaros),Rua),
* member(casa(amarela,_,_,dunhill,_),Rua),
* Rua = [_,_,casa(_,_,leite,_,_),_,_],
* ao_lado(casa(_,_,_,blends,_), casa(_,_,_,_,gatos),Rua),
* ao_lado(casa(_,_,_,_,cavalos), casa(_,_,_,dunhill,_),Rua),
* member(casa(_,_,cerveja,bluemaster,_),Rua),
* member(casa(_,alemao,_,prince,_),Rua),
* ao_lado(casa(_,noruegues,_,_,_), casa(azul,_,_,_,_),Rua),
* ao_lado(casa(_,_,_,blends,_), casa(_,_,agua,_,_),Rua),
* member(casa(_,_,_,_,peixes),Rua).
esquerda([A|As], _/*A*/, E) :-
* member(E, As).
esquerda([_|As], A, E) :-
* esquerda(As, A, E).
First, sorry for posting the whole program, but as I don't know were the problem is I don't know which parts are irrelevant. These are two slightly different implementations of the same logic puzzle in SWI-Prolog, the first one succeeds the second one fails and I can't find the reason for the failure.
The puzzle:
4 persons are having a diner:
Donna, Doreen, David, Danny
the woman (Donna,Doreen) are sitting vis-a-vis.
the men (David,Danny) are sitting vis-a-vis.
Each of them picked a unique meal and beverage.
1) Doreen sits next to the person that ordered risotto.
2) the salad came with a coke.
3) the person with the lasagna sits vis-a-vis the person with the milk.
4) david never drinks coffee.
5) donna only drinks water.
6) danny had no appetite for risotto.
who ordered the pizza?
I choose the following approach
table with positions:
1
4 O 2
3
domain: positions{1,2,3,4}
variables: persons, meals, beverages
First the inefficient succeeding implementation:
solution(Pizza, Doreen, Donna, David, Danny) :-
% assignment of unique positions to the variables
unique(Doreen,Donna,David,Danny),
unique(Lasagna,Pizza,Risotto,Salad),
unique(Water,Coke,Coffee,Milk),
% general setting
vis_a_vis(Donna,Doreen),
vis_a_vis(David,Danny),
% the six constraints
next_to(Doreen,Risotto),
Salad = Coke,
vis_a_vis(Lasagna,Milk),
\+ David = Coffee,
Donna = Water,
\+ Danny = Risotto.
unique(X1,X2,X3,X4) :-
pos(X1),
pos(X2),
\+ X1 = X2,
pos(X3),
\+ X1 = X3, \+ X2 = X3,
pos(X4),
\+ X1 = X4, \+ X2 = X4, \+ X3 = X4.
right(1,2).
right(2,3).
right(3,4).
right(4,1).
vis_a_vis(1,3).
vis_a_vis(3,1).
vis_a_vis(2,4).
vis_a_vis(4,2).
next_to(X,Y) :- right(X,Y).
next_to(X,Y) :- right(Y,X).
pos(1).
pos(2).
pos(3).
pos(4).
This works and gives the right result. But when I try to reorder the clauses of the solution procedure to be more efficient (this is the second implementation)
solution(Pizza, Doreen, Donna, David, Danny) :-
% general setting
vis_a_vis(Donna,Doreen),
vis_a_vis(David,Danny),
% the six constraints
Salad = Coke,
vis_a_vis(Lasagna,Milk),
\+ David = Coffee,
Donna = Water,
\+ Danny = Risotto,
% assignment of unique positions to the variables
unique(Doreen,Donna,David,Danny),
unique(Lasagna,Pizza,Risotto,Salad),
unique(Water,Coke,Coffee,Milk).
%% all other predicates are like the ones in the first implementation
I get a unassigned variable warning when trying to load the file:
Warning: /home/pizza.pl:28:
Singleton variable in \+: Coffee
and the computation returns false. But shouldn't it return the same result?
I see no reason for the difference...
the warning is due to the fact that Coffe and Risotto are unbound when the negation is executed. If you replace \+ David = Coffee, by David \= Coffee, you will avoid the warning, but the solution cannot will not be computed. Should be clear indeed that since Coffee is unbound, David \= Coffee will always fail. You can use dif/2, the solution will work and will be more efficient. I've named solution1/2 your first snippet, and solution2/5 this one (using dif/2):
solution2(Pizza, Doreen, Donna, David, Danny) :-
% general setting
vis_a_vis(Donna,Doreen),
vis_a_vis(David,Danny),
% the six constraints
next_to(Doreen,Risotto), % note: you forgot this one
Salad = Coke,
vis_a_vis(Lasagna,Milk),
dif(David, Coffee),
Donna = Water,
dif(Danny, Risotto),
% assignment of unique positions to the variables
unique(Doreen,Donna,David,Danny),
unique(Lasagna,Pizza,Risotto,Salad),
unique(Water,Coke,Coffee,Milk).
a small test:
?- time(aggregate_all(count,solution1(P,A,B,C,D),N)).
% 380,475 inferences, 0.058 CPU in 0.058 seconds (100% CPU, 6564298 Lips)
N = 8.
?- time(aggregate_all(count,solution2(P,A,B,C,D),N)).
% 10,626 inferences, 0.002 CPU in 0.002 seconds (100% CPU, 4738996 Lips)
N = 8.