Prolog Logic/Einstein Puzzle

Question

The problem is

Brown, Clark, Jones and Smith are four substantial citizens who serve the community as architect, banker, doctor and lawyer, though not necessarily respe

Answer 1

My solution based off what CapelliC said

% [name,job,conservative,golf,income,age]
% conserative: 1 = least conservative, 4 = most conservative
% golf: 1 = worst golfer, 4 = best golfer
% income: 1 = lowest income, 4 = highest income
% age: 1 = youngest, 4 = oldest

jobs(L) :- L = 
       [[brown,J1,C1,G1,I1,A1],
        [clark,J2,C2,G2,I2,A2],
        [jones,J3,C3,G3,I3,A3],
        [smith,J4,C4,G4,I4,A4]],

        permutation([1,2,3,4], [C1,C2,C3,C4]),
        permutation([1,2,3,4], [I1,I2,I3,I4]),
        permutation([1,2,3,4], [A1,A2,A3,A4]),
        permutation([1,2,3,4], [G1,G2,G3,G4]),
        permutation([banker,architect,doctor,lawyer], [J1,J2,J3,J4]),

        % Brown is more conservative than Jones. Brown is less conservative than Smith.
        member([brown,_,CB,GB,IB,AB],L),
        member([jones,_,CJ,_,_,_],L),
        member([smith,_,CS,_,_,_],L),
        CB > CJ,
        CB < CS,

        % Brown is a better golfer than those older than him.
        member([_,_,_,G01,_,A01],L),
        (A01 > AB, GB > G01 ; A01 < AB),
        member([_,_,_,G02,_,A02],L),
        (A02 > AB, GB > G02 ; A02 < AB),
        member([_,_,_,G03,_,A03],L),
        (A03 > AB, GB > G03 ; A03 < AB),

        vardiff(G01,G02,G03),
        vardiff(G01,A02,A03),

        % Brown has a higher income than those younger than Clark.
        member([clark,_,_,_,_,AC],L),
        member([_,_,_,_,I01,A04],L),
        (A04 < AC, IB > I01; AC < A04),

        % Banker has a higher income than architect. Banker is neither youngest nor oldest.
        member([_,banker,_,_,IBa,ABa],L),
        member([_,architect,CAr,_,IAr,_],L),
        IBa > IAr,
        (ABa \= 1, ABa \= 4),

        % Doctor is a worse golfer than lawyer. Doctor is less conservative than architect.
        member([_,doctor,CDo,GDo,_,_],L),
        member([_,lawyer,_,GLa,_,_],L),
        GDo < GLa,
        CDo < CAr,

        % Oldest is most conservative and has highest income.
        member([_,_,4,_,4,4],L),

        % Youngest is the best golfer.
        member([_,_,_,4,_,1],L).

vardiff(A,B,C) :- A\=B, A\=C, B\=C.

I get

3 ?- jobs(L).
L = [[brown,architect,2,4,1,1],[clark,banker,3,1,2,2],[jones,doctor,1,2,3,3],[smith,lawyer,4,3,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,2,2,2],[jones,doctor,1,1,3,3],[smith,lawyer,4,3,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,3,2,2],[jones,doctor,1,1,3,3],[smith,lawyer,4,2,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,1,2,3],[jones,doctor,1,2,3,2],[smith,lawyer,4,3,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,2,2,3],[jones,doctor,1,1,3,2],[smith,lawyer,4,3,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,3,2,3],[jones,doctor,1,1,3,2],[smith,lawyer,4,2,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,1,3,2],[jones,doctor,1,2,2,3],[smith,lawyer,4,3,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,2,3,2],[jones,doctor,1,1,2,3],[smith,lawyer,4,3,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,3,3,2],[jones,doctor,1,1,2,3],[smith,lawyer,4,2,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,1,3,3],[jones,doctor,1,2,2,2],[smith,lawyer,4,3,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,2,3,3],[jones,doctor,1,1,2,2],[smith,lawyer,4,3,4,4]] ;
L = [[brown,architect,2,4,1,1],[clark,banker,3,3,3,3],[jones,doctor,1,1,2,2],[smith,lawyer,4,2,4,4]] ;

