Category Archives: Prolog

1、代码实现

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

%求解函数
sudoku(Puzzle, Solution) :-
  length(Puzzle, L),                         
  Size is floor(sqrt(L)),                    %计算矩阵大小                   
  Solution = Puzzle,
  Puzzle ins 1..Size,                        %输入必须符合规范（比如9阶Sudoku，元素必须在1到9之间）
  slice(Puzzle, Rows, Size, 'row'),          %将输入拆分为行，
  slice(Puzzle, Cols, Size, 'col'),          %列，
  slice(Puzzle, Squares, Size, 'square'),    %方格。
  valid(Rows),                               %每行，每列，每个方格不可重复
  valid(Cols),
  valid(Squares),
  pretty_print(Rows).                        %输出

%校验，一个List不可重复
valid([]).
valid([Head | Tail]) :- all_different(Head), valid(Tail).

%List截取
sublist_length([], _).
sublist_length([Head | Tail], Length) :- length(Head, Length), sublist_length(Tail, Length).

%List拼接
insert_into_slice(Item, Values, X, Y) :-
  nth0(X, Values, Bucket),
  nth0(Y, Bucket, Item).

%按行分割坐标
slice_position('row', Size, I, X, Y) :-   
  X is I // Size,
  Y is I mod Size.

%按列分割坐标
slice_position('col', Size, I, X, Y) :- 
  X is I mod Size,
  Y is I // Size.

