在 Prolog 中解决文本逻辑难题 - 查找生日和月份

Question

I'm reading the "7 Languages in 7 Days"-book, and have reached the Prolog chapter. As a learning exercises I'm trying to solve some textual logic puzzles. The puzzle goes as follow:

Five sisters all have their birthday in a different month and each on a different day of the week. Using the clues below, determine the month and day of the week each sister's birthday falls.

1. Paula was born in March but not on Saturday. Abigail's birthday was not on Friday or Wednesday.
2. The girl whose birthday is on Monday was born earlier in the year than Brenda and Mary.
3. Tara wasn't born in February and her birthday was on the weekend.
4. Mary was not born in December nor was her birthday on a weekday. The girl whose birthday was in June was born on Sunday.
5. Tara was born before Brenda, whose birthday wasn't on Friday. Mary wasn't born in July.

My current implementation probably looks like a joke to experienced Prolog programmers. The code is pasted below.

I would love some input on how to solve the question, and how to make the code both clear and dense.

Ie:

1. How can I avoid typing out the limitations saying that the Days must be unique.
2. How can I avoid typing out the limitations saying that the Months must be unique.
3. Add the limitation about the ordering of the birthdays.

is_day(Day) :-
    member(Day, [sunday, monday, wednesday, friday, saturday]).

is_month(Month) :-
    member(Month, [february, march, june, july, december]).

solve(S) :-

    S = [[Name1, Month1, Day1],
         [Name2, Month2, Day2],
         [Name3, Month3, Day3],
         [Name4, Month4, Day4],
         [Name5, Month5, Day5]],

    % Five girls; Abigail, Brenda, Mary, Paula, Tara    
    Name1 = abigail,
    Name2 = brenda,
    Name3 = mary,
    Name4 = paula,
    Name5 = tara,

    is_day(Day1), is_day(Day2), is_day(Day3), is_day(Day4), is_day(Day5),
    Day1 \== Day2, Day1 \== Day3, Day1 \== Day4, Day1 \== Day5,
    Day2 \== Day1, Day2 \== Day3, Day2 \== Day4, Day2 \== Day5,
    Day3 \== Day1, Day3 \== Day2, Day3 \== Day4, Day3 \== Day5,
    Day4 \== Day1, Day4 \== Day2, Day4 \== Day3, Day4 \== Day5,

    is_month(Month1), is_month(Month2), is_month(Month3), is_month(Month4), is_month(Month5),
    Month1 \== Month2, Month1 \== Month3, Month1 \== Month4, Month1 \== Month5,
    Month2 \== Month1, Month2 \== Month3, Month2 \== Month4, Month2 \== Month5,
    Month3 \== Month1, Month3 \== Month2, Month3 \== Month4, Month3 \== Month5,
    Month4 \== Month1, Month4 \== Month2, Month4 \== Month3, Month4 \== Month5,

    % Paula was born in March but not on Saturday.  
    member([paula, march, _], S),
    Day4 \== sunday,

    % Abigail's birthday was not on Friday or Wednesday.    
    Day1 \== friday,
    Day1 \== wednesday,

    % The girl whose birthday is on Monday was born
    % earlier in the year than Brenda and Mary.

    % Tara wasn't born in February, and 
    % her birthday was on the weekend.
    Month5 \== february,
    Day5 \== monday, Day5 \== wednesday, Day5 \== friday,   

    % Mary was not born in December nor was her
    % birthday on a weekday.
    Month3 \== december,
    Day3 \== monday, Day3 \== wednesday, Day3 \== friday,

    % The girl whose birthday was in June was 
    % born on Sunday.
    member([_, june, sunday], S),

    % Tara was born before Brenda, whose birthday
    % wasn't on Friday.
    Day2 \== friday,

    % Mary wasn't born in July.
    Month3 \== july.

Update Based on the answer from chac I was able to solve the puzzle. Following the same recipe we (the programming language competency group at work) was able to solve a second puzzle as well. I have posted the complemete implementation, and example output as a gist on GitHub .

Answer 1

