Warren@SRI-AI@sri-unix.UUCP (07/28/83)
From: David Warren <Warren@SRI-AI>
Here's a solution to the puzzle Russ Abbott posed.
% Liars and Non-Liars Puzzle
% On a certain island the inhabitants are partitioned into those who
% always tell the truth and those who always lie. I landed on the
% island and met three inhabitants A, B, and C. I asked A, "Are you a
% truth-teller or a liar?" He mumbled something which I couldn't make
% out. I asked B what A had said. B replied, "A said he was a liar."
% C then volunteered, "Don't believe B, he's lying." What can you tell
% about A, B, and C?
:-op(900,xfx,if).
:-op(800,xfy,and).
:-op(700,xfx,[is_in,isnt_in]).
:-op(100,fy,not).
says(a,mumble).
says(b,says(a,liar(a))).
says(c,liar(b)).
liar(X) if says(X,Y) and not Y.
not liar(X) if says(X,Y) and Y.
not says(X,Y) if not liar(X) and not Y.
not says(X,Y) if liar(X) and Y.
provable(P and Q,A) :- !, provable(P,A), provable(Q,A).
provable(P,_) :- P.
provable(P,A) :- P is_in A.
provable(P,A) :- P isnt_in A, P if Q, negation(P,P1), provable(Q,[P1|A]).
P is_in [P|_].
P is_in [_|A] :- P is_in A.
P isnt_in [].
P isnt_in [P1|A] :- P \== P1, P isnt_in A.
negation(not P,P) :- !.
negation(P, not P).
:- provable(liar(X),[]), write(X), write(' is a liar.'), nl.
:- provable(not liar(X),[]), write(X), write(' is not a liar.'), nl.Suwa@Sumex-AIM@sri-unix.UUCP (09/19/83)
From: Motoi Suwa <Suwa@Sumex-AIM>
Date: 14 Sep. 1983
From: K.Handa ETL Japan
Subject: Another Puzzle Solution
This is the solution of Alan's puzzle introduced on 24 Aug.
?-go(10).
will display the ten disgit number as following:
-->6210001000
and
?-go(4).
will:
-->1210
-->2020
I found following numbers:
6210001000
521001000
42101000
3211000
21200
1210
2020
The Following is the total program ( DEC10 Prolog Ver.3 )
/*** initial assertion ***/
init(D):- ass_xn(D),assert(rest(D)),!.
ass_xn(0):- !.
ass_xn(D):- D1 is D-1,asserta(x(D1,_)),asserta(n(D1)),ass_xn(D1).
/*** main program ***/
go(D):- init(D),guess(D,0).
go(_):- abolish(x,2),abolish(n,1),abolish(rest,1).
/* guess 'N'th digit */
guess(D,D):- result,!,fail.
guess(D,N):- x(N,X),var(X),!,n(Y),N=<Y,N*Y=<D,ass(N,Y),set(D,N,Y),
N1 is N+1,guess(D,N1).
guess(D,N):- x(N,X),set(D,N,X),N1 is N+1,guess(D,N1).
/* let 'N'th digit be 'X' */
ass(N,X):- only(retract(x(N,_))),asserta(x(N,X)),only(update(1)).
ass(N,_):- retract(x(N,_)),asserta(x(N,_)),update(-1),!,fail.
only(X):- X,!.
/* 'X' 'N's appear in the sequence of digit */
set(D,N,X):- count(N,Y),rest(Z),!,Y=<X,X=<Y+Z,X1 is X-Y,set1
(D,N,X1,0).
set1(_,N,0,_):- !.
set1(D,N,X,P):- n(M),P=<M,x(M,Y),var(Y),M*N=<D,ass(M,N),set(D,M,N),
X1 is X-1,P1 is M,set1(D,N,X1,P1).
/* 'X' is the number of digits which value is 'N' */
count(N,X):- bagof(M,M^(x(M,Z),nonvar(Z),Z=N),L),length(L,X).
count(_,0).
/* update the number of digits which value is not yet assigned */
update(Z):- only(retract(rest(X))),Z1 is X-Z,assert(rest(Z1)).
update(Z):- retract(rest(X)),Z1 is X+Z,assert(rest(Z1)),!,fail.
/* display the result */
result:- print(-->),n(N),x(N,M),print(M),fail.
result:- nl.