%按方格分割坐标
slice_position('square', Size, I, X, Y) :- 
  Size_Sqrt is floor(sqrt(Size)),
  X is (I mod Size // Size_Sqrt) + (Size_Sqrt * (I // (Size * Size_Sqrt))),
  Y is (I mod Size_Sqrt) + (Size_Sqrt * ((I mod (Size * Size_Sqrt)) // Size)).

%数据分割函数
slice(Puzzle, Slice, Size, Type) :- slice(Puzzle, Slice, Size, Type, 0).
slice(_, Slice, Size, _, I) :- I is Size * Size, length(Slice, Size), sublist_length(Slice, Size).
slice([Head | Tail], Slice, Size, Type, I) :-
  slice_position(Type, Size, I, X, Y), 
  insert_into_slice(Head, Slice, X, Y),
  I1 is I + 1,
  slice(Tail, Slice, Size, Type, I1).

%输出函数
pretty_print([Head | Tail]) :-
  print(Head),
  nl,
  pretty_print(Tail).

2、测试一下

1 ?- sudoku([5, 3, _, _, 7, _, _, _, _, 
             6, _, _, 1, 9, 5, _, _, _, 
             _, 9, 8, _, _, _, _, 6, _, 
             8, _, _, _, 6, _, _, _, 3,
             4, _, _, 8, _, 3, _, _, 1,
             7, _, _, _, 2, _, _, _, 6,
             _, 6, _, _, _, _, 2, 8, _,
             _, _, _, 4, 1, 9, _, _, 5,
             _, _, _, _, 8, _, _, 7, 9], 
             Solution).

[5,3,4,6,7,8,9,1,2]
[6,7,2,1,9,5,3,4,8]
[1,9,8,3,4,2,5,6,7]
[8,5,9,7,6,1,4,2,3]
[4,2,6,8,5,3,7,9,1]
[7,1,3,9,2,4,8,5,6]
[9,6,1,5,3,7,2,8,4]
[2,8,7,4,1,9,6,3,5]
[3,4,5,2,8,6,1,7,9]
false.

1、求解源码如下

:- use_module(library(clpfd)).

%求解函数
sudoku(Rows) :-
        length(Rows, 9),                                         %输入为9行
        maplist(length_(9), Rows),                               %每行长度必须为9
        append(Rows, Vs), Vs ins 1..9,                           %所有行拼接为一个List，数值都必须在1到9之间
        maplist(all_distinct, Rows),                             %每行没有重复数据
        transpose(Rows, Columns), maplist(all_distinct, Columns),%矩阵转置，每列没有重复数据
        Rows = [R1,R2,R3,R4,R5,R6,R7,R8,R9],                     %输入拆分为9行
        blocks(R1,R2,R3), blocks(R4,R5,R6), blocks(R7,R8,R9).    %按每3行进行处理

%为了适应maplist函数，调整参数顺序
length_(L, Ls) :- length(Ls, L).

%对于每3行，每次从各行抽取前3个值，恰好为1个3×3的矩阵，共抽取3个矩阵
%对于矩阵，拼接为一个List，并要求没有重复数据
blocks([], [], []).
blocks([A,B,C|Bs1], [D,E,F|Bs2], [G,H,I|Bs3]) :-
        all_distinct([A,B,C,D,E,F,G,H,I]),
        blocks(Bs1, Bs2, Bs3).

%这个是输入函数，就不需要命令行输入了
%第1个是一个sudoku问题
problem(1, [[_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,3,_,8,5],
            [_,_,1,_,2,_,_,_,_],
            [_,_,_,5,_,7,_,_,_],
            [_,_,4,_,_,_,1,_,_],
            [_,9,_,_,_,_,_,_,_],
            [5,_,_,_,_,_,_,7,3],
            [_,_,2,_,1,_,_,_,_],
            [_,_,_,_,4,_,_,_,9]]).
            
%第2个是一个多解的sudoku问题           
problem(2, [[_,9,1,_,4,7,_,_,_],
            [7,_,_,_,1,_,_,_,_],
            [_,_,_,6,5,_,_,_,_],
            [9,_,_,4,_,6,_,_,7],
            [_,_,_,7,3,5,_,_,6],
            [_,_,7,9,8,1,_,_,_],
            [1,_,6,5,7,8,9,_,4],
            [_,_,9,1,6,_,8,_,_],
            [_,_,_,3,9,4,_,_,1]]).
            
%第3个是通过2得到的唯一解sudoku问题            
problem(3, [[8,9,1,_,4,7,6,_,_],
            [7,_,_,_,1,_,_,_,_],
            [2,_,_,6,5,_,_,_,_],
            [9,_,_,4,_,6,_,_,7],
            [_,_,_,7,3,5,_,_,6],
            [_,_,7,9,8,1,_,_,_],
            [1,_,6,5,7,8,9,_,4],
            [_,_,9,1,6,_,8,_,_],
            [_,_,_,3,9,4,_,_,1]]).

2、尝试一下

1 ?- problem(1, Rows), sudoku(Rows), maplist(writeln, Rows).
[9,8,7,6,5,4,3,2,1]
[2,4,6,1,7,3,9,8,5]
[3,5,1,9,2,8,7,4,6]
[1,2,8,5,3,7,6,9,4]
[6,3,4,8,9,2,1,5,7]
[7,9,5,4,6,1,8,3,2]
[5,1,9,2,8,6,4,7,3]
[4,7,2,3,1,9,5,6,8]
[8,6,3,7,4,5,2,1,9]
Rows = [[9, 8, 7, 6, 5, 4, 3, 2|...], [2, 4, 6, 1, 7, 3, 9|...], [3, 5, 1, 9, 2, 8|...], [1, 2, 8, 5, 3|...], [6, 3, 4, 8|...], [7, 9, 5|...], [5, 1|...], [4|...], [...|...]].

2 ?- problem(2, Rows), sudoku(Rows), maplist(writeln, Rows).
[_G296,9,1,_G320,4,7,_G344,_G368,_G392]
[7,_G416,_G440,_G464,1,_G488,_G512,_G536,_G560]
[_G584,_G608,_G632,6,5,_G656,7,1,_G728]
[9,_G752,_G776,4,2,6,_G824,8,7]
[_G872,_G896,_G920,7,3,5,_G944,9,6]
[_G992,_G1016,7,9,8,1,_G1040,_G1064,_G1088]
[1,_G1112,6,5,7,8,9,_G1136,4]
[_G1160,_G1184,9,1,6,2,8,_G1232,_G1256]
[_G1280,_G1304,_G1328,3,9,4,_G1352,_G1376,1]
Rows = [[_G24117, 9, 1, _G24126, 4, 7, _G24135, _G24138|...], [7, _G24150, _G24153, _G24156, 1, _G24162, _G24165|...], [_G24177, _G24180, _G24183, 6, 5, _G24192|...], [9, _G24210, _G24213, 4, 2|...], [_G24237, _G24240, _G24243, 7|...], [_G24267, _G24270, 7|...], [1, _G24300|...], [_G24327|...], [...|...]],
_G24117 in 2..3\/5..6\/8,
all_distinct([_G24117, 9, 1, 7, _G24150, _G24153, _G24177, _G24180|...]),
all_distinct([_G24117, 7, _G24177, 9, _G24237, _G24267, 1, _G24327|...]),
all_distinct([_G24117, 9, 1, _G24126, 4, 7, _G24135, _G24138|...]),
_G24150 in 2..6\/8,
all_distinct([9, _G24150, _G24180, _G24210, _G24240, _G24270, _G24300, _G24330|...]),
all_distinct([7, _G24150, _G24153, _G24156, 1, _G24162, _G24165, _G24168|...]),
_G24153 in 2..5\/8,
all_distinct([1, _G24153, _G24183, _G24213, _G24243, 7, 6, 9|...]),
_G24177 in 2..4\/8,
all_distinct([_G24177, _G24180, _G24183, 6, 5, _G24192, 7, 1|...]),
_G24180 in 2..4\/8,
_G24183 in 2..4\/8,
_G24213 in 3\/5,
all_distinct([9, _G24210, _G24213, _G24237, _G24240, _G24243, _G24267, _G24270|...]),
all_distinct([9, _G24210, _G24213, 4, 2, 6, _G24225, 8|...]),
_G24237 in 2\/4\/8,
all_distinct([_G24237, _G24240, _G24243, 7, 3, 5, _G24255, 9|...]),
_G24240 in 1..2\/4\/8,
_G24243 in 2\/4\/8,
_G24267 in 2..6,
all_distinct([_G24267, _G24270, 7, 9, 8, 1, _G24285, _G24288|...]),
_G24270 in 2..6,
_G24210 in 1\/3\/5,
_G24300 in 2..3,
all_distinct([1, _G24300, 6, _G24327, _G24330, 9, _G24357, _G24360|...]),
all_distinct([1, _G24300, 6, 5, 7, 8, 9, _G24318|...]),
_G24327 in 3..5,
all_distinct([_G24327, _G24330, 9, 1, 6, 2, 8, _G24348|...]),
_G24330 in 3..5\/7,
_G24357 in 2\/5\/8,
all_distinct([_G24357, _G24360, _G24363, 3, 9, 4, _G24375, _G24378|...]),
_G24360 in 2\/5\/7..8,
_G24363 in 2\/5\/8,
_G24375 in 2\/5..6,
all_distinct([9, _G24318, 4, 8, _G24348, _G24351, _G24375, _G24378|...]),
all_distinct([_G24135, _G24165, 7, _G24225, _G24255, _G24285, 9, 8|...]),
_G24378 in 2\/5..7,
all_distinct([_G24138, _G24168, 1, 8, 9, _G24288, _G24318, _G24348|...]),
_G24351 in 3\/5,
all_distinct([_G24141, _G24171, _G24201, 7, 6, _G24291, 4, _G24351|...]),
_G24348 in 3\/5\/7,
_G24318 in 2..3,
_G24288 in 2..5,
all_distinct([_G24225, 8, 7, _G24255, 9, 6, _G24285, _G24288|...]),
_G24291 in 2..3\/5,
_G24285 in 2..5,
_G24255 in 1..2\/4,
_G24225 in 1\/3\/5,
_G24165 in 2..6,
all_distinct([_G24135, _G24138, _G24141, _G24165, _G24168, _G24171, 7, 1|...]),
_G24168 in 2..6,
_G24171 in 2..3\/5\/8..9,
_G24201 in 2..3\/8..9,
_G24141 in 2..3\/5\/8,
_G24138 in 2..3\/5..6,
_G24135 in 2..3\/5..6,
_G24126 in 2\/8,
all_distinct([_G24126, 4, 7, _G24156, 1, _G24162, 6, 5|...]),
all_distinct([_G24126, _G24156, 6, 4, 7, 9, 5, 1|...]),
_G24156 in 2\/8,
_G24162 in 3\/9,
all_distinct([7, _G24162, _G24192, 6, 5, 1, 8, 2|...]),
_G24192 in 3\/9.

%根据2的提示，填写部分不确定的值后，可以得到问题3，根据选择不同，答案也不同
3 ?- problem(3, Rows), sudoku(Rows), maplist(writeln, Rows).
[8,9,1,2,4,7,6,5,3]
[7,6,5,8,1,3,4,2,9]
[2,3,4,6,5,9,7,1,8]
[9,1,3,4,2,6,5,8,7]
[4,8,2,7,3,5,1,9,6]
[6,5,7,9,8,1,3,4,2]
[1,2,6,5,7,8,9,3,4]
[3,4,9,1,6,2,8,7,5]
[5,7,8,3,9,4,2,6,1]
Rows = [[8, 9, 1, 2, 4, 7, 6, 5|...], [7, 6, 5, 8, 1, 3, 4|...], [2, 3, 4, 6, 5, 9|...], [9, 1, 3, 4, 2|...], [4, 8, 2, 7|...], [6, 5, 7|...], [1, 2|...], [3|...], [...|...]].

Family

% GENE.PRO - genealogical relationships
%
% A Prolog database of relations derived from basic information about
% individuals.  The relations ships can all be read as 'relationship
% of', so for example, parent(P,C) means P is parent of C.
%
% When there is a performance trade-of in the implementation of a rule,
% it is assumed that in general the second argument of a relation will
% most likely be bound.  See for example full_sibling/2, which will
% have a smaller search for full_sibling(X,joe), than full_sibling(joe,X).
%
% This code is used as an example of an embedded Prolog application.
% One is a C++ application and the other Visual Basic.
%
% To use this code from Prolog, consult it in the listener and use the
% following predicates:
%
% open(F) - opens a file of family relationships, ex. open('england.fam').
%    open/1 just does a consult, so you can use consult instead.
% close - retracts all the persons currently defined
% save(F) - saves the persons in the named file
% add_person(Name, Mother, Father, Gender, Spouse) - adds a person
%     fact with the specified attributes, checking semantics as it does
% Relationship(P1, P2) - any relationship query, such as child(X,Y).
% relation(R, P1, P2) - can be used to find the relationship between
%     individuals as well as pose relationship queries. 

parent(P,C) :-
 (mother(P,C) ; father(P,C)).

child(C,P) :- parent(P,C).

son(C,P) :- parent(P,C), male(C).

daughter(C,P) :- parent(P,C), female(C).

wife(W,P) :-
  spouse(W,P),
  female(W).

husband(H,P) :-
  spouse(H,P),
  male(H).

ancestor(A,P) :-
  parent(A,P).
ancestor(A,P) :-
  parent(X,P),
  ancestor(A,X).

descendent(D,P) :-
  parent(P,D).
descendent(D,P) :-
  parent(P,X),
  descendent(D,X).

full_sibling(S1, S2) :-
  mother(M,S2),
  mother(M,S1),
  S1 \= S2,
  father(F,S1),
  father(F,S2).

half_sibling(S1, S2) :-
  mother(M,S2),
  mother(M,S1),
  S1 \= S2,
  father(F1,S1),
  father(F2,S2),
  F1 \= F2.
half_sibling(S1, S2) :-
  father(F,S2),
  father(F,S1),
  S1 \= S2,
  mother(M1,S1),
  mother(M2,S2),
  M1 \= M2.

sibling(S1, S2) :-
  full_sibling(S1,S2).
sibling(S1, S2) :-
  half_sibling(S1,S2).

sister(S,P) :-
  sibling(S,P),
  female(S).

brother(B,P) :-
  sibling(B,P),
  male(B).

step_sibling(S1, S2) :-
  parent(P2, S2),
  spouse(M2, P2),
  parent(M2, S1),
  not(parent(M2,S2)),
  not(half_sibling(S1,S2)).
  
uncle(U,X) :-
  parent(P,X),
  brother(U,P).

aunt(A,X) :-
  parent(P,X),
  sister(A,P).

step_parent(P2,C) :-
  parent(P,C),
  spouse(P2,P),
  not(parent(P2,C)).

step_mother(M,C) :- step_parent(M,C), female(M).

step_father(F,C) :- step_parent(F,C), male(F).

step_child(C2,P) :- step_parent(P,C2).

step_daughter(D,P) :- step_child(D,P), female(D).

step_son(S,P) :- step_child(S,P), male(S).

nephew(N,X) :-
  sibling(S,X),
  parent(S,N),
  male(N).

niece(N,X) :-
  sibling(S,X),
  parent(S,N),
  female(N).

cousin(X,Y) :-
  parent(P,Y),
  sibling(S,P),
  parent(S,X).

grandmother(GM,X) :-
  parent(P,X),
  mother(GM,P).

grandfather(GF,X) :-
  parent(P,X),
  father(GF,P).

grandparent(GP,X) :-
  parent(P,X),  parent(GP,P).

grandson(GS,X) :-
  grandchild(GS,X),
  male(GS).

granddaughter(GD,X) :-
  grandchild(GD,X),
  female(GD).

grandchild(GC,X) :-
  parent(X,C),
  parent(C,GC).

%----------------------------------------------------------------------
% relation/3 - used to find relationships between individuals
%

relations([parent, wife, husband, ancestor, descendent, full_sibling,
    half_sibling, sibling, sister, brother, step_sibling, uncle,
    aunt, mother, father, child, son, daughter, step_parent,
    step_child, step_mother, step_father, step_son, step_daughter,
    nephew, niece, cousin, grandmother, grandfather, grandparent,
    grandson, granddaughter, grandchild]).

relation(R, X, Y) :-
  relations(Rs),
  member(R,Rs),
  Q =.. [R,X,Y],
  call(Q).


%----------------------------------------------------------------------
% person object
%
% These predicates define the interface to a person.  All of the
% genealogical rules are based on these predicates, which are
% based on the basic representation of a person.  These are the
% only rules which need to be changed if the representation of
% a person is changed.
%
% The current representation is flat database relations of the form:
%   person(Name, Gender, Mother, Father, Spouse).
%

add(Name,Gender,Mother,Father,Spouse) :-
  assert(person(Name,Gender,Mother,Father,Spouse)).
add(Name,_,_,_,_) :-
  delete(Name),
  fail.

open(FileName) :-
  consult(FileName).

close :-
  retractall(person(_,_,_,_,_)).

save(FileName) :-
  tell(FileName),
  listing(person),
  told.

delete(X) :-
  retract(person(X,_,_,_,_)).

person(X) :-
  person(X,_,_,_,_).

male(X) :-
  person(X,male,_,_,_).

female(Y) :-
  person(Y,female,_,_,_).

mother(M,C) :-
  person(C,_,M,_,_).

father(F,C) :-
  person(C,_,_,F,_).

spouse(S,P) :-
  person(P,_,_,_,S),
  S \= single.

%----------------------------------------------------------------------
% Semantic Integrity Checks on Update
%

add_person(Name,Gender,Mother,Father,Spouse) :-
  retractall(message(_)),
  dup_check(Name),
  add(Name,Gender,Mother,Father,Spouse),
  ancestor_check(Name),
  mother_check(Name, Gender, Mother),
  father_check(Name, Gender, Father),
  spouse_check(Name, Spouse).

dup_check(Name) :-
  person(Name),
  assert(message($Person is already in database$)),
  !, fail.
dup_check(_).
  
ancestor_check(Name) :-
  ancestor(Name,Name),
  assert(message($Person is their own ancestor/descendent$)),
  !, fail.
ancestor_check(_).

mother_check(_, _, Mother) :- not(person(Mother)), !.
mother_check(_, _, Mother) :-
  male(Mother),
  assert(message($Person's mother is a man$)),
  !, fail.
mother_check(Name, male, _) :-
  mother(Name, X),
  assert(message($Person, a male, is someone's mother$)),
  !, fail.
mother_check(_,_,_).

father_check(_, _, Father) :- not(person(Father)), !.
father_check(_, _, Father) :-
  female(Father),
  assert(message($Person's father is a man$)),
  !, fail.
father_check(Name, female, _) :-
  father(Name, X),
  assert(message($Person, a female, is someone's father$)),
  !, fail.
father_check(_,_,_).

spouse_check(Name, Spouse) :-
  spouse(Name, X),
  X \= Spouse,
  assert(message($Person is already someone else's spouse$)),
  !, fail.
spouse_check(Name, Spouse) :-
  blood_relative(Name, Spouse),
  assert(message($Person is a blood relative of spouse$)),
  !, fail.
spouse_check(_,_).
  
blood_relative(X,Y) :- (ancestor(X,Y); ancestor(Y,X)).
blood_relative(X,Y) :- sibling(X,Y).
blood_relative(X,Y) :- cousin(X,Y).
blood_relative(X,Y) :- (uncle(X,Y); uncle(Y,X)).
blood_relative(X,Y) :- (aunt(X,Y); aunt(Y,X)).

Custord

% CUSTORD 

% This is a sample Prolog program which implements a portion
% of a customer order inventory application.  It is not intended to
% be complete, and only illustrates the concept of writing a database
% application in Prolog.

% This example extends the concept of an intelligent database to include
% a full database application.  It is really a rule based approach to
% transaction processing.  In fact a large percentage of the procedural
% code normally written in database applications has to do with
% enforcing semantic integrity rules involving multiple records.

% The distinction between data and process is thoroughly blurred.  Both
% reside together in the same logicbase.

% There is pure data as it might be defined in a relational database
% (customer, item, inventory, order); there are rules which really
% represent data views (item_quant); there are rules which add
% intelligence to the logicbase (good_customer, valid_order); and there
% are rules which are processes (order, report_inventory).  

main :- order.

% customer(Name, Town, Credit-rating).

customer(dennis, winchester, xxx).
customer(dave, lexington, aaa).
customer(ron, lexington, bbb).
customer(julie, winchester, aaa).
customer(jawaid, cambridge, aaa).
customer(tom, newton, ccc).

% item(Number, Name, Reorder-quantity).

item(p1,thing,10).
item(p2,stuff,10).
item(p3,article,10).
item(p4,object,10).
item(p5,substance,10).
item(p6,piece,10).
item(p7,matter,10).

% inventory(Number, Quantity).

inventory(p1,10).
inventory(p2,10).
inventory(p3,10).
inventory(p4,78).
inventory(p5,23).
inventory(p6,14).
inventory(p7,8).

% item-inv view or join

item_quant(Item, Quantity):-
  item(Partno, Item, _),
  inventory(Partno, Quantity).

% reorder if inventory below reorder point

reorder(Item):-
  item(Partno, Item, Reorder_point),
  inventory(Partno, Quantity),
  Quantity < Reorder_point,
  write('Time to reorder '),
  write(Item), nl.
reorder(Item):-
  write('Inventory level ok for '),
  write(Item), nl.

% a good customer has a credit rating of aaa 
% or lives in winchester
% or has ordered something

good_customer(Cust):-
  customer(Cust, _, aaa).
good_customer(Cust):-
  customer(Cust, winchester, _).
good_customer(Cust):-
  order(Cust, _, _).

% process order

order:-
  write('Customer: '),
  read(Customer),
  write('Item: '),
  read(Item),
  write('Quantity: '),
  read(Quantity),
  valid_order(Customer,Item,Quantity),
  asserta(order(Customer,Item,Quantity)),
  update_inventory(Item,Quantity),
  reorder(Item).

% an order is valid if
% it doesn't go below zero inventory and
% the customer is a good customer

valid_order(C, I, Q):-
  item(Partno, I, _),
  inventory(Partno, Onhand),
  Q =< Onhand,
  good_customer(C).
valid_order(C, I, Q):-
  write('Bad order'),
  nl,
  fail.

% update the inventory

update_inventory(I,Q):-
  item(Pn, I, _),
  inventory(Pn, Amount),
  NewQ is Amount - Q,
  retract(inventory(Pn, Amount)),
  asserta(inventory(Pn, NewQ)).

% inventory report

report_inventory:-
  item_quant(I, Q),
  write(I), tab(1),
  write(Q), nl,
  fail.
report_inventory:-true.  

Birds

% BIRDS

% This is a sample of a classification expert system for identification
% of certain kinds of birds. The rules are rough excerpts from "Birds of
% North America" by Robbins, Bruum, Zim, and Singer.

% This type of expert system can easily use Prolog's built in inferencing
% system. While trying to satisfy the goal "bird" it tries to satisfy
% various subgoals, some of which will ask for information from the
% user.

% The information is all stored as attribute-value pairs. The attribute
% is represented as a predicate, and the value as the argument to the
% predicate. For example, the attribute-value pair "color-brown" is
% stored "color(brown)".

% "identify" is the high level goal that starts the program. The
% predicate "known/3" is used to remember answers to questions, so it
% is cleared at the beginning of the run.

% The rules of identification are the bulk of the code. They break up
% the problem into identifying orders and families before identifying
% the actual birds.

% The end of the code lists those attribute-value pairs which need
% to be asked for, and defines the predicate "ask" and "menuask"
% which are used to get information from the user, and remember it.

main :- identify.

identify:-
  retractall(known(_,_,_)),         % clear stored information
  bird(X),
  write('The bird is a '),write(X),nl.
identify:-
  write('I can''t identify that bird'),nl.

order(tubenose):-
  nostrils(external_tubular),
  live(at_sea),
  bill(hooked).
order(waterfowl):-
  feet(webbed),
  bill(flat).
order(falconiforms):-
  eats(meat),
  feet(curved_talons),
  bill(sharp_hooked).
order(passerformes):-
  feet(one_long_backward_toe).

family(albatross):-
  order(tubenose),
  size(large),
  wings(long_narrow).
family(swan):-
  order(waterfowl),
  neck(long),
  color(white),
  flight(ponderous).
family(goose):-
  order(waterfowl),
  size(plump),
  flight(powerful).
family(duck):-
  order(waterfowl),
  feed(on_water_surface),
  flight(agile).
family(vulture):-
  order(falconiforms),
  feed(scavange),
  wings(broad).
family(falcon):-
  order(falconiforms),
  wings(long_pointed),
  head(large),
  tail(narrow_at_tip).
family(flycatcher):-
  order(passerformes),
  bill(flat),
  eats(flying_insects).
family(swallow):-
  order(passerformes),
  wings(long_pointed),
  tail(forked),
  bill(short).

bird(laysan_albatross):-
  family(albatross),
  color(white).
bird(black_footed_albatross):-
  family(albatross),
  color(dark).
bird(fulmar):-
  order(tubenose),
  size(medium),
  flight(flap_glide).
bird(whistling_swan):-
  family(swan),
  voice(muffled_musical_whistle).
bird(trumpeter_swan):-
  family(swan),
  voice(loud_trumpeting).
bird(canada_goose):-
  family(goose),
  season(winter),                % rules can be further broken down
  country(united_states),        % to include regions and migration
  head(black),                   % patterns
  cheek(white).
bird(canada_goose):-
  family(goose),
  season(summer),
  country(canada),
  head(black), 
  cheek(white).
bird(snow_goose):-
  family(goose),
  color(white).
bird(mallard):-
  family(duck),                  % different rules for male
  voice(quack),
  head(green).
bird(mallard):-
  family(duck),                  % and female
  voice(quack),
  color(mottled_brown).
bird(pintail):-
  family(duck),
  voice(short_whistle).
bird(turkey_vulture):-
  family(vulture),
  flight_profile(v_shaped).
bird(california_condor):-
  family(vulture),
  flight_profile(flat).
bird(sparrow_hawk):-
  family(falcon),
  eats(insects).
bird(peregrine_falcon):-
  family(falcon),
  eats(birds).
bird(great_crested_flycatcher):-
  family(flycatcher),
  tail(long_rusty).
bird(ash_throated_flycatcher):-
  family(flycatcher),
  throat(white).
bird(barn_swallow):-
  family(swallow),
  tail(forked).
bird(cliff_swallow):-
  family(swallow),
  tail(square).
bird(purple_martin):-
  family(swallow),
  color(dark).

country(united_states):- region(new_england).
country(united_states):- region(south_east).
country(united_states):- region(mid_west).
country(united_states):- region(south_west).
country(united_states):- region(north_west).
country(united_states):- region(mid_atlantic).

country(canada):- province(ontario).
country(canada):- province(quebec).
country(canada):- province(etc).

region(new_england):-
  state(X),
  member(X, [massachusetts, vermont, etc]).
region(south_east):-
  state(X),
  member(X, [florida, mississippi, etc]).

region(canada):-
  province(X),
  member(X, [ontario,quebec,etc]).

nostrils(X):- ask(nostrils,X).
live(X):- ask(live,X).
bill(X):- ask(bill,X).
size(X):- menuask(size,X,[large,plump,medium,small]).
eats(X):- ask(eats,X).
feet(X):- ask(feet,X).
wings(X):- ask(wings,X).
neck(X):- ask(neck,X).
color(X):- ask(color,X).
flight(X):- menuask(flight,X,[ponderous,powerful,agile,flap_glide,other]).
feed(X):- ask(feed,X).
head(X):- ask(head,X).
tail(X):- menuask(tail,X,[narrow_at_tip,forked,long_rusty,square,other]).
voice(X):- ask(voice,X).
season(X):- menuask(season,X,[winter,summer]).
cheek(X):- ask(cheek,X).
flight_profile(X):- menuask(flight_profile,X,[flat,v_shaped,other]).
throat(X):- ask(throat,X).
state(X):- menuask(state,X,[massachusetts,vermont,florida,mississippi,etc]).
province(X):- menuask(province,X,[ontario,quebec,etc]).

% "ask" is responsible for getting information from the user, and remembering
% the users response. If it doesn't already know the answer to a question
% it will ask the user. It then asserts the answer. It recognizes two
% cases of knowledge: 1) the attribute-value is known to be true,
% 2) the attribute-value is known to be false.

% This means an attribute might have multiple values. A third test to
% see if the attribute has another value could be used to enforce
% single valued attributes. (This test is commented out below)

% For this system the menuask is used for attributes which are single
% valued

% "ask" only deals with simple yes or no answers. a "yes" is the only
% yes value. any other response is considered a "no".

ask(Attribute,Value):-
  known(yes,Attribute,Value),       % succeed if we know its true
  !.                                % and dont look any further
ask(Attribute,Value):-
  known(_,Attribute,Value),         % fail if we know its false
  !, fail.

ask(Attribute,_):-
  known(yes,Attribute,_),           % fail if we know its some other value.
  !, fail.                          % the cut in clause #1 ensures that if
                                    % we get here the value is wrong.
ask(A,V):-
  write(A:V),                       % if we get here, we need to ask.
  write('? (yes or no): '),
  read(Y),                          % get the answer
  asserta(known(Y,A,V)),            % remember it so we dont ask again.
  Y = yes.                          % succeed or fail based on answer.

% "menuask" is like ask, only it gives the user a menu to to choose
% from rather than a yes on no answer. In this case there is no
% need to check for a negative since "menuask" ensures there will
% be some positive answer.

menuask(Attribute,Value,_):-
  known(yes,Attribute,Value),       % succeed if we know
  !.
menuask(Attribute,_,_):-
  known(yes,Attribute,_),           % fail if its some other value
  !, fail.

menuask(Attribute,AskValue,Menu):-
  nl,write('What is the value for '),write(Attribute),write('?'),nl,
  display_menu(Menu),
  write('Enter the number of choice> '),
  read(Num),nl,
  pick_menu(Num,AnswerValue,Menu),
  asserta(known(yes,Attribute,AnswerValue)),
  AskValue = AnswerValue.           % succeed or fail based on answer

display_menu(Menu):-
  disp_menu(1,Menu), !.             % make sure we fail on backtracking

disp_menu(_,[]).
disp_menu(N,[Item | Rest]):-        % recursively write the head of
  write(N),write(' : '),write(Item),nl, % the list and disp_menu the tail
  NN is N + 1,
  disp_menu(NN,Rest).

pick_menu(N,Val,Menu):-
  integer(N),                       % make sure they gave a number
  pic_menu(1,N,Val,Menu), !.        % start at one
  pick_menu(Val,Val,_).             % if they didn't enter a number, use
                                    % what they entered as the value

pic_menu(_,_,none_of_the_above,[]). % if we've exhausted the list
pic_menu(N,N, Item, [Item|_]).      % the counter matches the number
pic_menu(Ctr,N, Val, [_|Rest]):-
  NextCtr is Ctr + 1,               % try the next one
  pic_menu(NextCtr, N, Val, Rest).

参考：
Adventure In Prolog

Definite Clasue Grammer(DCG)，把连接符:-替换成为–>，这种表达形式由Prolog翻译成为普通的差异表形式。

使用DCG，原来的句子谓词将写为：
sentence –> nounphrase, verbphrase.

这个句子将被翻译成一般的使用差异表的Prolog子句，但是这里不再用“-”隔开，而是变成了两个参数，上面的这个句子与下面的Prolog子句等价。
sentence(S1, S2):-
nounphrase(S1, S3),
verbphrase(S3, S2).

find nani 的最终版本

% NANI SEARCH - A sample adventure game

% Nani Search is designed to illustrate Prolog programming.  It
% is an implementation of the principle example used in
% this tutorial.

main:- nani_search.       % main entry point

nani_search:-
  init_dynamic_facts,     % predicates which are not compiled

  write('NANI SEARCH - A Sample Adventure Game'),nl,
  write('Copyright (C) Amzi! inc. 1990-2010'),nl,
  write('No rights reserved, use it as you wish'),nl,
  nl,
  write('Nani Search is designed to illustrate Prolog programming.'),nl,
  write('As such, it might be the simplest adventure game.  The game'),nl,
  write('is the primary example used in this tutorial.'),nl,
  write('Full source is included as well.'),nl,
  nl,
  write('Your persona as the adventurer is that of a three year'),nl,
  write('old.  The Nani is your security blanket.  It is getting'),nl,
  write('late and you''re tired, but you can''t go to sleep'),nl,
  write('without your Nani.  Your mission is to find the Nani.'),nl,
  nl,
  write('You control the game by using simple English commands'),nl,
  write('expressing the action you wish to take.  You can go to'),nl,
  write('other rooms, look at your surroundings, look in things'),nl,
  write('take things, drop things, eat things, inventory the'),nl,
  write('things you have, and turn things on and off.'),nl,
  nl,
  write('Hit any key to continue.'),get0(_),
  write('Type "help" if you need more help on mechanics.'),nl,
  write('Type "hint" if you want a big hint.'),nl,
  write('Type "quit" if you give up.'),nl,
  nl,
  write('Enjoy the hunt.'),nl,

  look,                   % give a look before starting the game
  command_loop.

% command_loop - repeats until either the nani is found or the
%     player types quit

command_loop:-
  repeat,
  get_command(X),
  do(X),
  (nanifound; X == quit).

% do - matches the input command with the predicate which carries out
%     the command.  More general approaches which might work in the
%     listener are not supported in the compiler.  This approach
%     also gives tighter control over the allowable commands.

%     The cuts prevent the forced failure at the end of "command_loop"
%     from backtracking into the command predicates.

do(goto(X)):-goto(X),!.
do(nshelp):-nshelp,!.
do(hint):-hint,!.
do(inventory):-inventory,!.
do(take(X)):-take(X),!.
do(drop(X)):-drop(X),!.
do(eat(X)):-eat(X),!.
do(look):-look,!.
do(turn_on(X)):-turn_on(X),!.
do(turn_off(X)):-turn_off(X),!.
do(look_in(X)):-look_in(X),!.
do(quit):-quit,!.

% These are the predicates which control exit from the game.  If
% the player has taken the nani, then the call to "have(nani)" will
% succeed and the command_loop will complete.  Otherwise it fails
% and command_loop will repeat.

nanifound:-
  have(nani),        
  write('Congratulations, you saved the Nani.'),nl,
  write('Now you can rest secure.'),nl,nl.

quit:-
  write('Giving up?  It''s going to be a scary night'),nl,
  write('and when you get the Nani it''s not going'),nl,
  write('to smell right.'),nl,nl.

% The help command

nshelp:-
  write('Use simple English sentences to enter commands.'),nl,
  write('The commands can cause you to:'),nl,
  nl,
  write('   go to a room          (ex. go to the office)'),nl,
  write('   look around           (ex. look)'),nl,
  write('   look in something     (ex. look in the desk)'),nl,
  write('   take something        (ex. take the apple)'),nl,
  write('   drop something        (ex. drop the apple)'),nl,
  write('   eat something         (ex. eat the apple)'),nl,
  write('   turn something on     (ex. turn on the light)'),nl,
  write('   inventory your things (ex. inventory)'),nl,
  nl,
  write('The examples are verbose, terser commands and synonyms'),nl,
  write('are usually accepted.'),nl,nl,
  write('Hit any key to continue.'),nl,
  get0(_),
  look.

hint:-
  write('You need to get to the cellar, and you can''t unless'),nl,
  write('you get some light.  You can''t turn on the cellar'),nl,
  write('light, but there is a flash light in the desk in the'),nl,
  write('office you might use.'),nl,nl,
  look.

% Initial facts describing the world.  Rooms and doors do not change,
% so they are compiled.

room(office).
room(kitchen).
room('dining room').
room(hall).
room(cellar).

door(office,hall).
door(hall,'dining room').
door('dining room',kitchen).
door(kitchen,cellar).
door(kitchen,office).

connect(X,Y):-
  door(X,Y).
connect(X,Y):-
  door(Y,X).

% These facts are all subject to change during the game, so rather
% than being compiled, they are "asserted" to the listener at
% run time.  This predicate is called when "nanisrch" starts up.

init_dynamic_facts:-
  assertz(location(desk,office)),
  assertz(location(apple,kitchen)),
  assertz(location(flashlight,desk)),
  assertz(location('washing machine',cellar)),
  assertz(location(nani,'washing machine')),
  assertz(location(table,kitchen)),
  assertz(location(crackers,desk)),
  assertz(location(broccoli,kitchen)),
  assertz(here(kitchen)),
  assertz(turned_off(flashlight)),
  assertz(turned_on(workaround)), %workaround under swiprolog
  retract(turned_on(workaround)),
  assertz(have(workaround)),      %workaround under swiprolog
  retract(have(workaround)).

furniture(desk).
furniture('washing machine').
furniture(table).

edible(apple).
edible(crackers).

tastes_yuchy(broccoli).

%%%%%%%% COMMANDS %%%%%%%%%%%%%%%%%%%%%%%%%%

% goto moves the player from room to room.

goto(Room):-
  can_go(Room),                 % check for legal move
  puzzle(goto(Room)),           % check for special conditions
  moveto(Room),                 % go there and tell the player
  look.
goto(_):- look.

can_go(Room):-                  % if there is a connection it 
  here(Here),                   % is a legal move.
  connect(Here,Room),!.
can_go(Room):-
  respond(['You can''t get to ',Room,' from here']),fail.

moveto(Room):-                  % update the logicbase with the
  retract(here(_)),             % new room
  asserta(here(Room)).

% look lists the things in a room, and the connections

look:-
  here(Here),
  respond(['You are in the ',Here]),
  write('You can see the following things:'),nl,
  list_things(Here),
  write('You can go to the following rooms:'),nl,
  list_connections(Here).

list_things(Place):-
  location(X,Place),
  tab(2),write(X),nl,
  fail.
list_things(_).

list_connections(Place):-
  connect(Place,X),
  tab(2),write(X),nl,
  fail.
list_connections(_).

% look_in allows the player to look inside a thing which might
% contain other things

look_in(Thing):-
  location(_,Thing),               % make sure there's at least one
  write('The '),write(Thing),write(' contains:'),nl,
  list_things(Thing).
look_in(Thing):-
  respond(['There is nothing in the ',Thing]).

% take allows the player to take something.  As long as the thing is
% contained in the room it can be taken, even if the adventurer hasn't
% looked in the the container which contains it.  Also the thing
% must not be furniture.

take(Thing):-
  is_here(Thing),
  is_takable(Thing),
  move(Thing,have),
  respond(['You now have the ',Thing]).

is_here(Thing):-
  here(Here),
  contains(Thing,Here),!.          % don't backtrack
is_here(Thing):-
  respond(['There is no ',Thing,' here']),
  fail.

contains(Thing,Here):-             % recursive definition to find
  location(Thing,Here).            % things contained in things etc.
contains(Thing,Here):-
  location(Thing,X),
  contains(X,Here).

is_takable(Thing):-                % you can't take the furniture
  furniture(Thing),
  respond(['You can''t pick up a ',Thing]),
  !,fail.
is_takable(_).                     % not furniture, ok to take

move(Thing,have):-
  retract(location(Thing,_)),      % take it from its old place
  asserta(have(Thing)).            % and add to your possessions

% drop - allows the player to transfer a possession to a room

drop(Thing):-
  have(Thing),                     % you must have the thing to drop it
  here(Here),                      % where are we
  retract(have(Thing)),
  asserta(location(Thing,Here)).
drop(Thing):-
  respond(['You don''t have the ',Thing]).


% eat, because every adventure game lets you eat stuff.

eat(Thing):-
  have(Thing),
  eat2(Thing).
eat(Thing):-
  respond(['You don''t have the ',Thing]).
  
eat2(Thing):-
  edible(Thing),
  retract(have(Thing)),
  respond(['That ',Thing,' was good']).
eat2(Thing):-
  tastes_yuchy(Thing),
  respond(['Three year olds don''t eat ',Thing]).
eat2(Thing):-
  respond(['You can''t eat a ',Thing]).

% inventory list your possesions

inventory:-
  have(X),                         % make sure you have at least one thing
  write('You have: '),nl,
  list_possessions.
inventory:-
  write('You have nothing'),nl.

list_possessions:-
  have(X),
  tab(2),write(X),nl,
  fail.
list_possessions.

% turn_on recognizes two cases.  If the player tries to simply turn
% on the light, it is assumed this is the room light, and the
% appropriate error message is issued.  Otherwise turn_on has to
% refer to an object which is turned_off.

turn_on(light):-
  respond(['You can''t reach the switch and there''s nothing to stand on']).

turn_on(Thing):-
  have(Thing),
  turn_on2(Thing).
turn_on(Thing):-
  respond(['You don''t have the ',Thing]).

turn_on2(Thing):-
  turned_on(Thing),
  respond([Thing,' is already on']).
turn_on2(Thing):-
  turned_off(Thing),
  retract(turned_off(Thing)),
  asserta(turned_on(Thing)),
  respond([Thing,' turned on']).
turn_on2(Thing):-
  respond(['You can''t turn a ',Thing,' on']).

% turn_off - I didn't feel like implementing turn_off （作者好任性啊）

turn_off(Thing):-
  respond(['I lied about being able to turn things off']).

% The only special puzzle in Nani Search has to do with going to the
% cellar.  Puzzle is only called from goto for this reason.  Other
% puzzles pertaining to other commands could easily be added.

puzzle(goto(cellar)):-
  have(flashlight),
  turned_on(flashlight),!.
puzzle(goto(cellar)):-
  write('You can''t go to the cellar because it''s dark in the'),nl,
  write('cellar, and you''re afraid of the dark.'),nl,
  !,fail.
puzzle(_).

% respond simplifies writing a mixture of literals and variables
 
respond([]):-
  write('.'),nl,nl.
respond([H|T]):-
  write(H),
  respond(T).

% Simple English command listener.  It does some semantic checking
% and allows for various synonyms.  Within a restricted subset of
% English, a command can be phrased many ways.  Also non grammatical
% constructs are understood, for example just giving a room name
% is interpreted as the command to goto that room.

% Some interpretation is based on the situation.  Notice that when
% the player says turn on the light it is ambiguous.  It could mean
% the room light (which can't be turned on in the game) or the
% flash light.  If the player has the flash light it is interpreted
% as flash light, otherwise it is interpreted as room light.

get_command(C):-
  readlist(L),        % reads a sentence and puts [it,in,list,form]
  command(X,L,[]),    % call the grammar for command
  C =.. X,!.          % make the command list a structure
get_command(_):-
  respond(['I don''t understand, try again or type help']),fail.

% The grammar doesn't have to be real English.  There are two
% types of commands in Nani Search, those with and without a 
% single argument.  A special case is also made for the command
% goto which can be activated by simply giving a room name.

command([Pred,Arg]) --> verb(Type,Pred),nounphrase(Type,Arg).
command([Pred]) --> verb(intran,Pred).
command([goto,Arg]) --> noun(go_place,Arg).

% Recognize three types of verbs.  Each verb corresponds to a command,
% but there are many synonyms allowed.  For example the command
% turn_on will be triggered by either "turn on" or "switch on".

verb(go_place,goto) --> go_verb.
verb(thing,V) --> tran_verb(V).
verb(intran,V) --> intran_verb(V).

go_verb --> [go].
go_verb --> [go,to].
go_verb --> [g].

tran_verb(take) --> [take].
tran_verb(take) --> [pick,up].
tran_verb(drop) --> [drop].
tran_verb(drop) --> [put].
tran_verb(drop) --> [put,down].
tran_verb(eat) --> [eat].
tran_verb(turn_on) --> [turn,on].
tran_verb(turn_on) --> [switch,on].
tran_verb(turn_off) --> [turn,off].
tran_verb(look_in) --> [look,in].
tran_verb(look_in) --> [look].
tran_verb(look_in) --> [open].

intran_verb(inventory) --> [inventory].
intran_verb(inventory) --> [i].
intran_verb(look) --> [look].
intran_verb(look) --> [look,around].
intran_verb(look) --> [l].
intran_verb(quit) --> [quit].
intran_verb(quit) --> [exit].
intran_verb(quit) --> [end].
intran_verb(quit) --> [bye].
intran_verb(nshelp) --> [help].
intran_verb(hint) --> [hint].

% a noun phrase is just a noun with an optional determiner in front.

nounphrase(Type,Noun) --> det,noun(Type,Noun).
nounphrase(Type,Noun) --> noun(Type,Noun).

det --> [the].
det --> [a].

% Nouns are defined as rooms, or things located somewhere.  We define
% special cases for those things represented in Nani Search by two
% words.  We can't expect the user to type the name in quotes.

noun(go_place,R) --> [R], {room(R)}.
noun(go_place,'dining room') --> [dining,room].

noun(thing,T) --> [T], {location(T,_)}.
noun(thing,T) --> [T], {have(T)}.
noun(thing,flashlight) --> [flash,light].
noun(thing,'washing machine') --> [washing,machine].
noun(thing,'dirty clothes') --> [dirty,clothes].

% If the player has just typed light, it can be interpreted three ways.
% If a room name is before it, it must be a room light.  If the
% player has the flash light, assume it means the flash light.  Otherwise
% assume it is the room light.

noun(thing,light) --> [X,light], {room(X)}.
noun(thing,flashlight) --> [light], {have(flashlight)}.
noun(thing,light) --> [light].

% readlist - read a list of words, based on a Clocksin & Mellish
% example.

readlist(L):-
  write('> '),
  read_word_list(L).

read_word_list([W|Ws]) :-
  get0(C),
  readword(C, W, C1),       % Read word starting with C, C1 is first new
  restsent(C1, Ws), !.      % character - use it to get rest of sentence

restsent(C,[]) :- lastword(C), !. % Nothing left if hit last-word marker
restsent(C,[W1|Ws]) :-
  readword(C,W1,C1),        % Else read next word and rest of sentence
  restsent(C1,Ws).

readword(C,W,C1) :-         % Some words are single characters
  single_char(C),           % i.e. punctuation
  !, 
  name(W, [C]),             % get as an atom
  get0(C1).
readword(C, W, C1) :-
  is_num(C),                % if we have a number --
  !,
  number_word(C, W, C1, _). % convert it to a genuine number
readword(C,W,C2) :-         % otherwise if character does not
  in_word(C, NewC),         % delineate end of word - keep
  get0(C1),                 % accumulating them until 
  restword(C1,Cs,C2),       % we have all the word     
  name(W, [NewC|Cs]).       % then make it an atom
readword(C,W,C2) :-         % otherwise
  get0(C1),       
  readword(C1,W,C2).        % start a new word

restword(C, [NewC|Cs], C2) :-
  in_word(C, NewC),
  get0(C1),
  restword(C1, Cs, C2).
restword(C, [], C).


single_char(0',).
single_char(0';).
single_char(0':).
single_char(0'?).
single_char(0'!).
single_char(0'.).


in_word(C, C) :- C >= 0'a, C =< 0'z.
in_word(C, L) :- C >= 0'A, C =< 0'Z, L is C + 32.
in_word(0'',0'').
in_word(0'-,0'-).

% Have character C (known integer) - keep reading integers and build
% up the number until we hit a non-integer. Return this in C1,
% and return the computed number in W.

number_word(C, W, C1, Pow10) :- 
  is_num(C),
  !,
  get0(C2),
  number_word(C2, W1, C1, P10),
  Pow10 is P10 * 10,
  W is integer(((C - 0'0) * Pow10) + W1).
number_word(C, 0, C, 0.1).


is_num(C) :-
  C =< 0'9,
  C >= 0'0.

% These symbols delineate end of sentence

lastword(10).   % end if new line entered
lastword(0'.).
lastword(0'!).
lastword(0'?).

我们可以试一下

?- nani_search().
NANI SEARCH - A Sample Adventure Game
Copyright (C) Amzi! inc. 1990-2010
No rights reserved, use it as you wish

Nani Search is designed to illustrate Prolog programming.
As such, it might be the simplest adventure game.  The game
is the primary example used in this tutorial.
Full source is included as well.

Your persona as the adventurer is that of a three year
old.  The Nani is your security blanket.  It is getting
late and you're tired, but you can't go to sleep
without your Nani.  Your mission is to find the Nani.

You control the game by using simple English commands
expressing the action you wish to take.  You can go to
other rooms, look at your surroundings, look in things
take things, drop things, eat things, inventory the
things you have, and turn things on and off.

Hit any key to continue.
Type "help" if you need more help on mechanics.
Type "hint" if you want a big hint.
Type "quit" if you give up.

Enjoy the hunt.
You are in the kitchen.

You can see the following things:
  apple
  table
  broccoli
You can go to the following rooms:
  cellar
  office
  dining room
> help
Use simple English sentences to enter commands.
The commands can cause you to:

   go to a room          (ex. go to the office)
   look around           (ex. look)
   look in something     (ex. look in the desk)
   take something        (ex. take the apple)
   drop something        (ex. drop the apple)
   eat something         (ex. eat the apple)
   turn something on     (ex. turn on the light)
   inventory your things (ex. inventory)

The examples are verbose, terser commands and synonyms
are usually accepted.

Hit any key to continue.
|: 
You are in the kitchen.

You can see the following things:
  apple
  table
  broccoli
You can go to the following rooms:
  cellar
  office
  dining room
> take the apple
You now have the apple.

> go to the office
You are in the office.

You can see the following things:
  desk
You can go to the following rooms:
  hall
  kitchen
> look in the desk
The desk contains:
  flashlight
  crackers
> take the crackers
You now have the crackers.

> take the flashlight
You now have the flashlight.

>turn on the flashlight
flashlight turned on.

> go to the kitchen
You are in the kitchen.

You can see the following things:
  table
  broccoli
You can go to the following rooms:
  cellar
  office
  dining room

> eat the apple
That apple was good.

> eat the crackers
That crackers was good.

> go to the cellar
You are in the cellar.

You can see the following things:
  washing machine
You can go to the following rooms:
  kitchen
look in the washing machine
The washing machine contains:
  nani
> take nani
You now have the nani.

Congratulations, you saved the Nani.
Now you can rest secure.

true .

参考：
Adventure In Prolog

首先，我们用英文语法分析两个句子：
The dog ate the bone.
The big brown mouse chases a lazy cat.

sentence（句子）: 
nounphrase（名词短语）, verbphrase（动词短语）.  

nounphrase（名词短语）: 
determiner（限定词）, nounexpression（名词表达式）.  
nounphrase （名词短语）: 
nounexpression（名词表达式）.  

nounexpression（名词表达式）:  
noun.  
nounexpression（名词表达式）:
adjective（形容词）, nounexpression（名词表达式）.  

verbphrase（动词短语）: 
verb（动词）, nounphrase（名词短语）.  

determiner（限定词）: 
the | a.  

noun（名词）: 
dog | bone | mouse | cat.  

verb（动词）: 
ate | chases.  

adjective（形容词）:  
big | brown | lazy.  

差异表：它由两个相关的表构成，第一个表称为全表，而第二个表称为余表。通常使用‘-’连接这两个表。它的形式是X-Y。

%单个词的判断规则：如果列表的第一个元素是所需的单词，那么余表就是除去第一个单词的表。
%名词
noun([dog|X]-X). 
noun([cat|X]-X). 
noun([mouse|X]-X). 

%动词
verb([ate|X]-X). 
verb([chases|X]-X). 

%形容词
adjective([big|X]-X). 
adjective([brown|X]-X). 
adjective([lazy|X]-X). 

%限定词
determiner([the|X]-X). 
determiner([a|X]-X). 

%短语判断规则
nounphrase(NP-X):- 
determiner(NP-S1), 
nounexpression(S1-X). 

nounphrase(NP-X):- 
nounexpression(NP-X). 
nounexpression(NE-X):- 
noun(NE-X). 

nounexpression(NE-X):- 
adjective(NE-S1), 
nounexpression(S1-X). 

verbphrase(VP-X):- 
verb(VP-S1), 
nounphrase(S1-X).

%语句判断规则：如果能够从列表S的头开始，提取出一个名词短语，其余部分S1,并且能够从S1的头开始，提取出一个动词短语，并且其余部分为空表，那么列表S是一个句子。
sentence(S) :- 
nounphrase(S-S1), 
verbphrase(S1-[]). 

测试一下：

?- sentence([the,lazy,mouse,ate,a,dog]).
true .

?- sentence([the,dog,ate]).
false.

?- sentence([a,big,brown,cat,chases,a,lazy,brown,dog]).
true .

?- sentence([the,cat,jumps,on,the,mouse]).
false.

递归与尾递归：

%需要栈记录中间结果
factorial_1(1,1).
factorial_1(N,F):- 
N > 1,
NN is N - 1,
factorial_1(NN,FF),
F is N * FF.

%不需要记录中间结果
factorial_2(1,F,F). 
factorial_2(N,T,F):- 
N > 1,
TT is N * T,
NN is N - 1,
factorial_2(NN,TT,F).

?- factorial_1(5,X).
X = 120 .

?- factorial_2(5,1,X).
X = 120 .

%用栈记录中间结果
reverse_1([],[]). 
reverse_1([H|T],Rev):- 
reverse_1(T,TR), 
append(TR,[H],Rev).

%借助变量记录中间结果
reverse_2([], Rev, Rev). 
reverse_2([H|T], Temp, Rev) :- 
reverse_2(T, [H|Temp], Rev). 

?- reverse_1([a,b,c,d,e],X).
X = [e, d, c, b, a].

?- reverse_2([a,b,c,d,e],[],X).
X = [e, d, c, b, a].

谓词repeat，相当于循环，根据最后一句语句判断是否退出循环。

sayhi:-
write('What is your name?'),
read(X),write('Hi '),write(X).

sayhito(X):-
write('Hi '),write(X).
do(sayhito(X)):-sayhito(X),!. 

loop_test:-
repeat, 
write('Enter command (end to exit): '), 
read(X), 
write(">>"), 
write(X), 
nl, 
X=end. 

用纯逻辑方法改写一下nani的例子

% a nonassertive version of nani search  

nani :- 
write('Welcome to Nani Search'), 
nl, 
initial_state(State), 
control_loop(State). 

control_loop(State) :- 
end_condition(State). 
control_loop(State) :- 
repeat, 
write('> '), 
read(X), 
constraint(State, X), 
do(State, NewState, X), 
control_loop(NewState). 

% initial dynamic state  
initial_state([ 
here(kitchen), 
have([]), 
location([ 
kitchen/apple, 
kitchen/broccoli, 
office/desk, 
office/flashlight, 
cellar/nani ]), 
status([ 
flashlight/off, 
game/on]) ]). 

% static state  
rooms([office, kitchen, cellar]). 
doors([office/kitchen, cellar/kitchen]). 

connect(X,Y) :- 
doors(DoorList), 
member(X/Y, DoorList). 
connect(X,Y) :- 
doors(DoorList), 
member(Y/X, DoorList). 

% list utilities  
member(X,[X|Y]). 
member(X,[Y|Z]) :- member(X,Z). 

delete(X, [], []). 
delete(X, [X|T], T). 
delete(X, [H|T], [H|Z]) :- delete(X, T, Z). 

% state manipulation utilities
get_state(State, here, X) :- 
member(here(X), State). 
get_state(State, have, X) :- 
member(have(Haves), State), 
member(X, Haves). 
get_state(State, location, Loc/X) :- 
member(location(Locs), State), 
member(Loc/X, Locs). 
get_state(State, status, Thing/Stat) :- 
member(status(Stats), State), 
member(Thing/Stat, Stats). 

del_state(OldState, [location(NewLocs) | Temp], location, Loc/X):- 
delete(location(Locs), OldState, Temp), 
delete(Loc/X, Locs, NewLocs). 

add_state(OldState, [here(X)|Temp], here, X) :- 
delete(here(_), OldState, Temp). 
add_state(OldState, [have([X|Haves])|Temp], have, X) :- 
delete(have(Haves), OldState, Temp). 
add_state(OldState, [status([Thing/Stat|TempStats])|Temp], status, Thing/Stat) :- 
delete(status(Stats), OldState, Temp), 
delete(Thing/_, Stats, TempStats). 

% end condition  
end_condition(State) :- 
get_state(State, have, nani), 
write('You win'). 

end_condition(State) :- 
get_state(State, status, game/off), 
write('quitter'). 

% constraints and puzzles together  
constraint(State, goto(cellar)) :- 
!, can_go_cellar(State). 
constraint(State, goto(X)) :- 
!, can_go(State, X). 
constraint(State, take(X)) :- 
!, can_take(State, X). 
constraint(State, turn_on(X)) :- 
!, can_turn_on(State, X). 
constraint(_, _). 

can_go(State,X) :- 
get_state(State, here, H), 

connect(X,H). 
can_go(_, X) :- 
write('You can''t get there from here'), 
nl, fail. 

can_go_cellar(State) :- 
can_go(State, cellar), 
!, cellar_puzzle(State). 

cellar_puzzle(State) :- 
get_state(State, have, flashlight), 
get_state(State, status, flashlight/on). 
cellar_puzzle(_) :- 
write('It''s dark in the cellar'), 
nl, fail. 

can_take(State, X) :- 
get_state(State, here, H), 
get_state(State, location, H/X). 
can_take(State, X) :- 
write('it is not here'), 
nl, fail. 

can_turn_on(State, X) :- 
get_state(State, have, X). 
can_turn_on(_, X) :- 
write('You don''t have it'), 
nl, fail. 

% commands  
do(Old, New, goto(X)) :- goto(Old, New, X), !. 
do(Old, New, take(X)) :- take(Old, New, X), !. 
do(Old, New, turn_on(X)) :- turn_on(Old, New, X), !. 
do(State, State, look) :- look(State), !. 
do(Old, New, quit) :- quit(Old, New). 
do(State, State, _) :- 
write('illegal command'), nl. 

look(State) :- 
get_state(State, here, H), 
write('You are in  '), write(H), nl, 
write('You can see'), list_things(State, H), nl,
write('You have'), list_bag(State, H), nl,
write('You can go'), list_rooms(H), nl. 

list_things(State, H) :- 
get_state(State, location, H/X), 
tab(2), write(X), 
fail. 
list_things(_, _). 

list_rooms(H) :- 
connect(X,H),tab(2),write(X),fail.
list_rooms(_).

list_bag(State, H) :- 
get_state(State, have, X), 
tab(2), write(X), 
fail. 
list_bag(_, _). 

goto(Old, New, X) :- 
add_state(Old, New, here, X), 
look(New). 

take(Old, New, X) :- 
get_state(Old, here, H), 
del_state(Old, Temp, location, H/X), 
add_state(Temp, New, have, X). 

turn_on(Old, New, X) :- 
add_state(Old, New, status, X/on). 

quit(Old, New) :- 
add_state(Old, New, status, game/off).

试一下

?- nani().
Welcome to Nani Search
> look.
You are in  kitchen
You can see  apple  broccoli
You have
You can go  office  cellar
> |: take(apple).
> |: take(broccoli).
> |: goto(office).
You are in  office
You can see  desk  flashlight
You have  broccoli  apple
You can go  kitchen
> |: take(desk).
> |: take(flashlight).
> |: goto(kitchen).
You are in  kitchen
You can see
You have  flashlight  desk  broccoli  apple
You can go  office  cellar
> |turn_on(flashlight).
> |: goto(cellar).
You are in  cellar
You can see  nani
You have  flashlight  desk  broccoli  apple
You can go  kitchen
> |: take(nani).
You win
true .

使用Prolog时，有时需要人为的终止回溯，此时会用到谓词cut，使用符号！来表示。

data(one).  
data(two). 
data(three).

cut_test_a(X) :- data(X).
cut_test_a('last clause').

cut_test_b(X) :- data(X), !.  
cut_test_b('last clause').

cut_test_c(X,Y) :- data(X), !, data(Y).
cut_test_c('last clause'). 

来测试一下

1- cut_test_a(X), write(X), nl, fail. 
one
two
three
last clause
false.

2- cut_test_b(X), write(X), nl, fail. 
one
false.

3- cut_test_c(X,Y), write(X-Y), nl, fail.
one-one
one-two
one-three
false.

此外，可以用not谓词判断条件是否成立

not(X) :- call(X), !, fail. 
not(X)

下面两种方式是等效的：

have(apple).

eat():-
write('yummy...').

eat_fruit_a(X):- 
have(X), 
!,
eat().

eat_fruit_b(X):-  not(can_not_eat(X)),eat().
can_not_eat(X):-  
not(have(X)).

eat_fruit_c(X):-  can_eat(X),eat().
can_eat(X):- have(X).
can_eat(X):- fail.

1- eat_fruit_a(apple).
yummy...
true.

2- eat_fruit_a(pear).
false.

3- eat_fruit_b(apple).
yummy...
true.

4- eat_fruit_b(pear).
false.

5- eat_fruit_c(apple).
yummy...
true .

6- eat_fruit_c(pear).
false.

可以用op/3把任何谓词定义为操作符，每个操作符有不同的优先权值，从1到1200。当某句中有多个操作符时，优先权高的将先被考虑，优先权值越小优先权越高。

Prolog操作符有三种形式,其结合性如下：
中缀（infix）：例如3+4
xfx 没有结合性
xfy 从右向左
yfx 从左向右

前缀（prefix）：例如-7
fx 没有结合性
fy 从右向左

后缀（postfix）：例如8f
xf 没有结合性
yf 从右向左

op/3需要三个参数，分别是：优先权、结合性、操作符名称。

其实Prolog程序的子语句也是使用操作符书写的Prolog数据结构。这里的操作符是”:-“，它是中缀操作符，有两个参数。
:-(Head, Body).

Body也是由操作符书写的数据结构。这里的操作符为”,”，它表示并且的意思，所以Body的形式如下：
,(goal1, ,(goal2,,goal3))

好像看不明白，操作符”,”与分隔符”,”无法区别，所以我们就是用”&”来代替操作符”,”，于是上面的形式就变成了下面这个样子了。
&(goal1, &(goal2, & goal3))

下面的两种形式表达的意思是相同的。
head :- goal1 & goal2 & goal3.
:-(head, &(goal1, &(goal2, & goal3))).

实际上是下面的形式：
head :- goal1 , goal2 , goal3.
:-(head, ,(goal1, ,(goal2, , goal3))).

下面用操作符改写一下roomlist：

%swipl -s operator.pl
%Hansen

%动态函数声明
:-dynamic here/1.
:-dynamic is_in/2.
:-dynamic in_bag/1.
:-dynamic take_thing/2.
:-dynamic put_thing/2.

%定义操作符
:-op(100,fx,is_room).
:-op(101,xfx,is_in).
:-op(101,fx,in_bag).
:-op(101,fx,move).
:-op(101,fx,eat).
:-op(101,f,look).

%房间定义
room(X):- is_room List,member(X,List).
is_room [kitchen,office,hall,diningroom,cellar]. 

%门定义
door(X,Y):- door_list(List),member([X,Y],List).
door_list([[office, hall],[kitchen, office],[hall, diningroom],[kitchen, cellar],[diningroom, kitchen]]).

%规则：有门的两个房间是相通的
connect(X,Y):- door(X,Y).
connect(X,Y):- door(Y,X).

%物品在哪个房间
location(X,Y):- List is_in Y, member(X, List).
[apple, broccoli, crackers] is_in kitchen. 
[desk, computer] is_in office.
[flashlight, envelope] is_in desk.
[stamp, key] is_in envelope.
[] is_in hall.
[] is_in diningroom.
[washingmachine] is_in cellar. 
[nani] is_in washingmachine.

%房间减少物品
take_thing(Thing, Place):- 
retract(List is_in Place),
delete(List,Thing,ThingsLeft),
asserta(ThingsLeft is_in Place). 

%房间增加物品
put_thing(Thing, Place):-  
retract(List is_in Place),
asserta([Thing|List] is_in Place).

%背包有哪些物品
bag(X):-in_bag List, member(X, List).
in_bag [tourch].

%背包增加物品
bag_in(Thing):- 
retract(in_bag List),
asserta(in_bag [Thing|List]).

%背包减少物品
bag_out(Thing):-
retract(in_bag List),
delete(List,Thing,ThingsLeft),
asserta(in_bag ThingsLeft). 

%哪些物品可以吃
edible(X):- 
member(X,[apple,crackers,broccoli]).

%当前位置
here(hall).

%房间之间移动
move(Place):- can_go(Place),retract(here(X)), asserta(here(Place)).
can_go(Place):- here(X), connect(X, Place).
can_go(Place):- write('You can''t go to '),write(Place),write(' from here.'), nl, fail.

%拿起物品
take(X):- can_take(X), here(Place), take_thing(X,Place), bag_in(X), write(X), write(' taken.'), nl.
can_take(Thing):- here(Place), location(Thing, Place).
can_take(Thing):- write('There is no '), write(Thing), write(' here.'), nl, fail.

%放下物品
put(X):- can_put(X), here(Place), bag_out(X), put_thing(X,Place), write(X), write(' put.'), nl.
can_put(Thing):- bag(Thing). 
can_put(Thing):- write('There is no '), write(Thing), write(' in your bag.'), nl, fail. 

%房间物品列表
list_things(Place):- location(X, Place),tab(2),write(X),nl,fail.
list_things(_).

%与Place相连的房间
list_connections(Place):- connect(Place, X),tab(2),write(X),nl,fail.
list_connections(_).

%持有物品列表
list_bag(Thing):- bag(X),tab(2),write(X),nl,fail.
list_bag(_).

%吃东西
eat(Thing):- can_eat(Thing), bag_out(Thing), write(Thing), write(' eaten. Yummy!').
can_eat(Thing):- bag(Thing), edible(Thing).
can_eat(Thing):- not(bag(Thing)), write('There is no '), write(Thing), write(' in your bag.'), nl, fail. 
can_eat(Thing):- bag(Thing), write('You can''t eat the '), write(Thing), write('.'), nl, fail. 

%查看房间情况
look :-
here(Place), write('You are in the '), write(Place), nl,
write('You can see:'),nl,list_things(Place),  
write('You can go to:'), nl, list_connections(Place),
write('You have:'),nl,list_bag(Thing).

%帮助
game :-
write('Look around: look/0'),nl,
write('Move around: move/1'),nl,
write('Take something: take/1'),nl,
write('Eat something: eat/1').

现在我们使用列表，重写一下room.pl文件。

%swipl -s roomlist.pl
%Hansen

%动态函数声明
:-dynamic here/1.
:-dynamic location_list/2.
:-dynamic bag_list/1.
:-dynamic take_thing/2.
:-dynamic put_thing/2.

%房间定义
room(X):- room_list(List),member(X,List).
room_list([kitchen,office,hall,diningroom,cellar]). 

%门定义
door(X,Y):- door_list(List),member([X,Y],List).
door_list([[office, hall],[kitchen, office],[hall, diningroom],[kitchen, cellar],[diningroom, kitchen]]).

%规则：有门的两个房间是相通的
connect(X,Y):- door(X,Y).
connect(X,Y):- door(Y,X).

%物品在哪个房间
location(X,Y):- location_list(List, Y), member(X, List).
location_list([apple, broccoli, crackers], kitchen). 
location_list([desk, computer], office).
location_list([flashlight, envelope], desk).
location_list([stamp, key], envelope).
location_list([], hall).
location_list([], diningroom).
location_list([washingmachine], cellar). 
location_list([nani], washingmachine).

%房间减少物品
take_thing(Thing, Place):- 
retract(location_list(List, Place)),
delete(List,Thing,ThingsLeft),
asserta(location_list(ThingsLeft,Place)). 

%房间增加物品
put_thing(Thing, Place):-  
retract(location_list(List, Place)),
asserta(location_list([Thing|List],Place)).

%背包有哪些物品
bag(X):-bag_list(List), member(X, List).
bag_list([tourch]).

%背包增加物品
bag_in(Thing):- 
retract(bag_list(List)),
asserta(bag_list([Thing|List])).

%背包减少物品
bag_out(Thing):-
retract(bag_list(List)),
delete(List,Thing,ThingsLeft),
asserta(bag_list(ThingsLeft)). 

%哪些物品可以吃
edible(X):- 
member(X,[apple,crackers,broccoli]).

%当前位置
here(hall).

%房间之间移动
move(Place):- can_go(Place),retract(here(X)), asserta(here(Place)).
can_go(Place):- here(X), connect(X, Place).
can_go(Place):- write('You can''t go to '),write(Place),write(' from here.'), nl, fail.

%拿起物品
take(X):- can_take(X), here(Place), take_thing(X,Place), bag_in(X), write(X), write(' taken.'), nl.
can_take(Thing):- here(Place), location(Thing, Place).
can_take(Thing):- write('There is no '), write(Thing), write(' here.'), nl, fail.

%放下物品
put(X):- can_put(X), here(Place), bag_out(X), put_thing(X,Place), write(X), write(' put.'), nl.
can_put(Thing):- bag(Thing). 
can_put(Thing):- write('There is no '), write(Thing), write(' in your bag.'), nl, fail. 

%房间物品列表
list_things(Place):- location(X, Place),tab(2),write(X),nl,fail.
list_things(_).

%与Place相连的房间
list_connections(Place):- connect(Place, X),tab(2),write(X),nl,fail.
list_connections(_).

%持有物品列表
list_bag(Thing):- bag(X),tab(2),write(X),nl,fail.
list_bag(_).

%吃东西
eat(Thing):- can_eat(Thing), bag_out(Thing), write(Thing), write(' eaten. Yummy!').
can_eat(Thing):- bag(Thing), edible(Thing).
can_eat(Thing):- not(bag(Thing)), write('There is no '), write(Thing), write(' in your bag.'), nl, fail. 
can_eat(Thing):- bag(Thing), write('You can''t eat the '), write(Thing), write('.'), nl, fail. 

%查看房间情况
look :-
here(Place), write('You are in the '), write(Place), nl,
write('You can see:'),nl,list_things(Place),  
write('You can go to:'), nl, list_connections(Place),
write('You have:'),nl,list_bag(Thing).

%帮助
game :-
write('Look around: look/0'),nl,
write('Move around: move/1'),nl,
write('Take something: take/1'),nl,
write('Eat something: eat/1').

进行查询

%查找与kitchen相连的房间
1 ?- findall(X, connect(kitchen, X), List).
List = [office, cellar, diningroom].

%查找全部食物与位置
2 ?- findall(foodat(X,Y), (location(X,Y) , edible(X)), L).
L = [foodat(broccoli, kitchen), foodat(crackers, kitchen)].