Multiple answers that repeat so I deleted some of them.

All the clues are satisfied except when Clark is the second oldest for example

L = [[brown,architect,2,4,1,1],[clark,banker,3,1,2,3],[jones,doctor,1,2,3,2],[smith,lawyer,4,3,4,4]] ;

This clue is violated

% Brown has a higher income than those younger than Clark.

And for all of my answers Brown is the youngest so clues like

% Brown is a better golfer than those older than him.
% Brown has a higher income than those younger than Clark.
% Youngest is the best golfer.

seem a bit pointless...

Answer 2

you need to bind your variables to a domain before to use them, the easiest way is permutation/2:

    L = [   [brown,J1,C1,G1,I1,A1],
            [clark,J2,C2,G2,I2,A2],
            [jones,J3,C3,G3,I3,A3],
            [smith,J4,C4,G4,I4,A4]],

permutation([1,2,3,4], [C1,C2,C3,C4]),
permutation([1,2,3,4], [I1,I2,I3,I4]),
permutation([1,2,3,4], [A1,A2,A3,A4]),
permutation([1,2,3,4], [G1,G2,G3,G4]),
permutation([banker,archit,doctor,lawyer], [J1,J2,J3,J4]),

now the rules can be used

    % Brown is more conservative than Jones. Brown is less conservative than Smith.
    member([brown,_,CB,GB,IB,AB],L),
    member([jones,_,CJ,_,_,_],L),
    CB > CJ,
    member([smith,_,CS,_,_,_],L),
    CB < CS,

