Bertrand Russell Puzzle

Question

Solve the following Caliban problem, translating each clue 'loyally' into Prolog, i.e. as loyally as possible.

As a simple exercise in abstraction suppose that four meaningless symbols a, b, c, and d correspond in one order or another to the equally meaningless symbols w, x, y, and z, and suppose further that

If a is not x, then c is not y.
If b is either y or z, then a is x.
If c is not w, then b is z.
If d is y, then b is not x.
If d is not x, then b is x.

In what order do the two sets of symbols correspond?

I tried the following code:

vban(L) :-
       L=[[a,C1],[b,C2],[c,C3],[d,C4]],

       ( member(C1,[w,y,z]) -> member(C3,[w,x,z])),
       ( member(C2,[y,z]) -> member(C1,[x])),
       ( member(C3,[x,y,z]) -> member(C2,[z])),
       ( member(C4,[y]) -> member(C2,[w,y,z])),
       ( member(C4,[w,y,z]) -> member(C2,[x])).

But it shows fail.Any help would be appreciated.

Answer 1

Using CLP(B) in SICStus Prolog or SWI:

:- use_module(library(clpb)).
:- use_module(library(lists)).
:- use_module(library(clpfd)).

corresponding(Matrix) :-
        Matrix = [[ _,AX, _, _],
                  [ _,BX,BY,BZ],
                  [CW, _,CY, _],
                  [ _,DX,DY, _]],
        maplist(card1, Matrix),
        transpose(Matrix, TMatrix),
        maplist(card1, TMatrix),
        sat(~AX =< ~CY),
        sat(BY + BZ =< AX),
        sat(~CW =< BZ),
        sat(DY =< ~BX),
        sat(~DX =< BX).

card1(Vs) :- sat(card([1], Vs)).

Example query:

?- corresponding(Vs), 
   pairs_keys_values(Pairs, [t,a,b,c,d], [[w,x,y,z]|Vs]),
   maplist(writeln, Pairs).

Yielding (1 denotes corresponding elements):

t-[w,x,y,z]
a-[0,0,1,0]
b-[0,1,0,0]
c-[1,0,0,0]
d-[0,0,0,1]

and bindings for Vs and Pairs.

Answer 2

Direct translation of the problem statement to ECLiPSe Prolog with ic_symbolic constraint programming library:

:- lib(ic).
:- lib(ic_symbolic).
:- local domain(symbol(w,x,y,z)).
russel(A, B, C, D) :-
    [A, B, C, D] &:: symbol,
    (A &\= x) => (C &\= y),
    (B &= y or B &= z) => (A &= x),
    (C &\= w) => (B &= z),
    (D &= y) => (B &\= x),
    (D &\= x) => (B &= x),
    ic_symbolic:alldifferent([A, B, C, D]),
    ic_symbolic:indomain(A),
    ic_symbolic:indomain(B),
    ic_symbolic:indomain(C),
    ic_symbolic:indomain(D).

Solution:

[eclipse]: russel(A,B,C,D).
A = y
B = x
C = w
D = z
Yes

Answer 3

I like Mat's solution, but to solve the problem, we can write logical expressions with "and" and "or".

a, b, c et d can be symbolised with [0,0], [0,1], [1,0] and [1,1].

Two numbers M and N are equals if (M1 = N1 and M2 = N2)

Two numbers are differents if (M1 \= N1) or (M2 \= N2) (or not(equals) )

Implication u => v is translated in not(u) or v

So we get :

:- use_module(library(clpb)).
:- use_module(library(lambda)).

or(A,B,A+B).
and(A,B,A*B).

% two numbers are equal
equal(A, B, Eq) :-
    foldl(\X^Y^Z^T^and(Z, (X =:= Y), T), A, B, 1, Eq).

% two numbers are different
different(A, B, Diff) :-
    equal(A,B,Eq),
    Diff = ~Eq.
    % foldl(\X^Y^Z^T^or(Z, (X =\= Y), T), A, B, 0, Diff).


puzzle :-
    A = [0,0],
    B = [0,1],
    C = [1,0],
    D = [1,1],

    W = [_,_],
    X = [_,_],
    Y = [_,_],
    Z = [_,_],

    % If a is not x, then c is not y.
    % (a is x) or (c is not y)
    equal(A, X, Eq1),
    different(C, Y, Di1),
    or(Eq1, Di1, P1),

    % If b is either y or z, then a is x.
    % (b is not y) and (b is not z) or (a is x)
    different(B, Y, Di2),
    different(B, Z, Di3),
    equal(A, X, Eq2),
    and(Di2, Di3, P2),
    or(Eq2, P2, P3),

    % If c is not w, then b is z.
    % (c is w) or (b is z)
    equal(C, W, Eq3),
    equal(B, Z, Eq4),
    or(Eq3, Eq4, P4),

    % If d is y, then b is not x.
    % (d is not y) or (b is not x)
    different(D, Y, Di4),
    different(B, X, Di5),
    or(Di4, Di5, P5),

    % If d is not x, then b is x.
    %(d is x) or (b is x)
    equal(D, X, Eq5),
    equal(B, X, Eq6),
    or(Eq5, Eq6, P6),

    % we must express that W,X,Y,Z are differents
    % W is different from X, Y, Z
    foldl(W +\R^S^T^(different(W, R, U),
             and(S, U, T)),
             [X,Y,Z], 1, Dif1),

    % X is different from Y, Z
    foldl(X +\R^S^T^(different(X, R, U),
             and(S, U, T)),
             [Y,Z], 1, Dif2),

    % Y is different from Z
    different(Y, Z, Dif3),

    % now we join all these expressions with an and
    Expr = *([P1,P3,P4,P5,P6, Dif1,Dif2, Dif3]),

    % we ask Prolog to count the number of solutions
    sat_count(Expr, N),
    writeln(N : ' solution(s)'),

    % we ask Prolog to satisfy the expr
    sat(Expr),

    maplist(writeln, [A, B, C, D]), nl,
    maplist(writeln, [W, X, Y, Z]).

We get :

?- puzzle.
1: solution(s)
[0,0]
[0,1]
[1,0]
[1,1]

[1,0]
[0,1]
[0,0]
[1,1]
true.