Using maplist/2 will considerably shorten your code. For example:

maplist(is_month, [Month1,Month2,Month3,Month4,Month5]).

month/1 might be a better predicate name than is_month/1. To state that two terms are different, use the constraint dif/2. Using maplist/2 and dif/2, you can describe that a list contains elements that are pairwise distinct:

all_dif([]).
all_dif([L|Ls]) :-
        maplist(dif(L), Ls),
        all_dif(Ls).

Example:

?- all_dif([X,Y,Z]).
dif(X, Z),
dif(X, Y),
dif(Y, Z).

solve/1 is an imperative name - you are describing solutions, so it is better to call it solution/1.

Answer 2

Maybe the riddle is underspecified, or your solution not complete: testing your code, I get

?- solve(X),maplist(writeln,X).
[abigail,february,monday]
[brenda,july,wednesday]
[mary,june,sunday]
[paula,march,friday]
[tara,december,saturday]
X = [[abigail, february, monday], [brenda, july, wednesday], [mary, june, sunday], [paula, march, friday], [tara, december, saturday]] ;
[abigail,february,monday]
[brenda,december,wednesday]
[mary,june,sunday]
[paula,march,friday]
[tara,july,saturday]
X = [[abigail, february, monday], [brenda, december, wednesday], [mary, june, sunday], [paula, march, friday], [tara, july, saturday]] 

and yet more solutions. So when is brenda born?

A 'trick of the trade' for uniqueness is using select /3 predicate, or simply permutation /2. Using this last the code becomes something like

solve(S) :-

    S = [[Name1, Month1, Day1],
         [Name2, Month2, Day2],
         [Name3, Month3, Day3],
         [Name4, Month4, Day4],
         [Name5, Month5, Day5]],

    Girls =  [abigail, brenda, mary, paula, tara],
    Girls =  [Name1, Name2, Name3, Name4, Name5],

    Months = [february, march, june, july, december],
    Days =   [sunday, monday, wednesday, friday, saturday],
    permutation(Months, [Month1, Month2, Month3, Month4, Month5]),
    permutation(Days,   [Day1, Day2, Day3, Day4, Day5]),

    % Paula was born in March but not on Saturday.
    member([paula, march, C1], S), C1 \= saturday,
   ...

the relation about 'before in year' can be coded like this:

    ...
    % The girl whose birthday is on Monday was born
    % earlier in the year than Brenda and Mary.
    member([_, C3, monday], S),
    member([brenda, C4, C10], S), before_in_year(C3, C4, Months),
    member([mary, C5, _], S), before_in_year(C3, C5, Months),
    ...

with the service predicate

before_in_year(X, Y, Months) :-
    nth1(Xi, Months, X),
    nth1(Yi, Months, Y),
    Xi < Yi.

The 'born in weekend' can be coded like

...
% Tara wasn't born in February, and
% her birthday was on the weekend.
member([tara, C6, C7], S), C6 \= february, (C7 = saturday ; C7 = sunday),

% Mary was not born in December nor was her
% birthday on a weekday.
member([mary, C8, C9], S), C8 \= december, (C9 = saturday ; C9 = sunday),
...

and so on. After this rewrite I get the unique solution

?- solve(X),maplist(writeln,X).
[abigail,february,monday]
[brenda,december,wednesday]
[mary,june,sunday]
[paula,march,friday]
[tara,july,saturday]
X = [[abigail, february, monday], [brenda, december, wednesday], [mary, june, sunday], [paula, march, friday], [tara, july, saturday]] ;
false.

edit

I've noted just now that I introduced some redundant member/2 and free variables, like member([brenda, C4, C10], S),... . Those C4, C10 obiouvsly can be replaced by the variables bound to Brenda as Month2, Day2, as was in original code.

Answer 3

Here is a solution which uses brute-force search over the problem space. To say I am not proud of it would not go far enough. Surely there is a more elegant solution to this problem.

Anyway:

month(january).
month(february).
month(march).
month(april).
month(may).
month(june).
month(july).
month(august).
month(september).
month(october).
month(november).
month(december).

