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

(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(A1A1), (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.