efficiency wise, when you select (via member) a named member, 'fetch' all related variables at once (brown attributes' are used later). Also beware that referencing in different selection variables J1,C1, etc could lead to unwanted binding.

A rule difficult to express is

    % Brown is a better golfer than those older than him.

    member([_,_,_,GO1,_,AO1],L),
    (AO1 > AB, GB > GO1 ; AO1 < AB),
    member([_,_,_,GO2,_,AO2],L),
    (AO2 > AB, GB > GO2 ; AO2 < AB),
    member([_,_,_,GO3,_,AO3],L),
    (AO3 > AB, GB > GO3 ; AO3 < AB),

    vardiff(GO1,GO2,GO3),
    vardiff(AO1,AO2,AO3),  % bug: AO1 was GO1

where vardiff/3 is a simple convenience:

vardiff(A,B,C) :- A\=B,A\=C,B\=C.

Of course, if your Prolog has available, CLP(FD) is a much better choice.

Answer 3

(continuing the trail blazed by CapelliC...) Selecting from domains and (better yet, while) applying the rules is usually the way to go in such puzzles. Carefully testing as soon as possible, to eliminate wrong choices as soon as possible -- but not sooner.

We can't arithmetically compare unknown values, this is what the error means: > compares two known arithmetical values to which its arguments are instantiated. But if a Prolog logical variable is not yet instantiated it means that its value is still unknown.

In constraint logical programming (CLP) we can register such constraints upfront, -- but not in vanilla Prolog. Though many a modern Prolog has CLP packages or predicates available in them. SWI Prolog has it too. But in vanilla Prolog code, we must be careful.

mselect([A|As],S,Z):- select(A,S,S1), mselect(As,S1,Z).
mselect([],Z,Z).         % (* instantiate a domain by selecting from it *)

puzzle(L):- % (* [_,_,Conserv,Golf,Income,Age] *)
  L =      [ [brown,_,C1,G1,I1,A1],
             [clark,_,C2,_ ,I2,A2],
             [jones,_,C3,_ ,I3,A3],
             [smith,_,C4,_ ,I4,A4] ],

  L1 = [[_,_,4,_,4,4], [_,_,_,4,_,1]],           % (* 6,7 - oldest, youngest *)
  mselect( L1, L, L2),                           % (* L2: neither youngest nor oldest *)
  mselect( [A3,A4], [1,2,3,4], [A2,A1]), A2 > 1, % (* 3b. 1 < A2 < A1  *)
  select( C2, [1,2,3,4], [C3,C1,C4]),            % (* 1.  C3 < C1 < C4 *)

  select(    [_, banker, _ ,GB,IB,_ ], L2, [P3] ),
  mselect( [ [_, archct, CA,GA,IA,_ ],           % (* second view into the same matrix *)
             [_, doctor, CD,GD,ID,_ ] ], [P3|L1], 
           [ [_, lawyer, _ ,GL,IL,_ ] ]         ),
  CD < CA,                                       % (* 5b.          *)
  mselect( [ID,IL], [1,2,3,4], [IA,IB]),         % (* 4a.  IA < IB *)
  mselect( [GA,GB], [1,2,3,4], [GD,GL]),         % (* 5a.  GD < GL *)

  % (* 2. ( X in L : A1 < AX ) => G1 > GX  *)
  % (* 3. ( Y in L : AY < A2 ) => I1 > IY ... so, not(A1<A2)! i.e. % 3b. 1 < A2 < A1 *)
  forall( (member(X,L), last(X,AX), AX>A1), (nth1(4,X,GX), G1>GX) ),
  forall( (member(Y,L), last(Y,AY), A2>AY), (nth1(5,Y,IY), I1>IY) ).

Testing: ([_,_,Conserv,Golf,Income,Age])

7 ?- time(( puzzle(_X), maplist(writeln,_X),nl, false; true )).
[brown,banker,3,3,3,3]
[clark,doctor,1,1,1,2]
[jones,archct,2,4,2,1]
[smith,lawyer,4,2,4,4]

[brown,banker,3,3,3,3]
[clark,doctor,1,1,2,2]
[jones,archct,2,4,1,1]
[smith,lawyer,4,2,4,4]

[brown,banker,3,3,2,3]
[clark,doctor,1,1,3,2]
[jones,archct,2,4,1,1]
[smith,lawyer,4,2,4,4]

% (* 2,299 inferences, 0.000 CPU in 0.120 seconds (0% CPU, Infinite Lips) *)
true.

This is actually one solution, according to the way the puzzle question is asked.

Answer 4

You code works exactly as expected if you just use finite domain constraints instead of lower-level arithmetic. For example, use (#>)/2 instead of (>)/2.

After you get it to run beyond this instantiation error by using constraints, you will then notice that among other things, your code has a typo: banker_. Also, you are not formulating the implication correctly, and your predicate will therefore yield false.

Here is a slightly modified version of your code, changed to use finite domain constraints and correcting the two mentioned mistakes:

:- use_module(library(clpfd)).

older_worse_golfer([], _, _).
older_worse_golfer([[_,_,_,G,_,A]|Rest], G0, A0) :-
        A #> A0 #==> G #< G0,
        older_worse_golfer(Rest, G0, A0).

younger_higher_income([], _, _).
younger_higher_income([[_,_,_,_,I,A]|Rest], I0, A0) :-
        A #< A0 #==> I0 #> I,
        younger_higher_income(Rest, I0, A0).

man_profession_rest([M,P|Rest], M-P, Rest).

jobs(Ls, Vs) :-
        Ls = [[brown,_,_,_,_,_],
              [clark,_,_,_,_,_],
              [jones,_,_,_,_,_],
              [smith,_,_,_,_,_]],
        maplist(man_profession_rest, Ls, _, Rests),
        append(Rests, Vs),
        Vs ins 1..4,

        % [name,job,conservative,golf,income,age]
        % conserative: 1 = least conservative, 4 = most conservative
        % golf: 1 = worst golfer, 4 = best golfer
        % income: 1 = least income, 4 = highest income
        % age: 1 = youngest, 4 = oldest

        % Oldest is most conservative and has highest income.
        member([_,_,4,_,4,4], Ls),

        % Brown is more conservative than Jones. Brown is less
        % conservative than Smith.
        memberchk([brown,_,C1,_,_,_], Ls),
        memberchk([jones,_,C2,_,_,_], Ls),
        memberchk([smith,_,C3,_,_,_], Ls),
        C1 #> C2,
        C1 #< C3,

        % Brown is a better golfer than those older than him.
        memberchk([brown,_,_,G1,_,A1], Ls),
        older_worse_golfer(Ls, G1, A1),

        % IMPLIED: Brown is not the oldest
        A1 #< 4,

        % Brown has a higher income than those younger than Clark.
        memberchk([brown,_,_,_,I1,_], Ls),
        memberchk([clark,_,_,_,_,A3], Ls),
        younger_higher_income(Ls, I1, A3),

        % IMPLIED: Clark is not the youngest
        A3 #> 1,

        % Banker has a higher income than architect. Banker is neither
        % youngest nor oldest.
        I3 #> I4,
        A5 in 2..3,
        member([_,banker,_,_,I3,A5], Ls),
        member([_,architect,_,_,I4,_], Ls),

        % Doctor is a worse golfer than lawyer. Doctor is less
        % conservative than architect.
        member([_,doctor,C4,G3,_,_], Ls),
        member([_,lawyer,_,G4,_,_], Ls),
        member([_,architect,C5,_,_,_], Ls),
        G3 #< G4,
        C4 #< C5,

        % Youngest is the best golfer.
        member([_,_,_,4,_,1], Ls).

You can use label/1 to search for concrete solutions. As you can see with the following query, there is a unique solution with respect to professions:

?- time(setof(MP, Ls^Vs^Rs^(jobs(Ls, Vs),
                            label(Vs),
                            maplist(man_profession_rest, Ls, MP, Rs)), MP)).

which yields:

% 124,485 inferences, 0.041 CPU in 0.042 seconds (97% CPU, 3043643 Lips)
MP = [[brown-banker, clark-doctor, jones-architect, smith-lawyer]].

And that's without even requiring that all income levels etc. be different. If you want, you can express this constraint easily by adding:

        transpose(Rests, RestsT), maplist(all_different, RestsT)

to this formulation.

Answer 5

Here's my answer to the problem:

puzzle(Puzzle) :-
    Names = [brown,clark,jones,smith],

    permute(Names,Conservatives),

% Brown is more conservative than Jones.
    ismore(brown,jones,Conservatives),

% Brown is less conservative than Smith.
    isless(brown,smith,Conservatives),

    permute(Names,Golfs),
    permute(Names,Ages),

% Brown is a better golfer than those older than him.
    worsethans(brown,Golfs,WorseAtGolfThanBrown),
    betterthans(brown,Ages,OlderThanBrown),
    members(OlderThanBrown,WorseAtGolfThanBrown),

    permute(Names,Incomes),

% Brown has a higher income than those younger than Clark.
    worsethans(brown,Incomes,WorseIncomeThanBrown),
    worsethans(clark,Ages,YoungerThanClark),
    members(YoungerThanClark,WorseIncomeThanBrown),

    permute([banker,architect,lawyer,doctor],Jobs),

% Banker has a higher income than architect.
    lookup(banker,Jobs,Names,Banker),
    lookup(architect,Jobs,Names,Architect),
    ismore(Banker,Architect,Incomes),

% Banker is neither youngest nor oldest.
    ([_,Banker,_,_]=Ages;[_,_,Banker,_]=Ages),

% Doctor is a worse golfer than lawyer.
    lookup(doctor,Jobs,Names,Doctor),
    lookup(lawyer,Jobs,Names,Lawyer),
    ismore(Lawyer,Doctor,Golfs),

% Doctor is less conservative than architect.
    ismore(Architect,Doctor,Conservatives),

% Oldest is most conservative and has highest income.
    [Oldest,_,_,_]=Ages,
    [Oldest,_,_,_]=Conservatives,
    [Oldest,_,_,_]=Incomes,

% Youngest is the best golfer.
    [_,_,_,Youngest]=Ages,
    [Youngest,_,_,_]=Golfs,

    Puzzle = [Names,Jobs,c(Conservatives),g(Golfs),i(Incomes),a(Ages)].

It needs these supporting predicates:

ismore(X,Y,Zs) :-
    append(Xs,[Y|_],Zs),
    member(X,Xs).

isless(X,Y,Zs) :-
    append(_,[Y|Xs],Zs),
    member(X,Xs).

betterthans(X,Ys,Zs) :-
    append(Zs,[X|_],Ys).

worsethans(X,Ys,Zs) :-
    append(_,[X|Zs],Ys).

%lookup(X,Xs,Ys,Y)
lookup(X,[X|_],[Y|_],Y).
lookup(X,[_|Xs],[_|Ys],Y) :-
    lookup(X,Xs,Ys,Y).

members([], _).
members([X|Xs], Ys) :-
    member(X, Ys),
    members(Xs, Ys).

select([X|Xs], X, Xs).
select([X|Xs], Y, [X|Ys]) :- select(Xs, Y, Ys).

permute([], []).
permute(Xs, [X|Zs]) :-
    select(Xs, X, Ys),
    permute(Ys, Zs).

Now, the only issue I had is that this gives me more than one answer. Unless I've got the logic wrong this is what I got:

[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,brown,clark,jones]),g([clark,brown,smith,jones]),i([smith,brown,clark,jones]),a([smith,brown,jones,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,brown,clark,jones]),g([clark,brown,smith,jones]),i([smith,brown,jones,clark]),a([smith,brown,jones,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,brown,clark,jones]),g([clark,brown,smith,jones]),i([smith,jones,brown,clark]),a([smith,brown,jones,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,brown,clark,jones]),g([clark,brown,smith,jones]),i([smith,brown,clark,jones]),a([smith,jones,brown,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,brown,clark,jones]),g([clark,brown,smith,jones]),i([smith,brown,jones,clark]),a([smith,jones,brown,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,brown,clark,jones]),g([clark,brown,smith,jones]),i([smith,jones,brown,clark]),a([smith,jones,brown,clark])]
[[brown,clark,jones,smith],[banker,doctor,architect,lawyer],c([smith,brown,jones,clark]),g([jones,brown,smith,clark]),i([smith,brown,clark,jones]),a([smith,brown,clark,jones])]
[[brown,clark,jones,smith],[banker,doctor,architect,lawyer],c([smith,brown,jones,clark]),g([jones,brown,smith,clark]),i([smith,brown,jones,clark]),a([smith,brown,clark,jones])]
[[brown,clark,jones,smith],[banker,doctor,architect,lawyer],c([smith,brown,jones,clark]),g([jones,brown,smith,clark]),i([smith,clark,brown,jones]),a([smith,brown,clark,jones])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,clark,brown,jones]),g([clark,brown,smith,jones]),i([smith,brown,clark,jones]),a([smith,brown,jones,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,clark,brown,jones]),g([clark,brown,smith,jones]),i([smith,brown,jones,clark]),a([smith,brown,jones,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,clark,brown,jones]),g([clark,brown,smith,jones]),i([smith,jones,brown,clark]),a([smith,brown,jones,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,clark,brown,jones]),g([clark,brown,smith,jones]),i([smith,brown,clark,jones]),a([smith,jones,brown,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,clark,brown,jones]),g([clark,brown,smith,jones]),i([smith,brown,jones,clark]),a([smith,jones,brown,clark])]
[[brown,clark,jones,smith],[banker,architect,doctor,lawyer],c([smith,clark,brown,jones]),g([clark,brown,smith,jones]),i([smith,jones,brown,clark]),a([smith,jones,brown,clark])]

I can constrain it to a single solution if I also say that Clark's income is greater than Brown's.

Can anyone confirm if my answer is correct or not and if there should be more constraints?