precedes(january, february).
precedes(february, march).
precedes(march, april).
precedes(april, may).
precedes(may, june).
precedes(june, july).
precedes(july, august).
precedes(august, september).
precedes(september, october).
precedes(october, november).
precedes(november, december).
earlier(M1, M2) :- precedes(M1, M2).
earlier(M1, M2) :- month(M1), month(M2), precedes(M1, X), month(X), earlier(X, M2).

weekday(monday).
weekday(tuesday).
weekday(wednesday).
weekday(thursday).
weekday(friday).
weekend(saturday).
weekend(sunday).

birthmonth(abigail, M) :- 
    month(M), 
    M \== march.
birthmonth(brenda, M) :- 
    month(M), 
    M \== march.
birthmonth(paula, march).
birthmonth(mary, M) :- 
    month(M), 
    M \== march, M \== december, M \== july.
birthmonth(tara, M) :- 
    month(M), 
    M \== march, 
    M \== february.

birthday(abigail, D) :- 
    weekday(D), 
    D \== friday, D \== wednesday.
birthday(brenda, D) :- 
    weekday(D), 
    D \== friday,
    D \== monday.
birthday(mary, D) :- weekend(D).
birthday(paula, D) :- weekday(D), D \==saturday.
birthday(tara, D) :- weekend(D).

answer(M, D):-
    candidate(M, D),
    member(june, M),
    member(sunday, D),
    nth(IM, M, june),
    nth(ID, D, sunday),
    IM =:= ID,
    nth(5, M, MTARA),
    nth(2, M, MBRENDA),
    earlier(MTARA, MBRENDA),
    nth(3, M, MMARY),
    nth(IMONDAY, D, monday),
    nth(IMONDAY, M, MMONDAY),
    earlier(MMONDAY, MBRENDA),
    earlier(MMONDAY, MMARY).


candidate([M1,M2,M3,M4,M5], [D1,D2,D3,D4,D5]):-
    birthday(abigail, D1),
    birthday(brenda, D2),
    D1 \== D2,
    birthday(mary, D3),
    D1 \== D3,
    D2 \== D3,
    birthday(paula, D4),
    D1 \== D4,
    D2 \== D4,
    D3 \== D4,
    birthday(tara, D5),
    D1 \== D5,
    D2 \== D5,
    D3 \== D5,
    D4 \== D5,
    birthmonth(abigail, M1), 
    birthmonth(brenda, M2), 
    M1 \== M2,
    birthmonth(mary, M3), 
    M1 \== M3, 
    M2 \== M3,
    birthmonth(paula, M4),
    M1 \== M4,
    M2 \== M4,
    M3 \== M4,
    birthmonth(tara, M5),
    M1 \== M5,   
    M2 \== M5,
    M3 \== M5,
    M4 \== M5.

A better answer would implement the ordering constraints as part of the birthmonth/2 or birthday/2 clauses. I haven't been able to get that to work, so far.

candidate/2 implements what amounts to a couple of nested for() loops, which you can't see but the WAM (Prolog's Warren Abstract Machine) goes through the machinations to iterate the values D1, D2, D3 ... etc.

To see the possible answers, use:

answer(M,D).

Keep pressing semicolon, or 'a' in gprolog to see all answers. The elements of each list correspond to the girls in alphabetical order.

Answer 4

Uniquely -selecting all entities upfront from a domain allows for an easy and simple, "both clear and dense" code. Using numerical domains makes for easy comparisons:

day(   d(_,D,_), D).   
fname( d(N,_,_), N).   % first name
month( d(_,_,M), M).   

sistersP(X):-
    maplist( fname, X, ['Paula', 'Abigail', 'Brenda', 'Mary', 'Tara']),
    maplist( month, X, [PM, AM, BM, MM, TM]),
    maplist( day,   X, [PD, AD, BD, MD, TD]),
    permutation( [PM,AM,BM,MM,TM], [2,3,6,7,12]),            % months of year
    permutation( [PD,AD,BD,MD,TD], [sun,mon,wed,fri,sat]),   % days of week

    PM = 3, PD \== sat, AD \== fri, AD \== wed,              % the five rules,
    day(G,mon), member(G,X), month(G,GM), GM < BM, GM < MM,  %   one per line
    TM =\= 2, (TD == sat ; TD == sun),
    MM =\= 12, (MD == sat ; MD == sun), month(G2,6), day(G2,sun), member(G2,X),
    TM < BM, BD \== fri, MM =\= 7.

This finds just one solution, using only those months of year and days of week which are mentioned in the puzzle:

?- sistersP(X).
X = [d('Paula', fri, 3), d('Abigail', mon, 2), d('Brenda', wed, 12), 
     d('Mary', sun, 6), d('Tara', sat, 7)] ;
No

?- time( sistersP(_) ).
% 19,537 inferences, 0.01 CPU in 0.01 seconds (100% CPU, 2624221 Lips)
Yes

?- time( (sistersP(_),fail;true) ).  % exhaust the search space
% 56,664 inferences, 0.03 CPU in 0.04 seconds (75% CPU, 2441285 Lips)
Yes

Testing as soon as possible, selecting incrementally, leads to much more efficient code. I like using my own select/2 which lets me uniquely select elements of list from a domain (ie another list, which is allowed to be longer than the first one, so that permutation/2 can't be used).

select([A|As],S):- select(A,S,S1),select(As,S1).
select([],_). 

sisters(X):-
    maplist(fname, X, ['Paula', 'Abigail', 'Brenda', 'Mary', 'Tara']),
    maplist(month, X, [PM, AM, BM, MM, TM]),
    maplist(day,   X, [PD, AD, BD, MD, TD]),
    Months = [2,3,6,7,12],           %%% [1,2,3,4,5,6,7,8,9,10,11,12],
    Days = [sun,mon,wed,fri,sat],    %%% [sun,mon,tue,wed,thu,fri,sat], 

    select(3,Months,M2),  PM = 3, 
    select(PD,Days,D2),   PD \== sat,              % 1a
    select(AD,D2,D3),     AD \== fri, AD \== wed,  % 1b
    select(TM,M2,M3),     TM =\= 2,                % 3a
    select(MM,M3,M4),     MM =\= 12,  MM =\= 7,    % 4a1 % 5c
    select(TD,D3,D4),  select([TD,MD],[sat,sun]),  % 3b  % 4a2
    month(G,6), day(G,sun), member(G,X),           % 4b
    select([MD,BD],D4),   BD \== fri,              % 5a
    select([BM,AM],M4),   TM < BM,                 % 5b
    day(G2,mon),          member(G2,X),
    month(G2,G2M),        G2M < BM, G2M < MM.      % 2

Run it:

?- sisters(X).
X = [d('Paula', fri, 3), d('Abigail', mon, 2), d('Brenda', wed, 12), 
     d('Mary', sun, 6), d('Tara', sat, 7)] ;
No

?- time(sisters(_)).
% 2,071 inferences, 0.00 CPU in 0.00 seconds (?% CPU, Infinite Lips)
Yes

?- time( (sisters(_),fail;true) ).  % exhaust the search space
% 2,450 inferences, 0.00 CPU in 0.00 seconds (?% CPU, Infinite Lips)
Yes

Using all 12 months of year and 7 days of week (which I did at first, unfortunately :) ), there are 4561 solutions, which the 2nd code finds quickly enough (0.16 secs, 424,600 inferences). The 1st code, with select/2 used instead of permutation/2 , takes 180,400,000 inferences and 75 seconds to produce just the first answer, vs. 19,400 infs in 0.01 secs for the 2nd, faster code.

Answer 5

In this kind of problem, I like to follow the text of the puzzle ( works with SWI Prolog 6.3.0) :

week_end(Day) :-
    member(Day, [saturday, sunday]).

day(Day) :-
    member(Day, [monday, wednesday, friday, saturday, sunday]).

month(Month) :-
    member(Month, [february, march, june, july, december]).


before(M1, M2) :-
    nth0(I1, [february, march, june, july, december], M1),
    nth0(I2, [february, march, june, july, december], M2),
    I1 < I2.

names([person(abigail, _, _),
       person(brenda, _, _),
       person(mary, _, _),
       person(paula, _, _),
       person(tara, _, _)]).


solve(L) :-
    maplist(\X^(X = person(_, Day, Month),
            day(Day),
            month(Month)),
        L),

    forall((select(X,L, L1), select(Y, L1, _)),
           (   X = person(_, D1, M1),
           Y = person(_, D2, M2),
           D1 \= D2,
           M1 \= M2)).

/*
1.Paula was born in March but not on Saturday. Abigail's birthday was not on Friday or Wednesday.
*/
rule_1(L) :-
    member(person(paula, D, march), L),
        D \== saturday,

    member(person(abigail, D1, _M), L),
    day(D1),
    \+ member(D1, [friday, wednesday]).


/*
2.The girl whose birthday is on Monday was born earlier in the year than Brenda and Mary.
*/
rule_2(L) :-
    member(person(_N, monday, M), L),
    member(person(brenda, _D1, M1), L),
    member(person(mary, _D2, M2), L),
    before(M, M1),
    before(M, M2).

/*
3.Tara wasn't born in February and her birthday was on the weekend.
*/

rule_3(L) :-
    member(person(tara, D, M), L),
    M \== february,
    week_end(D).

/*
4.Mary was not born in December nor was her birthday on a weekday. The girl whose birthday was in June was born on Sunday.
*/

rule_4(L) :-
    member(person(mary, D, M), L),
    week_end(D),
    M \== december,
    member(person(_N, sunday, june), L).

/*
5.Tara was born before Brenda, whose birthday wasn't on Friday. Mary wasn't born in July.
*/

rule_5(L) :-
    member(person(tara, _DT, MT), L),
    member(person(brenda, DB, MB), L),
    before(MT, MB),
    % DB \== friday,
    day(DB),
    DB \= friday,    
    member(person(mary, _D, M), L),
    M \== july.



puzzle :-
    names(L),
    rule_1(L),
    rule_2(L),
    rule_3(L),
    rule_4(L),
    rule_5(L),
    solve(L),
    maplist(writeln, L).

I get :

 ?- time(puzzle).
person(abigail,monday,february)
person(brenda,wednesday,december)
person(mary,sunday,june)
person(paula,friday,march)
person(tara,saturday,july)
% 45,144 inferences, 0.016 CPU in 0.031 seconds (50% CPU, 3294080 Lips)
true .

Answer 6

A #clpfd approach prolog:-

:-use_module(library(clpfd)).
puzzle(Sisters,Months,Days):-
Sisters=[Paula, Brenda, Abigail, Mary, Tara], Sisters ins 1..5,
Months=[Feburary, March, June, July, December], Months ins 1..5,
Days=[Monday, Wednesday, Friday, Saturday, Sunday], Days ins 1..5,

Paula#=March,
Paula#\=Saturday,
Abigail#\=Friday #\/ Abigail #\=Wednesday,
Tara#\=Feburary #/\ (Tara#=Saturday #\/ Tara#=Sunday),
Mary#\=December #/\ (Mary#\=Saturday #\/ Mary#\=Sunday),
Tara#=Brenda-1,
Brenda#\=Friday,
Mary#\=July,
June#=Sunday,
Brenda #\=Monday #/\ Mary #\=Monday,

all_different(Sisters),
all_different(Months),
all_different(Days),

labeling([], Sisters), labeling([],Months), labeling([], Days).

?-puzzle(Sisters,Months,Days).
OUTPUT:
Days = [1, 3, 4, 2, 5],
Months = [3, 1, 5, 2, 4],
Sisters = [1, 3, 4, 5, 2]
Days = [4, 3, 1, 2, 5],
Months = [3, 1, 5, 2, 4],
Sisters = [1, 3, 4, 5, 2]
Days = [1, 3, 4, 2, 5],
Months = [3, 1, 5, 4, 2],
Sisters = [1, 3, 4, 5, 2]
......